diff --git a/harbour/ChangeLog b/harbour/ChangeLog index e2ea28d348..9751dbffeb 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,54 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ + * changed to use stack macros/functions instead of direct accessing + HB_STACK members + + implemented PROCFILE() - it returns now real source file name + with body of given function symbol or function executed at given + stack level. If the source file cannot be detected then empty + string is returned. Unlike in xHarbour it works also for static + functions. synatx: + PROCFILE( [ | ] ) + F.e.: + PROCFILE() -> current module name + PROCFILE(@DBFCDX()) -> ../../dbfcdx1.c + +2006-06-16 01:30 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/include/hbapi.h + * harbour/source/vm/arrays.c + * added hb_arraySelfParams() + + * harbour/include/hbapierr.h + * harbour/source/rtl/errorapi.c + + added HB_ERR_ARGS_SELFPARAMS for automatic setting as argument list + array with self item and passed parameters + + * harbour/source/rtl/copyfile.c + * harbour/source/rtl/str.c + * harbour/source/rtl/strtran.c + * harbour/source/rtl/strzero.c + * harbour/source/rtl/substr.c + * harbour/source/vm/arrayshb.c + * harbour/source/vm/classes.c + * harbour/source/vm/evalhb.c + * harbour/source/vm/memvars.c + * harbour/source/vm/runner.c + * use HB_ERR_ARGS_BASEPARAMS in generated RT messages + + * harbour/source/rtl/fstemp.c + * formatting + + * harbour/source/vm/hvm.c + ! added some missing operator overloading + ! fixed some error messages to be Clipper compatible + ! fixed FOR loop for nonnumerical value and STEP, f.e.: + FOR d := date() TO date() + 10 step 2 + ? d + NEXT + * added disabled code to support reverted FOR condition + like in Clipper. See below. + + * harbour/source/compiler/harbour.y ! 2907 MAIN_MISC(200) TFORNEXT( NIL, NIL, NIL ) like in Clipper. I cannot uncomment it because it will break backward binary compatibility so I'll do that when some modification diff --git a/harbour/include/hbapi.h b/harbour/include/hbapi.h index 160668dab4..83b4437d6f 100644 --- a/harbour/include/hbapi.h +++ b/harbour/include/hbapi.h @@ -599,6 +599,7 @@ extern HB_EXPORT BOOL hb_arraySort( PHB_ITEM pArray, ULONG * pulStart, ULO extern HB_EXPORT PHB_ITEM hb_arrayFromStack( USHORT uiLen ); /* Creates and returns an Array of n Elements from the Eval Stack - Does NOT pop the items. */ extern HB_EXPORT PHB_ITEM hb_arrayFromParams( int iLevel ); /* Creates and returns an Array of Generic Parameters for a given call level */ extern HB_EXPORT PHB_ITEM hb_arrayBaseParams( void ); /* Creates and returns an Array of Generic Parameters for current base symbol. */ +extern HB_EXPORT PHB_ITEM hb_arraySelfParams( void ); /* Creates and returns an Array of Generic Parameters for current base symbol with self item */ #ifndef HB_LONG_LONG_OFF extern HB_EXPORT LONGLONG hb_arrayGetNLL( PHB_ITEM pArray, ULONG ulIndex ); /* retrieves the long long numeric value contained on an array element */ #endif diff --git a/harbour/include/hbapierr.h b/harbour/include/hbapierr.h index 398f73b406..f6c86d0bd8 100644 --- a/harbour/include/hbapierr.h +++ b/harbour/include/hbapierr.h @@ -94,6 +94,7 @@ HB_EXTERN_BEGIN #define HB_ERR_IE_GENERIC 1027 #define HB_ERR_ARGS_BASEPARAMS 0xFFFFFFFF +#define HB_ERR_ARGS_SELFPARAMS 0xFFFFFFFE /* Standard API */ diff --git a/harbour/source/compiler/harbour.y b/harbour/source/compiler/harbour.y index ca9b6d43d3..eb5f83cc2b 100644 --- a/harbour/source/compiler/harbour.y +++ b/harbour/source/compiler/harbour.y @@ -1602,11 +1602,19 @@ ForNext : FOR LValue ForAssign Expression /* 1 2 3 4 */ } Crlf /* 10 */ { +#if 0 /* This is real Clipper behavior which I'll restore when we add PCODE version checking */ + if( $8 ) + hb_compGenPCode1( HB_P_FORTEST ); + else + hb_compGenPCode1( HB_P_GREATER ); + $$ = hb_compGenJumpTrue( 0 ); /* 11 */ +#else if( $8 ) hb_compGenPCode1( HB_P_FORTEST ); else hb_compGenPCode1( HB_P_LESSEQUAL ); $$ = hb_compGenJumpFalse( 0 ); /* 11 */ +#endif } ForStatements /* 12 */ { diff --git a/harbour/source/rtl/copyfile.c b/harbour/source/rtl/copyfile.c index 012c682277..6d279f3977 100644 --- a/harbour/source/rtl/copyfile.c +++ b/harbour/source/rtl/copyfile.c @@ -141,5 +141,5 @@ HB_FUNC( __COPYFILE ) hb_retl( FALSE ); } else - hb_errRT_BASE( EG_ARG, 2010, NULL, "__COPYFILE", HB_MIN( hb_pcount(), 2 ), hb_paramError( 1 ), hb_paramError( 2 ) ); /* NOTE: Undocumented but existing Clipper Run-time error */ + hb_errRT_BASE( EG_ARG, 2010, NULL, "__COPYFILE", HB_ERR_ARGS_BASEPARAMS ); /* NOTE: Undocumented but existing Clipper Run-time error */ } diff --git a/harbour/source/rtl/errorapi.c b/harbour/source/rtl/errorapi.c index 9f63c7ea1b..a99b82b66d 100644 --- a/harbour/source/rtl/errorapi.c +++ b/harbour/source/rtl/errorapi.c @@ -779,7 +779,11 @@ USHORT hb_errRT_BASE( ULONG ulGenCode, ULONG ulSubCode, const char * szDescripti PHB_ITEM pArray; va_list va; ULONG ulArgPos; - BOOL bRelease = TRUE; + + /* I replaced EF_CANRETRY with EF_NONE for Clipper compatibility + * If it's wrong and I missed sth please fix me, Druzus. + */ + pError = hb_errRT_New( ES_ERROR, HB_ERR_SS_BASE, ulGenCode, ulSubCode, szDescription, szOperation, 0, EF_NONE /* EF_CANRETRY */ ); /* Build the array from the passed arguments. */ if( ulArgCount == 0 ) @@ -793,6 +797,10 @@ USHORT hb_errRT_BASE( ULONG ulGenCode, ULONG ulSubCode, const char * szDescripti else pArray = hb_arrayBaseParams(); } + else if( ulArgCount == HB_ERR_ARGS_SELFPARAMS ) + { + pArray = hb_arraySelfParams(); + } else { pArray = hb_itemArrayNew( ulArgCount ); @@ -804,12 +812,6 @@ USHORT hb_errRT_BASE( ULONG ulGenCode, ULONG ulSubCode, const char * szDescripti } va_end( va ); } - - /* I replaced EF_CANRETRY with EF_NONE for Clipper compatibility - * If it's wrong and I missed sth please fix me, Druzus. - */ - pError = hb_errRT_New( ES_ERROR, HB_ERR_SS_BASE, ulGenCode, ulSubCode, szDescription, szOperation, 0, EF_NONE /* EF_CANRETRY */ ); - if ( pArray ) { /* Assign the new array to the object data item. */ @@ -819,10 +821,7 @@ USHORT hb_errRT_BASE( ULONG ulGenCode, ULONG ulSubCode, const char * szDescripti hb_vmSend( 1 ); /* Release the Array. */ - if( bRelease ) - { - hb_itemRelease( pArray ); - } + hb_itemRelease( pArray ); } /* Ok, launch... */ @@ -845,16 +844,35 @@ USHORT hb_errRT_BASE_Ext1( ULONG ulGenCode, ULONG ulSubCode, const char * szDesc pError = hb_errRT_New( ES_ERROR, HB_ERR_SS_BASE, ulGenCode, ulSubCode, szDescription, szOperation, uiOsCode, uiFlags ); - if ( ulArgCount > 0 ) + /* Build the array from the passed arguments. */ + if( ulArgCount == 0 ) + { + pArray = NULL; + } + else if( ulArgCount == HB_ERR_ARGS_BASEPARAMS ) + { + if( hb_pcount() == 0 ) + pArray = NULL; + else + pArray = hb_arrayBaseParams(); + } + else if( ulArgCount == HB_ERR_ARGS_SELFPARAMS ) + { + pArray = hb_arraySelfParams(); + } + else { pArray = hb_itemArrayNew( ulArgCount ); - /* Build the array from the passed arguments. */ va_start( va, ulArgCount ); for( ulArgPos = 1; ulArgPos <= ulArgCount; ulArgPos++ ) + { hb_itemArrayPut( pArray, ulArgPos, va_arg( va, PHB_ITEM ) ); + } va_end( va ); - + } + if ( pArray ) + { /* Assign the new array to the object data item. */ hb_vmPushSymbol( hb_dynsymGetSymbol( "_ARGS" ) ); hb_vmPush( pError ); @@ -884,16 +902,35 @@ PHB_ITEM hb_errRT_BASE_Subst( ULONG ulGenCode, ULONG ulSubCode, const char * szD pError = hb_errRT_New_Subst( ES_ERROR, HB_ERR_SS_BASE, ulGenCode, ulSubCode, szDescription, szOperation, 0, EF_NONE ); - if ( ulArgCount > 0 ) + /* Build the array from the passed arguments. */ + if( ulArgCount == 0 ) + { + pArray = NULL; + } + else if( ulArgCount == HB_ERR_ARGS_BASEPARAMS ) + { + if( hb_pcount() == 0 ) + pArray = NULL; + else + pArray = hb_arrayBaseParams(); + } + else if( ulArgCount == HB_ERR_ARGS_SELFPARAMS ) + { + pArray = hb_arraySelfParams(); + } + else { pArray = hb_itemArrayNew( ulArgCount ); - /* Build the array from the passed arguments. */ va_start( va, ulArgCount ); for( ulArgPos = 1; ulArgPos <= ulArgCount; ulArgPos++ ) + { hb_itemArrayPut( pArray, ulArgPos, va_arg( va, PHB_ITEM ) ); + } va_end( va ); - + } + if ( pArray ) + { /* Assign the new array to the object data item. */ hb_vmPushSymbol( hb_dynsymGetSymbol( "_ARGS" ) ); hb_vmPush( pError ); @@ -919,7 +956,8 @@ void hb_errRT_BASE_SubstR( ULONG ulGenCode, ULONG ulSubCode, const char * szDesc PHB_ITEM pArray; va_list va; ULONG ulArgPos; - BOOL bRelease = TRUE; + + pError = hb_errRT_New_Subst( ES_ERROR, HB_ERR_SS_BASE, ulGenCode, ulSubCode, szDescription, szOperation, 0, EF_NONE ); /* Build the array from the passed arguments. */ if( ulArgCount == 0 ) @@ -933,6 +971,10 @@ void hb_errRT_BASE_SubstR( ULONG ulGenCode, ULONG ulSubCode, const char * szDesc else pArray = hb_arrayBaseParams(); } + else if( ulArgCount == HB_ERR_ARGS_SELFPARAMS ) + { + pArray = hb_arraySelfParams(); + } else { pArray = hb_itemArrayNew( ulArgCount ); @@ -944,9 +986,6 @@ void hb_errRT_BASE_SubstR( ULONG ulGenCode, ULONG ulSubCode, const char * szDesc } va_end( va ); } - - pError = hb_errRT_New_Subst( ES_ERROR, HB_ERR_SS_BASE, ulGenCode, ulSubCode, szDescription, szOperation, 0, EF_NONE ); - if ( pArray ) { /* Assign the new array to the object data item. */ @@ -956,10 +995,7 @@ void hb_errRT_BASE_SubstR( ULONG ulGenCode, ULONG ulSubCode, const char * szDesc hb_vmSend( 1 ); /* Release the Array. */ - if( bRelease ) - { - hb_itemRelease( pArray ); - } + hb_itemRelease( pArray ); } /* Ok, launch... */ diff --git a/harbour/source/rtl/fstemp.c b/harbour/source/rtl/fstemp.c index 2bca8a8887..4ce4a26386 100644 --- a/harbour/source/rtl/fstemp.c +++ b/harbour/source/rtl/fstemp.c @@ -151,9 +151,9 @@ HB_EXPORT FHANDLE hb_fsCreateTemp( const BYTE * pszDir, const BYTE * pszPrefix, static BOOL fsGetTempDirByCase( BYTE *pszName, const char *pszTempDir ) { BOOL bOk= FALSE; - if ( pszTempDir!= NULL && *pszTempDir!= '\0' ) + if ( pszTempDir != NULL && *pszTempDir != '\0' ) { - bOk= TRUE; + bOk = TRUE; strcpy( ( char * ) pszName, ( char * ) pszTempDir ); if ( hb_set.HB_SET_DIRCASE == HB_SET_CASE_LOWER || hb_set.HB_SET_DIRCASE == HB_SET_CASE_UPPER ) { @@ -161,10 +161,10 @@ static BOOL fsGetTempDirByCase( BYTE *pszName, const char *pszTempDir ) char *psZ = ( char * ) pszName ; int iChar ; BOOL bLower = hb_set.HB_SET_DIRCASE == HB_SET_CASE_LOWER ; - while ( *psZ ) + while( *psZ ) { iChar = ( int ) *psZ; - if ( isalpha( iChar ) && !( bLower ? islower( iChar ) : isupper( iChar ) ) ) + if( isalpha( iChar ) && !( bLower ? islower( iChar ) : isupper( iChar ) ) ) { bOk = FALSE; break; @@ -188,16 +188,16 @@ HB_EXPORT FHANDLE hb_fsCreateTemp( const BYTE * pszDir, const BYTE * pszPrefix, { pszName[0] = '\0'; - if ( pszDir != NULL && pszDir[0] != '\0' ) + if( pszDir != NULL && pszDir[0] != '\0' ) { strcpy( ( char * ) pszName, ( char * ) pszDir ); } - else if ( !fsGetTempDirByCase( pszName, getenv( "TMPDIR" ) ) && - !fsGetTempDirByCase( pszName, P_tmpdir ) ) + else if( !fsGetTempDirByCase( pszName, getenv( "TMPDIR" ) ) && + !fsGetTempDirByCase( pszName, P_tmpdir ) ) { strcpy( ( char * ) pszName, "." ); } - if ( pszName[0] != '\0' ) + if( pszName[0] != '\0' ) { int len; len = strlen( ( char * ) pszName ); diff --git a/harbour/source/rtl/str.c b/harbour/source/rtl/str.c index 0ef41752ad..3f14ebfcca 100644 --- a/harbour/source/rtl/str.c +++ b/harbour/source/rtl/str.c @@ -84,5 +84,5 @@ HB_FUNC( STR ) hb_retc( NULL ); } else - hb_errRT_BASE_SubstR( EG_ARG, 1099, NULL, "STR", HB_MIN( hb_pcount(), 3 ), hb_paramError( 1 ), hb_paramError( 2 ), hb_paramError( 3 ) ); + hb_errRT_BASE_SubstR( EG_ARG, 1099, NULL, "STR", HB_ERR_ARGS_BASEPARAMS ); } diff --git a/harbour/source/rtl/strtran.c b/harbour/source/rtl/strtran.c index 5c85be1f49..c96bfef886 100644 --- a/harbour/source/rtl/strtran.c +++ b/harbour/source/rtl/strtran.c @@ -189,9 +189,9 @@ HB_FUNC( STRTRAN ) hb_retclen( szText, ulText ); } else - hb_errRT_BASE_SubstR( EG_ARG, 1126, NULL, "STRTRAN", HB_MIN( hb_pcount(), 3 ), hb_paramError( 1 ), hb_paramError( 2 ), hb_paramError( 3 ) ); /* NOTE: Undocumented but existing Clipper Run-time error [vszakats] */ + hb_errRT_BASE_SubstR( EG_ARG, 1126, NULL, "STRTRAN", HB_ERR_ARGS_BASEPARAMS ); /* NOTE: Undocumented but existing Clipper Run-time error [vszakats] */ } else - hb_errRT_BASE_SubstR( EG_ARG, 1126, NULL, "STRTRAN", HB_MIN( hb_pcount(), 3 ), hb_paramError( 1 ), hb_paramError( 2 ), hb_paramError( 3 ) ); /* NOTE: Undocumented but existing Clipper Run-time error [vszakats] */ + hb_errRT_BASE_SubstR( EG_ARG, 1126, NULL, "STRTRAN", HB_ERR_ARGS_BASEPARAMS ); /* NOTE: Undocumented but existing Clipper Run-time error [vszakats] */ } diff --git a/harbour/source/rtl/strzero.c b/harbour/source/rtl/strzero.c index 1ebac02cd9..fd39f87f6d 100644 --- a/harbour/source/rtl/strzero.c +++ b/harbour/source/rtl/strzero.c @@ -119,9 +119,9 @@ HB_FUNC( STRZERO ) /* NOTE: In CA-Cl*pper STRZERO() is written in Clipper, and will call STR() to do the job, the error (if any) will also be thrown by STR(). [vszakats] */ - hb_errRT_BASE_SubstR( EG_ARG, 1099, NULL, "STR", HB_MIN( hb_pcount(), 3 ), hb_paramError( 1 ), hb_paramError( 2 ), hb_paramError( 3 ) ); + hb_errRT_BASE_SubstR( EG_ARG, 1099, NULL, "STR", HB_ERR_ARGS_BASEPARAMS ); #else - hb_errRT_BASE_SubstR( EG_ARG, 9999, NULL, "STRZERO", HB_MIN( hb_pcount(), 3 ), hb_paramError( 1 ), hb_paramError( 2 ), hb_paramError( 3 ) ); + hb_errRT_BASE_SubstR( EG_ARG, 9999, NULL, "STRZERO", HB_ERR_ARGS_BASEPARAMS ); #endif } } diff --git a/harbour/source/rtl/substr.c b/harbour/source/rtl/substr.c index ce27eecfcf..99044a0adf 100644 --- a/harbour/source/rtl/substr.c +++ b/harbour/source/rtl/substr.c @@ -91,7 +91,7 @@ HB_FUNC( SUBSTR ) } else { - hb_errRT_BASE_SubstR( EG_ARG, 1110, NULL, "SUBSTR", HB_MIN( hb_pcount(), 3 ), hb_paramError( 1 ), hb_paramError( 2 ), hb_paramError( 3 ) ); + hb_errRT_BASE_SubstR( EG_ARG, 1110, NULL, "SUBSTR", HB_ERR_ARGS_BASEPARAMS ); /* NOTE: Exit from inside [vszakats] */ return; } @@ -113,5 +113,5 @@ HB_FUNC( SUBSTR ) hb_retc( NULL ); } else - hb_errRT_BASE_SubstR( EG_ARG, 1110, NULL, "SUBSTR", HB_MIN( hb_pcount(), 3 ), hb_paramError( 1 ), hb_paramError( 2 ), hb_paramError( 3 ) ); + hb_errRT_BASE_SubstR( EG_ARG, 1110, NULL, "SUBSTR", HB_ERR_ARGS_BASEPARAMS ); } diff --git a/harbour/source/vm/arrays.c b/harbour/source/vm/arrays.c index 6d4ade00f1..0080bdd705 100644 --- a/harbour/source/vm/arrays.c +++ b/harbour/source/vm/arrays.c @@ -927,7 +927,7 @@ HB_EXPORT PHB_ITEM hb_arrayBaseParams( void ) PHB_ITEM pArray; USHORT uiPos, uiPCount; - HB_TRACE(HB_TR_DEBUG, ("hb_arrayFromParams()")); + HB_TRACE(HB_TR_DEBUG, ("hb_arrayBaseParams()")); pArray = hb_itemNew( NULL ); uiPCount = hb_stackBaseItem()->item.asSymbol.paramcnt; @@ -941,3 +941,23 @@ HB_EXPORT PHB_ITEM hb_arrayBaseParams( void ) return pArray; } + +HB_EXPORT PHB_ITEM hb_arraySelfParams( void ) +{ + PHB_ITEM pArray; + USHORT uiPos, uiPCount; + + HB_TRACE(HB_TR_DEBUG, ("hb_arraySelfParams()")); + + pArray = hb_itemNew( NULL ); + uiPCount = hb_stackBaseItem()->item.asSymbol.paramcnt; + + hb_arrayNew( pArray, uiPCount + 1 ); + + for( uiPos = 0; uiPos <= uiPCount; uiPos++ ) + { + hb_arraySet( pArray, uiPos + 1, hb_stackItemFromBase( uiPos ) ); + } + + return pArray; +} diff --git a/harbour/source/vm/arrayshb.c b/harbour/source/vm/arrayshb.c index 88931fea3c..8d578bd72c 100644 --- a/harbour/source/vm/arrayshb.c +++ b/harbour/source/vm/arrayshb.c @@ -101,7 +101,7 @@ HB_FUNC( ARRAY ) if( hb_parnl( iParam ) < 0 ) /* || hb_parnl( iParam ) <= 4096 */ { - hb_errRT_BASE( EG_BOUND, 1131, NULL, hb_langDGetErrorDesc( EG_ARRDIMENSION ), 1, hb_paramError( 1 ) ); + hb_errRT_BASE( EG_BOUND, 1131, NULL, hb_langDGetErrorDesc( EG_ARRDIMENSION ), HB_ERR_ARGS_BASEPARAMS ); bError = TRUE; break; } @@ -123,10 +123,10 @@ HB_FUNC( AADD ) if( pValue && hb_arrayAdd( pArray, pValue ) ) hb_itemReturn( pValue ); else - hb_errRT_BASE( EG_BOUND, 1187, NULL, "AADD", HB_MIN( hb_pcount(), 2 ), hb_paramError( 1 ), hb_paramError( 2 ) ); + hb_errRT_BASE( EG_BOUND, 1187, NULL, "AADD", HB_ERR_ARGS_BASEPARAMS ); } else - hb_errRT_BASE_SubstR( EG_ARG, 1123, NULL, "AADD", HB_MIN( hb_pcount(), 2 ), hb_paramError(1), hb_paramError( 2 ) ); + hb_errRT_BASE_SubstR( EG_ARG, 1123, NULL, "AADD", HB_ERR_ARGS_BASEPARAMS ); } HB_FUNC( HB_ARRAYID ) /* for debugging: returns the array's "address" so dual references to same array can be seen */ @@ -157,7 +157,7 @@ HB_FUNC( ASIZE ) } #ifdef HB_COMPAT_C53 /* From CA-Cl*pper 5.3a */ else - hb_errRT_BASE( EG_ARG, 2023, NULL, "ASIZE", HB_MIN( hb_pcount(), 2 ), hb_paramError( 1 ), hb_paramError( 2 ) ); + hb_errRT_BASE( EG_ARG, 2023, NULL, "ASIZE", HB_ERR_ARGS_BASEPARAMS ); #endif } @@ -244,9 +244,9 @@ HB_FUNC( AFILL ) /* NOTE: In CA-Cl*pper AFILL() is written in a manner that it will call AEVAL() to do the job, so the error (if any) will also be thrown by AEVAL(). [vszakats] */ - hb_errRT_BASE( EG_ARG, 2017, NULL, "AEVAL", HB_MIN( hb_pcount(), 4 ), hb_paramError( 1 ), hb_paramError( 2 ), hb_paramError( 3 ), hb_paramError( 4 ) ); + hb_errRT_BASE( EG_ARG, 2017, NULL, "AEVAL", HB_ERR_ARGS_BASEPARAMS ); #else - hb_errRT_BASE( EG_ARG, 9999, NULL, "AFILL", HB_MIN( hb_pcount(), 4 ), hb_paramError( 1 ), hb_paramError( 2 ), hb_paramError( 3 ), hb_paramError( 4 ) ); + hb_errRT_BASE( EG_ARG, 9999, NULL, "AFILL", HB_ERR_ARGS_BASEPARAMS ); #endif } @@ -290,7 +290,7 @@ HB_FUNC( AEVAL ) hb_itemReturn( hb_stackItemFromBase( 1 ) ); /* AEval() returns the array itself */ } else - hb_errRT_BASE( EG_ARG, 2017, NULL, "AEVAL", HB_MIN( hb_pcount(), 4 ), hb_paramError( 1 ), hb_paramError( 2 ), hb_paramError( 3 ), hb_paramError( 4 ) ); + hb_errRT_BASE( EG_ARG, 2017, NULL, "AEVAL", HB_ERR_ARGS_BASEPARAMS ); } HB_FUNC( ACOPY ) @@ -343,7 +343,7 @@ HB_FUNC( HB_AEXPRESSIONS ) if( pLine == NULL ) { - hb_errRT_BASE_SubstR( EG_ARG, 9999, NULL, "HB_AEXPRESSIONS", 1, hb_paramError(1) ); + hb_errRT_BASE_SubstR( EG_ARG, 9999, NULL, "HB_AEXPRESSIONS", HB_ERR_ARGS_BASEPARAMS ); return; } diff --git a/harbour/source/vm/classes.c b/harbour/source/vm/classes.c index dfebc2274d..741c1bb8b6 100644 --- a/harbour/source/vm/classes.c +++ b/harbour/source/vm/classes.c @@ -1849,7 +1849,7 @@ HB_FUNC( __OBJHASMSG ) else { /*hb_errRT_BASE( EG_ARG, 3000, NULL, "__OBJHASMSG", 0 );*/ - hb_errRT_BASE_SubstR( EG_ARG, 1099, NULL, "__ObjHasMsg", 2, hb_paramError( 1 ), hb_paramError( 2 ) ); + hb_errRT_BASE_SubstR( EG_ARG, 1099, NULL, "__ObjHasMsg", HB_ERR_ARGS_BASEPARAMS ); } } @@ -2395,7 +2395,7 @@ static HARBOUR hb___msgEval( void ) hb_vmDo( ( USHORT ) uiPCount ); } else - hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, "EVAL", 1, pSelf ); + hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, "EVAL", HB_ERR_ARGS_SELFPARAMS ); } /* @@ -2405,25 +2405,24 @@ static HARBOUR hb___msgEval( void ) */ static HARBOUR hb___msgNoMethod( void ) { - PHB_ITEM pSelf = hb_stackSelfItem(); PHB_SYMB pSym = hb_itemGetSymbol( hb_stackBaseItem() ); #if 1 /* Clipper compatible error message */ if( pSym->szName[ 0 ] == '_' ) - hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, NULL, pSym->szName + 1, 1, pSelf ); + hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, NULL, pSym->szName + 1, HB_ERR_ARGS_SELFPARAMS ); else - hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, pSym->szName, 1, pSelf ); + hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, pSym->szName, HB_ERR_ARGS_SELFPARAMS ); #else char szDesc[ 128 ]; if( pSym->szName[ 0 ] == '_' ) { - sprintf( szDesc, "Class: '%s' has no property", hb_objGetClsName( pSelf ) ); + sprintf( szDesc, "Class: '%s' has no property", hb_objGetClsName( hb_stackSelfItem() ) ); hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, szDesc, pSym->szName + 1, HB_ERR_ARGS_BASEPARAMS ); } else { - sprintf( szDesc, "Class: '%s' has no exported method", hb_objGetClsName( pSelf ) ); + sprintf( szDesc, "Class: '%s' has no exported method", hb_objGetClsName( hb_stackSelfItem() ) ); hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, szDesc, pSym->szName, HB_ERR_ARGS_BASEPARAMS ); } #endif @@ -2667,13 +2666,8 @@ HB_FUNC( __GETMSGPRF ) /* profiler: returns a method called and consumed times * USHORT uiMask = ( USHORT ) ( pClass->uiHashKey * BUCKET ); USHORT uiLimit = ( USHORT ) ( uiAt ? ( uiAt - 1 ) : ( uiMask - 1 ) ); PMETHOD pMethod; -#endif hb_reta( 2 ); - hb_stornl( 0, -1, 1 ); - hb_stornl( 0, -1, 2 ); - -#ifndef HB_NO_PROFILER while( uiAt != uiLimit ) { if( ! strcmp( pClass->pMethods[ uiAt ].pMessage->pSymbol->szName, cMsg ) ) @@ -2687,7 +2681,11 @@ HB_FUNC( __GETMSGPRF ) /* profiler: returns a method called and consumed times * if( uiAt == uiMask ) uiAt = 0; } +#else + hb_reta( 2 ); #endif + hb_stornl( 0, -1, 1 ); + hb_stornl( 0, -1, 2 ); } /* __ClsGetProperties( nClassHandle ) --> aPropertiesNames diff --git a/harbour/source/vm/evalhb.c b/harbour/source/vm/evalhb.c index 5b559a3d91..a32f7e84ff 100644 --- a/harbour/source/vm/evalhb.c +++ b/harbour/source/vm/evalhb.c @@ -81,7 +81,7 @@ HB_FUNC( EVAL ) } else { - hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, "EVAL", 1, hb_paramError( 1 ) ); + hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, "EVAL", HB_ERR_ARGS_BASEPARAMS ); } } diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index e09bbc2f7c..c37e21538c 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -2000,24 +2000,40 @@ static void hb_vmAddInt( HB_ITEM_PTR pResult, LONG lAdd ) { dNewVal = pResult->item.asDouble.value + lAdd; } + else if( hb_objHasOperator( pResult, HB_OO_OP_PLUS ) ) + { + hb_vmPushLong( lAdd ); + hb_objOperatorCall( HB_OO_OP_PLUS, pResult, pResult, hb_stackItemFromTop( -1 ) ); + hb_stackPop(); + return; + } else { PHB_ITEM pSubst; - if( lAdd > 0 ) + if( lAdd == 1 ) + { + pSubst = hb_errRT_BASE_Subst( EG_ARG, 1086, NULL, "++", 1, pResult ); + } + else if( lAdd == -1 ) + { + pSubst = hb_errRT_BASE_Subst( EG_ARG, 1087, NULL, "--", 1, pResult ); + } + else if( lAdd > 0 ) { hb_vmPushLong( lAdd ); pSubst = hb_errRT_BASE_Subst( EG_ARG, 1081, NULL, "+", 2, pResult, hb_stackItemFromTop( -1 ) ); + hb_stackPop(); } else { hb_vmPushLong( -lAdd ); pSubst = hb_errRT_BASE_Subst( EG_ARG, 1082, NULL, "-", 2, pResult, hb_stackItemFromTop( -1 ) ); + hb_stackPop(); } if( pSubst ) { - hb_stackPop(); hb_itemMove( pResult, pSubst ); hb_itemRelease( pSubst ); } @@ -3029,106 +3045,53 @@ static void hb_vmInstring( void ) */ static void hb_vmForTest( void ) /* Test to check the end point of the FOR */ { - double dStep; + BOOL fBack; HB_TRACE(HB_TR_DEBUG, ("hb_vmForTest()")); - while( ! HB_IS_NUMERIC( hb_stackItemFromTop( -1 ) ) ) + if( HB_IS_NUMERIC( hb_stackItemFromTop( -1 ) ) ) { - PHB_ITEM pItem1 = hb_stackItemFromTop( -1 ); - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1073, NULL, "<", 1, pItem1 ); - - if( pResult ) - { - hb_stackPop(); - hb_vmPush( pResult ); - hb_itemRelease( pResult ); - } - else - /* NOTE: Return from the inside. */ - return; - } - - dStep = hb_vmPopNumber(); - - while( ( ! HB_IS_NUMERIC( hb_stackItemFromTop( -1 ) ) ) && ( ! HB_IS_LOGICAL( hb_stackItemFromTop( -1 ) ) ) ) - { - PHB_ITEM pItem1 = hb_stackItemFromTop( -1 ); - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1073, NULL, "<", 1, pItem1 ); - - if( pResult ) - { - hb_stackPop(); - hb_vmPush( pResult ); - hb_itemRelease( pResult ); - } - else - /* NOTE: Return from the inside. */ - return; - } - - if ( hb_stackItemFromTop( -1 )->type == HB_IT_LOGICAL ) - { - BOOL lEnd; - BOOL lCurrent; - - lEnd = hb_vmPopLogical(); - while( ! HB_IS_LOGICAL( hb_stackItemFromTop( -1 ) ) ) - { - PHB_ITEM pItem1 = hb_stackItemFromTop( -1 ); - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1073, NULL, "<", 1, pItem1 ); - - if( pResult ) - { - hb_stackPop(); - hb_vmPush( pResult ); - hb_itemRelease( pResult ); - } - else - /* NOTE: Return from the inside. */ - return; - } - lCurrent = hb_vmPopLogical(); - if( dStep >= 0 ) /* Positive loop. Use LESS */ - { - hb_vmPushLogical( lCurrent <= lEnd ); - } - else if( dStep < 0 ) /* Negative loop. Use GREATER */ - { - hb_vmPushLogical( lCurrent >= lEnd ); - } + fBack = hb_vmPopNumber() < 0.0; } else { - double dEnd; - double dCurrent; + PHB_ITEM pResult; - dEnd = hb_vmPopNumber(); - while( ! HB_IS_NUMERIC( hb_stackItemFromTop( -1 ) ) ) + hb_vmPushInteger( 0 ); + pResult = hb_errRT_BASE_Subst( EG_ARG, 1073, NULL, "<", 2, hb_stackItemFromTop( -2 ), hb_stackItemFromTop( -1 ) ); + + if( pResult ) { - PHB_ITEM pItem1 = hb_stackItemFromTop( -1 ); - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1073, NULL, "<", 1, pItem1 ); - - if( pResult ) + if( HB_IS_LOGICAL( pResult ) ) { - hb_stackPop(); - hb_vmPush( pResult ); + fBack = pResult->item.asLogical.value; hb_itemRelease( pResult ); + hb_stackPop(); + hb_stackPop(); } else - /* NOTE: Return from the inside. */ + { + hb_itemMove( hb_stackItemFromTop( -1 ), pResult ); + hb_itemRelease( pResult ); + hb_errRT_BASE( EG_ARG, 1066, NULL, hb_langDGetErrorDesc( EG_CONDITION ), 1, hb_stackItemFromTop( -1 ) ); return; + } } - dCurrent = hb_vmPopNumber(); - if( dStep >= 0 ) /* Positive loop. Use LESS */ - { - hb_vmPushLogical( dCurrent <= dEnd ); - } - else if( dStep < 0 ) /* Negative loop. Use GREATER */ - { - hb_vmPushLogical( dCurrent >= dEnd ); - } + else + return; } + +#if 0 /* This is real Clipper behavior which I'll restore when we add PCODE version checking */ + if( fBack ) + hb_vmLess(); + else + hb_vmGreater(); +#else + if( fBack ) + hb_vmGreaterEqual(); + else + hb_vmLessEqual(); +#endif } /* At this moment the eval stack should store: @@ -3929,9 +3892,9 @@ HB_EXPORT void hb_vmDo( USHORT uiParams ) #endif } else if( pSym->szName[ 0 ] == '_' ) - hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, NULL, pSym->szName + 1, 1, pSelf ); + hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, NULL, pSym->szName + 1, HB_ERR_ARGS_SELFPARAMS ); else - hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, pSym->szName, 1, pSelf ); + hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, pSym->szName, HB_ERR_ARGS_SELFPARAMS ); if( lPopSuper ) hb_objPopSuperCast( pSelf ); @@ -4075,9 +4038,9 @@ HB_EXPORT void hb_vmSend( USHORT uiParams ) #endif } else if( pSym->szName[ 0 ] == '_' ) - hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, NULL, pSym->szName + 1, 1, pSelf ); + hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, NULL, pSym->szName + 1, HB_ERR_ARGS_SELFPARAMS ); else - hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, pSym->szName, 1, pSelf ); + hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, pSym->szName, HB_ERR_ARGS_SELFPARAMS ); if( lPopSuper ) hb_objPopSuperCast( pSelf ); @@ -6490,7 +6453,7 @@ HB_EXPORT void hb_xvmLocalSetInt( int iLocal, LONG lValue ) if( HB_IS_OBJECT( pLocal ) && hb_objHasOperator( pLocal, HB_OO_OP_ASSIGN ) ) { - hb_vmPushInteger( lValue ); + hb_vmPushLong( lValue ); hb_objOperatorCall( HB_OO_OP_ASSIGN, pLocal, pLocal, hb_stackItemFromTop( -1 ) ); hb_stackPop(); @@ -6673,7 +6636,7 @@ HB_EXPORT BOOL hb_xvmEqualInt( LONG lValue ) } else if( hb_objHasOperator( pItem, HB_OO_OP_EQUAL ) ) { - hb_vmPushNumInt( lValue ); + hb_vmPushLong( lValue ); hb_objOperatorCall( HB_OO_OP_EQUAL, pItem, pItem, hb_stackItemFromTop( -1 ) ); hb_stackPop(); diff --git a/harbour/source/vm/memvars.c b/harbour/source/vm/memvars.c index 16ffa76297..dc406c5aa8 100644 --- a/harbour/source/vm/memvars.c +++ b/harbour/source/vm/memvars.c @@ -668,7 +668,7 @@ void hb_memvarCreateFromItem( PHB_ITEM pMemvar, BYTE bScope, PHB_ITEM pValue ) else if( HB_IS_STRING( pMemvar ) ) pDynVar = hb_dynsymGet( pMemvar->item.asString.value ); else - hb_errRT_BASE( EG_ARG, 3008, NULL, "&", 2, hb_paramError( 1 ), hb_paramError( 2 ) ); + hb_errRT_BASE( EG_ARG, 3008, NULL, "&", HB_ERR_ARGS_BASEPARAMS ); if( pDynVar ) hb_memvarCreateFromDynSymbol( pDynVar, bScope, pValue ); @@ -758,7 +758,7 @@ static void hb_memvarRelease( HB_ITEM_PTR pMemvar ) hb_memvarReleasePublic( pMemvar ); } else - hb_errRT_BASE( EG_ARG, 3008, NULL, "RELEASE", 1, hb_paramError( 1 ) ); + hb_errRT_BASE( EG_ARG, 3008, NULL, "RELEASE", HB_ERR_ARGS_BASEPARAMS ); } @@ -1271,7 +1271,7 @@ HB_FUNC( __MVGET ) /* TODO: This should be expanded a little to report a passed incorrect * value to the error handler */ - hb_errRT_BASE_SubstR( EG_ARG, 3009, NULL, NULL, 1, hb_paramError( 1 ) ); + hb_errRT_BASE_SubstR( EG_ARG, 3009, NULL, NULL, HB_ERR_ARGS_BASEPARAMS ); } } @@ -1310,7 +1310,7 @@ HB_FUNC( __MVPUT ) /* TODO: This should be expanded a little to report a passed incorrect * value to the error handler */ - HB_ITEM_PTR pRetValue = hb_errRT_BASE_Subst( EG_ARG, 3010, NULL, NULL, 1, hb_paramError( 1 ) ); + HB_ITEM_PTR pRetValue = hb_errRT_BASE_Subst( EG_ARG, 3010, NULL, NULL, HB_ERR_ARGS_BASEPARAMS ); if( pRetValue ) hb_itemRelease( pRetValue ); @@ -1452,7 +1452,7 @@ HB_FUNC( __MVSAVE ) while( ( fhnd = hb_fsCreate( ( BYTE * ) szFileName, FC_NORMAL ) ) == FS_ERROR ) { - USHORT uiAction = hb_errRT_BASE_Ext1( EG_CREATE, 2006, NULL, szFileName, hb_fsError(), EF_CANDEFAULT | EF_CANRETRY, 3, hb_paramError( 1 ), hb_paramError( 2 ), hb_paramError( 3 ) ); + USHORT uiAction = hb_errRT_BASE_Ext1( EG_CREATE, 2006, NULL, szFileName, hb_fsError(), EF_CANDEFAULT | EF_CANRETRY, HB_ERR_ARGS_BASEPARAMS ); if( uiAction == E_DEFAULT || uiAction == E_BREAK ) break; @@ -1480,7 +1480,7 @@ HB_FUNC( __MVSAVE ) } else /* NOTE: Undocumented error message in CA-Cl*pper 5.2e and 5.3x. [ckedem] */ - hb_errRT_BASE( EG_ARG, 2008, NULL, "__MSAVE", HB_MIN( hb_pcount(), 3 ), hb_paramError( 1 ), hb_paramError( 2 ), hb_paramError( 3 ) ); + hb_errRT_BASE( EG_ARG, 2008, NULL, "__MSAVE", HB_ERR_ARGS_BASEPARAMS ); } /* NOTE: There's an extension in Harbour, which makes it possible to only @@ -1521,7 +1521,7 @@ HB_FUNC( __MVRESTORE ) while( ( fhnd = hb_fsOpen( ( BYTE * ) szFileName, FO_READ | FO_DENYWRITE | FO_PRIVATE ) ) == FS_ERROR ) { - USHORT uiAction = hb_errRT_BASE_Ext1( EG_OPEN, 2005, NULL, szFileName, hb_fsError(), EF_CANDEFAULT | EF_CANRETRY, 2, hb_paramError( 1 ), hb_paramError( 2 ) ); + USHORT uiAction = hb_errRT_BASE_Ext1( EG_OPEN, 2005, NULL, szFileName, hb_fsError(), EF_CANDEFAULT | EF_CANRETRY, HB_ERR_ARGS_BASEPARAMS ); if( uiAction == E_DEFAULT || uiAction == E_BREAK ) break; @@ -1622,7 +1622,7 @@ HB_FUNC( __MVRESTORE ) } else /* NOTE: Undocumented error message in CA-Cl*pper 5.2e and 5.3x. [ckedem] */ - hb_errRT_BASE( EG_ARG, 2007, NULL, "__MRESTORE", HB_MIN( hb_pcount(), 2 ), hb_paramError( 1 ), hb_paramError( 2 ) ); + hb_errRT_BASE( EG_ARG, 2007, NULL, "__MRESTORE", HB_ERR_ARGS_BASEPARAMS ); } /* ----------------------------------------------------------------------- */ diff --git a/harbour/source/vm/runner.c b/harbour/source/vm/runner.c index 3a894ecf79..04f0ae5e3c 100644 --- a/harbour/source/vm/runner.c +++ b/harbour/source/vm/runner.c @@ -711,7 +711,7 @@ PHRB_BODY hb_hrbLoadFromFile( char* szHrb ) while ( ( file = hb_fsOpen( ( BYTE *)szFileName, FO_READ )) == 0 ) { - USHORT uiAction = hb_errRT_BASE_Ext1( EG_OPEN, 9999, NULL, szFileName, hb_fsError(), EF_CANDEFAULT | EF_CANRETRY, 1, hb_paramError( 1 ) ); + USHORT uiAction = hb_errRT_BASE_Ext1( EG_OPEN, 9999, NULL, szFileName, hb_fsError(), EF_CANDEFAULT | EF_CANRETRY, HB_ERR_ARGS_BASEPARAMS ); if( uiAction == E_DEFAULT || uiAction == E_BREAK ) {