diff --git a/harbour/ChangeLog b/harbour/ChangeLog index e485cd68dd..7e47cb7060 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,55 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ +2005-11-07 14:35 UTC+0100 Ryszard Glab + * include/hbapi.h + * include/hbapiitm.h + * include/hbcomp.h + * include/hberrors.h + * include/hbexpra.c + * include/hbpcode.h + * include/hbsetup.h + * source/common/expropt1.c + * source/compiler/expropta.c + * source/compiler/genc.c + * source/compiler/gencli.c + * source/compiler/harbour.c + * source/compiler/harbour.l + * source/compiler/harbour.y + * source/compiler/hbfix.c + * source/compiler/hbgenerr.c + * source/compiler/hbpcode.c + * source/macro/macroa.c + * source/vm/hvm.c + * source/vm/itemapi.c + + tests/foreach.prg + + added support for FOR EACH loop + FOR EACH var1 [,var255] IN expr1 [,expr255] [DESCEND] + NEXT + + Note: + -expr can be a string or an array + if it is a string then assigments to the control + variable does not change the string + -after the loop the controlling variable(s) store the + value which they had before entering the loop + -the controlling variable supports the following properties + :__enumindex - the loop counter for variable + :__enumbase - the value that is being traversed + :__enumvalue - the value of variable + -see tests/foreach.prg for examples + + + added warnings in cases of duplicated loop variables + eg. FOR i:=1 TO 5 + FOR i:=i TO i+5 + + -removed strong typing in the compiler (xHarbour too) + (reactivate it by compiling with -DHB_COMP_STRONG_TYPES) + +NOTE: + The new pcodes were added - rebuild everything + + 2005-11-04 22:19 UTC+0100 Antonio Linares * harbour/source/vm/estack.c * hb_UnhandledExceptionFilter() modified to return EXCEPTION_CONTINUE_SEARCH diff --git a/harbour/include/hbapi.h b/harbour/include/hbapi.h index 9400b3f8f5..5861e2bbb5 100644 --- a/harbour/include/hbapi.h +++ b/harbour/include/hbapi.h @@ -226,6 +226,9 @@ struct hb_struRefer } BasePtr; LONG offset; /* 0 for static variables */ LONG value; + union { + struct _HB_ITEM * itemPtr; /* item pointer */ + } ValuePtr; }; struct hb_struString diff --git a/harbour/include/hbapiitm.h b/harbour/include/hbapiitm.h index 58fd536d8f..010cadea41 100644 --- a/harbour/include/hbapiitm.h +++ b/harbour/include/hbapiitm.h @@ -135,6 +135,7 @@ extern void hb_itemMove ( PHB_ITEM pDest, PHB_ITEM pSource ); extern void hb_itemClear ( PHB_ITEM pItem ); extern PHB_ITEM hb_itemUnRef ( PHB_ITEM pItem ); /* de-references passed variable */ extern PHB_ITEM hb_itemUnRefOnce( PHB_ITEM pItem ); /* de-references passed variable, one step*/ +extern PHB_ITEM hb_itemUnRefRefer( PHB_ITEM pItem ); /* de-references passed variable, leaving the last reference */ extern char * hb_itemStr ( PHB_ITEM pNumber, PHB_ITEM pWidth, PHB_ITEM pDec ); /* convert a number to a string */ extern char * hb_itemString ( PHB_ITEM pItem, ULONG * ulLen, BOOL * bFreeReq ); /* Convert any scalar to a string */ extern BOOL hb_itemStrBuf ( char *szResult, PHB_ITEM pNumber, int iSize, int iDec ); /* convert a number to a string */ diff --git a/harbour/include/hbcomp.h b/harbour/include/hbcomp.h index 44d59acc90..ff0241921e 100644 --- a/harbour/include/hbcomp.h +++ b/harbour/include/hbcomp.h @@ -140,6 +140,22 @@ typedef struct _VAR struct _VAR * pNext; /* pointer to next defined variable */ } VAR, * PVAR; +typedef struct HB_ENUMERATOR_ +{ + char *szName; + BOOL bForEach; + struct HB_ENUMERATOR_ *pNext; +} HB_ENUMERATOR, *HB_ENUMERATOR_PTR; /* support structure for FOR EACH statements */ + +/*Support for traversing of linked list */ +#define HB_CARGO_FUNC( proc ) void proc( void *cargo ) +typedef HB_CARGO_FUNC( HB_CARGO_FUNC_ ); +typedef HB_CARGO_FUNC_ *HB_CARGO_FUNC_PTR; + +#define HB_CARGO2_FUNC( proc ) void proc( void *cargo, void *dummy ) +typedef HB_CARGO2_FUNC( HB_CARGO2_FUNC_ ); +typedef HB_CARGO2_FUNC_ *HB_CARGO2_FUNC_PTR; + /* pcode chunks bytes size */ #define HB_PCODE_CHUNK 100 @@ -174,6 +190,7 @@ typedef struct __FUNC BOOL bLateEval; /* TRUE if accessing of declared (compile time) variables is allowed */ struct __FUNC * pOwner; /* pointer to the function/procedure that owns the codeblock */ struct __FUNC * pNext; /* pointer to the next defined function */ + HB_ENUMERATOR_PTR pEnum; /* pointer to FOR EACH variables */ } _FUNC, * PFUNCTION; /* structure to hold an INLINE block of source */ @@ -340,6 +357,7 @@ extern void hb_compAutoOpenAdd( char * szName ); #else /* HB_MACRO_SUPPORT */ extern BOOL hb_compIsValidMacroVar( char * ); /* checks if passed variable can be used in macro */ +extern BOOL hb_compForEachVarError( char * ); /* checks if it is FOR EACH enumerator variable and generates a warning */ extern ULONG hb_compGenJump( LONG ); /* generates the pcode to jump to a specific offset */ extern ULONG hb_compGenJumpFalse( LONG ); /* generates the pcode to jump if false */ @@ -408,6 +426,9 @@ extern void hb_compErrorCodeblock( char * ); extern void hb_compErrorMacro( char * ); extern HB_EXPR_PTR hb_compErrorRefer( HB_EXPR_PTR, char * ); +extern ULONG hb_compExprListEval( HB_EXPR_PTR pExpr, HB_CARGO_FUNC_PTR pEval ); +extern ULONG hb_compExprListEval2( HB_EXPR_PTR pExpr1, HB_EXPR_PTR pExpr2, HB_CARGO2_FUNC_PTR pEval ); + extern void hb_compChkCompilerSwitch( int, char * Args[] ); extern void hb_compChkEnvironVar( char * ); extern void hb_compChkPaths( void ); diff --git a/harbour/include/hberrors.h b/harbour/include/hberrors.h index a837c2b7f6..0a6f526433 100644 --- a/harbour/include/hberrors.h +++ b/harbour/include/hberrors.h @@ -112,6 +112,8 @@ HB_EXTERN_BEGIN #define HB_COMP_ERR_TOOMANY_INLINE 50 #define HB_COMP_ERR_REQUIRES_C 51 #define HB_COMP_ERR_OPTIMIZEDLOCAL_OUT_OF_RANGE 52 +#define HB_COMP_ERR_FORVAR_TOOMANY 53 +#define HB_COMP_ERR_FORVAR_DIFF 54 #define HB_COMP_WARN_AMBIGUOUS_VAR 1 #define HB_COMP_WARN_MEMVAR_ASSUMED 2 @@ -142,6 +144,8 @@ HB_EXTERN_BEGIN #define HB_COMP_WARN_MEANINGLESS 27 #define HB_COMP_WARN_UNREACHABLE 28 #define HB_COMP_WARN_DUPL_ANNOUNCE 29 +#define HB_COMP_WARN_FORVAR_DUPL 30 +#define HB_COMP_WARN_ENUM_INVALID 31 /* * Errors generated by Harbour preprocessor diff --git a/harbour/include/hbexpra.c b/harbour/include/hbexpra.c index 237afcac83..7156d147f0 100644 --- a/harbour/include/hbexpra.c +++ b/harbour/include/hbexpra.c @@ -213,6 +213,59 @@ void hb_compExprErrorType( HB_EXPR_PTR pExpr, HB_MACRO_DECL ) HB_SYMBOL_UNUSED( HB_MACRO_VARNAME ); } +#ifndef HB_MACRO_SUPPORT +ULONG hb_compExprListEval( HB_EXPR_PTR pExpr, HB_CARGO_FUNC_PTR pEval ) +{ + ULONG ulLen = 0; + + if( pEval && ((pExpr->ExprType == HB_ET_LIST) || (pExpr->ExprType == HB_ET_ARGLIST)) ) + { + pExpr = pExpr->value.asList.pExprList; + while( pExpr ) + { + (pEval)( (void *) pExpr ); + pExpr = pExpr->pNext; + ++ulLen; + } + } + return ulLen; +} + +ULONG hb_compExprListEval2( HB_EXPR_PTR pExpr1, HB_EXPR_PTR pExpr2, HB_CARGO2_FUNC_PTR pEval ) +{ + ULONG ulLen = 0; + + if( !pEval ) + return ulLen; + + if( (pExpr1->ExprType == HB_ET_LIST || pExpr1->ExprType == HB_ET_ARGLIST) + && + (pExpr2->ExprType == HB_ET_LIST || pExpr2->ExprType == HB_ET_ARGLIST) ) + { + pExpr1 = pExpr1->value.asList.pExprList; + pExpr2 = pExpr2->value.asList.pExprList; + while( pExpr1 && pExpr2 ) + { + (pEval)( (void *) pExpr1, (void *)pExpr2 ); + pExpr1 = pExpr1->pNext; + pExpr2 = pExpr2->pNext; + ++ulLen; + } + } + else if( pExpr1->ExprType == HB_ET_LIST || pExpr1->ExprType == HB_ET_ARGLIST) + { + pExpr1 = pExpr1->value.asList.pExprList; + while( pExpr1 ) + { + (pEval)( (void *) pExpr1, (void *)pExpr2 ); + pExpr1 = pExpr1->pNext; + ++ulLen; + } + } + return ulLen; +} +#endif + /* Add a new local variable declaration */ #ifdef HB_MACRO_SUPPORT @@ -649,6 +702,38 @@ HB_EXPR_PTR hb_compExprNewFunCall( HB_EXPR_PTR pName, HB_EXPR_PTR pParms ) return pExpr; } +/* Creates new send expression + * pObject : szMessage + */ +HB_EXPR_PTR hb_compExprNewSend( HB_EXPR_PTR pObject, char * szMessage ) +{ + HB_EXPR_PTR pExpr; + + HB_TRACE(HB_TR_DEBUG, ("hb_compExprNewSend(%p, %s)", pObject, szMessage)); + + pExpr = hb_compExprNew( HB_ET_SEND ); + pExpr->value.asMessage.szMessage = szMessage; + pExpr->value.asMessage.pObject = pObject; + pExpr->value.asMessage.pParms = NULL; + +#ifndef HB_MACRO_SUPPORT + if( (strcmp( "__ENUMINDEX", szMessage ) == 0) || + (strcmp( "__ENUMBASE", szMessage ) == 0 ) || + (strcmp( "__ENUMVALUE", szMessage ) == 0 ) ) + { + if( pObject->ExprType == HB_ET_VARIABLE ) + { + if( ! hb_compForEachVarError( pObject->value.asSymbol ) ) + { + pExpr->value.asMessage.pObject = hb_compExprNewVarRef( pObject->value.asSymbol ); + } + } + } +#endif + return pExpr; +} + + /* In macro compiler strings should be automatically deallocated by * the expression optimizer * In harbour compiler strings are shared in the hash table then they diff --git a/harbour/include/hbpcode.h b/harbour/include/hbpcode.h index 6a99bdd5fc..78de2faa03 100644 --- a/harbour/include/hbpcode.h +++ b/harbour/include/hbpcode.h @@ -192,8 +192,12 @@ typedef enum HB_P_LOCALNEARADDINT, /* 125 Add/Subtract specified int into specified local without using the stack. */ HB_P_MACROPUSHREF, /* 126 Reference to macro variable @&mvar */ HB_P_PUSHLONGLONG, /* 127 places an integer number on the virtual machine stack */ + HB_P_ENUMSTART, /* 128 Start of FOR EACH loop */ + HB_P_ENUMNEXT, /* 129 Next item of FOR EACH loop */ + HB_P_ENUMPREV, /* 130 Previous item of FOR EACH loop */ + HB_P_ENUMEND, /* 131 End of FOR EACH loop */ /* NOTE: This have to be the last definition */ - HB_P_LAST_PCODE /* 128 this defines the number of defined pcodes */ + HB_P_LAST_PCODE /* 132 this defines the number of defined pcodes */ } HB_PCODE; #endif /* HB_PCODE_H_ */ diff --git a/harbour/include/hbsetup.h b/harbour/include/hbsetup.h index 1b4f0e416f..14d8182d96 100644 --- a/harbour/include/hbsetup.h +++ b/harbour/include/hbsetup.h @@ -217,6 +217,15 @@ */ /* #define HB_FAST_STOD */ +/* *********************************************************************** + * You can select here if you want a strong type support in the compiler + * For example: + * LOCAL nVar AS ARRAY + * + * By default we are not using the strong typing because it is not + * complete code and can be erratic now. +*/ +/* #define HB_COMP_STRONG_TYPES */ /* *********************************************************************** * Detect GCC/OS2 diff --git a/harbour/source/common/expropt1.c b/harbour/source/common/expropt1.c index 56bcef2b1a..143b135baa 100644 --- a/harbour/source/common/expropt1.c +++ b/harbour/source/common/expropt1.c @@ -211,8 +211,9 @@ char *hb_compExprAsString( HB_EXPR_PTR pExpr ) switch( pExpr->ExprType ) { case HB_ET_VARIABLE: + case HB_ET_VARREF: return pExpr->value.asSymbol ; - + break; } return NULL; } @@ -483,23 +484,6 @@ HB_EXPR_PTR hb_compExprNewAliasExpr( HB_EXPR_PTR pAlias, HB_EXPR_PTR pExpList ) return pExpr; } -/* Creates new send expression - * pObject : szMessage - */ -HB_EXPR_PTR hb_compExprNewSend( HB_EXPR_PTR pObject, char * szMessage ) -{ - HB_EXPR_PTR pExpr; - - HB_TRACE(HB_TR_DEBUG, ("hb_compExprNewSend(%p, %s)", pObject, szMessage)); - - pExpr = hb_compExprNew( HB_ET_SEND ); - pExpr->value.asMessage.szMessage = szMessage; - pExpr->value.asMessage.pObject = pObject; - pExpr->value.asMessage.pParms = NULL; - - return pExpr; -} - /* Creates new method call * pObject : identifier ( pArgList ) * diff --git a/harbour/source/compiler/expropta.c b/harbour/source/compiler/expropta.c index e3f47d4c79..2bd4ca0132 100644 --- a/harbour/source/compiler/expropta.c +++ b/harbour/source/compiler/expropta.c @@ -5,6 +5,6 @@ /* hbexpra.c is also included from ../macro/macro.c * However it produces a slighty different code if used in * macro compiler (there is an additional parameter passed to some functions) - * 1.15 - ignore this magic number - this is used to force compilation + * 1.16 - ignore this magic number - this is used to force compilation */ #include "hbexpra.c" diff --git a/harbour/source/compiler/genc.c b/harbour/source/compiler/genc.c index 917c379ee4..26a5a58a27 100644 --- a/harbour/source/compiler/genc.c +++ b/harbour/source/compiler/genc.c @@ -1837,6 +1837,37 @@ static HB_GENC_FUNC( hb_p_macrolistend ) return 1; } +static HB_GENC_FUNC( hb_p_enumstart ) +{ + fprintf( cargo->yyc, "\tHB_P_ENUMSTART, %i, %i,\n", pFunc->pCode[ lPCodePos + 1 ], pFunc->pCode[ lPCodePos + 2 ] ); + return 3; +} + +static HB_GENC_FUNC( hb_p_enumnext ) +{ + HB_SYMBOL_UNUSED( pFunc ); + HB_SYMBOL_UNUSED( lPCodePos ); + fprintf( cargo->yyc, "\tHB_P_ENUMNEXT,\n" ); + return 1; +} + +static HB_GENC_FUNC( hb_p_enumprev ) +{ + HB_SYMBOL_UNUSED( pFunc ); + HB_SYMBOL_UNUSED( lPCodePos ); + fprintf( cargo->yyc, "\tHB_P_ENUMPREV,\n" ); + return 1; +} + +static HB_GENC_FUNC( hb_p_enumend ) +{ + HB_SYMBOL_UNUSED( pFunc ); + HB_SYMBOL_UNUSED( lPCodePos ); + fprintf( cargo->yyc, "\tHB_P_ENUMEND,\n" ); + return 1; +} + + static HB_GENC_FUNC( hb_p_localnearaddint ) { fprintf( cargo->yyc, "\tHB_P_LOCALNEARADDINT, %i, %i, %i,", pFunc->pCode[ lPCodePos + 1 ], @@ -1990,7 +2021,11 @@ static HB_GENC_FUNC_PTR s_verbose_table[] = { /* end: */ hb_p_localnearaddint, hb_p_macropushref, - hb_p_pushlonglong + hb_p_pushlonglong, + hb_p_enumstart, + hb_p_enumnext, + hb_p_enumprev, + hb_p_enumend }; static void hb_compGenCReadable( PFUNCTION pFunc, FILE * yyc ) diff --git a/harbour/source/compiler/gencli.c b/harbour/source/compiler/gencli.c index 718779b221..0e688486f8 100644 --- a/harbour/source/compiler/gencli.c +++ b/harbour/source/compiler/gencli.c @@ -971,6 +971,15 @@ static HB_GENC_FUNC( hb_p_macropush ) return 2; } +static HB_GENC_FUNC( hb_p_macropushref ) +{ + HB_SYMBOL_UNUSED( pFunc ); + HB_SYMBOL_UNUSED( lPCodePos ); + + fprintf( cargo->yyc, "\tHB_P_MACROPUSHREF,\n" ); + return 1; +} + static HB_GENC_FUNC( hb_p_macropusharg ) { HB_SYMBOL_UNUSED( pFunc ); @@ -1590,6 +1599,17 @@ static HB_GENC_FUNC( hb_p_pushlong ) return 5; } +static HB_GENC_FUNC( hb_p_pushlonglong ) +{ + HB_SYMBOL_UNUSED( pFunc ); + HB_SYMBOL_UNUSED( lPCodePos ); + + fprintf( cargo->yyc, "LONG LONG unsupported\n" ); + exit(1); + + return 9; +} + static HB_GENC_FUNC( hb_p_pushmemvar ) { fprintf( cargo->yyc, "\tHB_P_PUSHMEMVAR, %i, %i,", @@ -2023,6 +2043,36 @@ static HB_GENC_FUNC( hb_p_macrolistend ) return 1; } +static HB_GENC_FUNC( hb_p_enumstart ) +{ + fprintf( cargo->yyc, "\tHB_P_ENUMSTART, %i,\n", pFunc->pCode[ lPCodePos + 1 ] ); + return 2; +} + +static HB_GENC_FUNC( hb_p_enumnext ) +{ + HB_SYMBOL_UNUSED( pFunc ); + HB_SYMBOL_UNUSED( lPCodePos ); + fprintf( cargo->yyc, "\tHB_P_ENUMNEXT,\n" ); + return 1; +} + +static HB_GENC_FUNC( hb_p_enumprev ) +{ + HB_SYMBOL_UNUSED( pFunc ); + HB_SYMBOL_UNUSED( lPCodePos ); + fprintf( cargo->yyc, "\tHB_P_ENUMPREV,\n" ); + return 1; +} + +static HB_GENC_FUNC( hb_p_enumend ) +{ + HB_SYMBOL_UNUSED( pFunc ); + HB_SYMBOL_UNUSED( lPCodePos ); + fprintf( cargo->yyc, "\tHB_P_ENUMEND,\n" ); + return 1; +} + static HB_GENC_FUNC( hb_p_localnearaddint ) { fprintf( cargo->yyc, " IL_%04lX: ", lPCodePos ); @@ -2184,7 +2234,13 @@ static HB_GENC_FUNC_PTR s_verbose_table[] = { /* start: more pcodes generated by macro compiler */ hb_p_dummy, /* end: */ - hb_p_localnearaddint + hb_p_localnearaddint, + hb_p_macropushref, + hb_p_pushlonglong, + hb_p_enumstart, + hb_p_enumnext, + hb_p_enumprev, + hb_p_enumend }; static void hb_compGenCReadable( PFUNCTION pFunc, FILE * yyc ) diff --git a/harbour/source/compiler/harbour.c b/harbour/source/compiler/harbour.c index e8d50c9db1..5610ac092c 100644 --- a/harbour/source/compiler/harbour.c +++ b/harbour/source/compiler/harbour.c @@ -1509,6 +1509,7 @@ static PFUNCTION hb_compFunctionNew( char * szName, HB_SYMBOLSCOPE cScope ) pFunc->iStackFunctions = 0; pFunc->iStackClasses = 0; pFunc->bLateEval = TRUE; + pFunc->pEnum = NULL; return pFunc; } diff --git a/harbour/source/compiler/harbour.l b/harbour/source/compiler/harbour.l index 3fde9b0246..1688fc6788 100644 --- a/harbour/source/compiler/harbour.l +++ b/harbour/source/compiler/harbour.l @@ -120,7 +120,7 @@ Separator {SpaceTab} %x STRING1 STRING2 STRING3 STRING4START STRING4 STRING5 %x NEXT_ BREAK_ CASE_ DO_ DOIDENT_ WHILE_ WITH_ END_ FIELD_ -%x FOR_ FUNCTION_ IIF_ IF_ IN_ INIT_ +%x FOR_ FOREACH_ FUNCTION_ IIF_ IF_ IN_ INIT_ %x RETURN_ RECOVER_ %x INVALIDNUM_ OTHERWISE_ PROCEDURE_ %x DECLARE_ DECLARE_ID_ @@ -623,6 +623,14 @@ Separator {SpaceTab} %{ /* ************************************************************************ */ %} +"descend" { + yylval.string = hb_compIdentifierNew( "DESCEND", TRUE ); + hb_comp_iState =IDENTIFIER; + return DESCEND; + } +%{ +/* ************************************************************************ */ +%} "else" { /* ELSE can be used in one context only */ if( hb_comp_wIfCounter == 0 ) hb_compGenError( hb_comp_szErrors, 'E', HB_COMP_ERR_UNMATCHED_ELSE, NULL, NULL ); @@ -766,6 +774,7 @@ Separator {SpaceTab} /* ************************************************************************ */ %} "for" { BEGIN FOR_; } +{Separator}+"each" { BEGIN FOREACH_;} {Separator}+[&_a-zA-Z] { /* an identifier or a macro after the FOR */ BEGIN 0; unput( yytext[ yyleng-1 ] ); @@ -803,6 +812,19 @@ Separator {SpaceTab} hb_comp_iState =IDENTIFIER; return IDENTIFIER; } +{Separator}*[\:\=] { /* FOR each:= or FOR each= */ + BEGIN 0; + unput( yytext[ yyleng-1 ] ); + unput( 'h' ); unput( 'c' ); unput( 'a' ); unput( 'e' ); + hb_comp_iState = FOR; + return FOR; + } +. { + BEGIN 0; + unput( yytext[ yyleng-1 ] ); + hb_comp_iState = FOREACH; + return FOREACH; + } %{ /* ************************************************************************ */ %} diff --git a/harbour/source/compiler/harbour.y b/harbour/source/compiler/harbour.y index 743b10b6c2..3c70ebb866 100644 --- a/harbour/source/compiler/harbour.y +++ b/harbour/source/compiler/harbour.y @@ -88,6 +88,12 @@ static void hb_compRTVariableGen( char * ); static void hb_compVariableDim( char *, HB_EXPR_PTR ); +static void hb_compForStart( char *szVarName, BOOL bForEach ); +static void hb_compForEnd( char *szVarName ); +static void hb_compEnumStart( HB_EXPR_PTR pVars, HB_EXPR_PTR pExprs, int descend ); +static void hb_compEnumNext( HB_EXPR_PTR pExpr, int descend ); +static void hb_compEnumEnd( HB_EXPR_PTR pExpr ); + #ifdef HARBOUR_YYDEBUG #define YYDEBUG 1 /* Parser debug information support */ #endif @@ -181,6 +187,7 @@ static void hb_compDebugStart( void ) { }; %token AS_ARRAY_ARRAY AS_BLOCK_ARRAY AS_CHARACTER_ARRAY AS_CLASS_ARRAY AS_DATE_ARRAY AS_LOGICAL_ARRAY AS_NUMERIC_ARRAY AS_OBJECT_ARRAY %token PROCREQ GET %token CBSTART DOIDENT +%token FOREACH DESCEND /*the lowest precedence*/ /*postincrement and postdecrement*/ @@ -217,6 +224,7 @@ static void hb_compDebugStart( void ) { }; %type Params ParamList %type IfBegin VarList ExtVarList %type FieldList +%type Descend %type WhileBegin %type IfElseIf Cases %type Argument ArgList ElemList BlockExpList BlockVarList BlockNoVar @@ -250,6 +258,7 @@ static void hb_compDebugStart( void ) { }; %type DimIndex DimList %type FieldAlias FieldVarAlias %type PostOp +%type ForVar ForList ForExpr %type CBSTART %% @@ -463,6 +472,7 @@ IdentName : IDENTIFIER { $$ = $1; } | PUBLIC { $$ = $1; } | PARAMETERS { $$ = $1; } | PROCREQ { $$ = $1; } + | DESCEND { $$ = $1; } ; /* Numeric values @@ -1353,6 +1363,7 @@ ExecFlow : IfEndif | DoWhile | ForNext | BeginSeq + | ForEach ; IfEndif : IfBegin EndIf { hb_compGenJumpHere( $1 ); } @@ -1520,6 +1531,10 @@ ForNext : FOR LValue ForAssign Expression /* 1 2 3 4 */ hb_compDebugStart(); ++hb_comp_wForCounter; /* 5 */ $$ = hb_compExprGenStatement( hb_compExprAssign( $2, $4 ) ); + if( hb_compExprAsString($2) ) + { + hb_compForStart( hb_compExprAsString($2), FALSE ); + } } TO Expression StepExpr /* 6 7 8 */ { @@ -1572,6 +1587,10 @@ ForNext : FOR LValue ForAssign Expression /* 1 2 3 4 */ hb_compGenJump( $9 - hb_comp_functions.pLast->lPCodePos ); hb_compGenJumpHere( $11 ); hb_compLoopEnd(); + if( hb_compExprAsString($2) ) + { + hb_compForEnd( hb_compExprAsString($2) ); + } hb_compExprDelete( $7 ); hb_compExprDelete( $5 ); /* deletes $5, $2, $4 */ if( $8 ) @@ -1594,6 +1613,58 @@ ForStatements : EmptyStats NEXT { hb_compLinePush(); --hb_co | EmptyStats END IdentName { hb_compLinePush(); --hb_comp_wForCounter; } ; +ForVar : IdentName { $$ = hb_compExprNewVarRef($1); } + | AliasVar { $$ = hb_compExprNewRef($1); } + ; + +ForList : ForVar { $$ = hb_compExprNewArgList( $1 ); } + | ForList ',' ForVar { $$ = hb_compExprAddListExpr( $1, $3 ); } + ; + +ForExpr : Expression { $$ = hb_compExprNewArgList( $1 ); } + | ForExpr ',' Expression { $$ = hb_compExprAddListExpr( $1, $3 ); } + ; + +ForEach : FOREACH ForList IN ForExpr /* 1 2 3 4 */ + { + ++hb_comp_wForCounter; /* 5 */ + hb_compLinePush(); + hb_compDebugStart(); + } + Descend /* 6 */ + { + /* 7 + */ + hb_compEnumStart( $2, $4, $6 ); + + hb_compLoopStart(); + $$ = hb_comp_functions.pLast->lPCodePos; + } + Crlf /* 8 */ + { + /* 9 + */ + $$ = hb_compGenJumpFalse( 0 ); + } + ForStatements /* 10 */ + { + hb_compLoopHere(); + hb_compEnumNext( $2, $6 ); + hb_compGenJump( $7 - hb_comp_functions.pLast->lPCodePos ); + + hb_compGenJumpHere( $9 ); + hb_compLoopEnd(); + hb_comp_functions.pLast->bFlags &= ~ FUN_WITH_RETURN; + hb_compEnumEnd( $2 ); + hb_compExprDelete( $2 ); + hb_compExprDelete( $4 ); + } + ; + +Descend : /* default up */ { $$ = 1; } + | DESCEND { $$ = -1; } + ; + BeginSeq : BEGINSEQ { ++hb_comp_wSeqCounter; $$ = hb_compSequenceBegin(); } Crlf EmptyStats { @@ -2132,3 +2203,154 @@ static void hb_compVariableDim( char * szName, HB_EXPR_PTR pInitValue ) hb_compExprDelete( hb_compExprGenPop( hb_compExprNewVar( szName ) ) ); } } + +static void hb_compForStart( char *szVarName, BOOL bForEach ) +{ + HB_ENUMERATOR_PTR pEnumVar; + + pEnumVar = hb_comp_functions.pLast->pEnum; + if( pEnumVar == NULL ) + { + hb_comp_functions.pLast->pEnum = (HB_ENUMERATOR_PTR) hb_xgrab( sizeof(HB_ENUMERATOR) ); + pEnumVar = hb_comp_functions.pLast->pEnum; + } + else + { + BOOL bWarn = TRUE; + HB_ENUMERATOR_PTR pLast = pEnumVar; + + while( pEnumVar ) + { + if( strcmp( pEnumVar->szName, szVarName ) == 0 ) + { + /* Enumerator variable exists already - throw warning */ + if( bWarn == TRUE ) + { + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_FORVAR_DUPL, szVarName, NULL ); + bWarn = FALSE; + } + } + pLast = pEnumVar; + pEnumVar = pEnumVar->pNext; + } + pLast->pNext = (HB_ENUMERATOR_PTR) hb_xgrab( sizeof(HB_ENUMERATOR) ); + pEnumVar = pLast->pNext; + } + pEnumVar->szName = szVarName; + pEnumVar->bForEach = bForEach; + pEnumVar->pNext = NULL; +} + +BOOL hb_compForEachVarError( char *szVarName ) +{ + HB_ENUMERATOR_PTR pEnumVar; + + pEnumVar = hb_comp_functions.pLast->pEnum; + if( pEnumVar ) + { + while( pEnumVar ) + { + if( strcmp( pEnumVar->szName, szVarName ) == 0 ) + { + if( pEnumVar->bForEach ) + { + /* only if it is FOR EACH enumerator + * generate warning if it is FOR/NEXT loop + */ + return FALSE; + } + } + pEnumVar = pEnumVar->pNext; + } + } + + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_ENUM_INVALID, szVarName, NULL ); + return TRUE; +} + +static void hb_compForEnd( char *szVar ) +{ + HB_ENUMERATOR_PTR pEnumVar; + + HB_SYMBOL_UNUSED( szVar ); + + pEnumVar = hb_comp_functions.pLast->pEnum; + if( pEnumVar->pNext ) + { + HB_ENUMERATOR_PTR pLast = pEnumVar; + + while( pEnumVar->pNext ) + { + pLast = pEnumVar; + pEnumVar = pEnumVar->pNext; + } + hb_xfree( pEnumVar ); + pLast->pNext = NULL; + } + else + { + hb_xfree( pEnumVar ); + hb_comp_functions.pLast->pEnum = NULL; + } +} + +static HB_CARGO2_FUNC( hb_compEnumEvalStart ) +{ + char * szName = hb_compExprAsString( (HB_EXPR_PTR)cargo ); + if( szName ) + hb_compForStart( szName, TRUE ); + + hb_compExprGenPush( (HB_EXPR_PTR)dummy ); /* expression */ + hb_compExprGenPush( (HB_EXPR_PTR)cargo ); /* variable */ +} + +static void hb_compEnumStart( HB_EXPR_PTR pVars, HB_EXPR_PTR pExprs, int descend ) +{ + ULONG ulLen; + + if( hb_compExprListLen(pVars) != hb_compExprListLen(pExprs) ) + { + hb_compGenError( hb_comp_szErrors, 'E', HB_COMP_ERR_FORVAR_DIFF, NULL, NULL ); + } + + ulLen = hb_compExprListEval2( pVars, pExprs, hb_compEnumEvalStart ); + + if( ulLen > 255 ) + { + hb_compGenError( hb_comp_szErrors, 'E', HB_COMP_ERR_FORVAR_TOOMANY, NULL, NULL ); + } + else + { + BYTE Len; + Len = (BYTE) (ulLen & 0xFF); + hb_compGenPCode3( HB_P_ENUMSTART, Len, ((descend>0)?1:0), FALSE ); + } +} + +static void hb_compEnumNext( HB_EXPR_PTR pExpr, int descend ) +{ + HB_SYMBOL_UNUSED( pExpr ); + if( descend > 0 ) + { + hb_compGenPCode1( HB_P_ENUMNEXT ); + } + else + { + hb_compGenPCode1( HB_P_ENUMPREV ); + } +} + +static HB_CARGO_FUNC( hb_compEnumEvalEnd ) +{ + char * szName = hb_compExprAsString( (HB_EXPR_PTR)cargo ); + + if( szName ) + hb_compForEnd( szName ); +} + +static void hb_compEnumEnd( HB_EXPR_PTR pExpr ) +{ + hb_compExprListEval( pExpr, hb_compEnumEvalEnd ); + hb_compGenPCode1( HB_P_ENUMEND ); +} + diff --git a/harbour/source/compiler/hbfix.c b/harbour/source/compiler/hbfix.c index 626ec3fc0d..ad0df5cbb7 100644 --- a/harbour/source/compiler/hbfix.c +++ b/harbour/source/compiler/hbfix.c @@ -281,9 +281,11 @@ static HB_FIX_FUNC( hb_p_localnearaddint ) { /* After fixing this variable cannot be accessed using near code */ char sTemp[16]; + char sTemp2[16]; sprintf( (char *) sTemp, "%i", pFunc->wParamCount ); - hb_compGenError( hb_comp_szErrors, 'F', HB_COMP_ERR_OPTIMIZEDLOCAL_OUT_OF_RANGE, "HB_P_LOCALNEARADDINT", (const char *) sTemp ); + sprintf( (char *) sTemp2, "%i", wNewId ); + hb_compGenError( hb_comp_szErrors, 'F', HB_COMP_ERR_OPTIMIZEDLOCAL_OUT_OF_RANGE, (const char *) sTemp2, (const char *) sTemp ); } } @@ -425,8 +427,12 @@ static HB_FIX_FUNC_PTR s_fixlocals_table[] = NULL, /* HB_P_MACROLISTEND, */ NULL, /* HB_P_MPUSHSTR, */ hb_p_localnearaddint, /* HB_P_LOCALNEARADDINT, */ - NULL, /* HB_P_MACROPUSHREF, */ - NULL /* HB_P_PUSHLONGLONG */ + NULL, /* HB_P_MACROPUSHREF */ + NULL, /* HB_P_PUSHLONGLONG */ + NULL, /* HB_P_ENUMSTART */ + NULL, /* HB_P_ENUMNEXT */ + NULL, /* HB_P_ENUMPREV */ + NULL /* HB_P_ENUMEND */ }; void hb_compFixFuncPCode( PFUNCTION pFunc ) diff --git a/harbour/source/compiler/hbgenerr.c b/harbour/source/compiler/hbgenerr.c index 721cb9f7d2..2117e89141 100644 --- a/harbour/source/compiler/hbgenerr.c +++ b/harbour/source/compiler/hbgenerr.c @@ -83,7 +83,10 @@ char * hb_comp_szErrors[] = "GET contains complex macro", "Unterminated inline block in function: \'%s\'", "Too many inline blocks %s", - "Inline C requires C output generation, use -gc[n]" + "Inline C requires C output generation, use -gc[n]", + "Too many local variables [%s] or parameters [%s]", + "Too many enumerate variables in FOR EACH loop", + "Incorrect number of enumerate variables" }; /* Table with parse warnings */ @@ -120,7 +123,9 @@ char * hb_comp_szWarnings[] = "3Message \'%s\' not known in class \'%s\'", "0Meaningless use of expression: \'%s\'", "2Unreachable code", - "1Redundant \'ANNOUNCE %s\' statement ignored" + "1Redundant \'ANNOUNCE %s\' statement ignored", + "0Duplicate variable \'%s\' in nested FOR loop", + "0Invalid variable \'%s\' for enumerator message" }; void hb_compGenError( char * szErrors[], char cPrefix, int iError, const char * szError1, const char * szError2 ) diff --git a/harbour/source/compiler/hbpcode.c b/harbour/source/compiler/hbpcode.c index c0e42914bc..d20097722b 100644 --- a/harbour/source/compiler/hbpcode.c +++ b/harbour/source/compiler/hbpcode.c @@ -171,10 +171,15 @@ static BYTE s_pcode_len[] = { 1, /* HB_P_MACROLISTEND, */ 0, /* HB_P_MPUSHSTR */ 4, /* HB_P_LOCALNEARADDINT, */ - 1, /* HB_P_MACROPUSHREF, */ - 9 /* HB_P_PUSHLONGLONG */ + 1, /* HB_P_MACROPUSHREF */ + 9, /* HB_P_PUSHLONGLONG */ + 3, /* HB_P_ENUMSTART */ + 1, /* HB_P_ENUMNEXT */ + 1, /* HB_P_ENUMPREV */ + 1 /* HB_P_ENUMEND */ }; +#if defined(HB_COMP_STRONG_TYPES) static PVAR hb_compPrivateFind( char * szPrivateName ) { PFUNCTION pFunc = hb_comp_functions.pLast; @@ -193,6 +198,7 @@ static PVAR hb_compPrivateFind( char * szPrivateName ) } return NULL; } +#endif void hb_compPCodeEval( PFUNCTION pFunc, HB_PCODE_FUNC_PTR * pFunctions, void * cargo ) { @@ -229,6 +235,7 @@ void hb_compPCodeEval( PFUNCTION pFunc, HB_PCODE_FUNC_PTR * pFunctions, void * c } +#if defined(HB_COMP_STRONG_TYPES) void hb_compStrongType( int iSize ) { PFUNCTION pFunc = hb_comp_functions.pLast, pTmp; @@ -3061,6 +3068,7 @@ void hb_compStrongType( int iSize ) pFunc->iStackIndex = 0; } } +#endif /* ifdefined(HB_COMP_STRONG_TYPES) */ void hb_compGenPCode1( BYTE byte ) { @@ -3077,8 +3085,10 @@ void hb_compGenPCode1( BYTE byte ) pFunc->pCode[ pFunc->lPCodePos++ ] = byte; +#if defined(HB_COMP_STRONG_TYPES) if( hb_comp_iWarnings >= 3 ) hb_compStrongType( 1 ); +#endif } void hb_compGenPData1( BYTE byte ) @@ -3113,8 +3123,12 @@ void hb_compGenPCode2( BYTE byte1, BYTE byte2, BOOL bStackAffected ) pFunc->pCode[ pFunc->lPCodePos++ ] = byte1; pFunc->pCode[ pFunc->lPCodePos++ ] = byte2; +#if defined(HB_COMP_STRONG_TYPES) if( hb_comp_iWarnings >= 3 && bStackAffected ) hb_compStrongType( 2 ); +#else + HB_SYMBOL_UNUSED( bStackAffected ); +#endif } void hb_compGenPCode3( BYTE byte1, BYTE byte2, BYTE byte3, BOOL bStackAffected ) @@ -3134,8 +3148,12 @@ void hb_compGenPCode3( BYTE byte1, BYTE byte2, BYTE byte3, BOOL bStackAffected ) pFunc->pCode[ pFunc->lPCodePos++ ] = byte2; pFunc->pCode[ pFunc->lPCodePos++ ] = byte3; +#if defined(HB_COMP_STRONG_TYPES) if( hb_comp_iWarnings >= 3 && bStackAffected ) hb_compStrongType( 3 ); +#else + HB_SYMBOL_UNUSED( bStackAffected ); +#endif } void hb_compGenPCode4( BYTE byte1, BYTE byte2, BYTE byte3, BYTE byte4, BOOL bStackAffected ) @@ -3156,8 +3174,12 @@ void hb_compGenPCode4( BYTE byte1, BYTE byte2, BYTE byte3, BYTE byte4, BOOL bSta pFunc->pCode[ pFunc->lPCodePos++ ] = byte3; pFunc->pCode[ pFunc->lPCodePos++ ] = byte4; +#if defined(HB_COMP_STRONG_TYPES) if( hb_comp_iWarnings >= 3 && bStackAffected ) hb_compStrongType( 4 ); +#else + HB_SYMBOL_UNUSED( bStackAffected ); +#endif } void hb_compGenPCodeN( BYTE * pBuffer, ULONG ulSize, BOOL bStackAffected ) @@ -3180,6 +3202,10 @@ void hb_compGenPCodeN( BYTE * pBuffer, ULONG ulSize, BOOL bStackAffected ) memcpy( pFunc->pCode + pFunc->lPCodePos, pBuffer, ulSize ); pFunc->lPCodePos += ulSize; +#if defined(HB_COMP_STRONG_TYPES) if( hb_comp_iWarnings >= 3 && bStackAffected ) hb_compStrongType( ulSize ); +#else + HB_SYMBOL_UNUSED( bStackAffected ); +#endif } diff --git a/harbour/source/macro/macroa.c b/harbour/source/macro/macroa.c index 338c825299..ff768e11e2 100644 --- a/harbour/source/macro/macroa.c +++ b/harbour/source/macro/macroa.c @@ -5,7 +5,7 @@ /* hbexpra.c is also included from ../compiler/expropta.c * However it produces a slighty different code if used in * macro compiler (there is an additional parameter passed to some functions) - * 1.15 - ignore this magic number - this is used to force compilation + * 1.16 - ignore this magic number - this is used to force compilation */ #define HB_MACRO_SUPPORT diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index 85cdf475f1..eef83817ce 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -127,6 +127,10 @@ static void hb_vmGreater( void ); /* checks if the latest - 1 value i static void hb_vmGreaterEqual( void ); /* checks if the latest - 1 value is greater than or equal the latest, removes both and leaves result */ static void hb_vmInstring( void ); /* check whether string 1 is contained in string 2 */ static void hb_vmForTest( void ); /* test for end condition of for */ +static LONG hb_vmEnumStart( BYTE, BYTE, LONG ); /* prepare FOR EACH loop */ +static void hb_vmEnumNext( void ); /* increment FOR EACH loop counter */ +static void hb_vmEnumPrev( void ); /* decrement FOR EACH loop counter */ +static LONG hb_vmEnumEnd( void ); /* rewind the stack after FOR EACH loop counter */ /* Operators (logical) */ static void hb_vmNot( void ); /* changes the latest logical value on the stack */ @@ -255,6 +259,8 @@ static LONG s_lRecoverBase; #define HB_RECOVER_ADDRESS -3 #define HB_RECOVER_VALUE -4 +/* Stores the position on the stack of current FOR EACh envelope +*/ /* Stores level of procedures call stack */ static ULONG s_ulProcLevel = 0; @@ -581,6 +587,7 @@ void HB_EXPORT hb_vmExecute( const BYTE * pCode, PHB_SYMB pSymbols ) ULONG ulPrivateBase; ULONG ulLastOpcode = 0; /* opcodes profiler support */ ULONG ulPastClock = 0; /* opcodes profiler support */ + LONG lForEachBase = 0; /* Stores the position on the stack of current FOR EACH envelope */ #ifndef HB_GUI static unsigned short uiPolls = 1; #endif @@ -736,6 +743,26 @@ void HB_EXPORT hb_vmExecute( const BYTE * pCode, PHB_SYMB pSymbols ) w++; break; + case HB_P_ENUMSTART: + lForEachBase = hb_vmEnumStart( pCode[ w + 1 ], pCode[ w + 2 ], lForEachBase ); + w += 3; + break; + + case HB_P_ENUMNEXT: + hb_vmEnumNext(); + w++; + break; + + case HB_P_ENUMPREV: + hb_vmEnumPrev(); + w++; + break; + + case HB_P_ENUMEND: + lForEachBase = hb_vmEnumEnd(); + w++; + break; + /* Operators (logical) */ case HB_P_NOT: @@ -1816,6 +1843,15 @@ void HB_EXPORT hb_vmExecute( const BYTE * pCode, PHB_SYMB pSymbols ) * There is the BEGIN/END sequence deifined in current * procedure/function - use it to continue opcodes execution */ + while( lForEachBase && lForEachBase > s_lRecoverBase ) + { + /* remove FOR EACH stack frame so there is no orphan + * item pointers hanging + */ + hb_stackRemove( lForEachBase ); + lForEachBase = hb_vmEnumEnd(); + } + /* * remove all items placed on the stack after BEGIN code */ @@ -1846,6 +1882,15 @@ void HB_EXPORT hb_vmExecute( const BYTE * pCode, PHB_SYMB pSymbols ) } } + while( lForEachBase ) + { + /* remove FOR EACH stack frame so there is no orphan + * item pointers hanging + */ + hb_stackRemove( lForEachBase ); + lForEachBase = hb_vmEnumEnd(); + } + if( pSymbols ) hb_memvarSetPrivatesBase( ulPrivateBase ); } @@ -2979,6 +3024,231 @@ static void hb_vmForTest( void ) /* Test to check the end point of the FO } } +/* At this moment the eval stack should store: + * -2 -> + * -1 -> + */ + /* Test to check the start point of the FOR EACH loop */ +static LONG hb_vmEnumStart( BYTE nVars, BYTE nDescend, LONG lOldBase ) +{ + HB_ITEM_PTR pItem; + HB_ITEM_PTR pRef; + int i; + ULONG ulMax; + + --nVars; + pItem = hb_itemUnRef( hb_stackItemFromTop( -(nVars*2) -2 ) ); + if( HB_IS_ARRAY( pItem ) ) + { + ulMax = pItem->item.asArray.value->ulLen; + } + else if( HB_IS_STRING(pItem) ) + { + ulMax = pItem->item.asString.length; + } + else + { + hb_errRT_BASE( EG_ARG, 1068, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), 1, pItem ); + return lOldBase; + } + + for( i=nVars; i>=0; i-- ) + { + HB_ITEM item; + + /* value to iterate store it in temporary holder */ + item.type = HB_IT_NIL; + hb_itemCopy( &item, hb_itemUnRef( hb_stackItemFromTop( -(i*2) -2 ) ) ); + + /* the control variable */ + pRef = hb_itemUnRefOnce( hb_stackItemFromTop( -(i*2) -1 ) ); + /* store the old value of variable */ + hb_itemCopy( hb_stackItemFromTop( -(i*2) -2 ), pRef ); + hb_itemClear( pRef ); /* clear the old value of variable */ + + /* set the iterator value */ + pRef->type = HB_IT_BYREF; + pRef->item.asRefer.ValuePtr.itemPtr = NULL; + pRef->item.asRefer.BasePtr.itemPtr = hb_itemNew( &item ); + pRef->item.asRefer.offset = -1; /* enumerator variable */ + hb_itemClear( &item ); + + pItem = pRef->item.asRefer.BasePtr.itemPtr; + if( HB_IS_ARRAY(pItem) ) + { + pRef->item.asRefer.value = (nDescend>0)?1:pItem->item.asArray.value->ulLen; /* the index into an array */ + if( ulMax > pItem->item.asArray.value->ulLen ) + ulMax = pItem->item.asArray.value->ulLen; + } + else if( HB_IS_STRING(pItem) ) + { + /* storage item for single characters */ + pRef->item.asRefer.value = (nDescend>0)?1:pItem->item.asString.length; + pRef->item.asRefer.ValuePtr.itemPtr = + hb_itemPutCL( NULL, pItem->item.asString.value + + pRef->item.asRefer.value-1, 1 ); + if( ulMax > pItem->item.asString.length ) + ulMax = pItem->item.asString.length; + } + else + { + hb_errRT_BASE( EG_ARG, 1068, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), 1, pItem ); + } + } + + hb_vmPushLong( nVars + 1 ); /* number of iterators */ + hb_vmPushLong( lOldBase ); /* previous FOREACH frame */ + hb_vmPushLong( ulMax ); /* max number of iterations */ + + /* empty array/string - do not start enumerations loop */ + hb_vmPushLogical( ulMax != 0 ); + + return hb_stackTopOffset() - 1; +} + + +/* Enumeration in ascending order + * At this moment the eval stack should store: + * -5 -> + * -4 -> + * -3 -> + * -2 -> + * -1 -> + */ +static void hb_vmEnumNext( void ) +{ + ULONG ulIdx; + HB_ITEM_PTR pIdx; + HB_ITEM_PTR pRef; + int i; + LONG lVars; + + lVars = ( hb_stackItemFromTop( - 3 ) )->item.asLong.value; + + --lVars; + pIdx = hb_stackItemFromTop( -1 ); + ulIdx = pIdx->item.asLong.value - 1; + if( ulIdx > 0 ) + { + for( i=lVars; i >= 0; i-- ) + { + pRef = hb_itemUnRefRefer( hb_stackItemFromTop( -(i*2) - 4 ) ); + if( HB_IS_ARRAY(pRef->item.asRefer.BasePtr.itemPtr) ) + { + pRef->item.asRefer.value++; + } + else if( HB_IS_STRING(pRef->item.asRefer.BasePtr.itemPtr) ) + { + HB_ITEM_PTR pItem; + pRef->item.asRefer.value++; + pItem = pRef->item.asRefer.BasePtr.itemPtr; + hb_itemPutCL( pRef->item.asRefer.ValuePtr.itemPtr, + pItem->item.asString.value + pRef->item.asRefer.value-1, 1 ); + } + else + { + hb_errRT_BASE( EG_ARG, 1068, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), 1, pRef->item.asRefer.BasePtr.itemPtr ); + } + } + hb_vmPushLogical( TRUE ); + } + else + { + hb_vmPushLogical( FALSE ); + } + pIdx->item.asLong.value = ulIdx; +} + +/* Enumeration in descending order + * At this moment the eval stack should store: + * -5 -> + * -4 -> + * -3 -> + * -2 -> + * -1 -> + */ +static void hb_vmEnumPrev( void ) +{ + ULONG ulIdx; + HB_ITEM_PTR pIdx; + HB_ITEM_PTR pRef; + int i; + LONG lVars; + + lVars = ( hb_stackItemFromTop( - 3 ) )->item.asLong.value; + + --lVars; + pIdx = hb_stackItemFromTop( -1 ); + ulIdx = pIdx->item.asLong.value - 1; + if( ulIdx > 0 ) + { + for( i=lVars; i >= 0; i-- ) + { + pRef = hb_itemUnRefRefer( hb_stackItemFromTop( -(i*2) - 4 ) ); + if( HB_IS_ARRAY(pRef->item.asRefer.BasePtr.itemPtr) ) + { + pRef->item.asRefer.value--; + } + else if( HB_IS_STRING(pRef->item.asRefer.BasePtr.itemPtr) ) + { + HB_ITEM_PTR pItem; + pRef->item.asRefer.value--; + pItem = pRef->item.asRefer.BasePtr.itemPtr; + hb_itemPutCL( pRef->item.asRefer.ValuePtr.itemPtr, + pItem->item.asString.value + pRef->item.asRefer.value-1, 1 ); + } + else + { + hb_errRT_BASE( EG_ARG, 1068, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), 1, pRef->item.asRefer.BasePtr.itemPtr ); + } + } + hb_vmPushLogical( TRUE ); + } + else + { + hb_vmPushLogical( FALSE ); + } + pIdx->item.asLong.value = ulIdx; +} + +/* Enumeration in descending order + * At this moment the eval stack should store: + * -5 -> + * -4 -> + * -3 -> + * -2 -> + * -1 -> + */ +static LONG hb_vmEnumEnd() +{ + int i; + LONG lOldBase; + LONG lVars; + + /* remove loop counter */ + hb_stackDec(); + ( hb_stackTopItem() )->type = HB_IT_NIL; + /* restore stack frame offset of previous FOREACH loop + */ + hb_stackDec(); + lOldBase = ( hb_stackTopItem() )->item.asLong.value; + ( hb_stackTopItem() )->type = HB_IT_NIL; + /* remove number of iterators */ + hb_stackDec(); + lVars = ( hb_stackTopItem() )->item.asLong.value; + ( hb_stackTopItem() )->type = HB_IT_NIL; + + --lVars; + for( i=lVars; i>=0; i-- ) + { + /* restore the value of variable before the FOREACH loop */ + hb_itemCopy( hb_itemUnRefOnce( hb_stackItemFromTop( -1 ) ), hb_stackItemFromTop( -2 ) ); + hb_stackPop(); + hb_stackPop(); + } + return lOldBase; +} + /* ------------------------------- */ /* Operators (logical) */ /* ------------------------------- */ @@ -3687,6 +3957,7 @@ void HB_EXPORT hb_vmSend( USHORT uiParams ) ULONG ulClock = 0; void *pMethod = NULL; BOOL bProfiler = hb_bProfiler; /* because profiler state may change */ + BOOL bNotHandled = TRUE; HB_TRACE(HB_TR_DEBUG, ("hb_vmSend(%hu)", uiParams)); @@ -3713,7 +3984,34 @@ void HB_EXPORT hb_vmSend( USHORT uiParams ) /* printf( "Symbol: '%s'\n", pSym->szName ); */ - if( HB_IS_NIL( pSelf ) ) /* are we sending a message ? */ + if ( HB_IS_BYREF(pSelf) ) + { + /* method of enumerator variable from FOR EACH statement + */ + HB_ITEM_PTR pRef; + + pRef = hb_itemUnRefRefer( pSelf ); + if( HB_IS_BYREF(pRef) && pRef->item.asRefer.offset < 0 && pRef->item.asRefer.value >= 0 ) + { + if( hb_stricmp( (const char *)pSym->szName, "__ENUMINDEX" ) == 0 ) + { + hb_itemPutNL( &hb_stack.Return, pRef->item.asRefer.value ); + bNotHandled = FALSE; + } + else if( hb_stricmp( (const char *)pSym->szName, "__ENUMBASE" ) == 0 ) + { + hb_itemCopy( &hb_stack.Return, pRef->item.asRefer.BasePtr.itemPtr ); + bNotHandled = FALSE; + } + else if( hb_stricmp( (const char *)pSym->szName, "__ENUMVALUE" ) == 0 ) + { + hb_itemCopy( &hb_stack.Return, hb_itemUnRefOnce(pRef) ); + bNotHandled = FALSE; + } + } + } + + if( HB_IS_NIL( pSelf ) && bNotHandled ) /* are we sending a message ? */ { pFunc = pSym->value.pFunPtr; @@ -3765,7 +4063,7 @@ void HB_EXPORT hb_vmSend( USHORT uiParams ) } } } - else + else if( bNotHandled ) { PHB_BASEARRAY pSelfBase = NULL; BOOL lPopSuper = FALSE; diff --git a/harbour/source/vm/itemapi.c b/harbour/source/vm/itemapi.c index 0136271ff9..5a4075d5c1 100644 --- a/harbour/source/vm/itemapi.c +++ b/harbour/source/vm/itemapi.c @@ -1124,6 +1124,18 @@ void HB_EXPORT hb_itemClear( PHB_ITEM pItem ) else if( HB_IS_MEMVAR( pItem ) ) hb_memvarValueDecRef( pItem->item.asMemvar.value ); + else if( HB_IS_BYREF( pItem ) && pItem->item.asRefer.offset < 0 && pItem->item.asRefer.value >= 0 ) + { + /* FOR EACH control variable */ + hb_itemClear( pItem->item.asRefer.BasePtr.itemPtr ); + hb_itemRelease( pItem->item.asRefer.BasePtr.itemPtr ); + if( pItem->item.asRefer.ValuePtr.itemPtr ) + { + hb_itemClear( pItem->item.asRefer.ValuePtr.itemPtr ); + hb_itemRelease( pItem->item.asRefer.ValuePtr.itemPtr ); + } + } + #if defined( HB_FM_STATISTICS ) && defined( HB_PARANOID_MEM_CHECK ) else if( HB_IS_BADITEM( pItem ) ) hb_errInternal( HB_EI_VMPOPINVITEM, NULL, "hb_itemClear()", NULL ); @@ -1249,6 +1261,24 @@ PHB_ITEM hb_itemUnRef( PHB_ITEM pItem ) return pItem; } +/* Unreference passed variable + * Do not unreference the last reference stored +*/ +PHB_ITEM hb_itemUnRefRefer( PHB_ITEM pItem ) +{ + PHB_ITEM pRef = pItem; + PHB_ITEM pLast; + + HB_TRACE(HB_TR_DEBUG, ("hb_itemUnRefRefer(%p)", pItem)); + + do { + pLast = pItem; + pItem = hb_itemUnRefOnce( pItem ); + } + while( HB_IS_BYREF( pItem ) && (pRef != pItem) ); + + return pLast; +} /* Internal API, not standard Clipper */ /* De-references item passed by the reference */ @@ -1277,6 +1307,18 @@ PHB_ITEM hb_itemUnRefOnce( PHB_ITEM pItem ) pItem = *( pItem->item.asRefer.BasePtr.itemsbase ) + pItem->item.asRefer.value; } + else if( pItem->item.asRefer.offset < 0 ) + { + /* enumerator variable */ + if( HB_IS_ARRAY(pItem->item.asRefer.BasePtr.itemPtr) ) + { + pItem = hb_arrayGetItemPtr( pItem->item.asRefer.BasePtr.itemPtr, pItem->item.asRefer.value ); + } + else if( pItem->item.asRefer.ValuePtr.itemPtr ) + { + pItem = pItem->item.asRefer.ValuePtr.itemPtr; + } + } else { /* a reference to a local variable */ @@ -1829,6 +1871,7 @@ char HB_EXPORT * hb_itemPadConv( PHB_ITEM pItem, ULONG * pulSize, BOOL * bFreeRe { HB_TRACE_STEALTH(HB_TR_DEBUG, ("hb_itemPadConv(%p, %p, %p)", pItem, pulSize, bFreeReq)); + /* to be clipper compatible don't convert HB_IT_BYREF items */ if( pItem ) { switch( pItem->type ) diff --git a/harbour/tests/foreach.prg b/harbour/tests/foreach.prg new file mode 100644 index 0000000000..685d513564 --- /dev/null +++ b/harbour/tests/foreach.prg @@ -0,0 +1,141 @@ +/* + * $Id$ + */ + +PROCEDURE MAIN() +LOCAL A:={ "one ", "two ", "three" } +LOCAL AA:={ "AA-one ", "AA-two ", "AA-three", "AA-four " } +LOCAL c:="abcdefghij" +LOCAL enum:="b" +LOCAL bb, cc +LOCAL i + +/* + test(@a,b) + test(a,@b) + test(@a,@b) +*/ + ? "========================================================" + ? "before loop: ENUM=",ENUM + ? 'before loop: a[1]=',a[1], 'a[2]=',a[2], 'a[3]=',a[3] + FOR EACH enum IN A + ? "start: ENUM=", ENUM + IF( ENUM = 'two' ) + ENUM := UPPER( ENUM ) + ENDIF + ? "end: ENUM=", ENUM, "| index:", ENUM:__enumIndex, "| value:", ENUM:__enumValue, "| base: ", VALTYPE(ENUM:__enumBase) + NEXT + ? "after loop ENUM=", ENUM + ? 'after loop: a[1]=',a[1], 'a[2]=',a[2], 'a[3]=',a[3] + ? "-----------------" + ? + inkey(0) + + + ? "========================================================" + ? "Testing passing by reference" + ? "before loop: ENUM=",ENUM + ? 'after loop: a[1]=',a[1], 'a[2]=',a[2], 'a[3]=',a[3] + FOR EACH ENUM IN A + IF( UPPER(ENUM) = 'TWO' ) + ENUM := UPPER( ENUM ) + ? "before passing by @ | ENUM=", ENUM, "| index:", ENUM:__enumIndex, "| value:", ENUM:__enumValue, "| base: ", VALTYPE(ENUM:__enumBase) + testBYREF( @ENUM ) + ? " after passing by @ | ENUM=", ENUM, "| index:", ENUM:__enumIndex, "| value:", ENUM:__enumValue, "| base: ", VALTYPE(ENUM:__enumBase) + ENDIF + NEXT + ? "after loop ENUM=", ENUM + ? 'after loop: a[1]=',a[1], 'a[2]=',a[2], 'a[3]=',a[3] + inkey(0) + + ? "========================================================" + ? "Testing BREAK" + ? "before loop: ENUM=",ENUM + ? 'after loop: a[1]=',a[1], 'a[2]=',a[2], 'a[3]=',a[3] + BEGIN SEQUENCE + FOR EACH enum IN A DESCEND + ? "loop: ENUM=", ENUM, "| index:", ENUM:__enumIndex, "| value:", ENUM:__enumValue, "| base: ", VALTYPE(ENUM:__enumBase) + TESTbreak( ENUM ) + NEXT + + RECOVER USING i + ? "after loop ENUM=", ENUM + ? 'after loop: a[1]=',a[1], 'a[2]=',a[2], 'a[3]=',a[3] + ? "recover variable i=", i + END SEQUENCE + inkey(0) + + ? "========================================================" + ? "before loop: ENUM=",ENUM + ? 'before loop: c=',c + BEGIN SEQUENCE + FOR EACH enum IN c + ? "start: ENUM=", ENUM + IF( enum = 'd' ) + enum := UPPER( enum ) + ENDIF + Testbreak( enum ) + ? "end: ENUM=", ENUM, "| index:", ENUM:__enumIndex, "| value:", ENUM:__enumValue, "| base: ", VALTYPE(ENUM:__enumBase) + NEXT + RECOVER USING i + ? "after loop ENUM=", ENUM + ? 'after loop: c=', c + ? "recover variable i=", i + END SEQUENCE + + + ? "========================================================" + FOR EACH enum,bb,cc IN A,AA,c + ? enum, enum:__enumIndex, enum:__enumValue + ? bb, bb:__enumIndex, bb:__enumValue + ? cc, cc:__enumIndex, cc:__enumValue + NEXT + inkey(0) + + ? "========================================================" + FOR EACH enum,bb,cc IN A,AA,c DESCEND + ? enum, enum:__enumIndex, enum:__enumValue + ? bb, bb:__enumIndex, bb:__enumValue + ? cc, cc:__enumIndex, cc:__enumValue + NEXT + + FOR EACH enum IN a + BEGIN SEQUENCE + IF( enum = '2' ) + BREAK + ENDIF + END SEQUENCE + NEXT + + FOR EACH enum IN a + BEGIN SEQUENCE + IF( enum = '2' ) + ? "Breaking... enum=", enum + BREAK enum + ENDIF + RECOVER USING enum + ? "after recovery: enum=", enum + END SEQUENCE + NEXT + +RETURN + + +PROCEDURE TESTbreak( v ) + IF( v = '2' .or. v = 'd' ) + ? "issuing break" + BREAK( v ) + ENDIF + +RETURN + +PROCEDURE TESTBYREF( enum ) + ? "start of testBYREF ENUM=", ENUM + FOR EACH ENUM IN {1,2,3} + ? " -testBYREF=", ENUM + NEXT + ? "end of loop: ENUM=", ENUM + ENUM := "22222" + ? "end of testBYREF ENUM=", ENUM +RETURN +