From 01c7ba0a99936cf3857b53eb3e40f43f8932fb00 Mon Sep 17 00:00:00 2001 From: Ryszard Glab Date: Mon, 13 Sep 1999 13:44:20 +0000 Subject: [PATCH] ChangeLog 19990913-15:35 GMT+2 --- harbour/ChangeLog | 26 +++++++ harbour/include/ctoharb.h | 4 -- harbour/include/rddapi.h | 10 +-- harbour/source/rdd/dbcmd.c | 107 +++++++++++++++++++++++------ harbour/source/rtl/memvars.c | 88 ++++++++++++++++++++++-- harbour/source/vm/hvm.c | 71 ++++++++----------- harbour/tests/working/rtl_test.prg | 6 ++ 7 files changed, 234 insertions(+), 78 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 478935787a..a272cb4291 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,29 @@ +19990913-15:35 GMT+2 Ryszard Glab + + *source/rdd/dbcmd.c + * added retry possibility for error handling in field + assignment/access + * changed BOOL to ERRCODE for hb_rddSelect*() and + hb_rddPutFieldValue/hb_rddGetFieldValue + + *include/rddapi.h + * changed BOOL to ERRCODE for hb_rddSelect*() and + hb_rddPutFieldValue/hb_rddGetFieldValue + + *source/vm/hvm.c + * changed BOOL to ERRCODE for hb_rddSelect*() and + hb_rddPutFieldValue/hb_rddGetFieldValue + * memvar handling functions moved directly into main VM loop + + *include/ctoharb.h + * removed declaration of internal memvar functions used in VM + + *source/rtl/memvars.c + * added retry possibility for error handling in variable access + + *tests/working/rtl_test.prg + * added code to test __MVGET function (macro evaluation in Clipper) + 19990913-13:30 GMT+1 Victor Szel * source/compiler/harbour.y diff --git a/harbour/include/ctoharb.h b/harbour/include/ctoharb.h index aa5b91703c..6437630bd1 100644 --- a/harbour/include/ctoharb.h +++ b/harbour/include/ctoharb.h @@ -121,8 +121,6 @@ extern void hb_vmPushString( char * szText, ULONG length ); /* pushes a stri extern void hb_vmPushDate( LONG lDate ); /* pushes a long date onto the stack */ extern void hb_vmPushBlock( BYTE * pCode, PHB_SYMB pSymbols ); /* creates a codeblock */ extern void hb_vmPushSymbol( PHB_SYMB pSym ); /* pushes a function pointer onto the stack */ -extern void hb_vmPushMemvar( PHB_SYMB ); /* pushes a value of memvar variable */ -extern void hb_vmPushMemvarByRef( PHB_SYMB ); /* pushes a reference to a memvar variable */ extern void hb_vmPushLocal( SHORT iLocal ); /* pushes the containts of a local onto the stack */ extern void hb_vmPushLocalByRef( SHORT iLocal ); /* pushes a local by refrence onto the stack */ extern void hb_vmPushStatic( WORD wStatic ); /* pushes the containts of a static onto the stack */ @@ -133,9 +131,7 @@ extern long hb_vmPopDate( void ); /* pops the stack latest value and extern double hb_vmPopNumber( void ); /* pops the stack latest value and returns its numeric value */ extern double hb_vmPopDouble( WORD * ); /* pops the stack latest value and returns its double numeric format value */ extern BOOL hb_vmPopLogical( void ); /* pops the stack latest value and returns its logical value */ -extern void hb_vmPopParameter( PHB_SYMB, BYTE ); /* creates a PRIVATE variable and sets it with parameter's value */ extern void hb_vmPopLocal( SHORT wLocal ); /* pops the stack latest value onto a local */ -extern void hb_vmPopMemvar( PHB_SYMB ); /* pops a value of memvar variable */ extern void hb_vmPopStatic( WORD wStatic ); /* pops the stack latest value onto a static */ extern void hb_vmPopDefStat( WORD wStatic ); /* pops the stack latest value onto a static as default init */ diff --git a/harbour/include/rddapi.h b/harbour/include/rddapi.h index 378b8cf060..56ba2f9104 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 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 ERRCODE hb_rddSelectWorkAreaAlias( char * szAlias ); +extern ERRCODE hb_rddSelectWorkAreaNumber( int iArea ); +extern ERRCODE hb_rddSelectWorkAreaSymbol( PHB_SYMB pSymAlias ); +extern ERRCODE hb_rddGetFieldValue( HB_ITEM_PTR pItem, PHB_SYMB pFieldSymbol ); +extern ERRCODE hb_rddPutFieldValue( HB_ITEM_PTR pItem, PHB_SYMB pFieldSymbol ); extern void hb_rddShutDown( void ); diff --git a/harbour/source/rdd/dbcmd.c b/harbour/source/rdd/dbcmd.c index 0f143217ce..2f273f264a 100644 --- a/harbour/source/rdd/dbcmd.c +++ b/harbour/source/rdd/dbcmd.c @@ -118,6 +118,9 @@ static USHORT uiCurrArea = 1; /* Selectd area */ static LPRDDNODE pRddList = 0; /* Registered RDD's */ static BOOL bNetError = FALSE; /* Error on Networked environments */ +static ERRCODE hb_rddFieldPut( HB_ITEM_PTR, PHB_SYMB ); +static ERRCODE hb_rddFieldGet( HB_ITEM_PTR, PHB_SYMB ); + static LPAREANODE pWorkAreas = 0; /* WorkAreas */ static LPAREANODE pCurrArea = 0; /* Pointer to a selectd and valid area */ @@ -634,12 +637,16 @@ ERRCODE hb_rddInherit( PRDDFUNCS pTable, PRDDFUNCS pSubTable, PRDDFUNCS pSuperTa return SUCCESS; } +/* + * -- FUNCTIONS ACCESSED FROM VIRTUAL MACHINE -- + */ + int hb_rddGetCurrentWorkAreaNumber( void ) { return uiCurrArea; } -BOOL hb_rddSelectWorkAreaNumber( int iArea ) +ERRCODE hb_rddSelectWorkAreaNumber( int iArea ) { LPAREANODE pAreaNode; @@ -659,9 +666,9 @@ BOOL hb_rddSelectWorkAreaNumber( int iArea ) return FAILURE; } -BOOL hb_rddSelectWorkAreaSymbol( PHB_SYMB pSymAlias ) +ERRCODE hb_rddSelectWorkAreaSymbol( PHB_SYMB pSymAlias ) { - BOOL bResult; + ERRCODE bResult; if( pSymAlias->pDynSym->hArea ) bResult = hb_rddSelectWorkAreaNumber( pSymAlias->pDynSym->hArea ); @@ -692,11 +699,11 @@ BOOL hb_rddSelectWorkAreaSymbol( PHB_SYMB pSymAlias ) return bResult; } -BOOL hb_rddSelectWorkAreaAlias( char * szName ) +ERRCODE hb_rddSelectWorkAreaAlias( char * szName ) { PHB_DYNS pSymArea; WORD wLen; - BOOL bResult; + ERRCODE bResult; /* NOTE: szAlias have to be allocated on the stack because hb_errLaunch * doesn't return control to this function if QUIT action is requested */ @@ -739,31 +746,67 @@ BOOL hb_rddSelectWorkAreaAlias( char * szName ) return bResult; } -BOOL hb_rddGetFieldValue( HB_ITEM_PTR pItem, PHB_SYMB pFieldSymbol ) +ERRCODE hb_rddGetFieldValue( HB_ITEM_PTR pItem, PHB_SYMB pFieldSymbol ) { - LPFIELD pField; - USHORT uiField; + ERRCODE bSuccess = hb_rddFieldGet( pItem, pFieldSymbol ); - if( pCurrArea ) + if( bSuccess == FAILURE ) { - uiField = 1; - pField = ( ( AREAP ) pCurrArea->pArea )->lpFields; - while( pField ) + /* generate an error with retry possibility + * (user created error handler can make this field accessible) + */ + WORD wAction = E_RETRY; + HB_ITEM_PTR pError; + + pError = hb_errRT_New( ES_ERROR, NULL, EG_NOVAR, 1003, + NULL, pFieldSymbol->szName, 0, EF_CANRETRY ); + + while( wAction == E_RETRY ) { - if( ( PHB_DYNS ) pField->sym == pFieldSymbol->pDynSym ) + wAction = hb_errLaunch( pError ); + if( wAction == E_RETRY ) { - SELF_GETVALUE( ( AREAP ) pCurrArea->pArea, uiField, pItem ); - return SUCCESS; + bSuccess = hb_rddFieldGet( pItem, pFieldSymbol ); + if( bSuccess == SUCCESS ) + wAction = E_DEFAULT; } - pField = pField->lpfNext; - uiField++; } + hb_errRelease( pError ); } - hb_errRT_BASE( EG_NOVAR, 1003, 0, pFieldSymbol->szName ); - return FAILURE; + return bSuccess; } -BOOL hb_rddPutFieldValue( HB_ITEM_PTR pItem, PHB_SYMB pFieldSymbol ) +ERRCODE hb_rddPutFieldValue( HB_ITEM_PTR pItem, PHB_SYMB pFieldSymbol ) +{ + ERRCODE bSuccess = hb_rddFieldPut( pItem, pFieldSymbol ); + + if( bSuccess == FAILURE ) + { + /* generate an error with retry possibility + * (user created error handler can make this field accessible) + */ + WORD wAction = E_RETRY; + HB_ITEM_PTR pError; + + pError = hb_errRT_New( ES_ERROR, NULL, EG_NOVAR, 1003, + NULL, pFieldSymbol->szName, 0, EF_CANRETRY ); + + while( wAction == E_RETRY ) + { + wAction = hb_errLaunch( pError ); + if( wAction == E_RETRY ) + { + bSuccess = hb_rddFieldPut( pItem, pFieldSymbol ); + if( bSuccess == SUCCESS ) + wAction = E_DEFAULT; + } + } + hb_errRelease( pError ); + } + return bSuccess; +} + +static ERRCODE hb_rddFieldPut( HB_ITEM_PTR pItem, PHB_SYMB pFieldSymbol ) { LPFIELD pField; USHORT uiField; @@ -783,7 +826,29 @@ BOOL hb_rddPutFieldValue( HB_ITEM_PTR pItem, PHB_SYMB pFieldSymbol ) uiField++; } } - hb_errRT_BASE( EG_NOVAR, 1003, 0, pFieldSymbol->szName ); + return FAILURE; +} + +static ERRCODE hb_rddFieldGet( HB_ITEM_PTR pItem, PHB_SYMB pFieldSymbol ) +{ + LPFIELD pField; + USHORT uiField; + + if( pCurrArea ) + { + uiField = 1; + pField = ( ( AREAP ) pCurrArea->pArea )->lpFields; + while( pField ) + { + if( ( PHB_DYNS ) pField->sym == pFieldSymbol->pDynSym ) + { + SELF_GETVALUE( ( AREAP ) pCurrArea->pArea, uiField, pItem ); + return SUCCESS; + } + pField = pField->lpfNext; + uiField++; + } + } return FAILURE; } diff --git a/harbour/source/rtl/memvars.c b/harbour/source/rtl/memvars.c index 3a5c0390dc..4930d007ef 100644 --- a/harbour/source/rtl/memvars.c +++ b/harbour/source/rtl/memvars.c @@ -411,7 +411,36 @@ void hb_memvarGetValue( HB_ITEM_PTR pItem, PHB_SYMB pMemvarSymb ) hb_itemCopy( pItem, pGetItem ); } else /* variable is not initialized */ - hb_errRT_BASE( EG_NOVAR, 1003, NULL, pMemvarSymb->szName ); + { + /* Generate an error with retry possibility + * (user created error handler can create this variable) + */ + WORD wAction = E_RETRY; + HB_ITEM_PTR pError; + + pError = hb_errRT_New( ES_ERROR, NULL, EG_NOVAR, 1003, + NULL, pMemvarSymb->szName, 0, EF_CANRETRY ); + + while( wAction == E_RETRY ) + { + wAction = hb_errLaunch( pError ); + if( wAction == E_RETRY ) + { + if( pDyn->hMemvar ) + { + /* value is already created + */ + HB_ITEM_PTR pGetItem = &s_globalTable[ pDyn->hMemvar ].item; + if( IS_BYREF( pGetItem ) ) + hb_itemCopy( pItem, hb_itemUnRef( pGetItem ) ); + else + hb_itemCopy( pItem, pGetItem ); + wAction = E_DEFAULT; + } + } + } + hb_errRelease( pError ); + } } else hb_errRT_BASE( EG_NOVAR, 1003, NULL, pMemvarSymb->szName ); @@ -436,7 +465,35 @@ void hb_memvarGetRefer( HB_ITEM_PTR pItem, PHB_SYMB pMemvarSymb ) ++s_globalTable[ pDyn->hMemvar ].counter; } else - hb_errRT_BASE( EG_NOVAR, 1003, NULL, pMemvarSymb->szName ); + { + /* Generate an error with retry possibility + * (user created error handler can make this variable accessible) + */ + WORD wAction = E_RETRY; + HB_ITEM_PTR pError; + + pError = hb_errRT_New( ES_ERROR, NULL, EG_NOVAR, 1003, + NULL, pMemvarSymb->szName, 0, EF_CANRETRY ); + + while( wAction == E_RETRY ) + { + wAction = hb_errLaunch( pError ); + if( wAction == E_RETRY ) + { + if( pDyn->hMemvar ) + { + /* value is already created */ + pItem->type = IT_BYREF | IT_MEMVAR; + pItem->item.asMemvar.offset = 0; + pItem->item.asMemvar.value = pDyn->hMemvar; + pItem->item.asMemvar.itemsbase = &s_globalTable; + ++s_globalTable[ pDyn->hMemvar ].counter; + wAction = E_DEFAULT; + } + } + } + hb_errRelease( pError ); + } } else hb_errRT_BASE( EG_NOVAR, 1003, NULL, pMemvarSymb->szName ); @@ -1390,13 +1447,32 @@ HARBOUR HB___MVGET( void ) } else { - HB_ITEM_PTR pRetValue = hb_errRT_BASE_Subst( EG_NOVAR, 1003, NULL, pName->item.asString.value ); + /* Generate an error with retry possibility + * (user created error handler can create this variable) + */ + WORD wAction = E_RETRY; + HB_ITEM_PTR pError; - if( pRetValue ) + pError = hb_errRT_New( ES_ERROR, NULL, EG_NOVAR, 1003, + NULL, pName->item.asString.value, 0, EF_CANRETRY ); + + while( wAction == E_RETRY ) { - hb_itemReturn( pRetValue ); - hb_itemRelease( pRetValue ); + wAction = hb_errLaunch( pError ); + if( wAction == E_RETRY ) + { + pDynVar = hb_memvarFindSymbol( pName ); + if( pDynVar ) + { + HB_ITEM retValue; + hb_memvarGetValue( &retValue, pDynVar->pSymbol ); + hb_itemReturn( &retValue ); + hb_itemClear( &retValue ); + wAction =E_DEFAULT; + } + } } + hb_errRelease( pError ); } } else diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index 6766791c4a..437ba86f05 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -66,7 +66,7 @@ static void hb_vmPushAlias( void ); /* pushes the current workarea numb static void hb_vmPushAliasedField( PHB_SYMB ); /* pushes an aliased field on the eval stack */ static void hb_vmPushField( PHB_SYMB ); /* pushes an unaliased field on the eval stack */ static void hb_vmSwapAlias( void ); /* swaps items on the eval stack and pops the workarea number */ -static BOOL hb_vmSelectWorkarea( PHB_ITEM ); /* select the workarea using a given item or a substituted value */ +static ERRCODE hb_vmSelectWorkarea( PHB_ITEM ); /* select the workarea using a given item or a substituted value */ static void hb_vmDoInitStatics( void ); /* executes all _INITSTATICS functions */ static void hb_vmDoInitFunctions( int argc, char * argv[] ); /* executes all defined PRGs INIT functions */ @@ -431,7 +431,8 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols ) case HB_P_PARAMETER: wParams = pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 ); - hb_vmPopParameter( pSymbols + wParams, pCode[ w + 3 ] ); + hb_memvarSetValue( pSymbols + wParams, stack.pBase + 1 + pCode[ w + 3 ] ); + HB_DEBUG( "(hb_vmPopParameter)\n" ); w += 4; break; @@ -469,7 +470,10 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols ) case HB_P_POPMEMVAR: wParams = pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 ); - hb_vmPopMemvar( pSymbols + wParams ); + hb_stackDec(); + hb_memvarSetValue( pSymbols + wParams, stack.pPos ); + hb_itemClear( stack.pPos ); + HB_DEBUG( "(hb_vmPopMemvar)\n" ); w += 3; break; @@ -538,19 +542,24 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols ) case HB_P_PUSHMEMVAR: wParams = pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 ); - hb_vmPushMemvar( pSymbols + wParams ); + hb_memvarGetValue( stack.pPos, pSymbols + wParams ); + hb_stackPush(); + HB_DEBUG( "(hb_vmPushMemvar)\n" ); w += 3; break; case HB_P_PUSHMEMVARREF: wParams = pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 ); - hb_vmPushMemvarByRef( pSymbols + wParams ); + hb_memvarGetRefer( stack.pPos, pSymbols + wParams ); + hb_stackPush(); + HB_DEBUG( "(hb_vmPushMemvarRef)\n" ); w += 3; break; case HB_P_PUSHNIL: stack.pPos->type = IT_NIL; hb_stackPush(); + HB_DEBUG( "(hb_vmPushNil)\n" ); w++; break; @@ -1990,6 +1999,9 @@ double hb_vmPopDouble( WORD *pwDec ) return dNumber; } +/* Pops a value from the eval stack and uses it to set a new value + * of the given field + */ static void hb_vmPopField( PHB_SYMB pSym ) { hb_rddPutFieldValue( stack.pPos - 1, pSym ); @@ -2039,15 +2051,6 @@ BOOL hb_vmPopLogical( void ) } } -void hb_vmPopMemvar( PHB_SYMB pSym ) -{ - hb_stackDec(); - hb_memvarSetValue( pSym, stack.pPos ); - hb_itemClear( stack.pPos ); - - HB_DEBUG( "hb_vmPopMemvar\n" ); -} - double hb_vmPopNumber( void ) { PHB_ITEM pItem = stack.pPos - 1; @@ -2081,13 +2084,6 @@ double hb_vmPopNumber( void ) return dNumber; } -void hb_vmPopParameter( PHB_SYMB pSym, BYTE bParam ) -{ - hb_memvarSetValue( pSym, stack.pBase + 1 + bParam ); - - HB_DEBUG( "hb_vmPopParameter\n" ); -} - void hb_vmPopStatic( WORD wStatic ) { PHB_ITEM pStatic; @@ -2152,6 +2148,8 @@ static void hb_vmPushAliasedField( PHB_SYMB pSym ) PHB_ITEM pAlias = stack.pPos - 1; int iCurrArea = hb_rddGetCurrentWorkAreaNumber(); + /* NOTE: hb_vmSelecWorkarea clears passed item + */ if( hb_vmSelectWorkarea( pAlias ) == SUCCESS ) hb_rddGetFieldValue( pAlias, pSym ); @@ -2169,6 +2167,8 @@ void hb_vmPushLogical( BOOL bValue ) HB_DEBUG( "hb_vmPushLogical\n" ); } +/* It pushes the current value of the given field onto the eval stack + */ static void hb_vmPushField( PHB_SYMB pSym ) { hb_rddGetFieldValue( stack.pPos, pSym ); @@ -2213,22 +2213,6 @@ void hb_vmPushLocalByRef( SHORT iLocal ) HB_DEBUG2( "hb_vmPushLocalByRef %i\n", iLocal ); } -void hb_vmPushMemvar( PHB_SYMB pSym ) -{ - hb_memvarGetValue( stack.pPos, pSym ); - hb_stackPush(); - - HB_DEBUG( "hb_vmPushMemvar\n" ); -} - -void hb_vmPushMemvarByRef( PHB_SYMB pSym ) -{ - hb_memvarGetRefer( stack.pPos, pSym ); - hb_stackPush(); - - HB_DEBUG( "hb_vmPushMemvar\n" ); -} - void hb_vmPushNil( void ) { stack.pPos->type = IT_NIL; @@ -2559,10 +2543,13 @@ void hb_vmStatics( PHB_SYMB pSym ) /* initializes the global aStatics array or r HB_DEBUG2( "Statics %li\n", hb_arrayLen( &aStatics ) ); } -static BOOL hb_vmSelectWorkarea( PHB_ITEM pAlias ) +static ERRCODE hb_vmSelectWorkarea( PHB_ITEM pAlias ) { - BOOL bSuccess = SUCCESS; + ERRCODE bSuccess = SUCCESS; + /* NOTE: Clipper doesn't generate an error if an workarea specified + * as numeric value cannot be selected + */ switch( pAlias->type & ~IT_BYREF ) { case IT_INTEGER: @@ -2570,21 +2557,21 @@ static BOOL hb_vmSelectWorkarea( PHB_ITEM pAlias ) * or it was saved on the stack using hb_vmPushAlias() * or was evaluated from an expression, (nWorkArea)->field */ - bSuccess = hb_rddSelectWorkAreaNumber( pAlias->item.asInteger.value ); + hb_rddSelectWorkAreaNumber( pAlias->item.asInteger.value ); pAlias->type = IT_NIL; break; case IT_LONG: /* Alias was evaluated from an expression, (nWorkArea)->field */ - bSuccess = hb_rddSelectWorkAreaNumber( pAlias->item.asLong.value ); + hb_rddSelectWorkAreaNumber( pAlias->item.asLong.value ); pAlias->type = IT_NIL; break; case IT_DOUBLE: /* Alias was evaluated from an expression, (nWorkArea)->field */ - bSuccess = hb_rddSelectWorkAreaNumber( pAlias->item.asDouble.value ); + hb_rddSelectWorkAreaNumber( pAlias->item.asDouble.value ); pAlias->type = IT_NIL; break; diff --git a/harbour/tests/working/rtl_test.prg b/harbour/tests/working/rtl_test.prg index e6a9de3b47..49d06dba71 100644 --- a/harbour/tests/working/rtl_test.prg +++ b/harbour/tests/working/rtl_test.prg @@ -493,6 +493,12 @@ STATIC FUNCTION Main_HVM() TEST_LINE( scString-- , "E BASE 1087 Argument error -- F:S" ) TEST_LINE( mxNotHere , "E BASE 1003 Variable does not exist MXNOTHERE F:R" ) +#ifdef __HARBOUR__ + TEST_LINE( __MVGET("MXUNDECL") , "E BASE 1003 Variable does not exist MXUNDECL F:R" ) +#else + mxNotHere ="MXUNDECL" + TEST_LINE( &mxNotHere. , "E BASE 1003 Variable does not exist MXUNDECL F:R" ) +#endif TEST_LINE( saArray[ 0 ] , "E BASE 1132 Bound error array access " ) TEST_LINE( saArray[ 0 ] := 1 , "E BASE 1133 Bound error array assign " )