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

2005-11-07 14:35 UTC+0100 Ryszard Glab <rglab@imid.med.pl>

Browse Source 
* 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
This commit is contained in:
Ryszard Glab
2005-11-07 13:28:40 +00:00
parent c301bbe5f7
commit d947f68c8e
22 changed files with 1048 additions and 33 deletions
Download Patch File Download Diff File Expand all files Collapse all files

49
harbour/ChangeLog
View File

@@ -8,6 +8,55 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2005-11-07 14:35 UTC+0100 Ryszard Glab <rglab@imid.med.pl>
* 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 <alinares@fivetechsoft.com>
* harbour/source/vm/estack.c
* hb_UnhandledExceptionFilter() modified to return EXCEPTION_CONTINUE_SEARCH

3
harbour/include/hbapi.h
View File

@@ -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

1
harbour/include/hbapiitm.h
View File

@@ -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 */

21
harbour/include/hbcomp.h
View File

@@ -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 );

4
harbour/include/hberrors.h
View File

@@ -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

85
harbour/include/hbexpra.c
View File

@@ -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

6
harbour/include/hbpcode.h
View File

@@ -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_ */

9
harbour/include/hbsetup.h
View File

@@ -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

20
harbour/source/common/expropt1.c
View File

@@ -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 )
*

2
harbour/source/compiler/expropta.c
View File

@@ -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"

37
harbour/source/compiler/genc.c
View File

@@ -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 )

58
harbour/source/compiler/gencli.c
View File

@@ -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 )

1
harbour/source/compiler/harbour.c
View File

@@ -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;
}

24
harbour/source/compiler/harbour.l
View File

@@ -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_; }
<FOR_>{Separator}+"each" { BEGIN FOREACH_;}
<FOR_>{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;
}
<FOREACH_>{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;
}
<FOREACH_>. {
BEGIN 0;
unput( yytext[ yyleng-1 ] );
hb_comp_iState = FOREACH;
return FOREACH;
}
%{
/* ************************************************************************ */
%}

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

@@ -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 <iNumber> Params ParamList
%type <iNumber> IfBegin VarList ExtVarList
%type <iNumber> FieldList
%type <iNumber> Descend
%type <lNumber> WhileBegin
%type <pVoid> IfElseIf Cases
%type <asExpr> Argument ArgList ElemList BlockExpList BlockVarList BlockNoVar
@@ -250,6 +258,7 @@ static void hb_compDebugStart( void ) { };
%type <asExpr> DimIndex DimList
%type <asExpr> FieldAlias FieldVarAlias
%type <asExpr> PostOp
%type <asExpr> ForVar ForList ForExpr
%type <asCodeblock> CBSTART
%%
@@ -463,6 +472,7 @@ IdentName : IDENTIFIER { $$ = $1; }
| PUBLIC { $$ = $<string>1; }
| PARAMETERS { $$ = $<string>1; }
| PROCREQ { $$ = $<string>1; }
| DESCEND { $$ = $<string>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 */
$<asExpr>$ = hb_compExprGenStatement( hb_compExprAssign( $2, $4 ) );
if( hb_compExprAsString($<asExpr>2) )
{
hb_compForStart( hb_compExprAsString($<asExpr>2), FALSE );
}
}
TO Expression StepExpr /* 6 7 8 */
{
@@ -1572,6 +1587,10 @@ ForNext : FOR LValue ForAssign Expression /* 1 2 3 4 */
hb_compGenJump( $<lNumber>9 - hb_comp_functions.pLast->lPCodePos );
hb_compGenJumpHere( $<lNumber>11 );
hb_compLoopEnd();
if( hb_compExprAsString($<asExpr>2) )
{
hb_compForEnd( hb_compExprAsString($<asExpr>2) );
}
hb_compExprDelete( $7 );
hb_compExprDelete( $<asExpr>5 ); /* deletes $5, $2, $4 */
if( $<asExpr>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();
$<lNumber>$ = hb_comp_functions.pLast->lPCodePos;
}
Crlf /* 8 */
{
/* 9
*/
$<lNumber>$ = hb_compGenJumpFalse( 0 );
}
ForStatements /* 10 */
{
hb_compLoopHere();
hb_compEnumNext( $2, $6 );
hb_compGenJump( $<lNumber>7 - hb_comp_functions.pLast->lPCodePos );
hb_compGenJumpHere( $<lNumber>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; $<lNumber>$ = 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 );
}

12
harbour/source/compiler/hbfix.c
View File

@@ -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 )

9
harbour/source/compiler/hbgenerr.c
View File

@@ -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 )

30
harbour/source/compiler/hbpcode.c
View File

@@ -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
}

2
harbour/source/macro/macroa.c
View File

@@ -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

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

@@ -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 -> <array for traverse>
* -1 -> <the reference to enumerate variable>
*/
/* 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 -> <old value of enumerator variable>
* -4 -> <the reference to enumerate variable>
* -3 -> <number of iterators>
* -2 -> <previous FOREACH frame>
* -1 -> <max number of iterations>
*/
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 -> <old value of enumerator variable>
* -4 -> <the reference to enumerate variable>
* -3 -> <number of iterators>
* -2 -> <previous FOREACH frame>
* -1 -> <max number of iterations>
*/
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 -> <old value of enumerator variable>
* -4 -> <the reference to enumerate variable>
* -3 -> <number of iterators>
* -2 -> <previous FOREACH frame>
* -1 -> <max number of iterations>
*/
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;

43
harbour/source/vm/itemapi.c
View File

@@ -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 )

141
harbour/tests/foreach.prg Normal file
View File

@@ -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