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

ChangeLog 19990913-15:35 GMT+2

Browse Source
This commit is contained in:
Ryszard Glab
1999-09-13 13:44:20 +00:00
parent 5391b99e55
commit 01c7ba0a99
7 changed files with 234 additions and 78 deletions
Download Patch File Download Diff File Expand all files Collapse all files

26
harbour/ChangeLog
View File

@@ -1,3 +1,29 @@
19990913-15:35 GMT+2 Ryszard Glab <rglab@imid.med.pl>
*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 <info@szelvesz.hu>
* source/compiler/harbour.y

4
harbour/include/ctoharb.h
View File

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

10
harbour/include/rddapi.h
View File

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

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

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

88
harbour/source/rtl/memvars.c
View File

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

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

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

6
harbour/tests/working/rtl_test.prg
View File

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