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

2006-12-22 11:00 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* harbour/contrib/rdd_ads/adsfunc.c
    * do not use hb_param( pItem, HB_IT_BYREF ) but ISBYREF() macro

  * harbour/include/hbdefs.h
    * formatting

  * harbour/include/hbexprb.c
    ! fixed code generated for logical expressions when shortcutting
      is enabled to be Clipper compatible

  * harbour/source/compiler/cmdcheck.c
    ! added missing break in -z compiler switch decoding

  * harbour/source/compiler/hbfix.c
    % added optimizations for code generated for logical expressions,
      it strips a chain of HB_P_DUPLICATE -> HB_P_JUMP[TRUFALES] ->
      HB_P_DUPLICATE -> HB_P_JUMP[TRUFALES] -> ...
      In fact it should not be done here but because we do not have
      any metacode level where such optimizations should be done and
      PCODE is generated online then it will have to be here. Maybe
      in the future we will add metacode.

  * harbour/source/rdd/dbcmd.c
    * make "M" alias Clipper compatible. After some thoughts I decided
      that in some cases it can be usable so now "M" will set WA number
      to 65535 like in Clipper.

  * harbour/source/rdd/dbf1.c
    * allow to open VFP DBFs with _NullFlags system command

  * harbour/source/rdd/delim1.c
  * harbour/source/rdd/sdf1.c
    ! updated field size calculation for some some extended types.

  * harbour/source/rdd/workarea.c
    * generate RT error when CREATEFIELD() method does not accept some
      parameters to avoid silent DBCREATE() failing.

  * harbour/source/vm/macro.c
    * removed hb_compMemvarCheck() - this function was not dooing
      anything - only slows the TYPE() by calling hb_dynsymFind()
      one or two times.
    + added TODO note: memvars create by TYPE() have PUBLIC scope
      in Clipper. Clipper also always tries to evaluate valid expressions
      inside TYPE even if the contain UDF. UDF only stops evaluation
      so:
         TYPE( "(val:=1) + f() + (val2:=2)" )
      creates in clipper public variable VAL but not VAL2.
This commit is contained in:
Przemyslaw Czerpak
2006-12-22 10:07:21 +00:00
parent 2f8ddbd879
commit 2cdb32d6c3
12 changed files with 341 additions and 232 deletions
Download Patch File Download Diff File Expand all files Collapse all files

50
harbour/ChangeLog
View File

@@ -8,6 +8,56 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2006-12-22 11:00 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/contrib/rdd_ads/adsfunc.c
* do not use hb_param( pItem, HB_IT_BYREF ) but ISBYREF() macro
* harbour/include/hbdefs.h
* formatting
* harbour/include/hbexprb.c
! fixed code generated for logical expressions when shortcutting
is enabled to be Clipper compatible
* harbour/source/compiler/cmdcheck.c
! added missing break in -z compiler switch decoding
* harbour/source/compiler/hbfix.c
% added optimizations for code generated for logical expressions,
it strips a chain of HB_P_DUPLICATE -> HB_P_JUMP[TRUFALES] ->
HB_P_DUPLICATE -> HB_P_JUMP[TRUFALES] -> ...
In fact it should not be done here but because we do not have
any metacode level where such optimizations should be done and
PCODE is generated online then it will have to be here. Maybe
in the future we will add metacode.
* harbour/source/rdd/dbcmd.c
* make "M" alias Clipper compatible. After some thoughts I decided
that in some cases it can be usable so now "M" will set WA number
to 65535 like in Clipper.
* harbour/source/rdd/dbf1.c
* allow to open VFP DBFs with _NullFlags system command
* harbour/source/rdd/delim1.c
* harbour/source/rdd/sdf1.c
! updated field size calculation for some some extended types.
* harbour/source/rdd/workarea.c
* generate RT error when CREATEFIELD() method does not accept some
parameters to avoid silent DBCREATE() failing.
* harbour/source/vm/macro.c
* removed hb_compMemvarCheck() - this function was not dooing
anything - only slows the TYPE() by calling hb_dynsymFind()
one or two times.
+ added TODO note: memvars create by TYPE() have PUBLIC scope
in Clipper. Clipper also always tries to evaluate valid expressions
inside TYPE even if the contain UDF. UDF only stops evaluation
so:
TYPE( "(val:=1) + f() + (val2:=2)" )
creates in clipper public variable VAL but not VAL2.
2006-12-19 23:22 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/source/rdd/dbf1.c
! added missing 'else' and cleaned BCC warnings

12
harbour/contrib/rdd_ads/adsfunc.c
View File

@@ -2109,16 +2109,12 @@ HB_FUNC( ADSCONNECT60 )
if( ulRetVal == AE_SUCCESS )
{
// determine if is a DataDict
PHB_ITEM piByRefHandle = hb_param( 6, HB_IT_BYREF );
adsConnectHandle = hConnect; /* set new default */
adsConnectHandle = hConnect; // set new default
if ( piByRefHandle )
if( ISBYREF( 6 ) )
{
hb_stornl( hConnect, 6 );
}
hb_retl( 1 );
}
else
@@ -2296,12 +2292,12 @@ HB_FUNC( ADSDDGETUSERPROPERTY )
UNSIGNED32 ulRetVal;
UNSIGNED8 *pucUserName = (UNSIGNED8 *) hb_parcx( 1 );
UNSIGNED16 usPropertyID = hb_parni( 2 );
PHB_ITEM pPropertyByRef = hb_param( 3 , HB_IT_BYREF );
BOOL fPropertyByRef = ISBYREF( 3 );
ADSHANDLE hConnect = HB_ADS_PARCONNECTION( 4 );
UNSIGNED16 usPropertyLen = ADS_MAX_PARAMDEF_LEN ;
UNSIGNED8 pvProperty[ ADS_MAX_PARAMDEF_LEN ] = { 0 };
if (! pPropertyByRef )
if( ! fPropertyByRef )
{
hb_errRT_DBCMD( EG_ARG, 1014, NULL, "ADSDDGETUSERPROPERTY" );
return;

2
harbour/include/hbdefs.h
View File

@@ -1118,7 +1118,7 @@ typedef PHB_FUNC HB_FUNC_PTR;
#elif defined( __GNUC__ ) && defined( HB_OS_WIN_32 )
#define HB_EXPORT __attribute__ (( dllexport ))
#elif defined( __GNUC__ ) && defined( HB_OS_LINUX )
#elif defined( __GNUC__ ) && defined( HB_OS_LINUX )
#define HB_EXPORT __attribute__ ((visibility ("default")))
#elif defined( __BORLANDC__ )

276
harbour/include/hbexprb.c
View File

@@ -1207,138 +1207,132 @@ static HB_EXPR_FUNC( hb_compExprUseArrayAt )
switch( iMessage )
{
case HB_EA_REDUCE:
{
HB_EXPR_PTR pIdx;
pSelf->value.asList.pExprList = HB_EXPR_USE( pSelf->value.asList.pExprList, HB_EA_REDUCE );
pSelf->value.asList.pIndex = HB_EXPR_USE( pSelf->value.asList.pIndex, HB_EA_REDUCE );
pIdx = pSelf->value.asList.pIndex;
if( pIdx->ExprType == HB_ET_NUMERIC )
{
HB_EXPR_PTR pIdx;
HB_EXPR_PTR pExpr = pSelf->value.asList.pExprList; /* the expression that holds an array */
pSelf->value.asList.pExprList = HB_EXPR_USE( pSelf->value.asList.pExprList, HB_EA_REDUCE );
pSelf->value.asList.pIndex = HB_EXPR_USE( pSelf->value.asList.pIndex, HB_EA_REDUCE );
pIdx = pSelf->value.asList.pIndex;
if( pIdx->ExprType == HB_ET_NUMERIC )
if( pExpr->ExprType == HB_ET_ARRAY ) /* is it a literal array */
{
HB_EXPR_PTR pExpr = pSelf->value.asList.pExprList; /* the expression that holds an array */
LONG lIndex;
if( pExpr->ExprType == HB_ET_ARRAY ) /* is it a literal array */
pExpr = pExpr->value.asList.pExprList; /* the first element in the array */
if( pIdx->value.asNum.NumType == HB_ET_LONG )
lIndex = ( LONG ) pIdx->value.asNum.val.l;
else
lIndex = ( LONG ) pIdx->value.asNum.val.d;
if( lIndex > 0 )
{
LONG lIndex;
while( --lIndex && pExpr )
pExpr = pExpr->pNext;
}
else
pExpr = NULL; /* index is <= 0 - generate bound error */
pExpr = pExpr->value.asList.pExprList; /* the first element in the array */
if( pIdx->value.asNum.NumType == HB_ET_LONG )
lIndex = ( LONG ) pIdx->value.asNum.val.l;
else
lIndex = ( LONG ) pIdx->value.asNum.val.d;
if( lIndex > 0 )
{
while( --lIndex && pExpr )
pExpr = pExpr->pNext;
}
else
pExpr = NULL; /* index is <= 0 - generate bound error */
if( pExpr ) /* found ? */
{
/* extract a single expression from the array
*/
HB_EXPR_PTR pNew = hb_compExprNew( HB_ET_NONE, HB_COMP_PARAM );
memcpy( pNew, pExpr, sizeof( HB_EXPR ) );
/* This will suppres releasing of memory occupied by components of
* the expression - we have just copied them into the new expression.
* This method is simpler then traversing the list and releasing all
* but this choosen one.
*/
pExpr->ExprType = HB_ET_NONE;
/* Here comes the magic */
HB_EXPR_PCODE1( hb_compExprDelete, pSelf );
pSelf = pNew;
}
else
{
hb_compErrorBound( HB_COMP_PARAM, pIdx );
}
if( pExpr ) /* found ? */
{
/* extract a single expression from the array
*/
HB_EXPR_PTR pNew = hb_compExprNew( HB_ET_NONE, HB_COMP_PARAM );
memcpy( pNew, pExpr, sizeof( HB_EXPR ) );
/* This will suppres releasing of memory occupied by components of
* the expression - we have just copied them into the new expression.
* This method is simpler then traversing the list and releasing all
* but this choosen one.
*/
pExpr->ExprType = HB_ET_NONE;
/* Here comes the magic */
HB_EXPR_PCODE1( hb_compExprDelete, pSelf );
pSelf = pNew;
}
else
{
LONG lIndex;
if( pIdx->value.asNum.NumType == HB_ET_LONG )
lIndex = ( LONG ) pIdx->value.asNum.val.l;
else
lIndex = ( LONG ) pIdx->value.asNum.val.d;
if( lIndex > 0 )
HB_EXPR_USE( pExpr, HB_EA_ARRAY_AT );
else
hb_compErrorBound( HB_COMP_PARAM, pIdx ); /* index <= 0 - bound error */
hb_compErrorBound( HB_COMP_PARAM, pIdx );
}
}
else
{
LONG lIndex;
if( pIdx->value.asNum.NumType == HB_ET_LONG )
lIndex = ( LONG ) pIdx->value.asNum.val.l;
else
lIndex = ( LONG ) pIdx->value.asNum.val.d;
if( lIndex > 0 )
HB_EXPR_USE( pExpr, HB_EA_ARRAY_AT );
else
hb_compErrorBound( HB_COMP_PARAM, pIdx ); /* index <= 0 - bound error */
}
}
break;
}
case HB_EA_ARRAY_AT:
case HB_EA_ARRAY_INDEX:
case HB_EA_LVALUE:
break;
case HB_EA_PUSH_PCODE:
HB_EXPR_USE( pSelf->value.asList.pExprList, HB_EA_PUSH_PCODE );
if( HB_SUPPORT_XBASE )
{
HB_EXPR_USE( pSelf->value.asList.pExprList, HB_EA_PUSH_PCODE );
if( HB_SUPPORT_XBASE )
{
if( pSelf->value.asList.pIndex->ExprType == HB_ET_MACRO )
{
pSelf->value.asList.pIndex->value.asMacro.SubType |= HB_ET_MACRO_INDEX;
}
}
HB_EXPR_USE( pSelf->value.asList.pIndex, HB_EA_PUSH_PCODE );
if( pSelf->value.asList.reference )
HB_EXPR_PCODE1( hb_compGenPCode1, HB_P_ARRAYPUSHREF );
else
HB_EXPR_PCODE1( hb_compGenPCode1, HB_P_ARRAYPUSH );
if( pSelf->value.asList.pIndex->ExprType == HB_ET_MACRO )
pSelf->value.asList.pIndex->value.asMacro.SubType |= HB_ET_MACRO_INDEX;
}
HB_EXPR_USE( pSelf->value.asList.pIndex, HB_EA_PUSH_PCODE );
if( pSelf->value.asList.reference )
HB_EXPR_PCODE1( hb_compGenPCode1, HB_P_ARRAYPUSHREF );
else
HB_EXPR_PCODE1( hb_compGenPCode1, HB_P_ARRAYPUSH );
break;
case HB_EA_POP_PCODE:
{
BOOL bRemoveRef = FALSE;
/* #ifndef HB_C52_STRICT */
if( HB_SUPPORT_ARRSTR )
{
BOOL bRemoveRef = FALSE;
/* #ifndef HB_C52_STRICT */
if( HB_SUPPORT_ARRSTR )
/* to manage strings as bytes arrays, they must be pushed by reference */
/* arrays also are passed by reference */
if( pSelf->value.asList.pExprList->ExprType == HB_ET_VARIABLE )
{
pSelf->value.asList.pExprList->ExprType = HB_ET_VARREF;
bRemoveRef = TRUE;
}
/* #endif */
HB_EXPR_USE( pSelf->value.asList.pExprList, HB_EA_PUSH_PCODE );
HB_EXPR_USE( pSelf->value.asList.pIndex, HB_EA_PUSH_PCODE );
HB_EXPR_PCODE1( hb_compGenPCode1, HB_P_ARRAYPOP );
/* #ifndef HB_C52_STRICT */
if( HB_SUPPORT_ARRSTR )
if( bRemoveRef )
{
pSelf->value.asList.pExprList->ExprType = HB_ET_VARIABLE;
}
/* #endif */
/* to manage strings as bytes arrays, they must be pushed by reference */
/* arrays also are passed by reference */
if( pSelf->value.asList.pExprList->ExprType == HB_ET_VARIABLE )
{
pSelf->value.asList.pExprList->ExprType = HB_ET_VARREF;
bRemoveRef = TRUE;
}
}
/* #endif */
HB_EXPR_USE( pSelf->value.asList.pExprList, HB_EA_PUSH_PCODE );
HB_EXPR_USE( pSelf->value.asList.pIndex, HB_EA_PUSH_PCODE );
HB_EXPR_PCODE1( hb_compGenPCode1, HB_P_ARRAYPOP );
/* #ifndef HB_C52_STRICT */
if( HB_SUPPORT_ARRSTR && bRemoveRef )
{
pSelf->value.asList.pExprList->ExprType = HB_ET_VARIABLE;
}
/* #endif */
break;
}
case HB_EA_PUSH_POP:
{
/* NOTE: This is highly optimized code - this will work even
* if accessed value isn't an array. It will work also if
* the index is invalid
*/
HB_EXPR_USE( pSelf->value.asList.pExprList, HB_EA_PUSH_POP );
HB_EXPR_USE( pSelf->value.asList.pIndex, HB_EA_PUSH_POP );
}
/* NOTE: This is highly optimized code - this will work even
* if accessed value isn't an array. It will work also if
* the index is invalid
*/
HB_EXPR_USE( pSelf->value.asList.pExprList, HB_EA_PUSH_POP );
HB_EXPR_USE( pSelf->value.asList.pIndex, HB_EA_PUSH_POP );
/* no break */
case HB_EA_STATEMENT:
hb_compWarnMeaningless( HB_COMP_PARAM, pSelf );
break;
case HB_EA_DELETE:
HB_EXPR_PCODE1( hb_compExprDelete, pSelf->value.asList.pExprList );
HB_EXPR_PCODE1( hb_compExprDelete, pSelf->value.asList.pIndex );
@@ -2252,26 +2246,28 @@ static HB_EXPR_FUNC( hb_compExprUseAssign )
break;
case HB_EA_PUSH_PCODE:
/* NOTE: assigment to an object instance variable needs special handling
*/
if( pSelf->value.asOperator.pLeft->ExprType == HB_ET_SEND )
{
/* NOTE: assigment to an object instance variable needs special handling
*/
if( pSelf->value.asOperator.pLeft->ExprType == HB_ET_SEND )
HB_EXPR_PTR pObj = pSelf->value.asOperator.pLeft;
if( pObj->value.asMessage.pParms )
{
HB_EXPR_PTR pObj = pSelf->value.asOperator.pLeft;
pObj->value.asMessage.pParms = pSelf->value.asOperator.pRight;
HB_EXPR_USE( pObj, HB_EA_POP_PCODE );
pObj->value.asMessage.pParms = NULL; /* to suppress duplicated releasing */
hb_compErrorLValue( HB_COMP_PARAM, pObj );
}
else
{
/* it assigns a value and leaves it on the stack */
pObj->value.asMessage.pParms = pSelf->value.asOperator.pRight;
HB_EXPR_USE( pObj, HB_EA_POP_PCODE );
pObj->value.asMessage.pParms = NULL; /* to suppress duplicated releasing */
}
else
{
/* it assigns a value and leaves it on the stack */
HB_EXPR_USE( pSelf->value.asOperator.pRight, HB_EA_PUSH_PCODE );
/* QUESTION: Can we replace DUPLICATE+POP with a single PUT opcode
*/
HB_EXPR_PCODE1( hb_compGenPCode1, HB_P_DUPLICATE );
HB_EXPR_USE( pSelf->value.asOperator.pLeft, HB_EA_POP_PCODE );
}
HB_EXPR_USE( pSelf->value.asOperator.pRight, HB_EA_PUSH_PCODE );
/* QUESTION: Can we replace DUPLICATE+POP with a single PUT opcode
*/
HB_EXPR_PCODE1( hb_compGenPCode1, HB_P_DUPLICATE );
HB_EXPR_USE( pSelf->value.asOperator.pLeft, HB_EA_POP_PCODE );
}
break;
@@ -2280,24 +2276,26 @@ static HB_EXPR_FUNC( hb_compExprUseAssign )
case HB_EA_PUSH_POP:
case HB_EA_STATEMENT:
/* NOTE: assigment to an object instance variable needs special handling
*/
if( pSelf->value.asOperator.pLeft->ExprType == HB_ET_SEND )
{
/* NOTE: assigment to an object instance variable needs special handling
*/
if( pSelf->value.asOperator.pLeft->ExprType == HB_ET_SEND )
HB_EXPR_PTR pObj = pSelf->value.asOperator.pLeft;
if( pObj->value.asMessage.pParms )
{
HB_EXPR_PTR pObj = pSelf->value.asOperator.pLeft;
pObj->value.asMessage.pParms = pSelf->value.asOperator.pRight;
HB_EXPR_USE( pObj, HB_EA_POP_PCODE );
pObj->value.asMessage.pParms = NULL; /* to suppress duplicated releasing */
/* Remove the return value */
HB_EXPR_PCODE1( hb_compGenPCode1, HB_P_POP );
}
else
{
/* it assigns a value and removes it from the stack */
HB_EXPR_USE( pSelf->value.asOperator.pRight, HB_EA_PUSH_PCODE );
HB_EXPR_USE( pSelf->value.asOperator.pLeft, HB_EA_POP_PCODE );
hb_compErrorLValue( HB_COMP_PARAM, pObj );
}
pObj->value.asMessage.pParms = pSelf->value.asOperator.pRight;
HB_EXPR_USE( pObj, HB_EA_POP_PCODE );
pObj->value.asMessage.pParms = NULL; /* to suppress duplicated releasing */
/* Remove the return value */
HB_EXPR_PCODE1( hb_compGenPCode1, HB_P_POP );
}
else
{
/* it assigns a value and removes it from the stack */
HB_EXPR_USE( pSelf->value.asOperator.pRight, HB_EA_PUSH_PCODE );
HB_EXPR_USE( pSelf->value.asOperator.pLeft, HB_EA_POP_PCODE );
}
break;
@@ -2578,8 +2576,8 @@ static HB_EXPR_FUNC( hb_compExprUseOr )
HB_EXPR_USE( pSelf->value.asOperator.pLeft, HB_EA_PUSH_PCODE );
HB_EXPR_PCODE1( hb_compGenPCode1, HB_P_DUPLICATE );
lEndPos = HB_EXPR_PCODE1( hb_compGenJumpTrue, 0 );
HB_EXPR_PCODE1( hb_compGenPCode1, HB_P_POP );
HB_EXPR_USE( pSelf->value.asOperator.pRight, HB_EA_PUSH_PCODE );
HB_EXPR_PCODE1( hb_compGenPCode1, HB_P_OR );
HB_EXPR_PCODE1( hb_compGenJumpHere, lEndPos );
}
else
@@ -2594,13 +2592,16 @@ static HB_EXPR_FUNC( hb_compExprUseOr )
break;
case HB_EA_PUSH_POP:
if( HB_SUPPORT_HARBOUR )
if( HB_SUPPORT_HARBOUR && HB_COMP_ISSUPPORTED( HB_COMPFLAG_SHORTCUTS ) )
{
LONG lEndPos;
HB_EXPR_USE( pSelf->value.asOperator.pLeft, HB_EA_PUSH_PCODE );
lEndPos = HB_EXPR_PCODE1( hb_compGenJumpTrue, 0 );
/* NOTE: This will not generate a runtime error if incompatible
* data type is used
*/
HB_EXPR_USE( pSelf->value.asOperator.pLeft, HB_EA_PUSH_POP );
HB_EXPR_USE( pSelf->value.asOperator.pRight, HB_EA_PUSH_POP );
HB_EXPR_PCODE1( hb_compGenJumpHere, lEndPos );
}
else
{
@@ -2650,8 +2651,8 @@ static HB_EXPR_FUNC( hb_compExprUseAnd )
HB_EXPR_USE( pSelf->value.asOperator.pLeft, HB_EA_PUSH_PCODE );
HB_EXPR_PCODE1( hb_compGenPCode1, HB_P_DUPLICATE );
lEndPos = HB_EXPR_PCODE1( hb_compGenJumpFalse, 0 );
HB_EXPR_PCODE1( hb_compGenPCode1, HB_P_POP );
HB_EXPR_USE( pSelf->value.asOperator.pRight, HB_EA_PUSH_PCODE );
HB_EXPR_PCODE1( hb_compGenPCode1, HB_P_AND );
HB_EXPR_PCODE1( hb_compGenJumpHere, lEndPos );
}
else
@@ -2666,13 +2667,16 @@ static HB_EXPR_FUNC( hb_compExprUseAnd )
break;
case HB_EA_PUSH_POP:
if( HB_SUPPORT_HARBOUR )
if( HB_SUPPORT_HARBOUR && HB_COMP_ISSUPPORTED( HB_COMPFLAG_SHORTCUTS ) )
{
LONG lEndPos;
HB_EXPR_USE( pSelf->value.asOperator.pLeft, HB_EA_PUSH_PCODE );
lEndPos = HB_EXPR_PCODE1( hb_compGenJumpFalse, 0 );
/* NOTE: This will not generate a runtime error if incompatible
* data type is used
*/
HB_EXPR_USE( pSelf->value.asOperator.pLeft, HB_EA_PUSH_POP );
HB_EXPR_USE( pSelf->value.asOperator.pRight, HB_EA_PUSH_POP );
HB_EXPR_PCODE1( hb_compGenJumpHere, lEndPos );
}
else
{

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

@@ -522,6 +522,7 @@ static void hb_compChkEnvironVar( HB_COMP_DECL, char *szSwitch )
HB_COMP_PARAM->supported |= HB_COMPFLAG_SHORTCUTS;
else
HB_COMP_PARAM->supported &= ~HB_COMPFLAG_SHORTCUTS;
break;
default:
hb_compGenError( HB_COMP_PARAM, hb_comp_szErrors, 'F', HB_COMP_ERR_BADOPTION, s, NULL );

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

@@ -471,6 +471,53 @@ static HB_FIX_FUNC( hb_p_not )
return 1;
}
static HB_FIX_FUNC( hb_p_duplicate )
{
HB_COMP_DECL = cargo->HB_COMP_PARAM;
if( cargo->iNestedCodeblock == 0 && HB_COMP_ISSUPPORTED(HB_COMPFLAG_OPTJUMP) )
{
switch( pFunc->pCode[ lPCodePos + 1 ] )
{
case HB_P_JUMPTRUEFAR:
case HB_P_JUMPFALSEFAR:
if( pFunc->pCode[ lPCodePos + 5 ] == HB_P_POP )
{
BYTE * pAddr = &pFunc->pCode[ lPCodePos + 2 ];
LONG lOffset = HB_PCODE_MKINT24( pAddr );
ULONG ulNewPos = lPCodePos + 1 + lOffset;
if( lOffset > 0 && pFunc->pCode[ ulNewPos ] == HB_P_DUPLICATE )
{
hb_p_duplicate( pFunc, ulNewPos, cargo );
if( pFunc->pCode[ ulNewPos ] == HB_P_NOOP )
{
ulNewPos++;
lOffset++;
}
}
if( ( pFunc->pCode[ ulNewPos ] == HB_P_JUMPTRUEFAR ||
pFunc->pCode[ ulNewPos ] == HB_P_JUMPFALSEFAR ) &&
!hb_compIsJump( cargo->HB_COMP_PARAM, pFunc, lPCodePos + 1 ) &&
!hb_compIsJump( cargo->HB_COMP_PARAM, pFunc, lPCodePos + 5 ) )
{
if( pFunc->pCode[ ulNewPos ] == pFunc->pCode[ lPCodePos + 1 ] )
lOffset += HB_PCODE_MKINT24( &pFunc->pCode[ ulNewPos + 1 ] );
else
lOffset += 4;
HB_PUT_LE_UINT24( pAddr, lOffset );
hb_compNOOPfill( pFunc, lPCodePos, 1, FALSE, FALSE );
hb_compNOOPfill( pFunc, lPCodePos + 5, 1, FALSE, FALSE );
}
}
break;
}
}
return 1;
}
static HB_FIX_FUNC( hb_p_jumpfar )
{
HB_COMP_DECL = cargo->HB_COMP_PARAM;
@@ -578,7 +625,7 @@ static HB_FIX_FUNC_PTR s_fixlocals_table[] =
NULL, /* HB_P_DIVIDE, */
NULL, /* HB_P_DO, */
NULL, /* HB_P_DOSHORT, */
NULL, /* HB_P_DUPLICATE, */
hb_p_duplicate, /* HB_P_DUPLICATE, */
NULL, /* HB_P_DUPLTWO, */
NULL, /* HB_P_INC, */
NULL, /* HB_P_INSTRING, */

22
harbour/source/rdd/dbcmd.c
View File

@@ -559,7 +559,7 @@ HB_EXPORT ERRCODE hb_rddGetAliasNumber( char * szAlias, int * iArea )
}
else if ( fOneLetter && c == 'M' )
{
*iArea = 0;
*iArea = HARBOUR_MAX_RDD_AREA_NUM;
}
else
{
@@ -807,6 +807,9 @@ HB_EXPORT USHORT hb_rddInsertAreaNode( char *szDriver )
HB_TRACE(HB_TR_DEBUG, ("hb_rddInsertAreaNode(%s)", szDriver));
if( s_uiCurrArea && s_pCurrArea )
return 0;
pRddNode = hb_rddFindNode( szDriver, &uiRddID );
if( !pRddNode )
return 0;
@@ -828,10 +831,6 @@ HB_EXPORT USHORT hb_rddInsertAreaNode( char *szDriver )
}
HB_SET_WA( uiArea );
}
else if( s_pCurrArea )
{
return 0;
}
if ( s_uiCurrArea >= s_uiWaNumMax )
{
@@ -951,7 +950,7 @@ HB_EXPORT ERRCODE hb_rddSelectWorkAreaNumber( int iArea )
HB_TRACE(HB_TR_DEBUG, ("hb_rddSelectWorkAreaNumber(%d)", iArea));
LOCK_AREA
if ( iArea < 1 || iArea > HARBOUR_MAX_RDD_AREA_NUM )
if( iArea < 1 || iArea > HARBOUR_MAX_RDD_AREA_NUM )
{
HB_SET_WA( 0 );
}
@@ -990,6 +989,11 @@ HB_EXPORT ERRCODE hb_rddSelectWorkAreaSymbol( PHB_SYMB pSymAlias )
hb_rddSelectWorkAreaNumber( toupper( szName[ 0 ] ) - 'A' + 1 );
bResult = SUCCESS;
}
else if( szName[ 0 ] && ! szName[ 1 ] && toupper( szName[ 0 ] ) == 'M' )
{
hb_rddSelectWorkAreaNumber( HARBOUR_MAX_RDD_AREA_NUM );
bResult = SUCCESS;
}
else
{
/*
@@ -2182,7 +2186,11 @@ HB_FUNC( DBSELECTAREA )
{
LONG lNewArea = hb_parnl( 1 );
if( lNewArea < 1 || lNewArea > HARBOUR_MAX_RDD_AREA_NUM )
/*
* NOTE: lNewArea >= HARBOUR_MAX_RDD_AREA_NUM used intentionally
* In Clipper area 65535 is reserved for "M" alias [druzus]
*/
if( lNewArea < 1 || lNewArea >= HARBOUR_MAX_RDD_AREA_NUM )
{
hb_rddSelectFirstAvailable();
}

49
harbour/source/rdd/dbf1.c
View File

@@ -214,6 +214,10 @@ static void hb_dbfSetBlankRecord( DBFAREAP pArea )
}
}
memset( pPtr, bFill, ulSize );
ulSize = pArea->pRecord - pPtr - ulSize;
if( ulSize < ( ULONG ) pArea->uiRecordLen )
memset( pPtr, '\0', ( ULONG ) pArea->uiRecordLen - ulSize );
}
/*
@@ -536,7 +540,7 @@ HB_EXPORT ERRCODE hb_dbfGetEGcode( ERRCODE errCode )
HB_TRACE(HB_TR_DEBUG, ("hb_dbfGetEGcode(%hu)", errCode));
switch ( errCode )
switch( errCode )
{
case EDBF_OPEN_DBF:
errEGcode = EG_OPEN;
@@ -769,7 +773,7 @@ HB_EXPORT ERRCODE hb_dbfSetMemoData( DBFAREAP pArea, USHORT uiIndex,
*/
HB_EXPORT BOOL hb_dbfLockIdxGetData( BYTE bScheme, HB_FOFFSET *ulPos, HB_FOFFSET *ulPool )
{
switch ( bScheme )
switch( bScheme )
{
case DB_DBFLOCK_CLIP:
*ulPos = IDX_LOCKPOS_CLIP;
@@ -821,7 +825,7 @@ HB_EXPORT BOOL hb_dbfLockIdxFile( FHANDLE hFile, BYTE bScheme, USHORT usMode, HB
do
{
switch ( usMode & FL_MASK )
switch( usMode & FL_MASK )
{
case FL_LOCK:
if( ulPool )
@@ -1476,7 +1480,7 @@ static ERRCODE hb_dbfGetValue( DBFAREAP pArea, USHORT uiIndex, PHB_ITEM pItem )
{
double dValue;
int iLen;
switch ( pField->uiLen )
switch( pField->uiLen )
{
case 1:
dValue = ( SCHAR ) pArea->pRecord[ pArea->pFieldOffset[ uiIndex ] ];
@@ -1509,7 +1513,7 @@ static ERRCODE hb_dbfGetValue( DBFAREAP pArea, USHORT uiIndex, PHB_ITEM pItem )
}
else
{
switch ( pField->uiLen )
switch( pField->uiLen )
{
case 1:
hb_itemPutNILen( pItem, ( SCHAR ) pArea->pRecord[ pArea->pFieldOffset[ uiIndex ] ], 4 );
@@ -1932,7 +1936,7 @@ static ERRCODE hb_dbfPutValue( DBFAREAP pArea, USHORT uiIndex, PHB_ITEM pItem )
}
else
{
switch ( pField->uiLen )
switch( pField->uiLen )
{
case 1:
pArea->pRecord[ pArea->pFieldOffset[ uiIndex ] ] = ( signed char ) lVal;
@@ -2430,7 +2434,9 @@ static ERRCODE hb_dbfCreate( DBFAREAP pArea, LPDBOPENINFO pCreateInfo )
break;
case HB_IT_INTEGER:
pThisField->bType = 'I';
pThisField->bType = ( pArea->bTableType == DB_DBF_VFP &&
pField->uiLen == 8 && pField->uiDec == 4 ) ?
'Y' : 'I';
if( ( pField->uiLen > 4 && pField->uiLen != 8 ) ||
pField->uiLen == 0 )
{
@@ -2932,7 +2938,7 @@ static ERRCODE hb_dbfNewArea( DBFAREAP pArea )
static ERRCODE hb_dbfOpen( DBFAREAP pArea, LPDBOPENINFO pOpenInfo )
{
ERRCODE errCode;
USHORT uiFlags, uiFields, uiSize, uiCount;
USHORT uiFlags, uiFields, uiSize, uiCount, uiSkip;
BOOL fRetry, fRawBlob;
PHB_ITEM pError, pFileExt, pItem;
PHB_FNAME pFileName;
@@ -3016,7 +3022,7 @@ static ERRCODE hb_dbfOpen( DBFAREAP pArea, LPDBOPENINFO pOpenInfo )
if( fRawBlob )
{
uiFields = 0;
uiFields = uiSkip = 0;
pBuffer = NULL;
pArea->fHasMemo = TRUE;
}
@@ -3071,6 +3077,7 @@ static ERRCODE hb_dbfOpen( DBFAREAP pArea, LPDBOPENINFO pOpenInfo )
}
/* Add fields */
uiSkip = 0;
uiFields = ( pArea->uiHeaderLen - sizeof( DBFHEADER ) ) / sizeof( DBFFIELD );
uiSize = uiFields * sizeof( DBFFIELD );
pBuffer = uiFields ? ( BYTE * ) hb_xgrab( uiSize ) : NULL;
@@ -3119,16 +3126,22 @@ static ERRCODE hb_dbfOpen( DBFAREAP pArea, LPDBOPENINFO pOpenInfo )
data as fields description */
for( uiCount = 0; uiCount < uiFields; uiCount++ )
{
if( pBuffer[ uiCount * sizeof( DBFFIELD ) ] == 0x0d )
pField = ( LPDBFFIELD ) ( pBuffer + uiCount * sizeof( DBFFIELD ) );
if( pField->bName[ 0 ] == 0x0d )
{
uiFields = uiCount;
break;
}
else if( pArea->bTableType == DB_DBF_VFP &&
pField->bFieldFlags & 0x01 )
{
uiSkip++;
}
/* Peter added it for FVP DBFs but in wrong place,
anyhow I cannot see why it's necessary, FVP private data
in header should be after 0x0d - I disabled this code, [druzus] */
/*
if( pArea->bTableType == DB_DBF_VFP &&
if( pArea->bTableType == DB_DBF_VFP &&
pBuffer[ uiCount * sizeof( DBFFIELD ) ] == 0x00 )
{
uiFields = uiCount;
@@ -3136,6 +3149,7 @@ static ERRCODE hb_dbfOpen( DBFAREAP pArea, LPDBOPENINFO pOpenInfo )
}
*/
}
uiFields -= uiSkip;
}
/* CL5.3 allow to create and open DBFs without fields */
@@ -3158,12 +3172,12 @@ static ERRCODE hb_dbfOpen( DBFAREAP pArea, LPDBOPENINFO pOpenInfo )
/* Size for deleted flag */
pArea->uiRecordLen = 1;
for( uiCount = 0; uiCount < uiFields; uiCount++ )
for( uiCount = 0; uiCount < uiFields + uiSkip; uiCount++ )
{
pField = ( LPDBFFIELD ) ( pBuffer + uiCount * sizeof( DBFFIELD ) );
pFieldInfo.atomName = pField->bName;
pFieldInfo.atomName[10] = '\0';
hb_strUpper( (char *) pFieldInfo.atomName, 11 );
/* hb_strUpper( (char *) pFieldInfo.atomName, 11 ); */
pFieldInfo.uiLen = pField->bLen;
pFieldInfo.uiDec = 0;
pFieldInfo.uiTypeExtended = 0;
@@ -3243,6 +3257,15 @@ static ERRCODE hb_dbfOpen( DBFAREAP pArea, LPDBOPENINFO pOpenInfo )
break;
default:
if( pArea->bTableType == DB_DBF_VFP && pField->bFieldFlags & 0x01 )
{
if( memcmp( pFieldInfo.atomName, "_NullFlags", 10 ) == 0 )
{
/* TODO: NULLABLE and VARLENGTH support */
}
pArea->uiRecordLen += pFieldInfo.uiLen;
continue;
}
errCode = FAILURE;
break;
}

5
harbour/source/rdd/delim1.c
View File

@@ -1066,6 +1066,11 @@ static ERRCODE hb_delimAddField( DELIMAREAP pArea, LPDBFIELDINFO pFieldInfo )
case HB_IT_INTEGER:
pFieldInfo->uiType = HB_IT_LONG;
pFieldInfo->uiLen = s_uiNumLength[ pFieldInfo->uiLen ];
if( pFieldInfo->uiDec )
{
pFieldInfo->uiDec = 0;
pFieldInfo->uiLen++;
}
pArea->fTransRec = FALSE;
break;

5
harbour/source/rdd/sdf1.c
View File

@@ -811,6 +811,11 @@ static ERRCODE hb_sdfAddField( SDFAREAP pArea, LPDBFIELDINFO pFieldInfo )
case HB_IT_INTEGER:
pFieldInfo->uiType = HB_IT_LONG;
pFieldInfo->uiLen = s_uiNumLength[ pFieldInfo->uiLen ];
if( pFieldInfo->uiDec )
{
pFieldInfo->uiDec = 0;
pFieldInfo->uiLen++;
}
pArea->fTransRec = FALSE;
break;

17
harbour/source/rdd/workarea.c
View File

@@ -271,6 +271,7 @@ ERRCODE hb_waAddField( AREAP pArea, LPDBFIELDINFO pFieldInfo )
ERRCODE hb_waCreateFields( AREAP pArea, PHB_ITEM pStruct )
{
USHORT uiItems, uiCount, uiLen, uiDec;
ERRCODE errCode = SUCCESS;
DBFIELDINFO pFieldInfo;
PHB_ITEM pFieldDesc;
int iData;
@@ -354,6 +355,7 @@ ERRCODE hb_waCreateFields( AREAP pArea, PHB_ITEM pStruct )
case 'N':
case 'F':
pFieldInfo.uiType = HB_IT_LONG;
pFieldInfo.uiDec = uiDec;
/* DBASE documentation defines maximum numeric field size as 20
* but Clipper alows to create longer fileds so I remove this
* limit, Druzus
@@ -362,16 +364,21 @@ ERRCODE hb_waCreateFields( AREAP pArea, PHB_ITEM pStruct )
if( uiLen > 20 )
*/
if( uiLen > 255 )
return FAILURE;
else
pFieldInfo.uiDec = uiDec;
errCode = FAILURE;
break;
default:
return FAILURE;
errCode = FAILURE;
break;
}
if( errCode != SUCCESS )
{
hb_errRT_DBCMD( EG_ARG, EDBCMD_DBCMDBADPARAMETER, NULL, &hb_errFuncName );
return errCode;
}
/* Add field */
if( SELF_ADDFIELD( pArea, &pFieldInfo ) != SUCCESS )
else if( SELF_ADDFIELD( pArea, &pFieldInfo ) != SUCCESS )
return FAILURE;
}
return SUCCESS;

85
harbour/source/vm/macro.c
View File

@@ -58,7 +58,6 @@
#include "hbmacro.h"
#include "hbcomp.h"
#include "hbstack.h"
#include "hbmemvar.ch" /* for values returned by hb_memvarScope() */
#ifdef HB_MACRO_STATEMENTS
#include "hbpp.h"
@@ -1026,37 +1025,12 @@ void hb_compGenJumpHere( ULONG ulOffset, HB_COMP_DECL )
hb_compGenJumpThere( ulOffset, HB_PCODE_DATA->lPCodePos, HB_COMP_PARAM );
}
/* Checks if there is a visible memvar variable
* szVarName = variable name
*/
static void hb_compMemvarCheck( char * szVarName, HB_COMP_DECL )
{
if( HB_MACRO_DATA->Flags & HB_MACRO_GEN_TYPE )
{
/* Test if variable exist if called from TYPE() function only */
if( !( HB_MACRO_DATA->status & (HB_MACRO_UNKN_VAR | HB_MACRO_UNKN_SYM) ) )
{
/* checking for variable is quite expensive than don't check it
* if there are already some undefined symbols or variables
*/
if( hb_memvarScope( szVarName, strlen( szVarName ) + 1 ) <= HB_MV_ERROR )
{
if( ! hb_dynsymFind( szVarName ) )
{
/* there is no memvar or field variable visible at this moment */
HB_MACRO_DATA->status |= HB_MACRO_UNKN_VAR;
HB_MACRO_DATA->status &= ~HB_MACRO_CONT; /* don't run this pcode */
}
}
}
}
}
/*
* Function generates pcode for passed memvar name
*/
void hb_compMemvarGenPCode( BYTE bPCode, char * szVarName, HB_COMP_DECL )
{
BYTE byBuf[ sizeof( HB_DYNS_PTR ) + 1 ];
HB_DYNS_PTR pSym;
if( HB_MACRO_DATA->Flags & HB_MACRO_GEN_TYPE )
@@ -1065,26 +1039,26 @@ void hb_compMemvarGenPCode( BYTE bPCode, char * szVarName, HB_COMP_DECL )
* then we shouldn't create the requested variable if it doesn't exist
*/
pSym = hb_dynsymFind( szVarName );
if( ! pSym )
if( !pSym )
{
HB_MACRO_DATA->status |= HB_MACRO_UNKN_VAR;
pSym = hb_dynsymGet( szVarName );
}
}
/* Find the address of passed symbol -
* create the symbol if doesn't exist (Clipper compatibility)
*/
pSym = hb_dynsymGet( szVarName );
hb_compGenPCode1( bPCode, HB_COMP_PARAM );
{
BYTE byBuf[ sizeof( HB_DYNS_PTR ) ];
else
/* Find the address of passed symbol - create the symbol if doesn't exist
* (Clipper compatibility). */
pSym = hb_dynsymGet( szVarName );
HB_PUT_PTR( byBuf, pSym );
hb_compGenPCodeN( byBuf, sizeof( pSym ), HB_COMP_PARAM );
}
/* hb_compGenPCodeN( ( BYTE * )( &pSym ), sizeof( pSym ), HB_COMP_PARAM ); */
byBuf[ 0 ] = bPCode;
HB_PUT_PTR( &byBuf[ 1 ], pSym );
hb_compGenPCodeN( byBuf, sizeof( byBuf ), HB_COMP_PARAM );
}
/* generates the pcode to push a symbol on the virtual machine stack */
void hb_compGenPushSymbol( char * szSymbolName, BOOL bFunction, BOOL bAlias, HB_COMP_DECL )
{
BYTE byBuf[ sizeof( HB_DYNS_PTR ) + 1 ];
HB_DYNS_PTR pSym;
HB_SYMBOL_UNUSED( bAlias );
@@ -1116,14 +1090,9 @@ void hb_compGenPushSymbol( char * szSymbolName, BOOL bFunction, BOOL bAlias, HB_
else
pSym = hb_dynsymGet( szSymbolName );
hb_compGenPCode1( HB_P_MPUSHSYM, HB_COMP_PARAM );
{
BYTE byBuf[ sizeof( HB_DYNS_PTR ) ];
HB_PUT_PTR( byBuf, pSym );
hb_compGenPCodeN( byBuf, sizeof( pSym ), HB_COMP_PARAM );
}
/* hb_compGenPCodeN( ( BYTE * ) &pSym, sizeof( pSym ), HB_COMP_PARAM ); */
byBuf[ 0 ] = HB_P_MPUSHSYM;
HB_PUT_PTR( &byBuf[ 1 ], pSym );
hb_compGenPCodeN( byBuf, sizeof( byBuf ), HB_COMP_PARAM );
}
/* generates the pcode to push a long number on the virtual machine stack */
@@ -1174,19 +1143,17 @@ void hb_compGenPushDate( HB_LONG lNumber, HB_COMP_DECL )
/* sends a message to an object */
void hb_compGenMessage( char * szMsgName, BOOL bIsObject, HB_COMP_DECL )
{
BYTE byBuf[ sizeof( HB_DYNS_PTR ) + 1 ];
/* Find the address of passed symbol - create the symbol if doesn't exist
*/
HB_DYNS_PTR pSym = hb_dynsymGet( szMsgName );
hb_compGenPCode1( HB_P_MMESSAGE, HB_COMP_PARAM );
{
BYTE byBuf[ sizeof( HB_DYNS_PTR ) ];
byBuf[ 0 ] = HB_P_MMESSAGE;
HB_PUT_PTR( &byBuf[ 1 ], pSym );
hb_compGenPCodeN( byBuf, sizeof( byBuf ), HB_COMP_PARAM );
HB_PUT_PTR( byBuf, pSym );
hb_compGenPCodeN( byBuf, sizeof( pSym ), HB_COMP_PARAM );
}
HB_SYMBOL_UNUSED( bIsObject ); /* used in full compiler only */
/* hb_compGenPCodeN( ( BYTE * ) &pSym, sizeof( pSym ), HB_COMP_PARAM ); */
}
/* generates an underscore-symbol name for a data assignment */
@@ -1214,8 +1181,8 @@ void hb_compGenPopVar( char * szVarName, HB_COMP_DECL )
}
else
{
/* TODO: memvars created inside TYPE() function should have PUBLIC scope */
hb_compMemvarGenPCode( HB_P_MPOPMEMVAR, szVarName, HB_COMP_PARAM );
hb_compMemvarCheck( szVarName, HB_COMP_PARAM );
}
}
@@ -1238,8 +1205,8 @@ void hb_compGenPopAliasedVar( char * szVarName,
if( szAlias[ 0 ] == 'M' && ( iLen == 1 ||
( iLen >= 4 && iLen <= 6 && strncmp( szAlias, "MEMVAR", iLen ) == 0 ) ) )
{ /* M-> or MEMV-> or MEMVA-> or MEMVAR-> variable */
/* TODO: memvars created inside TYPE() function should have PUBLIC scope */
hb_compMemvarGenPCode( HB_P_MPOPMEMVAR, szVarName, HB_COMP_PARAM );
hb_compMemvarCheck( szVarName, HB_COMP_PARAM );
}
else if( iLen >= 4 && iLen <= 5 && strncmp( szAlias, "FIELD", iLen ) == 0 )
{ /* FIELD-> */
@@ -1263,8 +1230,8 @@ void hb_compGenPopAliasedVar( char * szVarName,
* NOTE: An alias will be determined at runtime then we cannot decide
* here if passed name is either a field or a memvar
*/
/* TODO: memvars created inside TYPE() function should have PUBLIC scope */
hb_compMemvarGenPCode( HB_P_MPOPALIASEDVAR, szVarName, HB_COMP_PARAM );
hb_compMemvarCheck( szVarName, HB_COMP_PARAM );
}
}
@@ -1286,7 +1253,6 @@ void hb_compGenPushVar( char * szVarName, BOOL bMacroVar, HB_COMP_DECL )
else
{
hb_compMemvarGenPCode( HB_P_MPUSHVARIABLE, szVarName, HB_COMP_PARAM );
hb_compMemvarCheck( szVarName, HB_COMP_PARAM );
}
}
@@ -1301,7 +1267,6 @@ void hb_compGenPushVarRef( char * szVarName, HB_COMP_DECL )
else
{
hb_compMemvarGenPCode( HB_P_MPUSHMEMVARREF, szVarName, HB_COMP_PARAM );
hb_compMemvarCheck( szVarName, HB_COMP_PARAM );
}
}
@@ -1329,7 +1294,6 @@ void hb_compGenPushAliasedVar( char * szVarName,
( iLen >= 4 && iLen <= 6 && strncmp( szAlias, "MEMVAR", iLen ) == 0 ) ) )
{ /* M-> or MEMV-> or MEMVA-> or MEMVAR-> variable */
hb_compMemvarGenPCode( HB_P_MPUSHMEMVAR, szVarName, HB_COMP_PARAM );
hb_compMemvarCheck( szVarName, HB_COMP_PARAM );
}
else if( iLen >= 4 && iLen <= 5 && strncmp( szAlias, "FIELD", iLen ) == 0 )
{ /* FIELD-> */
@@ -1354,7 +1318,6 @@ void hb_compGenPushAliasedVar( char * szVarName,
* here if passed name is either a field or a memvar
*/
hb_compMemvarGenPCode( HB_P_MPUSHALIASEDVAR, szVarName, HB_COMP_PARAM );
hb_compMemvarCheck( szVarName, HB_COMP_PARAM );
}
}