diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 927b8798e5..bf430bf6f7 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,56 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ +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 diff --git a/harbour/contrib/rdd_ads/adsfunc.c b/harbour/contrib/rdd_ads/adsfunc.c index c5de95e49b..25d2c6465e 100644 --- a/harbour/contrib/rdd_ads/adsfunc.c +++ b/harbour/contrib/rdd_ads/adsfunc.c @@ -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; diff --git a/harbour/include/hbdefs.h b/harbour/include/hbdefs.h index 074ec82ac6..f0c22ba2ec 100644 --- a/harbour/include/hbdefs.h +++ b/harbour/include/hbdefs.h @@ -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__ ) diff --git a/harbour/include/hbexprb.c b/harbour/include/hbexprb.c index 0471ccb22a..fafc07542f 100644 --- a/harbour/include/hbexprb.c +++ b/harbour/include/hbexprb.c @@ -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 { diff --git a/harbour/source/compiler/cmdcheck.c b/harbour/source/compiler/cmdcheck.c index 7d63c6a0aa..603cc63de6 100644 --- a/harbour/source/compiler/cmdcheck.c +++ b/harbour/source/compiler/cmdcheck.c @@ -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 ); diff --git a/harbour/source/compiler/hbfix.c b/harbour/source/compiler/hbfix.c index 77878ccfcd..ac64537f32 100644 --- a/harbour/source/compiler/hbfix.c +++ b/harbour/source/compiler/hbfix.c @@ -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, */ diff --git a/harbour/source/rdd/dbcmd.c b/harbour/source/rdd/dbcmd.c index cfd31ddccc..b7044471b4 100644 --- a/harbour/source/rdd/dbcmd.c +++ b/harbour/source/rdd/dbcmd.c @@ -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(); } diff --git a/harbour/source/rdd/dbf1.c b/harbour/source/rdd/dbf1.c index 0cf454166e..133877b595 100644 --- a/harbour/source/rdd/dbf1.c +++ b/harbour/source/rdd/dbf1.c @@ -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; } diff --git a/harbour/source/rdd/delim1.c b/harbour/source/rdd/delim1.c index 7ff6782a01..e9aec7e01b 100644 --- a/harbour/source/rdd/delim1.c +++ b/harbour/source/rdd/delim1.c @@ -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; diff --git a/harbour/source/rdd/sdf1.c b/harbour/source/rdd/sdf1.c index 3ac980d1d3..47f4a2109d 100644 --- a/harbour/source/rdd/sdf1.c +++ b/harbour/source/rdd/sdf1.c @@ -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; diff --git a/harbour/source/rdd/workarea.c b/harbour/source/rdd/workarea.c index 68cc1a3c0f..a35768b7b7 100644 --- a/harbour/source/rdd/workarea.c +++ b/harbour/source/rdd/workarea.c @@ -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; diff --git a/harbour/source/vm/macro.c b/harbour/source/vm/macro.c index cd9fc8c5b1..3ce6450534 100644 --- a/harbour/source/vm/macro.c +++ b/harbour/source/vm/macro.c @@ -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 ); } }