From 4ff4ff3d1125032007aa97ad0ad0f8d7a1ce02fb Mon Sep 17 00:00:00 2001 From: Ryszard Glab Date: Fri, 14 May 2004 13:58:47 +0000 Subject: [PATCH] 2004-05-14 16:05 UTC+0100 Ryszard Glab * include/hbexpra.c * source/compiler/expropta.c * source/compiler/harbour.c * source/macro/macroa.c * source/rtl/tget.prg * source/rtl/tgetint.prg * fixed to be more Clipper compatible * source/rtl/persist.prg * fixed to not use xBase extensions --- harbour/ChangeLog | 14 ++++++ harbour/include/hbexpra.c | 81 ++++++++++++++++++------------ harbour/source/compiler/expropta.c | 2 +- harbour/source/compiler/harbour.c | 13 ++++- harbour/source/macro/macroa.c | 2 +- harbour/source/rtl/persist.prg | 4 +- harbour/source/rtl/tget.prg | 36 ++++++++++++- harbour/source/rtl/tgetint.prg | 31 +++++------- 8 files changed, 124 insertions(+), 59 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index b58f84d3ab..2fc104a9d1 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,20 @@ 2002-12-01 23:12 UTC+0100 Foo Bar */ +2004-05-14 16:05 UTC+0100 Ryszard Glab + + * include/hbexpra.c + * source/compiler/expropta.c + * source/compiler/harbour.c + * source/macro/macroa.c + * source/rtl/tget.prg + * source/rtl/tgetint.prg + * fixed to be more Clipper compatible + + * source/rtl/persist.prg + * fixed to not use xBase extensions + + 2004-05-13 11:00 UTC+0100 Ryszard Glab * source/rtl/transform.c diff --git a/harbour/include/hbexpra.c b/harbour/include/hbexpra.c index 718373eb7e..237afcac83 100644 --- a/harbour/include/hbexpra.c +++ b/harbour/include/hbexpra.c @@ -453,12 +453,18 @@ HB_EXPR_PTR hb_compExprNewFunCall( HB_EXPR_PTR pName, HB_EXPR_PTR pParms ) pVar = pVar->value.asList.pExprList; } - /* create a set/get codeblock */ -#ifdef HB_MACRO_SUPPORT - pVar = hb_compExprSetGetBlock( pVar, HB_MACRO_PARAM ); -#else - pVar = hb_compExprSetGetBlock( pVar ); -#endif + /* create a set only codeblock */ + if( pVar->ExprType == HB_ET_MACRO ) + { + /* &var[1] */ + hb_compExprFree( pVar, NULL ); + pVar = hb_compExprNewNil(); + } + else + { + pVar = hb_compExprAddCodeblockExpr( hb_compExprNewCodeBlock(NULL,0,0), pVar ); + } + /* pVar will be the first argument now */ pParms->value.asList.pExprList = pVar; @@ -594,7 +600,23 @@ HB_EXPR_PTR hb_compExprNewFunCall( HB_EXPR_PTR pName, HB_EXPR_PTR pParms ) #ifdef HB_MACRO_SUPPORT pArg = hb_compExprSetGetBlock( pArg, HB_MACRO_PARAM ); #else - pArg = hb_compExprSetGetBlock( pArg ); + if( pArg->ExprType == HB_ET_VARIABLE ) + { + if( hb_compVariableScope( pArg->value.asSymbol ) > 0 ) + pArg = hb_compExprSetGetBlock( pArg ); + else + { + /* Undeclared variable name - create a set/get codeblock + * at runtime + */ + hb_compExprFree( pArg, NULL ); + pArg = hb_compExprNewNil(); + } + } + else + { + pArg = hb_compExprSetGetBlock( pArg ); + } #endif /* restore next arguments */ pArg->pNext = pNext; @@ -932,7 +954,7 @@ HB_EXPR_PTR hb_compExprReduce( HB_EXPR_PTR pExpr ) #ifndef SIMPLEX /* Creates a set/get codeblock for passed expression used in __GET * - * {|| IIF( PCOUNT()==0, , :=HB_PARAM(1) )} + * {|var| IIF( var==NIL, , :=var )} */ #ifdef HB_MACRO_SUPPORT HB_EXPR_PTR hb_compExprSetGetBlock( HB_EXPR_PTR pExpr, HB_MACRO_DECL ) @@ -943,42 +965,35 @@ HB_EXPR_PTR hb_compExprSetGetBlock( HB_EXPR_PTR pExpr ) HB_EXPR_PTR pIIF; HB_EXPR_PTR pSet; - /* create PCOUNT() expression */ + /* create {|var| expression + * NOTE: this is not a valid variable name so there will be no collisions + */ + pIIF =hb_compExprNewVar( hb_strdup("~1") ); + /* create var==NIL */ #ifdef HB_MACRO_SUPPORT - pIIF = hb_compExprNewFunCall( hb_compExprNewFunName( hb_strdup("PCOUNT") ), - hb_compExprNewArgList( hb_compExprNewEmpty() ), HB_MACRO_PARAM ); + pIIF = hb_compExprSetOperand( hb_compExprNewEQ( pIIF ), hb_compExprNewNil(), HB_MACRO_PARAM ); #else - pIIF = hb_compExprNewFunCall( hb_compExprNewFunName( hb_strdup("PCOUNT") ), - hb_compExprNewArgList( hb_compExprNewEmpty() ) ); + pIIF = hb_compExprSetOperand( hb_compExprNewEQ( pIIF ), hb_compExprNewNil() ); #endif - /* create PCOUNT()==0 */ -#ifdef HB_MACRO_SUPPORT - pIIF = hb_compExprSetOperand( hb_compExprNewEQ( pIIF ), hb_compExprNewLong( 0 ), HB_MACRO_PARAM ); -#else - pIIF = hb_compExprSetOperand( hb_compExprNewEQ( pIIF ), hb_compExprNewLong( 0 ) ); -#endif - /* create ( PCOUNT()==0, */ + /* create ( var==NIL, */ pIIF = hb_compExprNewList( pIIF ); - /* create ( PCOUNT()==0, , */ + /* create ( var==NIL, , */ pIIF = hb_compExprAddListExpr( pIIF, pExpr ); - /* create HB_PCOUNT(1) */ -#ifdef HB_MACRO_SUPPORT - pSet = hb_compExprNewFunCall( hb_compExprNewFunName( hb_strdup("HB_PVALUE") ), - hb_compExprNewArgList( hb_compExprNewLong( 1 ) ), HB_MACRO_PARAM ); -#else - pSet = hb_compExprNewFunCall( hb_compExprNewFunName( hb_strdup("HB_PVALUE") ), - hb_compExprNewArgList( hb_compExprNewLong( 1 ) ) ); -#endif - /* create :=HB_PCOUNT(1) */ + /* create var */ + pSet =hb_compExprNewVar( hb_strdup("~1") ); + /* create :=var */ pSet = hb_compExprAssign( hb_compExprClone( pExpr ), pSet ); - /* create ( PCOUNT()==0, , :=HB_PARAM(1)) */ + /* create ( var==nil, , :=var ) */ pIIF = hb_compExprAddListExpr( pIIF, pSet ); /* create IIF() expression */ pIIF = hb_compExprNewIIF( pIIF ); /* create a codeblock - * NOTE: we can ommit a local variable if HB_PARAM() is used */ - return hb_compExprAddCodeblockExpr( hb_compExprNewCodeBlock(NULL,0,0), pIIF ); +#ifdef HB_MACRO_SUPPORT + return hb_compExprAddCodeblockExpr( hb_compExprCBVarAdd( hb_compExprNewCodeBlock(NULL,0,0), hb_strdup("~1"), HB_MACRO_PARAM ), pIIF ); +#else + return hb_compExprAddCodeblockExpr( hb_compExprCBVarAdd( hb_compExprNewCodeBlock(NULL,0,0), "~1", ' ' ), pIIF ); +#endif } #endif diff --git a/harbour/source/compiler/expropta.c b/harbour/source/compiler/expropta.c index 1d65de0d10..e3f47d4c79 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.14 - ignore this magic number - this is used to force compilation + * 1.15 - ignore this magic number - this is used to force compilation */ #include "hbexpra.c" diff --git a/harbour/source/compiler/harbour.c b/harbour/source/compiler/harbour.c index 0a09a9abab..e3e0973523 100644 --- a/harbour/source/compiler/harbour.c +++ b/harbour/source/compiler/harbour.c @@ -376,7 +376,16 @@ void hb_compExternAdd( char * szExternName ) /* defines a new extern name */ { PEXTERN pExtern = ( PEXTERN ) hb_xgrab( sizeof( _EXTERN ) ), pLast; - pExtern->szName = szExternName; + if( strcmp( "_GET_", szExternName ) == 0 ) + { + /* special function to implement @ GET statement */ + hb_compExternAdd( hb_strdup("__GETA") ); + pExtern->szName = hb_strdup("__GET"); + } + else + { + pExtern->szName = szExternName; + } pExtern->pNext = NULL; if( hb_comp_pExterns == NULL ) @@ -836,7 +845,7 @@ int hb_compVariableScope( char * szVarName ) { /* Check file-wide variables */ - if( hb_compMemvarGetPos( szVarName, hb_comp_functions.pFirst ) == 0 ) + if( hb_compMemvarGetPos( szVarName, hb_comp_functions.pFirst ) > 0 ) iScope = HB_VS_GLOBAL_MEMVAR; else if( hb_compFieldGetPos( szVarName, hb_comp_functions.pFirst ) > 0 ) iScope = HB_VS_GLOBAL_FIELD; diff --git a/harbour/source/macro/macroa.c b/harbour/source/macro/macroa.c index b4838a6cbf..338c825299 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.14 - ignore this magic number - this is used to force compilation + * 1.15 - ignore this magic number - this is used to force compilation */ #define HB_MACRO_SUPPORT diff --git a/harbour/source/rtl/persist.prg b/harbour/source/rtl/persist.prg index fd91b5a422..1290399b72 100644 --- a/harbour/source/rtl/persist.prg +++ b/harbour/source/rtl/persist.prg @@ -98,13 +98,13 @@ METHOD LoadFromText( cObjectText ) CLASS HBPersistent cLine := StrTran( cLine, "::", "oSelf:" ) cLine := StrTran( cLine, " LEN ", " = Array( " ) cLine := RTrim( StrTran( cLine, "=", ":=", , 1 ) ) + " )" - &( cLine ) + cLine := &( cLine ) case Left( cToken := LTrim( __StrToken( cLine, 1, "=" ) ), 2 ) == "::" M->oSelf := Self cLine := StrTran( cLine, "::", "oSelf:" ) cLine := StrTran( cLine, "=", ":=", , 1 ) - &( cLine ) + cLine := &( cLine ) endcase diff --git a/harbour/source/rtl/tget.prg b/harbour/source/rtl/tget.prg index 7f22aafbd9..d33f096f41 100644 --- a/harbour/source/rtl/tget.prg +++ b/harbour/source/rtl/tget.prg @@ -541,11 +541,24 @@ return Self //---------------------------------------------------------------------------// METHOD VarPut( xValue, lReFormat ) CLASS Get +LOCAL aSubs, nLen, aValue +LOCAL i DEFAULT lReFormat TO .t. if ValType( ::Block ) == 'B' - Eval( ::block, xValue ) + IF ::SubScript == NIL + Eval( ::Block, xValue ) + ELSE + aSubs := ::SubScript + nLen := Len( aSubs ) + aValue := Eval( ::Block ) + FOR i:=1 TO nLen - 1 + aValue := aValue[ aSubs[ i ] ] + NEXT + aValue[ aSubs[ i ] ] := xValue + ENDIF + if lReFormat if !::hasfocus ::Original := xValue @@ -561,8 +574,27 @@ return xValue //---------------------------------------------------------------------------// METHOD VarGet() CLASS Get +LOCAL aSubs, nLen, aValue +LOCAL i +LOCAL xValue -return IIF( ValType( ::Block ) == 'B', Eval( ::Block ), NIL ) + IF ValType( ::Block ) == 'B' + IF ::SubScript == NIL + xValue := Eval( ::Block ) + ELSE + aSubs := ::SubScript + nLen := Len( aSubs ) + aValue := Eval( ::Block ) + FOR i:=1 TO nLen - 1 + aValue := aValue[ aSubs[ i ] ] + NEXT + xValue := aValue[ aSubs[ i ] ] + ENDIF + ELSE + xValue := NIL + ENDIF + +return xValue //---------------------------------------------------------------------------// diff --git a/harbour/source/rtl/tgetint.prg b/harbour/source/rtl/tgetint.prg index d6e41cfdcc..8dc77715bc 100644 --- a/harbour/source/rtl/tgetint.prg +++ b/harbour/source/rtl/tgetint.prg @@ -60,6 +60,9 @@ #include "hbclass.ch" #include "hbsetup.ch" +REQUEST HB_PVALUE +REQUEST PCOUNT + //---------------------------------------------------------------------------// FUNCTION GetNew( nRow, nCol, bVarBlock, cVarName, cPicture, cColor ) @@ -72,11 +75,12 @@ FUNCTION __GET( bSetGet, cVarName, cPicture, bValid, bWhen ) LOCAL oGet IF bSetGet == NIL - IF __MVEXIST( cVarName ) + IF FieldPos( cVarName ) > 0 + bSetGet := &( "{|| IIF( PCOUNT()==0, FIELD->" + cVarName + ", FIELD->" + cVarName + " := HB_PVALUE(1) ) }" ) + ELSEIF __MVEXIST( cVarName ) bSetGet := {|_1| iif( _1 == NIL, __MVGET( cVarName ), __MVPUT( cVarName, _1 ) ) } ELSE - // "{|_1| IIF( _1 == NIL, &cVarName, &cVarName := _1 )" - bSetGet := &( "{|_1| iif( _1 == NIL, " + cVarName + ", " + cVarName + " := _1 ) }" ) + bSetGet := &( "{|| IIF( PCOUNT()==0, " + cVarName + ", " + cVarName + " := HB_PVALUE(1) ) }" ) ENDIF ENDIF @@ -90,27 +94,18 @@ FUNCTION __GET( bSetGet, cVarName, cPicture, bValid, bWhen ) FUNCTION __GETA( bGetArray, cVarName, cPicture, bValid, bWhen, aIndex ) LOCAL oGet - LOCAL nDim := Len( aIndex ) - LOCAL bSetGet - LOCAL aGetVar - LOCAL nCounter IF bGetArray == NIL - IF __MVEXIST( cVarName ) - aGetVar := __MVGET( cVarName ) + IF FieldPos( cVarName ) > 0 + bGetArray := &( "{|| FIELD->" + cVarName + "}" ) + ELSEIF __MVEXIST( cVarName ) + bGetArray := {|| __MVGET( cVarName ) } ELSE - aGetVar := &cVarName + bGetArray := &( "{|| " + cVarName + "}" ) ENDIF - ELSE - aGetVar := Eval( bGetArray ) ENDIF - FOR nCounter := 1 TO nDim - 1 - aGetVar := aGetVar[ aIndex[ nCounter ] ] - NEXT - bSetGet := {|_1| iif( _1 == NIL, aGetVar[ aIndex[ nCounter ] ], aGetVar[ aIndex[ nCounter ] ] := _1 ) } - - oGet := Get():New(,, bSetGet, cVarName, cPicture ) + oGet := Get():New(,, bGetArray, cVarName, cPicture ) oGet:SubScript := aIndex oGet:PreBlock := bWhen