From 81e26ae43b451ca4cacce580dba22a68b7747825 Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Thu, 15 Jun 2006 23:48:56 +0000 Subject: [PATCH] 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 * added disabled code to generate reverted FOR condition like in Clipper. I cannot uncomment it because it will break backward binary compatibility so I'll do that when some modification will force PCODE version updating. Enabling this code clean the following errors reported by hbtest: ! 2907 MAIN_MISC(200) TFORNEXT( NIL, NIL, NIL ) Result: "E BASE 1074 Argument error <= A:2:U:NIL;U:NIL F:S" Expected: "E BASE 1075 Argument error > A:2:U:NIL;U:NIL F:S" ! 2919 MAIN_MISC(212) TFORNEXT( NIL, NIL, NIL ) Result: "E BASE 1074 Argument error <= A:2:U:NIL;U:NIL F:S" Expected: "E BASE 1075 Argument error > A:2:U:NIL;U:NIL F:S" --- harbour/ChangeLog | 48 ++++++++++ harbour/include/hbapi.h | 1 + harbour/include/hbapierr.h | 1 + harbour/source/compiler/harbour.y | 8 ++ harbour/source/rtl/copyfile.c | 2 +- harbour/source/rtl/errorapi.c | 86 ++++++++++++----- harbour/source/rtl/fstemp.c | 16 ++-- harbour/source/rtl/str.c | 2 +- harbour/source/rtl/strtran.c | 4 +- harbour/source/rtl/strzero.c | 4 +- harbour/source/rtl/substr.c | 4 +- harbour/source/vm/arrays.c | 22 ++++- harbour/source/vm/arrayshb.c | 16 ++-- harbour/source/vm/classes.c | 22 ++--- harbour/source/vm/evalhb.c | 2 +- harbour/source/vm/hvm.c | 147 +++++++++++------------------- harbour/source/vm/memvars.c | 16 ++-- harbour/source/vm/runner.c | 2 +- 18 files changed, 239 insertions(+), 164 deletions(-) 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 ) {