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

ChangeLog 19990911-12:45

Browse Source
This commit is contained in:
Ryszard Glab
1999-09-11 10:54:40 +00:00
parent e713e45e0b
commit 4f4e69a873
6 changed files with 189 additions and 63 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
harbour/ChangeLog
View File

@@ -1,3 +1,22 @@
19990911-12:45 GMT+2 Ryszard Glab <rglab@imid.med.pl>
*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 <info@szelvesz.hu>
* contrib/odbc/odbc.c
include/classes.ch

14
harbour/include/rddapi.h
View File

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

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

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

29
harbour/source/rdd/dbcmd.c
View File

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

95
harbour/source/rtl/math.c
View File

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

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

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