From 4262bd7cd934d8fabf158651cb276b293add1988 Mon Sep 17 00:00:00 2001 From: Ryszard Glab Date: Wed, 19 Jan 2000 11:52:45 +0000 Subject: [PATCH] ChangeLog 20000117-13:05 GMT+1 --- harbour/ChangeLog | 47 ++++++ harbour/doc/funclist.txt | 2 +- harbour/include/ctoharb.h | 6 +- harbour/include/errorapi.h | 18 +++ harbour/include/extend.h | 4 +- harbour/include/macro.h | 22 ++- harbour/source/macro/macro.c | 224 ++++++++++++++++++++++++---- harbour/source/macro/macro.y | 15 +- harbour/source/rdd/dbfcdx/dbfcdx1.c | 2 - harbour/source/rtl/errorapi.c | 71 +++++++-- harbour/source/rtl/itemapi.c | 7 +- harbour/source/rtl/type.c | 92 ++++++++++-- harbour/source/rtl/valtype.c | 83 ++++++----- harbour/source/vm/hvm.c | 15 ++ 14 files changed, 500 insertions(+), 108 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 34a799e0f8..382bc12eab 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,50 @@ +20000119-13:05 GMT+1 Ryszard Glab + + *source/macro/macro.y + * fixed GPF when IIF()/IF() was used in macro expression + * support for TYPE() function was added + + *include/macro.h + *source/macro/macro.c + * support for TYPE() function was added + * memory allocated for macro evaluation is properly released + when a runtime error occurs during evaluation + + *source/rtl/type.c + * full implementation of TYPE() function was added + + *include/extend.h + * new declaration for hb_macroGetType - called from TYPE() + * new declaration for hb_valtypeGet shared by VALTYPE and TYPE + + *source/rtl/valtype.c + * new function hb_valtypeGet() used internally in Harbour + + *source/rtl/errorapi.c + *include/errorapi.h + * new structure HB_ERROR_INFO for catching errors at C level + * new function hb_errorHandler() that sets/gets low-level + error handler. + + *include/ctoharb.h + *source/vm/hvm.c + * added HB_ENDPROC_REQUEST and hb_vmRequestEndProc() which are used + to request immediately return from currently evaluated pcode buffer. + This is used to stop processing of macro compiled code. + + *source/rtl/itemapi.c + * if parameter passed to hb_itemNew is not NULL then it is used to + initialize the new item (in other words it creates a copy of + passed item) + + *source/rdd/rddcdx/dbfcdx1.c + * The macro structure is now self deallocating if hb_macroDelete() + is called - it must not call hb_xfree() after hb_macroDelete() + was used. + + *doc/funclist.txt + * marked TYPE() as Ready :) + 2000-01-19 08:28 GMT+1 Antonio Linares * source/debug/debugger.prg + fixed and improved to use Class TDbMenuItem METHOD Display diff --git a/harbour/doc/funclist.txt b/harbour/doc/funclist.txt index ab2f1f8ccc..edfede4842 100644 --- a/harbour/doc/funclist.txt +++ b/harbour/doc/funclist.txt @@ -246,7 +246,7 @@ SUBSTR ;R; TIME ;R; TONE ;S; TRANSFORM ;R; -TYPE ;N; +TYPE ;R; UPDATED ;N; UPPER ;R; USED ;R; diff --git a/harbour/include/ctoharb.h b/harbour/include/ctoharb.h index 43ccacf486..456367cbc5 100644 --- a/harbour/include/ctoharb.h +++ b/harbour/include/ctoharb.h @@ -49,14 +49,16 @@ extern void hb_vmSymbolInit_RT( void ); /* initialization of runtime suppor /* Harbour virtual machine escaping API */ extern void hb_vmRequestQuit( void ); +extern void hb_vmRequestEndProc( void ); extern void hb_vmRequestCancel( void ); extern void hb_vmRequestBreak( PHB_ITEM pItem ); extern USHORT hb_vmRequestQuery( void ); extern void hb_vmQuit( void ); /* Immediately quits the virtual machine */ /* Return values of hb_vmRequestQuery() */ -#define HB_QUIT_REQUESTED 1 /* immediately quit the application */ -#define HB_BREAK_REQUESTED 2 /* break to nearest RECOVER/END sequence */ +#define HB_QUIT_REQUESTED 1 /* immediately quit the application */ +#define HB_BREAK_REQUESTED 2 /* break to nearest RECOVER/END sequence */ +#define HB_ENDPROC_REQUESTED 4 /* immediately return from procedure (error handler in macro evaluation) */ /* Public PCode functions */ diff --git a/harbour/include/errorapi.h b/harbour/include/errorapi.h index 3f320f160f..90653dba70 100644 --- a/harbour/include/errorapi.h +++ b/harbour/include/errorapi.h @@ -133,4 +133,22 @@ extern USHORT hb_errRT_TOOLS ( ULONG ulGenCode, ULONG ulSubCode, char extern void hb_errInternal ( ULONG ulIntCode, char * szText, char * szPar1, char * szPar2 ); +/* Low-level error handling */ +struct HB_ERROR_INFO_; /* forward declaration */ +#define HB_ERROR_HANDLE( hbfunc ) HB_ITEM_PTR hbfunc( struct HB_ERROR_INFO_ * ErrorInfo ) +typedef HB_ERROR_HANDLE( HB_ERROR_HANDLER ); +typedef HB_ERROR_HANDLER *HB_ERROR_HANDLER_PTR; + +typedef struct HB_ERROR_INFO_ +{ + HB_ERROR_HANDLER_PTR Func; + HB_ITEM_PTR Error; + void * Cargo; + struct HB_ERROR_INFO_ *Previous; + HB_ITEM_PTR ErrorBlock; +} HB_ERROR_INFO, *HB_ERROR_INFO_PTR; + +/* set/get current error handler */ +extern HB_ERROR_INFO_PTR hb_errorHandler( HB_ERROR_INFO_PTR ); + #endif /* HB_ERRORAPI_H_ */ diff --git a/harbour/include/extend.h b/harbour/include/extend.h index 2a6ba9de6b..f178ac4470 100644 --- a/harbour/include/extend.h +++ b/harbour/include/extend.h @@ -451,7 +451,6 @@ typedef struct HB_MACRO_ /* a macro compiled pcode container */ void * pParseInfo; /* data needed by the parser - it should be 'void *' to allow different implementation of macr compiler */ BOOL bName10; /* are we limiting identifier names to 10 chars ? */ BOOL bShortCuts; /* are we using logical shorcuts (in OR/AND) */ - PHB_SYMB pSymbols; /* local symbol table */ } HB_MACRO, * HB_MACRO_PTR; extern void hb_macroGetValue( HB_ITEM_PTR ); @@ -465,9 +464,12 @@ extern char * hb_macroTextSubst( char *, ULONG * ); extern BOOL hb_macroIsIdent( char * ); extern void hb_macroPopAliasedValue( HB_ITEM_PTR, HB_ITEM_PTR ); extern void hb_macroPushAliasedValue( HB_ITEM_PTR, HB_ITEM_PTR ); +extern char * hb_macroGetType( HB_ITEM_PTR ); /* misc */ extern char * hb_version( USHORT uiMode ); +extern char * hb_valtypeGet( HB_ITEM_PTR ); + /* Please leave these at the bottom of this file */ diff --git a/harbour/include/macro.h b/harbour/include/macro.h index 2b59503959..58fb09dc54 100644 --- a/harbour/include/macro.h +++ b/harbour/include/macro.h @@ -56,12 +56,26 @@ #include "errorapi.h" #include "expropt.h" +/* flags for compilation process + */ +#define HB_MACRO_GEN_PUSH 1 /* generate PUSH pcodes */ +#define HB_MACRO_GEN_POP 2 /* generate POP pcodes */ +#define HB_MACRO_GEN_ALIASED 4 /* force aliased variable */ +#define HB_MACRO_GEN_TYPE 8 /* check the type of expression (from TYPE() function) */ +#define HB_MACRO_DEALLOCATE 128 /* macro structure is allocated on the heap */ + +/* values returned from compilation process + */ #define HB_MACRO_OK 0 /* macro compiled successfully */ #define HB_MACRO_FAILURE 1 /* syntax error */ + +/* additional status of compilation + */ +#define HB_MACRO_CONT 1 /* everything is OK so far */ #define HB_MACRO_TOO_COMPLEX 2 /* compiled expression is too complex */ -#define HB_MACRO_GEN_PUSH 4 /* generate PUSH pcodes */ -#define HB_MACRO_GEN_POP 8 /* generate POP pcodes */ -#define HB_MACRO_GEN_ALIASED 16 /* force aliased variable */ +#define HB_MACRO_UDF 4 /* code uses UDF function (info used by TYPE function) */ +#define HB_MACRO_UNKN_SYM 8 /* requested symbol was not found in runtime symbol table */ + /* Global functions @@ -73,6 +87,8 @@ void hb_compGenPCode1( BYTE, HB_MACRO_DECL ); void hb_compGenPCode3( BYTE, BYTE, BYTE, HB_MACRO_DECL ); void hb_compGenPCodeN( BYTE * pBuffer, ULONG ulSize, HB_MACRO_DECL ); +void hb_compGenJumpHere( ULONG, HB_MACRO_DECL ); + /* Size of pcode buffer incrementation */ #define HB_PCODE_SIZE 512 diff --git a/harbour/source/macro/macro.c b/harbour/source/macro/macro.c index 1e97ee931d..9e627b8745 100644 --- a/harbour/source/macro/macro.c +++ b/harbour/source/macro/macro.c @@ -57,7 +57,7 @@ static void hb_macroUseAliased( HB_ITEM_PTR, HB_ITEM_PTR, int ); * 'iFlag' - specifies if compiled code should generate pcodes either for push * operation (for example: var :=¯o) or for pop operation (¯o :=var) */ -static int hb_macroParse( HB_MACRO_PTR pMacro, char * szString, int iFlag ) +static int hb_macroParse( HB_MACRO_PTR pMacro, char * szString ) { /* initialize the input buffer - it will be scanned by lex */ pMacro->string = szString; @@ -75,11 +75,6 @@ static int hb_macroParse( HB_MACRO_PTR pMacro, char * szString, int iFlag ) HB_TRACE(HB_TR_DEBUG, ("hb_macroParse.(%p, %s, %i)", pMacro, szString, iFlag)); pMacro->pCodeInfo->pCode = ( BYTE * ) hb_xgrab( HB_PCODE_SIZE ); - /* We have to specify if we want either a push or a pop operation because - * we are using different pcodes for these operations - */ - pMacro->Flags = iFlag; - return hb_compParse( pMacro ); } @@ -95,6 +90,8 @@ void hb_macroDelete( HB_MACRO_PTR pMacro ) hb_xfree( (void *) pMacro->pCodeInfo->pCode ); hb_xfree( (void *) pMacro->pCodeInfo ); + if( pMacro->Flags & HB_MACRO_DEALLOCATE ) + hb_xfree( pMacro ); } /* checks if a correct ITEM was passed from the virtual machine eval stack @@ -121,6 +118,36 @@ static BOOL hb_macroCheckParam( HB_ITEM_PTR pItem ) return bValid; } +/* It handles an error generated during macro evaluation + */ +static HB_ERROR_HANDLE( hb_macroErrorEvaluation ) +{ + HB_ITEM_PTR pResult = hb_itemDo( ErrorInfo->ErrorBlock, 1, ErrorInfo->Error ); + + /* In a special case when QUIT is requested then there is no return + * to code where macro evaluation was called. We have to + * release all used memory here. + */ + if( hb_vmRequestQuery() == HB_QUIT_REQUESTED ) + hb_macroDelete( ( HB_MACRO_PTR ) ErrorInfo->Cargo ); + + return pResult; +} + +/* It handles an error generated during checking of expression type + */ +static HB_ERROR_HANDLE( hb_macroErrorType ) +{ + HB_MACRO_PTR pMacro = ( HB_MACRO_PTR ) ErrorInfo->Cargo; + + pMacro->status &= ~HB_MACRO_CONT; + /* ignore rest of compiled code + */ + hb_vmRequestEndProc(); + return NULL; /* ignore this error */ +} + + /* Executes pcode compiled by macro compiler * * pMacro is a pointer to HB_MACRO structure created by macro compiler @@ -133,6 +160,22 @@ void hb_macroRun( HB_MACRO_PTR pMacro ) hb_vmExecute( pMacro->pCodeInfo->pCode, NULL ); } +/* evaluate a macro-cmpiled code and discard it + */ +static void hb_macroEvaluate( HB_MACRO_PTR pMacro ) +{ + HB_ERROR_INFO struErr; + HB_ERROR_INFO_PTR pOld; + + struErr.Func = hb_macroErrorEvaluation; + struErr.Cargo = ( void * ) pMacro; + pOld = hb_errorHandler( &struErr ); + hb_macroRun( pMacro ); + hb_errorHandler( pOld ); + hb_macroDelete( pMacro ); +} + + static void hb_macroSyntaxError( HB_MACRO_PTR pMacro ) { HB_ITEM_PTR pResult; @@ -355,15 +398,15 @@ void hb_macroGetValue( HB_ITEM_PTR pItem ) int iStatus; char * szString = pItem->item.asString.value; + struMacro.Flags = HB_MACRO_GEN_PUSH; struMacro.bShortCuts = hb_comp_bShortCuts; struMacro.bName10 = hb_comp_bUseName10; - iStatus = hb_macroParse( &struMacro, szString, HB_MACRO_GEN_PUSH ); + iStatus = hb_macroParse( &struMacro, szString ); hb_stackPop(); /* remove compiled string */ - if( iStatus == HB_MACRO_OK && struMacro.status == HB_MACRO_OK ) + if( iStatus == HB_MACRO_OK && ( struMacro.status & HB_MACRO_CONT ) ) { - hb_macroRun( &struMacro ); - hb_macroDelete( &struMacro ); + hb_macroEvaluate( &struMacro ); } else hb_macroSyntaxError( &struMacro ); @@ -385,15 +428,15 @@ void hb_macroSetValue( HB_ITEM_PTR pItem ) HB_MACRO struMacro; int iStatus; + struMacro.Flags = HB_MACRO_GEN_POP; struMacro.bShortCuts = hb_comp_bShortCuts; struMacro.bName10 = hb_comp_bUseName10; - iStatus = hb_macroParse( &struMacro, szString, HB_MACRO_GEN_POP ); + iStatus = hb_macroParse( &struMacro, szString ); hb_stackPop(); /* remove compiled string */ - if( iStatus == HB_MACRO_OK && struMacro.status == HB_MACRO_OK ) + if( iStatus == HB_MACRO_OK && ( struMacro.status & HB_MACRO_CONT ) ) { - hb_macroRun( &struMacro ); - hb_macroDelete( &struMacro ); + hb_macroEvaluate( &struMacro ); } else hb_macroSyntaxError( &struMacro ); @@ -454,19 +497,19 @@ static void hb_macroUseAliased( HB_ITEM_PTR pAlias, HB_ITEM_PTR pVar, int iFlag memcpy( szString + pAlias->item.asString.length + 2, pVar->item.asString.value, pVar->item.asString.length ); szString[ pAlias->item.asString.length + 2 + pVar->item.asString.length ] = '\0'; + struMacro.Flags = iFlag; struMacro.bShortCuts = hb_comp_bShortCuts; struMacro.bName10 = hb_comp_bUseName10; - iStatus = hb_macroParse( &struMacro, szString, iFlag ); + iStatus = hb_macroParse( &struMacro, szString ); hb_xfree( szString ); struMacro.string = NULL; hb_stackPop(); /* remove compiled variable name */ hb_stackPop(); /* remove compiled alias */ - if( iStatus == HB_MACRO_OK && struMacro.status == HB_MACRO_OK ) + if( iStatus == HB_MACRO_OK && ( struMacro.status & HB_MACRO_CONT ) ) { - hb_macroRun( &struMacro ); - hb_macroDelete( &struMacro ); + hb_macroEvaluate( &struMacro ); } else hb_macroSyntaxError( &struMacro ); @@ -480,16 +523,16 @@ static void hb_macroUseAliased( HB_ITEM_PTR pAlias, HB_ITEM_PTR pVar, int iFlag int iStatus; char * szString = pVar->item.asString.value; + struMacro.Flags = iFlag | HB_MACRO_GEN_ALIASED; struMacro.bShortCuts = hb_comp_bShortCuts; struMacro.bName10 = hb_comp_bUseName10; - iStatus = hb_macroParse( &struMacro, szString, iFlag | HB_MACRO_GEN_ALIASED ); + iStatus = hb_macroParse( &struMacro, szString ); hb_stackPop(); /* remove compiled string */ - if( iStatus == HB_MACRO_OK && struMacro.status == HB_MACRO_OK ) + if( iStatus == HB_MACRO_OK && ( struMacro.status & HB_MACRO_CONT ) ) { - hb_macroRun( &struMacro ); - hb_macroDelete( &struMacro ); + hb_macroEvaluate( &struMacro ); } else hb_macroSyntaxError( &struMacro ); @@ -508,10 +551,11 @@ HB_MACRO_PTR hb_macroCompile( char * szString ) HB_TRACE(HB_TR_DEBUG, ("hb_macroCompile(%s)", szString)); pMacro = ( HB_MACRO_PTR ) hb_xgrab( sizeof( HB_MACRO ) ); + pMacro->Flags = HB_MACRO_DEALLOCATE | HB_MACRO_GEN_PUSH; pMacro->bShortCuts = hb_comp_bShortCuts; pMacro->bName10 = hb_comp_bUseName10; - iStatus = hb_macroParse( pMacro, szString, HB_P_MACROPUSH ); - if( ! ( iStatus == HB_MACRO_OK && pMacro->status == HB_MACRO_OK ) ) + iStatus = hb_macroParse( pMacro, szString ); + if( ! ( iStatus == HB_MACRO_OK && ( pMacro->status & HB_MACRO_CONT ) ) ) { hb_macroDelete( pMacro ); hb_xfree( pMacro ); @@ -592,6 +636,86 @@ void hb_macroTextValue( HB_ITEM_PTR pItem ) } } +char * hb_macroGetType( HB_ITEM_PTR pItem ) +{ + char * szType; + + HB_TRACE(HB_TR_DEBUG, ("hb_macroGetType(%p)", pItem)); + + if( hb_macroCheckParam( pItem ) ) + { + HB_MACRO struMacro; + int iStatus; + char * szString = pItem->item.asString.value; + + struMacro.Flags = HB_MACRO_GEN_PUSH | HB_MACRO_GEN_TYPE; + struMacro.bShortCuts = hb_comp_bShortCuts; + struMacro.bName10 = hb_comp_bUseName10; + iStatus = hb_macroParse( &struMacro, szString ); + + if( iStatus == HB_MACRO_OK ) + { + /* passed string was successfully compiled + */ + if( struMacro.status & HB_MACRO_UNKN_SYM ) + { + /* request for a symbol that is not in a symbol table + */ + szType = "U"; + } + else if( struMacro.status & HB_MACRO_UDF ) + { + szType = "UI"; /* UDF function was used - cannot determine a type */ + } + else if( struMacro.status & HB_MACRO_CONT ) + { + /* OK - the pcode was generated and it can be evaluated + */ + HB_ERROR_INFO struErr; + HB_ERROR_INFO_PTR pOld; + + /* Set our temporary error handler. We do not need any error + * messages here - we need to know only if evaluation was + * successfull. If evaluation was successfull then the data type + * of expression can be determined. + */ + struErr.Func = hb_macroErrorType; + struErr.Cargo = ( void * ) &struMacro; + pOld = hb_errorHandler( &struErr ); + hb_macroRun( &struMacro ); + hb_errorHandler( pOld ); + + if( struMacro.status & HB_MACRO_CONT ) + { + /* Evaluation was successfull + * Now the value of expression is placed on the eval stack - + * check its type and pop it from the stack + */ + szType = hb_valtypeGet( hb_stack.pPos - 1 ); + hb_stackPop(); + } + else + { + /* something unpleasant happened during macro evaluation */ + szType = "UE"; + } + } + else + { + szType = "UE"; + } + } + else + szType = "UE"; /* syntax error during compilation */ + + hb_macroDelete( &struMacro ); + } + else + szType = "U"; + + return szType; +} + /* ************************************************************************* */ @@ -682,9 +806,28 @@ void hb_compMemvarGenPCode( BYTE bPCode, char * szVarName, HB_MACRO_DECL ) { HB_DYNS_PTR pSym; - /* Find the address of passed symbol - create the symbol if doesn't exist - */ - pSym = hb_dynsymGet( szVarName ); + if( HB_MACRO_DATA->Flags & HB_MACRO_GEN_TYPE ) + { + /* we are determining the type of expression (called from TYPE() function) + * then we shouldn't create the requested variable if it doesn't exist + */ + pSym = hb_dynsymFind( szVarName ); + if( ! pSym ) + { + HB_MACRO_DATA->status |= HB_MACRO_UNKN_SYM; + HB_MACRO_DATA->status &= ~HB_MACRO_CONT; /* don't run this pcode */ + /* + * NOTE: the compiled pcode will be not executed then we can ignore + * NULL value for pSym + */ + } + } + else + { + /* Find the address of passed symbol - create the symbol if doesn't exist + */ + pSym = hb_dynsymGet( szVarName ); + } hb_compGenPCode1( bPCode, HB_MACRO_PARAM ); hb_compGenPCodeN( ( BYTE * )( &pSym ), sizeof( pSym ), HB_MACRO_PARAM ); } @@ -694,7 +837,24 @@ void hb_compGenPushSymbol( char * szSymbolName, HB_MACRO_DECL ) { HB_DYNS_PTR pSym; - pSym = hb_dynsymGet( szSymbolName ); + if( HB_MACRO_DATA->Flags & HB_MACRO_GEN_TYPE ) + { + /* we are determining the type of expression (called from TYPE() function) + */ + pSym = hb_dynsymFind( szSymbolName ); + if( ! pSym ) + { + HB_MACRO_DATA->status |= HB_MACRO_UNKN_SYM; + HB_MACRO_DATA->status &= ~HB_MACRO_CONT; /* don't run this pcode */ + /* + * NOTE: the compiled pcode will be not executed then we can ignore + * NULL value for pSym + */ + } + } + else + pSym = hb_dynsymGet( szSymbolName ); + hb_compGenPCode1( HB_P_MPUSHSYM, HB_MACRO_PARAM ); hb_compGenPCodeN( ( BYTE * ) &pSym, sizeof( pSym ), HB_MACRO_PARAM ); } @@ -834,7 +994,7 @@ void hb_compGenPushVar( char * szVarName, HB_MACRO_DECL ) else { /* NOTE: In clipper all undeclared variables are assumed MEMVAR if - * they are popped however there is nno such assumption if avariable + * they are popped however there is no such assumption if a variable * is pushed on the eval stack */ hb_compMemvarGenPCode( HB_P_MPUSHVARIABLE, szVarName, HB_MACRO_PARAM ); @@ -944,7 +1104,10 @@ void hb_compGenPushFunCall( char * szFunName, HB_MACRO_DECL ) hb_compGenPushSymbol( szFunction, HB_MACRO_PARAM ); } else + { + HB_MACRO_DATA->status |= HB_MACRO_UDF; /* this is used in hb_macroGetType */ hb_compGenPushSymbol( szFunName, HB_MACRO_PARAM ); + } } /* generates the pcode to push a string on the virtual machine stack */ @@ -996,7 +1159,8 @@ void hb_compGenPCodeN( BYTE * pBuffer, ULONG ulSize, HB_MACRO_DECL ) void hb_macroError( int iError, HB_MACRO_DECL ) { - HB_MACRO_DATA->status = iError; + HB_MACRO_DATA->status |= iError; + HB_MACRO_DATA->status &= ~HB_MACRO_CONT; /* clear CONT bit */ } /* diff --git a/harbour/source/macro/macro.y b/harbour/source/macro/macro.y index fc400bb3d8..d4a65faf36 100644 --- a/harbour/source/macro/macro.y +++ b/harbour/source/macro/macro.y @@ -78,7 +78,7 @@ extern void yyerror( char * ); /* parsing error management function */ /* Standard checking for valid expression creation */ #define HB_MACRO_CHECK( pExpr ) \ - if( HB_MACRO_DATA->status != HB_MACRO_OK ) \ + if( ! ( HB_MACRO_DATA->status & HB_MACRO_CONT ) ) \ { \ hb_compExprDelete( pExpr, HB_MACRO_PARAM ); \ YYABORT; \ @@ -185,13 +185,16 @@ int yylex( YYSTYPE *, HB_MACRO_PTR ); %% -Main : Expression '\n' { if( HB_MACRO_DATA->Flags & HB_MACRO_GEN_PUSH ) +Main : Expression '\n' { + if( HB_MACRO_DATA->Flags & HB_MACRO_GEN_PUSH ) hb_compExprDelete( hb_compExprGenPush( $1, HB_MACRO_PARAM ), HB_MACRO_PARAM ); else hb_compExprDelete( hb_compExprGenPop( $1, HB_MACRO_PARAM ), HB_MACRO_PARAM ); hb_compGenPCode1( HB_P_ENDPROC, HB_MACRO_PARAM ); } - | Expression { if( HB_MACRO_DATA->Flags & HB_MACRO_GEN_PUSH ) + + | Expression { + if( HB_MACRO_DATA->Flags & HB_MACRO_GEN_PUSH ) hb_compExprDelete( hb_compExprGenPush( $1, HB_MACRO_PARAM ), HB_MACRO_PARAM ); else hb_compExprDelete( hb_compExprGenPop( $1, HB_MACRO_PARAM ), HB_MACRO_PARAM ); @@ -699,12 +702,12 @@ PareExpListAlias : PareExpList ALIASOP { $$ = $1; } ; IfInline : IIF '(' Expression ',' EmptyExpression ',' - { $$ = hb_compExprAddListExpr( $3, $5 ); } + { $$ = hb_compExprAddListExpr( hb_compExprNewList( $3 ), $5 ); } EmptyExpression ')' { $$ = hb_compExprNewIIF( hb_compExprAddListExpr( $7, $8 ) ); } | IF '(' Expression ',' EmptyExpression ',' - { $$ = hb_compExprAddListExpr( $3, $5 ); } + { $$ = hb_compExprAddListExpr( hb_compExprNewList( $3 ), $5 ); } EmptyExpression ')' { $$ = hb_compExprNewIIF( hb_compExprAddListExpr( $7, $8 ) ); } ; @@ -722,7 +725,7 @@ int hb_compParse( HB_MACRO_PTR pMacro ) lexBuffer = hb_compFlexNew( pMacro ); - pMacro->status = HB_MACRO_OK; + pMacro->status = HB_MACRO_CONT; /* NOTE: bison requires (void *) pointer */ iResult = yyparse( ( void * ) pMacro ); diff --git a/harbour/source/rdd/dbfcdx/dbfcdx1.c b/harbour/source/rdd/dbfcdx/dbfcdx1.c index 3b73ed619e..9d3fd41dfb 100644 --- a/harbour/source/rdd/dbfcdx/dbfcdx1.c +++ b/harbour/source/rdd/dbfcdx/dbfcdx1.c @@ -505,7 +505,6 @@ static ERRCODE cdxOrderCreate( AREAP pArea, LPDBORDERCREATEINFO pOrderInfo ) pMacro = ( HB_MACRO_PTR ) hb_itemGetPtr( pExpr ); hb_macroRun( pMacro ); hb_macroDelete( pMacro ); - hb_xfree( pMacro ); pResult = pExpr; hb_itemCopy( pResult, &hb_stack.Return ); } @@ -577,7 +576,6 @@ static ERRCODE cdxOrderCreate( AREAP pArea, LPDBORDERCREATEINFO pOrderInfo ) pMacro = ( HB_MACRO_PTR ) hb_itemGetPtr( pExpr ); hb_macroRun( pMacro ); hb_macroDelete( pMacro ); - hb_xfree( pMacro ); pResult = pExpr; hb_itemCopy( pResult, &hb_stack.Return ); } diff --git a/harbour/source/rtl/errorapi.c b/harbour/source/rtl/errorapi.c index 4ddac1844a..54157add14 100644 --- a/harbour/source/rtl/errorapi.c +++ b/harbour/source/rtl/errorapi.c @@ -68,6 +68,7 @@ better shows what is really the problem */ #define HB_ERROR_LAUNCH_MAX 8 +static HB_ERROR_INFO_PTR s_errorHandler = NULL; static HB_ITEM s_errorBlock; static int s_iLaunchCount = 0; static USHORT s_uiErrorDOS = 0; /* The value of DOSERROR() */ @@ -84,7 +85,7 @@ void hb_errForceLink() } /* There's a similar undocumented, internal functions in CA-Cl*pper named - ErrorInHandler(). */ + ErrorInHandler(). */ HARBOUR HB___ERRINHANDLER( void ) { @@ -106,6 +107,20 @@ HARBOUR HB_ERRORBLOCK( void ) hb_itemClear( &oldError ); } +/* set new low-level error launcher (C function) and return + * handler currently active + */ +HB_ERROR_INFO_PTR hb_errorHandler( HB_ERROR_INFO_PTR pNewHandler ) +{ + HB_ERROR_INFO_PTR pOld = s_errorHandler; + + if( pNewHandler ) + pNewHandler->Previous = s_errorHandler; + s_errorHandler = pNewHandler; + + return pOld; +} + /* TOFIX: Make it Clipper compatible */ HARBOUR HB_DOSERROR( void ) @@ -150,6 +165,7 @@ PHB_ITEM hb_errNew( void ) USHORT hb_errLaunch( PHB_ITEM pError ) { USHORT uiAction; + USHORT usRequest; HB_TRACE(HB_TR_DEBUG, ("hb_errLaunch(%p)", pError)); @@ -171,24 +187,38 @@ USHORT hb_errLaunch( PHB_ITEM pError ) s_iLaunchCount++; - pResult = hb_itemDo( &s_errorBlock, 1, pError ); + if( s_errorHandler ) + { + /* there is a low-level error handler defined - use it instead + * of normal Harbour-level one + */ + s_errorHandler->Error = pError; + s_errorHandler->ErrorBlock = &s_errorBlock; + pResult = (s_errorHandler->Func)( s_errorHandler ); + s_errorHandler->Error = NULL; + } + else + pResult = hb_itemDo( &s_errorBlock, 1, pError ); s_iLaunchCount--; /* Check results */ - if( hb_vmRequestQuery() == HB_QUIT_REQUESTED ) + usRequest = hb_vmRequestQuery(); + if( usRequest == HB_QUIT_REQUESTED ) { - hb_itemRelease( pResult ); + if( pResult ) + hb_itemRelease( pResult ); hb_errRelease( pError ); hb_vmQuit(); } - else if( hb_vmRequestQuery() == HB_BREAK_REQUESTED ) + else if( usRequest == HB_BREAK_REQUESTED || usRequest == HB_ENDPROC_REQUESTED ) { - hb_itemRelease( pResult ); + if( pResult ) + hb_itemRelease( pResult ); uiAction = E_BREAK; } - else + else if( pResult ) { BOOL bFailure = FALSE; USHORT uiFlags = hb_errGetFlags( pError ); @@ -217,6 +247,8 @@ USHORT hb_errLaunch( PHB_ITEM pError ) if( uiAction == E_RETRY ) hb_errPutTries( pError, hb_errGetTries( pError ) + 1 ); } + else + hb_errInternal( 9999, "Error recovery failure", NULL, NULL ); } else uiAction = E_RETRY; /* Clipper does this, undocumented */ @@ -237,6 +269,7 @@ USHORT hb_errLaunch( PHB_ITEM pError ) PHB_ITEM hb_errLaunchSubst( PHB_ITEM pError ) { PHB_ITEM pResult; + USHORT usRequest; HB_TRACE(HB_TR_DEBUG, ("hb_errLaunchSubst(%p)", pError)); @@ -256,21 +289,35 @@ PHB_ITEM hb_errLaunchSubst( PHB_ITEM pError ) s_iLaunchCount++; - pResult = hb_itemDo( &s_errorBlock, 1, pError ); + if( s_errorHandler ) + { + /* there is a low-level error handler defined - use it instead + * of normal Harbour-level one + */ + s_errorHandler->Error = pError; + s_errorHandler->ErrorBlock = &s_errorBlock; + pResult = (s_errorHandler->Func)( s_errorHandler ); + s_errorHandler->Error = NULL; + } + else + pResult = hb_itemDo( &s_errorBlock, 1, pError ); s_iLaunchCount--; /* Check results */ - if( hb_vmRequestQuery() == HB_QUIT_REQUESTED ) + usRequest = hb_vmRequestQuery(); + if( usRequest == HB_QUIT_REQUESTED ) { - hb_itemRelease( pResult ); + if( pResult ) + hb_itemRelease( pResult ); hb_errRelease( pError ); hb_vmQuit(); } - else if( hb_vmRequestQuery() == HB_BREAK_REQUESTED ) + else if( usRequest == HB_BREAK_REQUESTED || usRequest == HB_ENDPROC_REQUESTED ) { - hb_itemRelease( pResult ); + if( pResult ) + hb_itemRelease( pResult ); pResult = NULL; } else diff --git a/harbour/source/rtl/itemapi.c b/harbour/source/rtl/itemapi.c index 9b52bce63f..224611e02c 100644 --- a/harbour/source/rtl/itemapi.c +++ b/harbour/source/rtl/itemapi.c @@ -305,12 +305,13 @@ PHB_ITEM hb_itemNew( PHB_ITEM pNull ) HB_TRACE(HB_TR_DEBUG, ("hb_itemNew(%p)", pNull)); - HB_SYMBOL_UNUSED( pNull ); - pItem = ( PHB_ITEM ) hb_xgrab( sizeof( HB_ITEM ) ); - memset( pItem, 0, sizeof( HB_ITEM ) ); pItem->type = IT_NIL; + if( pNull ) + hb_itemCopy( pItem, pNull ); + else + memset( pItem, 0, sizeof( HB_ITEM ) ); return pItem; } diff --git a/harbour/source/rtl/type.c b/harbour/source/rtl/type.c index b71fa2b039..6e8de031e7 100644 --- a/harbour/source/rtl/type.c +++ b/harbour/source/rtl/type.c @@ -6,7 +6,7 @@ * Harbour Project source code: * TYPE() function * - * Copyright 1999 {list of individual authors and e-mail addresses} + * Copyright 1999 Ryszard Glab * www - http://www.harbour-project.org * * This program is free software; you can redistribute it and/or modify @@ -34,6 +34,7 @@ */ #include "extend.h" +#include "errorapi.h" /* $DOC$ * $FUNCNAME$ @@ -45,19 +46,82 @@ * $SYNTAX$ * TYPE( ) --> * $ARGUMENTS$ - * is a character expression. + * must be a character expression. * $RETURNS$ - * Returns a character indicating the type of the passed expression. + * Returns a string indicating the type of the passed expression. + * + * "A" - array + * "B" - block + * "C" - string + * "D" - date + * "L" - logical + * "M" - memo + * "N" - numeric + * "O" - object + * "U" - NIL, local, or static variable, or not linked-in function + * "UE" - syntax error in the expression or invalid arguments + * "UI" - function with non-reserved name was requested * $DESCRIPTION$ - * This function returns one character which represents the date type - * of the argument. + * This function returns a string which represents the data type + * of the argument. The argument can be any valid Harbour expression. + * If there is a syntax error in passed expression then "UE" is returned. + * If there is a call for any non-reserved Harbour function then "UI" + * is returned (in other words there is no call for passed UDF function + * during a data type determination - this is Clipper compatible + * behavior). Additionally if requested user defined function is not + * linked into executable then "U" is returned. + * + * The data type of expression is checked by invoking a macro compiler + * and by evaluation of generated code (if there is no syntax errors). + * This causes that TYPE() cannot determine a type of local or static + * variables - only symbols visible at runtime can be checked. + * + * Notice the subtle difference between TYPE and VALTYPE functions. + * VALTYPE() function doesn't call a macro compiler - it simply checks + * the type of passed argument of any type. TYPE() requires a string + * argument with a valid Harbour expression - the data type of this + * expression is returned. + * + * Notes: + * - Incompatibility with Clipper: + * In the following code: + * + * PRIVATE lCond := 0 + * ? TYPE( "IIF( lCond, 'true', MyUDF() )" ) + * + * Clipper will print "UE" - in Harbour the output will be "UI" + * + * - if "UI" is returned then the syntax of the expression is + * correct. However invalid arguments can be passed to + * function/procedure that will cause runtime errors during + * evaluation of expression. + * * $EXAMPLES$ - * See Test + * ? TYPE( "{ 1, 2 }" ) //prints "A" + * ? TYPE( "IIF(.T., SUBSTR('TYPE',2,1), .F.)" ) //prints "C" + * ? TYPE( "AT( 'OK', MyUDF())>0" ) //prints "UI" + * ? TYPE( "{ 1, 2 }[ 5 ]" ) //prints "UE" + * + * //-------------------------------------------------------- + * + * LOCAL c + * PRIVATE a:="A", b:="B" + * ? TYPE( "a + b + c" ) //prints: "U" ('C' variable is a local one) + * + * //-------------------------------------------------------- + * + * LOCAL cFilter := SPACE( 60 ) + * ACCEPT "Enter filter expression:" TO cFilter + * IF( TYPE( cFilter ) $ "CDLMN" ) ) + * // this is a valid expression + * SET FILTER TO &cFilter + * ENDIF + * * $TESTS$ * $STATUS$ - * S + * R * $COMPLIANCE$ - * + * * $SEEALSO$ * VALTYPE() * $END$ @@ -65,6 +129,14 @@ HARBOUR HB_TYPE( void ) { - /* TODO: implement this */ - hb_retc( "U" ); + HB_ITEM_PTR pItem = hb_param( 1, IT_STRING ); + + if( pItem ) + { + hb_retc( hb_macroGetType( pItem ) ); + } + else + { + hb_errRT_BASE( EG_ARG, 1121, NULL, "TYPE" ); + } } diff --git a/harbour/source/rtl/valtype.c b/harbour/source/rtl/valtype.c index d58c25ede2..59b80e575d 100644 --- a/harbour/source/rtl/valtype.c +++ b/harbour/source/rtl/valtype.c @@ -73,6 +73,50 @@ * $END$ */ +char * hb_valtypeGet( HB_ITEM_PTR pItem ) +{ + char * szType; + + switch( pItem->type & ~IT_BYREF ) + { + case IT_ARRAY: + szType = ( hb_arrayIsObject( pItem ) ? "O" : "A" ); + break; + + case IT_BLOCK: + szType = "B"; + break; + + case IT_DATE: + szType = "D"; + break; + + case IT_LOGICAL: + szType = "L"; + break; + + case IT_INTEGER: + case IT_LONG: + case IT_DOUBLE: + szType = "N"; + break; + + case IT_STRING: + szType = "C"; + break; + + case IT_MEMO: + szType = "M"; + break; + + default: + szType = "U"; + break; + } + return szType; +} + + HARBOUR HB_VALTYPE( void ) { PHB_ITEM pItem = hb_param( 1, IT_ANY ); @@ -82,44 +126,7 @@ HARBOUR HB_VALTYPE( void ) may not do so. [vszel] */ if( pItem ) - { - switch( pItem->type & ~IT_BYREF ) - { - case IT_ARRAY: - hb_retc( hb_arrayIsObject( pItem ) ? "O" : "A" ); - break; - - case IT_BLOCK: - hb_retc( "B" ); - break; - - case IT_DATE: - hb_retc( "D" ); - break; - - case IT_LOGICAL: - hb_retc( "L" ); - break; - - case IT_INTEGER: - case IT_LONG: - case IT_DOUBLE: - hb_retc( "N" ); - break; - - case IT_STRING: - hb_retc( "C" ); - break; - - case IT_MEMO: - hb_retc( "M" ); - break; - - default: - hb_retc( "U" ); - break; - } - } + hb_retc( hb_valtypeGet( pItem ) ); else hb_retc( "U" ); } diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index bfa8933b66..9648aa2d8c 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -1138,6 +1138,14 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols ) } else if( s_uiActionRequest & HB_QUIT_REQUESTED ) break; + else if( s_uiActionRequest & HB_ENDPROC_REQUESTED ) + { + /* request to stop current procedure was issued + * (from macro evaluation) + */ + s_uiActionRequest = 0; + break; + } } } hb_memvarSetPrivatesBase( ulPrivateBase ); @@ -3750,6 +3758,13 @@ void hb_vmRequestQuit( void ) s_uiActionRequest = HB_QUIT_REQUESTED; } +void hb_vmRequestEndProc( void ) +{ + HB_TRACE(HB_TR_DEBUG, ("hb_vmRequestEndProc()")); + + s_uiActionRequest = HB_ENDPROC_REQUESTED; +} + void hb_vmRequestBreak( PHB_ITEM pItem ) { HB_TRACE(HB_TR_DEBUG, ("hb_vmRequestBreak(%p)", pItem));