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

2004-05-14 16:05 UTC+0100 Ryszard Glab <rglab@imid.med.pl>

Browse Source 
* 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
This commit is contained in:
Ryszard Glab
2004-05-14 13:58:47 +00:00
parent f130138204
commit 4ff4ff3d11
8 changed files with 124 additions and 59 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
harbour/ChangeLog
View File

@@ -8,6 +8,20 @@
2002-12-01 23:12 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2004-05-14 16:05 UTC+0100 Ryszard Glab <rglab@imid.med.pl>
* 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 <rglab@imid.med.pl>
* source/rtl/transform.c

81
harbour/include/hbexpra.c
View File

@@ -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, <pExpr>, <pExpr>:=HB_PARAM(1) )}
* {|var| IIF( var==NIL, <pExpr>, <pExpr>:=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, <pExpr>, */
/* create ( var==NIL, <pExpr>, */
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 <pExpr>:=HB_PCOUNT(1) */
/* create var */
pSet =hb_compExprNewVar( hb_strdup("~1") );
/* create <pExpr>:=var */
pSet = hb_compExprAssign( hb_compExprClone( pExpr ), pSet );
/* create ( PCOUNT()==0, <pExpr>, <pExpr>:=HB_PARAM(1)) */
/* create ( var==nil, <pExpr>, <pExpr>:=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

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

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

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

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

4
harbour/source/rtl/persist.prg
View File

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

36
harbour/source/rtl/tget.prg
View File

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

31
harbour/source/rtl/tgetint.prg
View File

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