From 4f4e69a8736b9345494dca239ea4833a52965f6f Mon Sep 17 00:00:00 2001 From: Ryszard Glab Date: Sat, 11 Sep 1999 10:54:40 +0000 Subject: [PATCH] ChangeLog 19990911-12:45 --- harbour/ChangeLog | 19 +++++++ harbour/include/rddapi.h | 14 ++--- harbour/source/compiler/harbour.y | 72 +++++++++++------------ harbour/source/rdd/dbcmd.c | 29 ++++++---- harbour/source/rtl/math.c | 95 ++++++++++++++++++++++++++++++- harbour/source/vm/hvm.c | 23 +++++--- 6 files changed, 189 insertions(+), 63 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index ec1c8d976c..3c83efb3af 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,22 @@ +19990911-12:45 GMT+2 Ryszard Glab + + *source/compiler/harbour.y + * changed binary search to linear search for abbreviations + or redefinitions of reserved functions + + *source/rtl/math.c + * added generation of runtime errors in case of math errors + (log(0), sgrt(-2), etc) - for Watcom C only at this moment. + 'matherr' function is used to suppress printing of internal + compiler message for math errors. I think we need rethink + the handling of such errors. + + *source/rdd/dbcmd.c + *include/rddapi.h + *source/vm/hvm.c + * functions called from virtual machine return SUCCESS or FAILURE + + 19990911-11:30 GMT+1 Victor Szel * contrib/odbc/odbc.c include/classes.ch diff --git a/harbour/include/rddapi.h b/harbour/include/rddapi.h index ebc73faebc..378b8cf060 100644 --- a/harbour/include/rddapi.h +++ b/harbour/include/rddapi.h @@ -12,11 +12,11 @@ typedef USHORT ERRCODE; /* RDD virtual machine integration functions */ extern int hb_rddGetCurrentWorkAreaNumber( void ); -extern void hb_rddSelectWorkAreaAlias( char * szAlias ); -extern void hb_rddSelectWorkAreaNumber( int iArea ); -extern void hb_rddSelectWorkAreaSymbol( PHB_SYMB pSymAlias ); -extern void hb_rddGetFieldValue( HB_ITEM_PTR pItem, PHB_SYMB pFieldSymbol ); -extern void hb_rddPutFieldValue( HB_ITEM_PTR pItem, PHB_SYMB pFieldSymbol ); +extern BOOL hb_rddSelectWorkAreaAlias( char * szAlias ); +extern BOOL hb_rddSelectWorkAreaNumber( int iArea ); +extern BOOL hb_rddSelectWorkAreaSymbol( PHB_SYMB pSymAlias ); +extern BOOL hb_rddGetFieldValue( HB_ITEM_PTR pItem, PHB_SYMB pFieldSymbol ); +extern BOOL hb_rddPutFieldValue( HB_ITEM_PTR pItem, PHB_SYMB pFieldSymbol ); extern void hb_rddShutDown( void ); @@ -125,9 +125,9 @@ extern void hb_rddShutDown( void ); #define APPEND_LOCK 7 #define APPEND_UNLOCK 8 -/* forward declarations +/* forward declarations */ -struct _RDDFUNCS; +struct _RDDFUNCS; struct _AREA; diff --git a/harbour/source/compiler/harbour.y b/harbour/source/compiler/harbour.y index 1c72df65d8..809a43c2b5 100644 --- a/harbour/source/compiler/harbour.y +++ b/harbour/source/compiler/harbour.y @@ -434,33 +434,10 @@ static const char * _szReservedFun[] = { "YEAR" }; #define RESERVED_FUNCTIONS sizeof( _szReservedFun ) / sizeof( char * ) -/* function compares strings upto maximum 4 characters (used in bsearch) */ -/* Borland C 3.1 reports error when this forward declaration is used - * int sz_compare4( const void *, const void * ); - * - */ -/* Compare first 4 characters - * If they are the same then compare the whole name - * SECO() is not allowed because of Clipper function SECONDS() - * however SECO32() is a valid name. - */ -int EXTERNAL_LINKAGE sz_compare4( const void * pLookup, const void * pReserved ) -{ - int iCmp, iSlen; - iSlen = strlen( ( const char * ) pLookup ); - - iCmp = strncmp( ( const char * ) pLookup, * ( ( const char * * ) pReserved ), - ( iSlen && iSlen < 4 ) ? iSlen : 4 ); - if( iCmp == 0 ) - iCmp = strncmp( ( const char * ) pLookup, * ( ( const char * * ) pReserved ), - iSlen + 1); - return iCmp; -} - -#define RESERVED_FUNC( szName ) \ - bsearch( ( szName ), _szReservedFun, RESERVED_FUNCTIONS, sizeof( char * ), sz_compare4 ) +static char * reserved_name( char * ); +#define RESERVED_FUNC(szName) reserved_name( (szName) ) FILES files; FUNCTIONS functions, funcalls; @@ -2507,7 +2484,7 @@ void FunDef( char * szFunName, SYMBOLSCOPE cScope, int iType ) { PCOMSYMBOL pSym; PFUNCTION pFunc; - char * * pFunction; + char * szFunction; pFunc = GetFunction( szFunName ); if( pFunc ) @@ -2518,13 +2495,13 @@ void FunDef( char * szFunName, SYMBOLSCOPE cScope, int iType ) GenError( _szCErrors, 'E', ERR_FUNC_DUPL, szFunName, NULL ); } - pFunction = ( char * * ) RESERVED_FUNC( szFunName ); - if( pFunction && !( functions.iCount==0 && !_bStartProc ) ) + szFunction = RESERVED_FUNC( szFunName ); + if( szFunction && !( functions.iCount==0 && !_bStartProc ) ) { /* We are ignoring it when it is the name of PRG file and we are * not creating implicit starting procedure */ - GenError( _szCErrors, 'E', ERR_FUNC_RESERVED, *pFunction, szFunName ); + GenError( _szCErrors, 'E', ERR_FUNC_RESERVED, szFunction, szFunName ); } FixReturns(); /* fix all previous function returns offsets */ @@ -4681,14 +4658,14 @@ void PushDouble( double dNumber, BYTE bDec ) void PushFunCall( char * szFunName ) { - char * * pFunction; + char * szFunction; - pFunction = ( char * * ) RESERVED_FUNC( szFunName ); - if( pFunction ) + szFunction = RESERVED_FUNC( szFunName ); + if( szFunction ) { /* Abbreviated function name was used - change it for whole name */ - PushSymbol( yy_strdup( *pFunction ), 1 ); + PushSymbol( yy_strdup( szFunction ), 1 ); } else PushSymbol( szFunName, 1 ); @@ -4772,14 +4749,14 @@ void PushSymbol( char * szSymbolName, int iIsFunction ) if( iIsFunction ) { - char * * pName = ( char * * ) RESERVED_FUNC( szSymbolName ); + char * pName = RESERVED_FUNC( szSymbolName ); /* If it is reserved function name then we should truncate * the requested name. * We have to use passed szSymbolName so we can latter deallocate it * (pName points to static data) */ if( pName ) - szSymbolName[ strlen( *pName ) ] ='\0'; + szSymbolName[ strlen( pName ) ] ='\0'; } pSym = GetSymbol( szSymbolName, &wSym ); @@ -5954,6 +5931,31 @@ char * yy_strdup( char * p ) return pDup; } +/* checks if passed string is a reserved function name + */ +static char * reserved_name( char * szName ) +{ + WORD wNum = 0; + int iFound = 1; + + while( wNum < RESERVED_FUNCTIONS && iFound ) + { + /* Compare first 4 characters + * If they are the same then compare the whole name + * SECO() is not allowed because of Clipper function SECONDS() + * however SECO32() is a valid name. + */ + iFound = strncmp( szName, _szReservedFun[ wNum ], 4 ); + if( iFound == 0 ) + iFound = strncmp( szName, _szReservedFun[ wNum ], strlen( szName ) ); + ++wNum; + } + if( iFound ) + return NULL; + else + return (char *) _szReservedFun[ wNum - 1 ]; +} + #define SYM_NOLINK 0 /* Symbol does not have to be linked */ #define SYM_FUNC 1 /* Defined function */ diff --git a/harbour/source/rdd/dbcmd.c b/harbour/source/rdd/dbcmd.c index 6f0075175d..6c5aa7c0cb 100644 --- a/harbour/source/rdd/dbcmd.c +++ b/harbour/source/rdd/dbcmd.c @@ -639,7 +639,7 @@ int hb_rddGetCurrentWorkAreaNumber( void ) return uiCurrArea; } -void hb_rddSelectWorkAreaNumber( int iArea ) +BOOL hb_rddSelectWorkAreaNumber( int iArea ) { LPAREANODE pAreaNode; @@ -651,26 +651,29 @@ void hb_rddSelectWorkAreaNumber( int iArea ) if( ( ( AREAP ) pAreaNode->pArea )->uiArea == uiCurrArea ) { pCurrArea = pAreaNode; /* Select a valid WorkArea */ - return; + return SUCCESS; } pAreaNode = pAreaNode->pNext; } pCurrArea = 0; /* Selected WorkArea is closed */ + return FAILURE; } -void hb_rddSelectWorkAreaSymbol( PHB_SYMB pSymAlias ) +BOOL hb_rddSelectWorkAreaSymbol( PHB_SYMB pSymAlias ) { if( pSymAlias->pDynSym->hArea ) - hb_rddSelectWorkAreaNumber( pSymAlias->pDynSym->hArea ); + return hb_rddSelectWorkAreaNumber( pSymAlias->pDynSym->hArea ); else hb_errRT_BASE( EG_NOALIAS, 1002, 0, pSymAlias->szName ); + return FAILURE; } -void hb_rddSelectWorkAreaAlias( char * szName ) +BOOL hb_rddSelectWorkAreaAlias( char * szName ) { PHB_DYNS pSymArea; char * szAlias; WORD wLen; + BOOL bResult; wLen = strlen( szName ); szAlias = ( char * ) hb_xgrab( wLen + 1 ); @@ -678,14 +681,18 @@ void hb_rddSelectWorkAreaAlias( char * szName ) hb_strUpper( szAlias, wLen ); pSymArea = hb_dynsymFind( szAlias ); if( pSymArea && pSymArea->hArea ) - hb_rddSelectWorkAreaNumber( pSymArea->hArea ); + bResult = hb_rddSelectWorkAreaNumber( pSymArea->hArea ); else + { hb_errRT_BASE( EG_NOALIAS, 1002, 0, szAlias ); + bResult = FAILURE; + } hb_xfree( szAlias ); + return bResult; } -void hb_rddGetFieldValue( HB_ITEM_PTR pItem, PHB_SYMB pFieldSymbol ) +BOOL hb_rddGetFieldValue( HB_ITEM_PTR pItem, PHB_SYMB pFieldSymbol ) { LPFIELD pField; USHORT uiField; @@ -699,16 +706,17 @@ void hb_rddGetFieldValue( HB_ITEM_PTR pItem, PHB_SYMB pFieldSymbol ) if( ( PHB_DYNS ) pField->sym == pFieldSymbol->pDynSym ) { SELF_GETVALUE( ( AREAP ) pCurrArea->pArea, uiField, pItem ); - return; + return SUCCESS; } pField = pField->lpfNext; uiField++; } } hb_errRT_BASE( EG_NOVAR, 1003, 0, pFieldSymbol->szName ); + return FAILURE; } -void hb_rddPutFieldValue( HB_ITEM_PTR pItem, PHB_SYMB pFieldSymbol ) +BOOL hb_rddPutFieldValue( HB_ITEM_PTR pItem, PHB_SYMB pFieldSymbol ) { LPFIELD pField; USHORT uiField; @@ -722,13 +730,14 @@ void hb_rddPutFieldValue( HB_ITEM_PTR pItem, PHB_SYMB pFieldSymbol ) if( ( PHB_DYNS ) pField->sym == pFieldSymbol->pDynSym ) { SELF_PUTVALUE( ( AREAP ) pCurrArea->pArea, uiField, pItem ); - return; + return SUCCESS; } pField = pField->lpfNext; uiField++; } } hb_errRT_BASE( EG_NOVAR, 1003, 0, pFieldSymbol->szName ); + return FAILURE; } /* diff --git a/harbour/source/rtl/math.c b/harbour/source/rtl/math.c index e1230cd440..3a30f7f0fd 100644 --- a/harbour/source/rtl/math.c +++ b/harbour/source/rtl/math.c @@ -16,6 +16,48 @@ #include "itemapi.h" #include "errorapi.h" +static int internal_math_error = 0; + +#if defined( __WATCOMC__ ) +/* define harbour specific error handler for math errors + */ +int matherr( struct exception *err ) +{ + switch( err->type ) + { + case DOMAIN: + /* a domain error has occured, such as sqrt( -1 ) */ + internal_math_error = EG_ARG; + break; + case SING: + /* a singularity will result, such as pow( 0, -2 ) */ + internal_math_error = EG_ARG; + break; + case OVERFLOW: + /* an overflow will result, such as pow( 10, 100 ) */ + internal_math_error = EG_NUMOVERFLOW; + break; + case UNDERFLOW: + /* an underflow will result, such as pow( 10, -100 ) */ + internal_math_error = EG_NUMOVERFLOW; + break; + case TLOSS: + /* total loss of significance will result, such as exp( 1000 ) */ + internal_math_error = EG_NUMERR; + break; + case PLOSS: + /* partial loss of significance will result, such as sin( 10e70 ) */ + internal_math_error = EG_NUMERR; + break; + default: + internal_math_error = EG_NUMERR; + break; + } + err->retval = 0.0; + return 1; /* don't print any message and don't ser errno */ +} +#endif + HARBOUR HB_ABS( void ) { if( hb_pcount() == 1 ) @@ -74,7 +116,23 @@ HARBOUR HB_EXP( void ) if( hb_pcount() == 1 ) { if( ISNUM( 1 ) ) - hb_retnd( exp( hb_parnd( 1 ) ) ); + { + double dResult = exp( hb_parnd( 1 ) ); + + if( internal_math_error ) + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( internal_math_error, 1096, NULL, "EXP" ); + + internal_math_error = 0; + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } + else + hb_retnd( dResult ); + } else { PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1096, NULL, "EXP" ); @@ -126,13 +184,29 @@ HARBOUR HB_LOG( void ) { if( ISNUM( 1 ) ) { - double dNumber = hb_parnd( 1 ); +#if defined( __WATCOMC__ ) + double dResult = log( hb_parnd( 1 ) ); + if( internal_math_error ) + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( internal_math_error, 1095, NULL, "LOG" ); + internal_math_error = 0; + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } + else + hb_retnd( dResult ); +#else + double dNumber = hb_parnd( 1 ); if( dNumber <= 0.0 ) /* Indicate overflow if called with an invalid argument */ hb_retndlen( log( dNumber ), 99, -1 ); else hb_retnd( log( dNumber ) ); +#endif } else { @@ -379,12 +453,29 @@ HARBOUR HB_SQRT( void ) { if( ISNUM( 1 ) ) { +#if defined( __WATCOMC__ ) + double dResult = sqrt( hb_parnd( 1 ) ); + if( internal_math_error ) + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( internal_math_error, 1097, NULL, "SQRT" ); + + internal_math_error = 0; + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } + else + hb_retnd( dResult ); +#else double dNumber = hb_parnd( 1 ); if( dNumber > 0 ) hb_retnd( sqrt( dNumber ) ); else hb_retnd( 0 ); /* Clipper doesn't error! */ +#endif } else { diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index 0abaee4f00..8769c5221f 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -1972,6 +1972,7 @@ static void hb_vmPopAliasedField( PHB_SYMB pSym ) { PHB_ITEM pAlias = stack.pPos - 1; int iCurrArea = hb_rddGetCurrentWorkAreaNumber(); + BOOL bSuccess; switch( pAlias->type & ~IT_BYREF ) { @@ -1980,21 +1981,21 @@ static void hb_vmPopAliasedField( PHB_SYMB pSym ) * or it was saved on the stack using hb_vmPushAlias() * or was evaluated from an expression, (nWorkArea)->field */ - hb_rddSelectWorkAreaNumber( pAlias->item.asInteger.value ); + bSuccess = hb_rddSelectWorkAreaNumber( pAlias->item.asInteger.value ); pAlias->type = IT_NIL; break; case IT_SYMBOL: /* Alias was specified using alias identifier, for example: al->field */ - hb_rddSelectWorkAreaSymbol( pAlias->item.asSymbol.value ); + bSuccess = hb_rddSelectWorkAreaSymbol( pAlias->item.asSymbol.value ); pAlias->type = IT_NIL; break; case IT_STRING: /* Alias was evaluated from an expression, for example: (cVar)->field */ - hb_rddSelectWorkAreaAlias( pAlias->item.asString.value ); + bSuccess = hb_rddSelectWorkAreaAlias( pAlias->item.asString.value ); hb_itemClear( pAlias ); break; @@ -2004,7 +2005,8 @@ static void hb_vmPopAliasedField( PHB_SYMB pSym ) return; } - hb_rddPutFieldValue( stack.pPos - 2, pSym ); + if( bSuccess == SUCCESS ) + hb_rddPutFieldValue( stack.pPos - 2, pSym ); hb_rddSelectWorkAreaNumber( iCurrArea ); hb_stackPop(); /* field */ hb_stackPop(); /* alias */ @@ -2204,6 +2206,7 @@ static void hb_vmPushAliasedField( PHB_SYMB pSym ) { PHB_ITEM pAlias = stack.pPos - 1; int iCurrArea = hb_rddGetCurrentWorkAreaNumber(); + BOOL bSuccess; switch( pAlias->type & ~IT_BYREF ) { @@ -2212,33 +2215,35 @@ static void hb_vmPushAliasedField( PHB_SYMB pSym ) * or it was saved on the stack using hb_vmPushAlias() * or was evaluated from an expression, (nWorkArea)->field */ - hb_rddSelectWorkAreaNumber( pAlias->item.asInteger.value ); + bSuccess = hb_rddSelectWorkAreaNumber( pAlias->item.asInteger.value ); pAlias->type = IT_NIL; break; case IT_SYMBOL: /* Alias was specified using alias identifier, for example: al->field */ - hb_rddSelectWorkAreaSymbol( pAlias->item.asSymbol.value ); + bSuccess = hb_rddSelectWorkAreaSymbol( pAlias->item.asSymbol.value ); pAlias->type = IT_NIL; break; case IT_STRING: /* Alias was evaluated from an expression, for example: (cVar)->field */ - hb_rddSelectWorkAreaAlias( pAlias->item.asString.value ); + bSuccess = hb_rddSelectWorkAreaAlias( pAlias->item.asString.value ); hb_itemClear( pAlias ); break; default: -/* Clipper doesn't error in this case, just pass the failed value. hb_itemClear( pAlias ); +/* Clipper doesn't error in this case, just pass the failed value. hb_errRT_BASE( EG_BADALIAS, 9992, NULL, NULL ); */ return; } - hb_rddGetFieldValue( pAlias, pSym ); + if( bSuccess == SUCCESS ) + hb_rddGetFieldValue( pAlias, pSym ); + hb_rddSelectWorkAreaNumber( iCurrArea ); HB_DEBUG( "hb_vmPushAliasedField\n" );