fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ChangeLog 19990908-17:00 GMT+2

Browse Source
This commit is contained in:
Ryszard Glab
1999-09-08 15:08:25 +00:00
parent 6b91104883
commit b40b9b2105
7 changed files with 494 additions and 63 deletions
Download Patch File Download Diff File Expand all files Collapse all files

28
harbour/ChangeLog
View File

@@ -1,3 +1,31 @@
19990908-17:00 GMT+2 Ryszard Glab <rglab@imid.med.pl>
*source/compiler/harbour.y
* corrected handling of parenthesized expressions
* corrected generation of pcodes for declaration of dimensioned
array variables ( LOCAL var[ 2, 4 ] ) - there is no longer POP
opcode between array dimensions
*source/vm/hvm.c
+ added code that creates multi-dimensioned arrays
(arrays declared by LOCAL arr[ 3, 5, getDim() ] - it
supports PRIVATE and PUBLIC declaration too)
*source/rtl/arrays.c
+ added functions hb_arrayGetItemPointer() which returns a pointer
to an item occcupied by a specified array element
*include/extend.h
+ added declaration of hb_arrayGetItemPointer() function
*tests/broken/parexpr.prg
! moved to tests/working directory
+ added some code to test IF and IIF expressions (it is really
related to parenthesized expressions)
*tests/working/Makefile
+ added parexpr.prg
19990908-10:30 EDT David G. Holm <dholm@jsd-llc.com>
* source/rtl/environ.c
! I restored the Windows #ifdef #include block from the 1.43 version,

1
harbour/include/extend.h
View File

@@ -288,6 +288,7 @@ extern BOOL hb_arrayLast( PHB_ITEM pArray, PHB_ITEM pResult );
extern BOOL hb_arrayRelease( PHB_ITEM pArray ); /* releases an array - don't call it - use ItemRelease() !!! */
extern BOOL hb_arraySet( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem ); /* sets an array element */
extern BOOL hb_arrayGet( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem ); /* retrieves an item */
extern PHB_ITEM hb_arrayGetItemPointer( PHB_ITEM pArray, ULONG ulIndex ); /* returns pointer to specified element of the array */
extern ULONG hb_arrayCopyC( PHB_ITEM pArray, ULONG ulIndex, char * szBuffer, ULONG ulLen );
extern char * hb_arrayGetC( PHB_ITEM pArray, ULONG ulIndex ); /* retrieves the string contained on an array element */
extern char * hb_arrayGetCPtr( PHB_ITEM pArray, ULONG ulIndex ); /* retrieves the string pointer on an array element */

352
harbour/source/compiler/harbour.y
View File

@@ -139,6 +139,22 @@ void AliasSwap( void );
void AliasAdd( ALIASID_PTR );
void AliasRemove( void );
/* Support for parenthesized expressions
*/
typedef struct _EXPLIST
{
BYTE * prevPCode; /* pcode buffer used at the start of expression */
LONG prevSize;
LONG prevPos;
BYTE * exprPCode; /* pcode buffer for current expression */
LONG exprSize;
struct _EXPLIST *pPrev; /* previous expression in the list */
struct _EXPLIST *pNext; /* next expression in the list */
} EXPLIST, *EXPLIST_PTR;
void ExpListPush( void ); /* pushes the new expression on the stack */
void ExpListPop( int ); /* pops previous N expressions */
/* lex & yacc related prototypes */
void yyerror( char * ); /* parsing error management function */
int yylex( void ); /* main lex token function, called by yyparse() */
@@ -192,6 +208,7 @@ void GenArray( WORD wElements ); /* instructs the virtual machine to build an ar
void GenBreak( void ); /* generate code for BREAK statement */
void * GenElseIf( void * pFirstElseIf, WORD wOffset ); /* generates a support structure for elseifs pcode fixups */
void GenExterns( void ); /* generates the symbols for the EXTERN names */
void GenIfInline( void ); /* generates pcodes for IIF( expr1, expr2, expr3 ) */
PFUNCTION GetFuncall( char * szFunName ); /* locates a previously defined called function */
int GetFieldVarPos( char *, PFUNCTION * ); /* return if passed name is a field variable */
PVAR GetVar( PVAR pVars, WORD wOrder ); /* returns a variable if defined or zero */
@@ -477,6 +494,8 @@ ALIASID_PTR pAliasId = NULL;
WORD _wLastLinePos = 0; /* position of last opcode with line number */
BOOL _bDontGenLineNum = FALSE; /* suppress line number generation */
EXPLIST_PTR _pExpList = NULL; /* stack used for parenthesized expressions */
PSTACK_VAL_TYPE pStackValType = NULL; /* compile time stack values linked list */
char cVarType = ' '; /* current declared variable type */
@@ -536,7 +555,7 @@ extern int _iState; /* current parser state (defined in harbour.l */
%type <string> IDENTIFIER LITERAL FunStart MethStart IdSend ObjectData AliasVar
%type <dNum> DOUBLE
%type <iNumber> ArgList ElemList PareExpList ExpList FunCall FunScope IncDec
%type <iNumber> Params ParamList Logical
%type <iNumber> Params ParamList Logical ArrExpList
%type <iNumber> INTEGER BlockExpList Argument IfBegin VarId VarList MethParams ObjFunCall
%type <iNumber> MethCall BlockList FieldList DoArgList VarAt
%type <lNumber> INTLONG WhileBegin BlockBegin
@@ -709,11 +728,11 @@ NumExpression : DOUBLE { PushDouble( $1.dNumber,$1.bDec )
ConExpression : NIL { PushNil(); }
| LITERAL { PushString( $1 ); }
| CodeBlock {}
| Logical { PushLogical( $1 ); }
;
DynExpression : Variable
| VarUnary
| Logical { PushLogical( $1 ); }
| Operators {}
| FunCall { Function( $1 ); }
| IfInline {}
@@ -722,61 +741,26 @@ DynExpression : Variable
| Macro {}
| AliasVar { PushId( $1 ); AliasRemove(); }
| AliasFunc {}
| PareExpList {}
| SELF { GenPCode1( HB_P_PUSHSELF ); }
;
Expression : NumExpression
SimpleExpression : NumExpression
| ConExpression
| DynExpression
;
IfInline : IIF '(' Expression ',' { $<iNumber>$ = JumpFalse( 0 ); }
IfInlExp ',' { $<iNumber>$ = Jump( 0 ); JumpHere( $<iNumber>5 ); }
IfInlExp ')' { JumpHere( $<iNumber>8 );
if( _bWarnings )
{
PSTACK_VAL_TYPE pFree;
if( pStackValType )
{
pFree = pStackValType;
debug_msg( "\n***---IIF()\n", NULL );
pStackValType = pStackValType->pPrev;
hb_xfree( ( void * )pFree );
}
else
debug_msg( "\n***IIF() Compile time stack overflow\n", NULL );
}
}
| IF '(' Expression ',' { $<iNumber>$ = JumpFalse( 0 ); }
IfInlExp ',' { $<iNumber>$ = Jump( 0 ); JumpHere( $<iNumber>5 ); }
IfInlExp ')' { JumpHere( $<iNumber>8 );
if( _bWarnings )
{
PSTACK_VAL_TYPE pFree;
if( pStackValType )
{
pFree = pStackValType;
debug_msg( "\n***---IIF()\n", NULL );
pStackValType = pStackValType->pPrev;
hb_xfree( ( void * )pFree );
}
else
debug_msg( "\n***IIF() Compile time stack overflow\n", NULL );
}
}
Expression : SimpleExpression {}
| PareExpList {}
;
IfInlExp : /* nothing => nil */ { PushNil(); }
EmptyExpression: /* nothing => nil */
| Expression
;
IfInline : IIF PareExpList3 { GenIfInline(); }
| IF PareExpList3 { GenIfInline(); }
;
Macro : '&' Variable
| '&' '(' Expression ')'
;
@@ -983,11 +967,42 @@ BlockList : IDENTIFIER { cVarType = ' '; AddVar( $1
| BlockList ',' IDENTIFIER { AddVar( $3 ); $$++; }
;
PareExpList: '(' ExpList ')' { $$ = $2; }
/* There is a conflict between the use of IF( Expr1, Expr2, Expr3 )
* and parenthesized expression ( Expr1, Expr2, Expr3 )
* To solve this conflict we have to split the definitions into more
* atomic ones.
* Also the generation of pcodes have to be delayed and moved to the
* end of whole parenthesized expression.
*/
PareExpList1: ExpList1 ')' { ExpListPop( 1 ); }
;
PareExpList2: ExpList2 ')' { ExpListPop( 2 ); }
;
PareExpList3: ExpList3 ')' { /* this needs the special handling if used in inline IF */ }
;
PareExpListN: ExpList ')' { ExpListPop( $1 ); }
;
ExpList : Expression %prec POST { $$ = 1; }
| ExpList { GenPCode1( HB_P_POP ); } ',' Expression %prec POST { $$++; }
PareExpList : PareExpList1 { }
| PareExpList2 { }
| PareExpList3 { ExpListPop( 3 ); }
| PareExpListN { }
;
ExpList1 : '(' { ExpListPush(); } EmptyExpression
;
ExpList2 : ExpList1 ',' { ExpListPush(); } EmptyExpression
;
ExpList3 : ExpList2 ',' { ExpListPush(); } EmptyExpression
;
ExpList : ExpList3 { ExpListPush(); } ',' EmptyExpression { $$ = 4; }
| ExpList { ExpListPush(); } ',' EmptyExpression { $$++; }
;
VarDefs : LOCAL { iVarScope = VS_LOCAL; Line(); } VarList Crlf { cVarType = ' '; }
@@ -1019,8 +1034,12 @@ VarDef : IDENTIFIER { cVarType = ' '; AddV
| IDENTIFIER AS_ARRAY INASSIGN Expression { cVarType = 'A'; AddVar( $1 ); PopId( $1 ); }
| IDENTIFIER AS_BLOCK INASSIGN Expression { cVarType = 'B'; AddVar( $1 ); PopId( $1 ); }
| IDENTIFIER AS_OBJECT INASSIGN Expression { cVarType = 'O'; AddVar( $1 ); PopId( $1 ); }
| IDENTIFIER '[' ExpList ']' { cVarType = ' '; AddVar( $1 ); DimArray( $3 ); PopId( $1 ); }
| IDENTIFIER '[' ExpList ']' AS_ARRAY { cVarType = 'A'; AddVar( $1 ); DimArray( $3 ); PopId( $1 ); }
| IDENTIFIER ArrExpList ']' { cVarType = ' '; AddVar( $1 ); DimArray( $2 ); PopId( $1 ); }
| IDENTIFIER ArrExpList ']' AS_ARRAY { cVarType = 'A'; AddVar( $1 ); DimArray( $2 ); PopId( $1 ); }
;
ArrExpList : '[' Expression { $$ = 1; }
| ArrExpList ',' Expression { $$++; }
;
FieldsDef : FIELD { iVarScope =VS_FIELD; } FieldList Crlf
@@ -1058,7 +1077,19 @@ IfEndif : IfBegin EndIf { JumpHere( $1 ); }
| IfBegin IfElseIf IfElse EndIf { JumpHere( $1 ); FixElseIfs( $2 ); }
;
IfBegin : IF Expression { ++_wIfCounter; } Crlf { $$ = JumpFalse( 0 ); Line(); }
IfBegin : IF SimpleExpression { ++_wIfCounter; } Crlf { $$ = JumpFalse( 0 ); Line(); }
IfStats
{ $$ = Jump( 0 ); JumpHere( $<iNumber>5 ); }
| IF PareExpList1 { ++_wIfCounter; } Crlf { $$ = JumpFalse( 0 ); Line(); }
IfStats
{ $$ = Jump( 0 ); JumpHere( $<iNumber>5 ); }
| IF PareExpList2 { ++_wIfCounter; } Crlf { $$ = JumpFalse( 0 ); Line(); }
IfStats
{ $$ = Jump( 0 ); JumpHere( $<iNumber>5 ); }
| IF PareExpListN { ++_wIfCounter; } Crlf { $$ = JumpFalse( 0 ); Line(); }
IfStats
{ $$ = Jump( 0 ); JumpHere( $<iNumber>5 ); }
;
@@ -2199,6 +2230,97 @@ void DupPCode( WORD wStart ) /* duplicates the current generated pcode from an o
GenPCode1( functions.pLast->pCode[ wStart + w ] );
}
/*
* Starts a new expression in the parenthesized epressions list
*/
void ExpListPush( void )
{
EXPLIST_PTR pExp = (EXPLIST_PTR) hb_xgrab( sizeof(EXPLIST) );
pExp->pNext = pExp->pPrev =NULL;
/* Store the previous state on the stack */
if( _pExpList )
{
_pExpList->pNext = pExp;
pExp->pPrev = _pExpList;
/* save currently used pcode buffer */
_pExpList->exprSize =functions.pLast->lPCodePos;
}
_pExpList = pExp;
/* store current pcode buffer */
pExp->prevPCode =functions.pLast->pCode;
pExp->prevSize =functions.pLast->lPCodeSize;
pExp->prevPos =functions.pLast->lPCodePos;
/* and create the new one */
functions.pLast->pCode = ( BYTE * ) hb_xgrab( PCODE_CHUNK );
functions.pLast->lPCodeSize = PCODE_CHUNK;
functions.pLast->lPCodePos = 0;
pExp->exprPCode =functions.pLast->pCode;
}
/*
* Pops specified number of expressions from the stack
*/
void ExpListPop( int iExpCount )
{
EXPLIST_PTR pExp, pDel;
/* save currently used pcode buffer */
_pExpList->exprSize =functions.pLast->lPCodePos;
_pExpList->exprPCode =functions.pLast->pCode;
/* find the first expression in the list */
while( --iExpCount )
_pExpList = _pExpList->pPrev;
/* return to the original pcode buffer */
functions.pLast->pCode =_pExpList->prevPCode;
functions.pLast->lPCodeSize =_pExpList->prevSize;
functions.pLast->lPCodePos =_pExpList->prevPos;
pExp = _pExpList;
if( _pExpList->pPrev )
{
_pExpList =_pExpList->pPrev;
_pExpList->pNext =NULL;
}
else
_pExpList = NULL;
while( pExp )
{
if( pExp->exprSize )
{
GenPCodeN( pExp->exprPCode, pExp->exprSize );
if( pExp->pNext )
GenPCode1( HB_P_POP );
}
else
{
/* exprN, , exprN1
* in this context empty expression is not allowed
*
* NOTE:
* We don't have to generate this error - it is safe to continue
* pcode generation - in this case an empty expression will not
* generate any opcode
*/
GenError( _szCErrors, 'E', ERR_SYNTAX, ")", NULL );
}
hb_xfree( pExp->exprPCode );
pDel =pExp;
pExp =pExp->pNext;
hb_xfree( pDel );
}
}
/*
* Function generates passed pcode for passed database field
*/
@@ -3329,6 +3451,134 @@ void GenExterns( void ) /* generates the symbols for the EXTERN names */
}
}
/* This function generates pcodes for IIF( expr1, expr2, expr3 )
* or IF( expr1, expr2, expr3 )
*
* NOTE:
* 'IF' followed by parenthesized expression containing 3 expressions
* is always interpreted as IF inlined - it is not possible to distinguish
* it from IF( expr1, expr2, expr3 ); ENDIF syntax
* (This behaviour is Clipper compatible)
*/
void GenIfInline( void )
{
EXPLIST_PTR pExp, pDel;
int iExpCount = 3; /* We are expecting 3 expressions here */
BOOL bGenPCode;
/* save currently used pcode buffer */
_pExpList->exprSize =functions.pLast->lPCodePos;
_pExpList->exprPCode =functions.pLast->pCode;
/* find the first expression in the list */
while( --iExpCount )
_pExpList = _pExpList->pPrev;
/* return to the original pcode buffer */
functions.pLast->pCode =_pExpList->prevPCode;
functions.pLast->lPCodeSize =_pExpList->prevSize;
functions.pLast->lPCodePos =_pExpList->prevPos;
/* Update the pointer for nested or next expressions */
pExp = _pExpList;
if( _pExpList->pPrev )
{
_pExpList =_pExpList->pPrev;
_pExpList->pNext =NULL;
}
else
_pExpList = NULL;
bGenPCode =TRUE;
pDel =pExp; /* save it for later use */
/* pExp points now to pcode buffer for logical condition
*/
if( pExp->exprSize == 0 )
{
/* The logical condition have to be specified.
* If it is empty then generate the syntax error
*/
GenError( _szCErrors, 'E', ERR_SYNTAX, ",", NULL );
}
else if( pExp->exprSize == 1 )
{
/* one byte opcode for logical condition - check if it is TRUE or FALSE
*/
if( pExp->exprPCode[ 0 ] == HB_P_TRUE )
{
/* move to the second expression */
pExp =pExp->pNext;
if( pExp->exprSize )
GenPCodeN( pExp->exprPCode, pExp->exprSize );
else
PushNil(); /* IIF have to return some value */
bGenPCode =FALSE;
}
else if( pExp->exprPCode[ 0 ] == HB_P_FALSE )
{
/* move to the third expression */
pExp =pExp->pNext;
pExp =pExp->pNext;
if( pExp->exprSize )
GenPCodeN( pExp->exprPCode, pExp->exprSize );
else
PushNil(); /* IIF have to return some value */
bGenPCode =FALSE;
}
}
if( bGenPCode )
{
/* generate pcodes for all expressions
*/
LONG lPosFalse, lPosEnd;
GenPCodeN( pExp->exprPCode, pExp->exprSize );
lPosFalse =JumpFalse( 0 );
pExp =pExp->pNext;
if( pExp->exprSize )
GenPCodeN( pExp->exprPCode, pExp->exprSize );
else
PushNil(); /* IIF have to return some value */
lPosEnd =Jump( 0 );
JumpHere( lPosFalse );
pExp =pExp->pNext;
if( pExp->exprSize )
GenPCodeN( pExp->exprPCode, pExp->exprSize );
else
PushNil(); /* IIF have to return some value */
JumpHere( lPosEnd );
}
while( pDel )
{
pExp =pDel;
pDel =pDel->pNext;
hb_xfree( pExp->exprPCode );
hb_xfree( pExp );
}
if( _bWarnings )
{
PSTACK_VAL_TYPE pFree;
if( pStackValType )
{
pFree = pStackValType;
debug_msg( "\n***---IIF()\n", NULL );
pStackValType = pStackValType->pPrev;
hb_xfree( ( void * )pFree );
}
else
debug_msg( "\n***IIF() Compile time stack overflow\n", NULL );
}
}
PFUNCTION GetFuncall( char * szFunctionName ) /* returns a previously called defined function */
{
PFUNCTION pFunc = funcalls.pFirst;

26
harbour/source/rtl/arrays.c
View File

@@ -262,6 +262,32 @@ char * hb_arrayGetDS( PHB_ITEM pArray, ULONG ulIndex, char * szDate )
return szDate;
}
BOOL hb_arrayGetBool( PHB_ITEM pArray, ULONG ulIndex )
{
if( IS_ARRAY( pArray ) )
{
if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen )
return hb_itemGetL( pArray->item.asArray.value->pItems + ulIndex - 1 );
}
return FALSE;
}
/*
* This function returns a pointer to an item occupied by the specified
* array element - it doesn't return an item's value
*/
PHB_ITEM hb_arrayGetItemPointer( PHB_ITEM pArray, ULONG ulIndex )
{
if( IS_ARRAY( pArray ) )
{
if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen )
return pArray->item.asArray.value->pItems + ( ulIndex - 1 );
}
return NULL;
}
BOOL hb_arrayGetL( PHB_ITEM pArray, ULONG ulIndex )
{
if( IS_ARRAY( pArray ) && ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen )

60
harbour/source/vm/hvm.c
View File

@@ -68,6 +68,8 @@ static void hb_vmReleaseLocalSymbols( void ); /* releases the memory of the
static void hb_vmDebuggerShowLine( WORD wLine ); /* makes the debugger shows a specific source code line */
static void hb_vmDebuggerEndProc( void ); /* notifies the debugger for an endproc */
static void hb_vmArrayNew( HB_ITEM_PTR, WORD ); /* creates array */
#ifdef HARBOUR_OBJ_GENERATION
static void hb_vmProcessObjSymbols ( void ); /* process Harbour generated OBJ symbols */
@@ -896,24 +898,58 @@ void hb_vmDec( void )
}
}
/* This function creates an array item using 'wDimension' as an index
* to retrieve the number of elements from the stack
*/
static void hb_vmArrayNew( HB_ITEM_PTR pArray, WORD wDimension )
{
ULONG ulElements;
HB_ITEM_PTR pDim = stack.pPos - wDimension;
/* use the proper type of number of elements */
switch( pDim->type & ~IT_BYREF )
{
case IT_INTEGER:
ulElements = (ULONG) pDim->item.asInteger.value;
break;
case IT_LONG:
ulElements = pDim->item.asLong.value;
break;
case IT_DOUBLE:
ulElements = (ULONG) pDim->item.asDouble.value;
break;
default:
/* NOTE: Clipper creates empty array if non-numeric value is
* specified as dimension and stops further processing.
* There is no runtime error generated.
*/
ulElements = 0;
break;
}
/* create an array */
hb_arrayNew( pArray, ulElements );
if( --wDimension )
{
/* call self recursively to create next dimensions
*/
while( ulElements )
hb_vmArrayNew( hb_arrayGetItemPointer( pArray, ulElements-- ), wDimension );
}
}
void hb_vmDimArray( WORD wDimensions ) /* generates a wDimensions Array and initialize those dimensions from the stack values */
{
HB_ITEM itArray;
WORD w; /* , wElements; */
itArray.type = IT_NIL;
hb_arrayNew( &itArray, ( stack.pPos - wDimensions )->item.asLong.value );
hb_vmArrayNew( &itArray, wDimensions );
if( wDimensions > 1 )
hb_errInternal( 9999, "HVM.C hb_vmDimArray() does not supports multiple dimensions yet", NULL, NULL );
/*
for( w = 0; w < wElements; w++ )
hb_itemCopy( itArray.item.asArray.value->pItems + w,
stack.pPos - wElements + w );
*/
for( w = 0; w < wDimensions; w++ )
while( wDimensions-- )
hb_stackPop();
hb_itemCopy( stack.pPos, &itArray );

1
harbour/tests/working/Makefile
View File

@@ -94,6 +94,7 @@ PRG_SOURCES=\
os.prg \
output.prg \
overload.prg \
parexpr.prg \
passref.prg \
procline.prg \
procname.prg \

89
harbour/tests/working/parexpr.prg Normal file
View File

@@ -0,0 +1,89 @@
//
// $Id$
//
// The following code tests harbour's ability to cope with parenthesized
// expressions.
// These tests were written by Dave Pearson <davep@hagbard.demon.co.uk> and
// are placed into the public domain.
Function Main()
Local x
Local y
// Simple one to start with.
x := ( 1 )
? x
// Now with a little more complex:
x := ( 1, 2 )
? x
// And a little more, this is really the same as the previous one.
x := ( 1, 2, 3 )
? x
// Expression within expression
x := ( ( 1, 2, 3 ) )
? x
// And a little more:
x := ( ( 1, 2, 3 ), ( 1, 2, 3 ) )
? x
// Some inline assignments
x := ( y := 10, y )
? x
x := ( ( y := ( 1, 2, 3) ), y * ( 10, 20, 30 ) )
? x
// Now mix with statements and functions
? ( 1, 2, 3 )
If ( y := .t. )
? "Working"
Else
? "Borken"
EndIf
If ( x := 10, y := ( x == 10 ) )
? "Working"
Else
? "Broken"
EndIf
If ( Something( 1, 2, 3 ), .T. )
? "Working"
Else
? "Broken"
EndIf
?
// Now even some more testing of related code
// placed into public domain by Ryszard Glab
? IF( (.F.,0,.T.), ("some", "text", "IF Working"), ("some", "text", "Broken") )
? IF( (.T.,1,.F.), ("some", "text", "Broken"), ("some", "text", "IF Working") )
? IF( (.T. .OR. .F.), IF( .T., "Working", "Broken" ), IF( .F., "Broken", "Working" ) )
/* The following code should generate syntax error if uncommented
* because IF token followed by any three expressions is interpreted
* as IIF inline
*/
// IF( .T., .F., .T. )
// ? "Working"
// ELSE
// ? "Broken"
// ENDIF
Return( NIL )
Static Function Something( x, y, z )
// This does something and it does it well/
Return( NIL )