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

2006-06-16 01:30 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* 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"
This commit is contained in:
Przemyslaw Czerpak
2006-06-15 23:48:56 +00:00
parent 3f605c0795
commit 81e26ae43b
18 changed files with 239 additions and 164 deletions
Download Patch File Download Diff File Expand all files Collapse all files

48
harbour/ChangeLog
View File

@@ -8,6 +8,54 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
* 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( [ <FuncSym> | <nStackLevel> ] )
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

1
harbour/include/hbapi.h
View File

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

1
harbour/include/hbapierr.h
View File

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

8
harbour/source/compiler/harbour.y
View File

@@ -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( $<asExpr>8 )
hb_compGenPCode1( HB_P_FORTEST );
else
hb_compGenPCode1( HB_P_GREATER );
$<lNumber>$ = hb_compGenJumpTrue( 0 ); /* 11 */
#else
if( $<asExpr>8 )
hb_compGenPCode1( HB_P_FORTEST );
else
hb_compGenPCode1( HB_P_LESSEQUAL );
$<lNumber>$ = hb_compGenJumpFalse( 0 ); /* 11 */
#endif
}
ForStatements /* 12 */
{

2
harbour/source/rtl/copyfile.c
View File

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

86
harbour/source/rtl/errorapi.c
View File

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

16
harbour/source/rtl/fstemp.c
View File

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

2
harbour/source/rtl/str.c
View File

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

4
harbour/source/rtl/strtran.c
View File

@@ -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] */
}

4
harbour/source/rtl/strzero.c
View File

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

4
harbour/source/rtl/substr.c
View File

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

22
harbour/source/vm/arrays.c
View File

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

16
harbour/source/vm/arrayshb.c
View File

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

22
harbour/source/vm/classes.c
View File

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

2
harbour/source/vm/evalhb.c
View File

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

147
harbour/source/vm/hvm.c
View File

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

16
harbour/source/vm/memvars.c
View File

@@ -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 );
}
/* ----------------------------------------------------------------------- */

2
harbour/source/vm/runner.c
View File

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