From 5f67da88968be1482b2a502600ea4a93b10a86bd Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Mon, 19 Jun 2006 21:11:59 +0000 Subject: [PATCH] 2006-06-19 23:10 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/include/Makefile + added hbapicls.h * harbour/include/hbapi.h * harbour/source/vm/garbage.c * added some testing macros * harbour/include/hbmath.h * HB_MATH_ERRNO enabled for MINGW build. Seems that MinGW doesn't activate math error handler and only sets errno * harbour/include/hbtypes.h * harbour/source/vm/maindllp.c ! fixed VM_PROCESS_SYMBOLS_EX definition * cleaned a little bit code to not return uninitialized values when original function cannot be detected * harbour/source/compiler/genc.c * minor modifications * harbour/source/rtl/math.c ! fixed possible memory leak * indenting * harbour/source/vm/classes.c ! fixed possible GPF in __GETMSGPRF * use only one function for method name hashing * harbour/source/vm/hvm.c * minor fix --- harbour/ChangeLog | 32 +++ harbour/include/Makefile | 1 + harbour/include/hbapi.h | 12 +- harbour/include/hbmath.h | 10 +- harbour/include/hbtypes.h | 5 +- harbour/source/compiler/genc.c | 53 +++-- harbour/source/rtl/math.c | 375 ++++++++++++++++----------------- harbour/source/vm/classes.c | 143 ++++++------- harbour/source/vm/garbage.c | 9 + harbour/source/vm/hvm.c | 2 +- harbour/source/vm/maindllp.c | 23 +- 11 files changed, 352 insertions(+), 313 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 76ae916443..310da565c9 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,38 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ + * harbour/source/rtl/gtwin/gtwin.c + + Copied Windows Clipboard support from the GTWVT driver. So now + it is available in Win32 console apps too. (Thanks Przemek for + the functions and instructions). + ! Fixed TBrowse:skipBlock() (throwing proper error, NIL parameter + +2006-06-20 02:37 UTC+0100 Viktor Szakats (viktor.szakats syenar.hu) + * harbour/source/rtl/tbrowse.prg + ! Fixed TBrowseNew() not initializing :skipBlock() + ! Fixed TBrowse:skipBlock() (throwing proper error, NIL parameter + behaviour, parameter checking) + +2006-06-19 23:10 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/include/Makefile + + added hbapicls.h + + * harbour/include/hbapi.h + * harbour/source/vm/garbage.c + * added some testing macros + + * harbour/include/hbmath.h + * HB_MATH_ERRNO enabled for MINGW build. Seems that MinGW doesn't + activate math error handler and only sets errno + + * harbour/include/hbtypes.h + * harbour/source/vm/maindllp.c + ! fixed VM_PROCESS_SYMBOLS_EX definition + * cleaned a little bit code to not return uninitialized values + when original function cannot be detected + + * harbour/source/compiler/genc.c + * minor modifications * harbour/source/rtl/math.c ! fixed possible memory leak diff --git a/harbour/include/Makefile b/harbour/include/Makefile index 030ad34b9e..04a91eff38 100644 --- a/harbour/include/Makefile +++ b/harbour/include/Makefile @@ -9,6 +9,7 @@ C_HEADERS=\ extend.h \ hbapi.h \ hbapicdp.h \ + hbapicls.h \ hbapierr.h \ hbapifs.h \ hbapigt.h \ diff --git a/harbour/include/hbapi.h b/harbour/include/hbapi.h index 83b4437d6f..951b11c9ce 100644 --- a/harbour/include/hbapi.h +++ b/harbour/include/hbapi.h @@ -513,12 +513,13 @@ extern void * hb_xRefResize( void * pMem, ULONG ulSave, ULONG ulSize ); /* #define hb_xRefDec( p ) (--(*HB_COUNTER_PTR( p ))==0) #define hb_xRefFree( p ) do { \ if( hb_xRefDec( p ) ) \ - hb_xfree( (p) ); \ + hb_xfree( p ); \ } while( 0 ) +#define hb_xRefCount( p ) (*HB_COUNTER_PTR( p )) #endif -#endif +#endif /* _HB_API_INTERNAL_ */ /* #if UINT_MAX == ULONG_MAX */ /* it fails on 64bit platforms where int has 32 bit and long has 64 bit. @@ -553,7 +554,14 @@ extern void hb_gcRefInc( void * pAlloc ); /* increment reference counter extern BOOL hb_gcRefDec( void * pAlloc ); /* decrement reference counter, return TRUE when 0 reached */ extern void hb_gcRefFree( void * pAlloc ); /* decrement reference counter and free the block when 0 reached */ extern HB_COUNTER hb_gcRefCount( void * pAlloc ); /* return number of references */ + +#if 0 +#define hb_gcRefInc( p ) hb_xRefInc( HB_GC_PTR( p ) ) +#define hb_gcRefDec( p ) hb_xRefDec( HB_GC_PTR( p ) ) +#define hb_gcRefCount( p ) hb_xRefCount( HB_GC_PTR( p ) ) #endif + +#endif /* _HB_API_INTERNAL_ */ extern void hb_gcCollect( void ); /* checks if a single memory block can be released */ extern void hb_gcCollectAll( void ); /* checks if all memory blocks can be released */ extern void hb_gcReleaseAll( void ); /* release all memory blocks unconditionally */ diff --git a/harbour/include/hbmath.h b/harbour/include/hbmath.h index eb1d4a1bd6..58ffe8730f 100644 --- a/harbour/include/hbmath.h +++ b/harbour/include/hbmath.h @@ -66,7 +66,7 @@ HB_EXTERN_BEGIN #if defined(__WATCOMC__) #define HB_MATH_HANDLER - #if (__WATCOMC__ > 1000) && defined(__cplusplus) + #if (__WATCOMC__ > 1000) /* && defined(__cplusplus) */ #define exception _exception #endif #elif defined(__BORLANDC__) @@ -82,7 +82,10 @@ HB_EXTERN_BEGIN #define exception _exception #endif #endif -#elif defined(__MINGW32__) + +/* it seems that MinGW has some problem with MATH HANDLER + use HB_MATH_ERRNO instead */ +#elif defined(__MINGW32__) && 0 #define HB_MATH_HANDLER #define matherr _matherr #define exception _exception @@ -90,8 +93,7 @@ HB_EXTERN_BEGIN #define HB_MATH_HANDLER #endif -#if !defined(HB_MATH_HANDLER) && defined(__GNUC__) && \ - ( defined(HB_OS_LINUX) || defined(HB_OS_UNIX) ) +#if !defined(HB_MATH_HANDLER) && defined(__GNUC__) /* && defined(HB_OS_UNIX) */ #define HB_MATH_ERRNO #endif diff --git a/harbour/include/hbtypes.h b/harbour/include/hbtypes.h index f29b9865ea..b5b6e9fd04 100644 --- a/harbour/include/hbtypes.h +++ b/harbour/include/hbtypes.h @@ -63,9 +63,8 @@ typedef PHB_SYMB ( * VM_PROCESS_DLL_SYMBOLS ) ( PHB_SYMB pModuleSymbols, USHORT uiModuleSymbols ); typedef PHB_SYMB ( * VM_PROCESS_SYMBOLS_EX ) - ( PHB_SYMB pModuleSymbols, USHORT uiModuleSymbols, - char * szModuleName, ULONG ulID, - USHORT uiPcodeMin, USHORT uiPcodeMax ); + ( PHB_SYMB pModuleSymbols, USHORT uiModuleSymbols, + char * szModuleName, ULONG ulID, USHORT uiPcodeVer ); typedef void ( * VM_DLL_EXECUTE ) ( const BYTE * pCode, PHB_SYMB pSymbols ); diff --git a/harbour/source/compiler/genc.c b/harbour/source/compiler/genc.c index e192de222d..844d6687a4 100644 --- a/harbour/source/compiler/genc.c +++ b/harbour/source/compiler/genc.c @@ -59,10 +59,10 @@ void hb_compGenCCode( PHB_FNAME pFileName ) /* generates the C language ou FILE * yyc; /* file handle for C output */ PINLINE pInline = hb_comp_inlines.pFirst; - BOOL bIsPublicFunction ; - BOOL bIsInitFunction ; - BOOL bIsExitFunction ; - BOOL bIsStaticVariable ; + BOOL bIsInitStatics; + BOOL bIsInitFunction; + BOOL bIsExitFunction; + BOOL bIsStaticFunction; hb_fsFNameMerge( szFileName, pFileName ); if( ! pFileName->szExtension ) @@ -104,16 +104,13 @@ void hb_compGenCCode( PHB_FNAME pFileName ) /* generates the C language ou /* write functions prototypes for PRG defined functions */ while( pFunc ) { - bIsInitFunction = ( pFunc->cScope & HB_FS_INIT ) ; - bIsExitFunction = ( pFunc->cScope & HB_FS_EXIT ) ; - bIsStaticVariable = ( pFunc == hb_comp_pInitFunc ) ; - bIsPublicFunction = ( pFunc->cScope == HB_FS_PUBLIC ) ; + bIsInitStatics = ( pFunc == hb_comp_pInitFunc ); + bIsInitFunction = ( pFunc->cScope & HB_FS_INIT ) != 0; + bIsExitFunction = ( pFunc->cScope & HB_FS_EXIT ) != 0; + bIsStaticFunction = ( pFunc->cScope & HB_FS_STATIC ) != 0; - /* Is it a PUBLIC FUNCTION/PROCEDURE */ - if ( bIsPublicFunction ) - fprintf( yyc, "HB_FUNC( %s );\n", pFunc->szName ); - /* Is it a STATIC$ */ - else if ( bIsStaticVariable ) + /* Is it _STATICS$ - static initialization function */ + if( bIsInitStatics ) fprintf( yyc, "HB_FUNC_INITSTATICS();\n" ); /* NOTE: hb_ intentionally in lower case */ /* Is it an INIT FUNCTION/PROCEDURE */ else if ( bIsInitFunction ) @@ -121,9 +118,11 @@ void hb_compGenCCode( PHB_FNAME pFileName ) /* generates the C language ou /* Is it an EXIT FUNCTION/PROCEDURE */ else if ( bIsExitFunction ) hb_compGenCFunc( yyc, "HB_FUNC_EXIT( %s );\n", pFunc->szName, 1 ); - /* Then it must be a STATIC FUNCTION/PROCEDURE */ - else + /* Is it a STATIC FUNCTION/PROCEDURE */ + else if ( bIsStaticFunction ) fprintf( yyc, "HB_FUNC_STATIC( %s );\n", pFunc->szName ); + else /* Then it must be PUBLIC FUNCTION/PROCEDURE */ + fprintf( yyc, "HB_FUNC( %s );\n", pFunc->szName ); pFunc = pFunc->pNext; } @@ -178,7 +177,7 @@ void hb_compGenCCode( PHB_FNAME pFileName ) /* generates the C language ou * we are using these two bits to mark the special function used to * initialize static variables */ - fprintf( yyc, "{ \"%s\", {HB_FS_INITEXIT|HB_FS_LOCAL}, {hb_INITSTATICS}, NULL }", pSym->szName ); /* NOTE: hb_ intentionally in lower case */ + fprintf( yyc, "{ \"%s\", {HB_FS_INITEXIT | HB_FS_LOCAL}, {hb_INITSTATICS}, NULL }", pSym->szName ); /* NOTE: hb_ intentionally in lower case */ } else { @@ -241,16 +240,13 @@ void hb_compGenCCode( PHB_FNAME pFileName ) /* generates the C language ou while( pFunc ) { - bIsInitFunction = ( pFunc->cScope & HB_FS_INIT ) ; - bIsExitFunction = ( pFunc->cScope & HB_FS_EXIT ) ; - bIsStaticVariable = ( pFunc == hb_comp_pInitFunc ) ; - bIsPublicFunction = ( pFunc->cScope == HB_FS_PUBLIC ) ; + bIsInitStatics = ( pFunc == hb_comp_pInitFunc ); + bIsInitFunction = ( pFunc->cScope & HB_FS_INIT ) != 0; + bIsExitFunction = ( pFunc->cScope & HB_FS_EXIT ) != 0; + bIsStaticFunction = ( pFunc->cScope & HB_FS_STATIC ) != 0; - /* Is it a PUBLIC FUNCTION/PROCEDURE */ - if ( bIsPublicFunction ) - fprintf( yyc, "HB_FUNC( %s )", pFunc->szName ); - /* Is it STATICS$ */ - else if( bIsStaticVariable ) + /* Is it _STATICS$ - static initialization function */ + if( bIsInitStatics ) fprintf( yyc, "HB_FUNC_INITSTATICS()" ); /* NOTE: hb_ intentionally in lower case */ /* Is it an INIT FUNCTION/PROCEDURE */ else if ( bIsInitFunction ) @@ -258,9 +254,11 @@ void hb_compGenCCode( PHB_FNAME pFileName ) /* generates the C language ou /* Is it an EXIT FUNCTION/PROCEDURE */ else if ( bIsExitFunction ) hb_compGenCFunc( yyc, "HB_FUNC_EXIT( %s )", pFunc->szName, 1 ); - /* Then it must be a STATIC FUNCTION/PROCEDURE */ - else + /* Is it a STATIC FUNCTION/PROCEDURE */ + else if ( bIsStaticFunction ) fprintf( yyc, "HB_FUNC_STATIC( %s )", pFunc->szName ); + else /* Then it must be PUBLIC FUNCTION/PROCEDURE */ + fprintf( yyc, "HB_FUNC( %s )", pFunc->szName ); fprintf( yyc, "\n" ); if( hb_comp_iGenCOutput == HB_COMPGENC_REALCODE ) @@ -287,6 +285,7 @@ void hb_compGenCCode( PHB_FNAME pFileName ) /* generates the C language ou fprintf( yyc, "#include \"hbapierr.h\"\n" ); fprintf( yyc, "#include \"hbapiitm.h\"\n" ); fprintf( yyc, "#include \"hbvm.h\"\n" ); + fprintf( yyc, "#include \"hbapicls.h\"\n" ); fprintf( yyc, "#include \"hboo.ch\"\n" ); } diff --git a/harbour/source/rtl/math.c b/harbour/source/rtl/math.c index 293c005f96..43bf55ea5f 100644 --- a/harbour/source/rtl/math.c +++ b/harbour/source/rtl/math.c @@ -199,7 +199,6 @@ int matherr (struct exception * err) retval = 1; /* don't print any message, don't set errno and use return value provided by C RTL */ } return (retval); - } #elif defined(HB_MATH_ERRNO) @@ -210,11 +209,13 @@ int hb_mathErrSet( double dResult, double arg1, double arg2, char * szFunc, int HB_TRACE (HB_TR_DEBUG, ("hb_mathErrSet(%f, %d)", dResult, errCode)); - switch (errCode) + switch( errCode ) { case EDOM: case ERANGE: +#if defined(EOVERFLOW) case EOVERFLOW: +#endif break; default: @@ -224,6 +225,8 @@ int hb_mathErrSet( double dResult, double arg1, double arg2, char * szFunc, int } #if defined(HB_OS_SUNOS) else if ( !finite( dResult ) ) +#elif defined(HB_OS_OS2) + else if ( !isfinite( dResult ) ) #else else if ( isinf( dResult ) ) #endif @@ -240,7 +243,7 @@ int hb_mathErrSet( double dResult, double arg1, double arg2, char * szFunc, int hb_mathResetError(); /* map math error types */ - switch (errCode) + switch( errCode ) { case EDOM: s_hb_exc.type = HB_MATH_ERR_DOMAIN; @@ -251,12 +254,12 @@ int hb_mathErrSet( double dResult, double arg1, double arg2, char * szFunc, int s_hb_exc.type = HB_MATH_ERR_SING; s_hb_exc.error = "Calculation results in singularity"; break; - +#if defined(EOVERFLOW) case EOVERFLOW: s_hb_exc.type = HB_MATH_ERR_OVERFLOW; s_hb_exc.error = "Calculation result too large to represent"; break; - +#endif default: s_hb_exc.type = HB_MATH_ERR_UNKNOWN; s_hb_exc.error = "Unknown math error"; @@ -270,9 +273,9 @@ int hb_mathErrSet( double dResult, double arg1, double arg2, char * szFunc, int s_hb_exc.handled = 0; mathHandler = hb_mathGetHandler(); - if (mathHandler != NULL) + if( mathHandler != NULL ) { - (*(mathHandler))(&s_hb_exc); + ( *( mathHandler ) )( &s_hb_exc ); } return 1; } @@ -330,94 +333,84 @@ HB_FUNC( HB_MATHERMODE ) /* ([]) -> */ } /* Harbour default math error handling routine */ -int hb_matherr (HB_MATH_EXCEPTION * pexc) +int hb_matherr( HB_MATH_EXCEPTION * pexc ) { + int mode = hb_mathGetErrMode(); + int iRet = 1; - int mode = hb_mathGetErrMode(); + HB_TRACE(HB_TR_DEBUG, ("hb_matherr(%p)",pexc)); - HB_TRACE(HB_TR_DEBUG, ("hb_matherr(%p)",pexc)); - if ((pexc == NULL) || - ((pexc != NULL) && (pexc->handled != 0))) - { - /* error already handled by other handlers ! */ - return (1); - } + if( pexc == NULL || pexc->handled != 0 ) + { + /* error already handled by other handlers ! */ + return 1; + } - if ((mode == HB_MATH_ERRMODE_USER) || (mode == HB_MATH_ERRMODE_USERDEFAULT) || - (mode == HB_MATH_ERRMODE_USERCDEFAULT)) - { + if( mode == HB_MATH_ERRMODE_USER || mode == HB_MATH_ERRMODE_USERDEFAULT || + mode == HB_MATH_ERRMODE_USERCDEFAULT ) + { + PHB_ITEM pArg1, pArg2, pError; + PHB_ITEM pMatherrResult; - PHB_ITEM pMatherrResult; - PHB_ITEM pArg1 = hb_itemPutND(NULL, pexc->arg1); - PHB_ITEM pArg2 = hb_itemPutND(NULL, pexc->arg2); - PHB_ITEM pError; + /* create an error object */ + /* NOTE: In case of HB_MATH_ERRMODE_USER[C]DEFAULT, I am setting both EF_CANSUBSTITUTE and EF_CANDEFAULT to .T. here. + This is forbidden according to the original Cl*pper docs, but I think this reflects the situation best here: + The error handler can either substitute the errorneous value (by returning a numeric value) or choose the + default error handling (by returning .F., as usual) [martin vogel]*/ + pError = hb_errRT_New_Subst( ES_ERROR, "MATH", EG_NUMERR, pexc->type, + pexc->error, pexc->funcname, 0, EF_CANSUBSTITUTE | + ( mode == HB_MATH_ERRMODE_USER ? 0 : EF_CANDEFAULT ) ); - /* create an error object */ - /* NOTE: In case of HB_MATH_ERRMODE_USER[C]DEFAULT, I am setting both EF_CANSUBSTITUTE and EF_CANDEFAULT to .T. here. - This is forbidden according to the original Cl*pper docs, but I think this reflects the situation best here: - The error handler can either substitute the errorneous value (by returning a numeric value) or choose the - default error handling (by returning .F., as usual) [martin vogel]*/ - pError = hb_errRT_New_Subst (ES_ERROR, "MATH", EG_NUMERR, pexc->type, - pexc->error, pexc->funcname, 0, EF_CANSUBSTITUTE | - (mode == HB_MATH_ERRMODE_USER ? 0: EF_CANDEFAULT)); + /* Assign the new array to the object data item. */ + /* NOTE: Unfortunately, we cannot decide whether one or two parameters have been used when the + math function has been called, so we always take two */ + pArg1 = hb_itemPutND( NULL, pexc->arg1 ); + pArg2 = hb_itemPutND( NULL, pexc->arg2 ); + hb_errPutArgs( pError, 2, pArg1, pArg2 ); + hb_itemRelease( pArg1 ); + hb_itemRelease( pArg2 ); - /* Assign the new array to the object data item. */ - /* NOTE: Unfortunately, we cannot decide whether one or two parameters have been used when the - math function has been called, so we always take two */ - hb_errPutArgs( pError, 2, pArg1, pArg2 ); + /* launch error codeblock */ + pMatherrResult = hb_errLaunchSubst( pError ); + hb_errRelease( pError ); - /* launch error codeblock */ - pMatherrResult = hb_errLaunchSubst (pError); - hb_errRelease (pError); - - if (pMatherrResult != NULL) - { - if (HB_IS_NUMERIC (pMatherrResult)) + if( pMatherrResult != NULL ) { - pexc->retval = hb_itemGetND (pMatherrResult); - hb_itemGetNLen (pMatherrResult, &(pexc->retvalwidth), &(pexc->retvaldec)); - pexc->handled = 1; + if( HB_IS_NUMERIC( pMatherrResult ) ) + { + pexc->retval = hb_itemGetND( pMatherrResult ); + hb_itemGetNLen( pMatherrResult, &pexc->retvalwidth, &pexc->retvaldec ); + pexc->handled = 1; + } + hb_itemRelease( pMatherrResult ); } - hb_itemRelease (pMatherrResult); - } - } + } - /* math exception not handled by Harbour error routine above ? */ - if (pexc->handled == 0) - { - int iret; - switch (mode) - { - case HB_MATH_ERRMODE_USER: + /* math exception not handled by Harbour error routine above ? */ + if( pexc->handled == 0 ) + { + switch( mode ) { - /* user failed to handle the math exception, so quit the app [yes, that's the meaning of this mode !!] */ - iret = 0; - hb_vmRequestQuit(); - }; break; + case HB_MATH_ERRMODE_USER: + /* user failed to handle the math exception, so quit the app [yes, that's the meaning of this mode !!] */ + iRet = 0; + hb_vmRequestQuit(); + break; - case HB_MATH_ERRMODE_DEFAULT: - case HB_MATH_ERRMODE_USERDEFAULT: - { - /* return 1 to suppress C RTL error msgs, but leave error handling to the calling Harbour routine */ - iret = 1; - }; break; + case HB_MATH_ERRMODE_DEFAULT: + case HB_MATH_ERRMODE_USERDEFAULT: + /* return 1 to suppress C RTL error msgs, but leave error handling to the calling Harbour routine */ + break; - case HB_MATH_ERRMODE_CDEFAULT: - case HB_MATH_ERRMODE_USERCDEFAULT: - { - /* use the correction value supplied in pexc->retval */ - pexc->handled = 1; - iret = 1; - }; break; - default: - iret = 1; - } - return (iret); - - } - - return (1); /* error handling successful */ + case HB_MATH_ERRMODE_CDEFAULT: + case HB_MATH_ERRMODE_USERCDEFAULT: + /* use the correction value supplied in pexc->retval */ + pexc->handled = 1; + break; + } + } + return iRet; /* error handling successful */ } @@ -432,24 +425,24 @@ int hb_matherr (HB_MATH_EXCEPTION * pexc) static HB_MATH_HANDLERPROC s_mathHandlerProc = hb_matherr; /* TODO: make this thread safe */ /* install a harbour-like math error handler (that will be called by the matherr() function), return old handler */ -HB_MATH_HANDLERPROC hb_mathSetHandler (HB_MATH_HANDLERPROC handlerproc) +HB_MATH_HANDLERPROC hb_mathSetHandler( HB_MATH_HANDLERPROC handlerproc ) { - HB_MATH_HANDLERPROC oldHandlerProc; + HB_MATH_HANDLERPROC oldHandlerProc; - HB_TRACE (HB_TR_DEBUG, ("hb_mathSetHandler (%p)", handlerproc)); + HB_TRACE (HB_TR_DEBUG, ("hb_mathSetHandler (%p)", handlerproc)); - oldHandlerProc = s_mathHandlerProc; - s_mathHandlerProc = handlerproc; + oldHandlerProc = s_mathHandlerProc; + s_mathHandlerProc = handlerproc; - return ((HB_MATH_HANDLERPROC)oldHandlerProc); + return oldHandlerProc; } /* get current harbour-like math error handler */ -HB_MATH_HANDLERPROC hb_mathGetHandler (void) +HB_MATH_HANDLERPROC hb_mathGetHandler( void ) { - HB_TRACE (HB_TR_DEBUG, ("hb_mathGetHandler ()")); + HB_TRACE (HB_TR_DEBUG, ("hb_mathGetHandler ()")); - return ((HB_MATH_HANDLERPROC)s_mathHandlerProc); + return s_mathHandlerProc; } /* @@ -465,105 +458,105 @@ static HB_MATH_HANDLERPROC sPrevMathHandler = NULL; static int hb_matherrblock( HB_MATH_EXCEPTION * pexc ) { - int retval; + int retval; - /* call codeblock for both case: handled and unhandled exceptions */ + /* call codeblock for both case: handled and unhandled exceptions */ - if( spMathErrorBlock != NULL ) - { - PHB_ITEM pArray, pRet; - PHB_ITEM pType, pFuncname, pError, pArg1, pArg2, pRetval, pHandled; + if( spMathErrorBlock != NULL ) + { + PHB_ITEM pArray, pRet; + PHB_ITEM pType, pFuncname, pError, pArg1, pArg2, pRetval, pHandled; - pType = hb_itemPutNI (NULL, pexc->type); - pFuncname = hb_itemPutC (NULL, pexc->funcname); - pError = hb_itemPutC (NULL, pexc->error); - pArg1 = hb_itemPutND (NULL, pexc->arg1); - pArg2 = hb_itemPutND (NULL, pexc->arg2); - pRetval = hb_itemPutNDLen (NULL, pexc->retval, pexc->retvalwidth, pexc->retvaldec); - pHandled = hb_itemPutL (NULL, pexc->handled); + pType = hb_itemPutNI( NULL, pexc->type ); + pFuncname = hb_itemPutC( NULL, pexc->funcname ); + pError = hb_itemPutC( NULL, pexc->error ); + pArg1 = hb_itemPutND( NULL, pexc->arg1 ); + pArg2 = hb_itemPutND( NULL, pexc->arg2 ); + pRetval = hb_itemPutNDLen( NULL, pexc->retval, pexc->retvalwidth, pexc->retvaldec ); + pHandled = hb_itemPutL( NULL, pexc->handled ); - pArray = hb_itemArrayNew (2); - hb_itemArrayPut (pArray, 1, pRetval); - hb_itemArrayPut (pArray, 2, pHandled); + pArray = hb_itemArrayNew( 2 ); + hb_itemArrayPut( pArray, 1, pRetval ); + hb_itemArrayPut( pArray, 2, pHandled ); - /* launch error codeblock that can - a) change the members of the array = {dRetval, lHandled} to set the return value of the math C RTL routine and - the and it - b) can return an integer value to set the return value of matherr(). - NOTE that these values are only used if lHandled was .F. and is set to .T. within the codeblock */ - pRet = hb_itemDo (spMathErrorBlock, 6, pType, pFuncname, pError, pArg1, pArg2, pArray); + /* launch error codeblock that can + a) change the members of the array = {dRetval, lHandled} to set the return value of the math C RTL routine and + the and it + b) can return an integer value to set the return value of matherr(). + NOTE that these values are only used if lHandled was .F. and is set to .T. within the codeblock */ + pRet = hb_itemDo( spMathErrorBlock, 6, pType, pFuncname, pError, pArg1, pArg2, pArray ); - hb_itemRelease (pType); - hb_itemRelease (pFuncname); - hb_itemRelease (pError); - hb_itemRelease (pArg1); - hb_itemRelease (pArg2); - hb_itemRelease (pRetval); - hb_itemRelease (pHandled); + hb_itemRelease( pType ); + hb_itemRelease( pFuncname ); + hb_itemRelease( pError ); + hb_itemRelease( pArg1 ); + hb_itemRelease( pArg2 ); + hb_itemRelease( pRetval ); + hb_itemRelease( pHandled ); - if( pexc->handled ) - { - /* math exception has already been handled, so codeblock call above was only informative */ - retval = 1; - } - else - { - /* exception handled by codeblock ? */ - pHandled = hb_itemArrayGet (pArray, 2); - if (pHandled != NULL) + if( pexc->handled ) { - pexc->handled = hb_itemGetL( pHandled ); - hb_itemRelease( pHandled ); - } - - if (pexc->handled) - { - /* YES ! */ - /* extract retval for math routine and matherr() */ - pRetval = hb_itemArrayGet (pArray, 1); - if (pRetval != NULL) - { - pexc->retval = hb_itemGetND (pRetval); - hb_itemGetNLen (pRetval, &(pexc->retvalwidth), &(pexc->retvaldec)); - hb_itemRelease (pRetval); - } - if ((pRet != NULL) && HB_IS_NUMERIC (pRet)) - { - retval = hb_itemGetNI (pRet); /* block may also return 0 to force C math lib warnings */ - hb_itemRelease (pRet); - } - else - { - retval = 1; /* default return value to suppress C math lib warnings */ - } + /* math exception has already been handled, so codeblock call above was only informative */ + retval = 1; } else { - /* NO ! */ - retval = 1; - } - } - hb_itemRelease (pArray); - } - else - { - retval = 1; /* default return value to suppress C math lib warnings */ - } + /* exception handled by codeblock ? */ + pHandled = hb_itemArrayGet( pArray, 2 ); + if( pHandled != NULL ) + { + pexc->handled = hb_itemGetL( pHandled ); + hb_itemRelease( pHandled ); + } - if (sPrevMathHandler != NULL) - { - if (pexc->handled) - { - /* the error is handled, so simply inform the previous handler */ - (*sPrevMathHandler)(pexc); - } - else - { - /* else go on error handling within previous handler */ - retval = (*sPrevMathHandler)(pexc); - } - } - return retval; + if( pexc->handled ) + { + /* YES ! */ + /* extract retval for math routine and matherr() */ + pRetval = hb_itemArrayGet( pArray, 1 ); + if( pRetval != NULL ) + { + pexc->retval = hb_itemGetND( pRetval ); + hb_itemGetNLen( pRetval, &pexc->retvalwidth, &pexc->retvaldec ); + hb_itemRelease( pRetval ); + } + if( pRet != NULL && HB_IS_NUMERIC( pRet ) ) + { + retval = hb_itemGetNI( pRet ); /* block may also return 0 to force C math lib warnings */ + hb_itemRelease( pRet ); + } + else + { + retval = 1; /* default return value to suppress C math lib warnings */ + } + } + else + { + /* NO ! */ + retval = 1; + } + } + hb_itemRelease( pArray ); + } + else + { + retval = 1; /* default return value to suppress C math lib warnings */ + } + + if( sPrevMathHandler != NULL ) + { + if( pexc->handled ) + { + /* the error is handled, so simply inform the previous handler */ + (*sPrevMathHandler)( pexc ); + } + else + { + /* else go on error handling within previous handler */ + retval = (*sPrevMathHandler)( pexc ); + } + } + return retval; } /* set/get math error block */ @@ -625,16 +618,16 @@ HB_FUNC( EXP ) if( ISNUM( 1 ) ) { HB_MATH_EXCEPTION hb_exc; - double dResult; + double dResult, dArg = hb_parnd( 1 ); #if defined(HB_MATH_ERRNO) errno = 0; - dResult = exp( hb_parnd( 1 ) ); - if ( hb_mathErrSet( dResult, hb_parnd (1), 0.0, "EXP", errno ) ) + dResult = exp( dArg ); + if( hb_mathErrSet( dResult, dArg, 0.0, "EXP", errno ) ) #else hb_mathResetError(); - dResult = exp( hb_parnd( 1 ) ); - if ( hb_mathIsMathErr() ) + dResult = exp( dArg ); + if( hb_mathIsMathErr() ) #endif { /* the C-RTL provides a kind of matherr() mechanism */ @@ -674,16 +667,16 @@ HB_FUNC( LOG ) if( ISNUM ( 1 ) ) { HB_MATH_EXCEPTION hb_exc; - double dResult; + double dResult, dArg = hb_parnd( 1 ); #if defined(HB_MATH_ERRNO) errno = 0; - dResult = log( hb_parnd( 1 ) ); - if ( hb_mathErrSet( dResult, hb_parnd (1), 0.0, "LOG", errno ) ) + dResult = log( dArg ); + if( hb_mathErrSet( dResult, dArg, 0.0, "LOG", errno ) ) #else hb_mathResetError(); - dResult = log( hb_parnd( 1 ) ); - if ( hb_mathIsMathErr() ) + dResult = log( dArg ); + if( hb_mathIsMathErr() ) #endif { /* the C-RTL provides a kind of matherr() mechanism */ @@ -726,16 +719,16 @@ HB_FUNC( SQRT ) if( ISNUM( 1 ) ) { HB_MATH_EXCEPTION hb_exc; - double dResult; + double dResult, dArg = hb_parnd( 1 ); #if defined(HB_MATH_ERRNO) errno = 0; - dResult = sqrt( hb_parnd( 1 ) ); - if ( hb_mathErrSet( dResult, hb_parnd( 1 ), 0.0, "SQRT", errno ) ) + dResult = sqrt( dArg ); + if ( hb_mathErrSet( dResult, dArg, 0.0, "SQRT", errno ) ) #else hb_mathResetError(); - dResult = sqrt( hb_parnd( 1 ) ); - if ( hb_mathIsMathErr() ) + dResult = sqrt( dArg ); + if( hb_mathIsMathErr() ) #endif { /* the C-RTL provides a kind of matherr() mechanism */ diff --git a/harbour/source/vm/classes.c b/harbour/source/vm/classes.c index 741c1bb8b6..417af54a18 100644 --- a/harbour/source/vm/classes.c +++ b/harbour/source/vm/classes.c @@ -706,6 +706,7 @@ char * hb_objGetClsName( PHB_ITEM pObject ) break; case HB_IT_STRING: + case HB_IT_MEMO: szClassName = "CHARACTER"; break; @@ -752,57 +753,54 @@ char * hb_objGetRealClsName( PHB_ITEM pObject, char * szName ) { HB_TRACE(HB_TR_DEBUG, ("hb_objGetrealClsName(%p)", pObject)); - if( HB_IS_ARRAY( pObject ) ) + if( HB_IS_OBJECT( pObject ) ) { - if( pObject->item.asArray.value->uiClass ) + PHB_DYNS pMsg = hb_dynsymFindName( szName ); + USHORT uiClass; + USHORT uiCurCls; + USHORT uiClsTree; + + uiClass = pObject->item.asArray.value->uiClass; + + /* default value to current class object */ + if (pObject->item.asArray.value->puiClsTree && pObject->item.asArray.value->puiClsTree[0]) { - PHB_DYNS pMsg = hb_dynsymFindName( szName ); - USHORT uiClass; - USHORT uiCurCls; - USHORT uiClsTree; - - uiClass = pObject->item.asArray.value->uiClass; - - /* default value to current class object */ - if (pObject->item.asArray.value->puiClsTree && pObject->item.asArray.value->puiClsTree[0]) - { - uiClsTree = pObject->item.asArray.value->puiClsTree[0] ; - uiCurCls = pObject->item.asArray.value->puiClsTree[uiClsTree] ; - } - else - { - uiClsTree = 1; /* Flag value */ - uiCurCls = uiClass; - } - - while (uiClsTree) - { - if( uiCurCls && uiCurCls <= s_uiClasses ) - { - PCLASS pClass = s_pClasses + ( uiCurCls - 1 ); - USHORT uiAt = ( USHORT ) ( ( ( hb_cls_MsgToNum( pMsg ) ) % pClass->uiHashKey ) * BUCKET ); - USHORT uiMask = ( USHORT ) ( pClass->uiHashKey * BUCKET ); - USHORT uiLimit = ( USHORT ) ( uiAt ? ( uiAt - 1 ) : ( uiMask - 1 ) ); - - while( uiAt != uiLimit ) - { - if( pClass->pMethods[ uiAt ].pMessage == pMsg ) - { - uiClass = (pClass->pMethods + uiAt)->uiSprClass; - uiClsTree=1; /* Flag Value */ - break; - } - if( ++uiAt == uiMask ) - uiAt = 0; - } - } - if (-- uiClsTree) - uiCurCls = pObject->item.asArray.value->puiClsTree[uiClsTree] ; - } - - if( uiClass && uiClass <= s_uiClasses ) - return ( s_pClasses + uiClass - 1 )->szName; + uiClsTree = pObject->item.asArray.value->puiClsTree[0] ; + uiCurCls = pObject->item.asArray.value->puiClsTree[uiClsTree] ; } + else + { + uiClsTree = 1; /* Flag value */ + uiCurCls = uiClass; + } + + while (uiClsTree) + { + if( uiCurCls && uiCurCls <= s_uiClasses ) + { + PCLASS pClass = s_pClasses + ( uiCurCls - 1 ); + USHORT uiAt = ( USHORT ) ( ( ( hb_cls_MsgToNum( pMsg ) ) % pClass->uiHashKey ) * BUCKET ); + USHORT uiMask = ( USHORT ) ( pClass->uiHashKey * BUCKET ); + USHORT uiLimit = ( USHORT ) ( uiAt ? ( uiAt - 1 ) : ( uiMask - 1 ) ); + + while( uiAt != uiLimit ) + { + if( pClass->pMethods[ uiAt ].pMessage == pMsg ) + { + uiClass = (pClass->pMethods + uiAt)->uiSprClass; + uiClsTree=1; /* Flag Value */ + break; + } + if( ++uiAt == uiMask ) + uiAt = 0; + } + } + if (-- uiClsTree) + uiCurCls = pObject->item.asArray.value->puiClsTree[uiClsTree] ; + } + + if( uiClass && uiClass <= s_uiClasses ) + return ( s_pClasses + uiClass - 1 )->szName; } return hb_objGetClsName( pObject ); @@ -2629,17 +2627,6 @@ HB_FUNC( __CLS_PAR00 ) } #ifndef HB_NO_PROFILER -static ULONG MsgToNum( char * szName ) -{ - USHORT i; - ULONG nRetVal = 0; - - for( i = 0; szName[ i ] != '\0'; i++) - nRetVal = ( nRetVal << 1 ) + szName[ i ]; - - return nRetVal; -} - /* profiler: It provides to the HVM the just requested method pointer */ void * hb_mthRequested( void ) { @@ -2660,26 +2647,36 @@ HB_FUNC( __GETMSGPRF ) /* profiler: returns a method called and consumed times * /* ( nClass, cMsg ) --> aMethodInfo { nTimes, nTime } */ { #ifndef HB_NO_PROFILER - PCLASS pClass = s_pClasses + ( hb_parnl( 1 ) - 1 ); + USHORT uiClass = ( USHORT ) hb_parni( 1 ); char * cMsg = hb_parc( 2 ); - USHORT uiAt = ( USHORT ) ( ( ( MsgToNum( cMsg ) ) % pClass->uiHashKey ) * BUCKET ); - USHORT uiMask = ( USHORT ) ( pClass->uiHashKey * BUCKET ); - USHORT uiLimit = ( USHORT ) ( uiAt ? ( uiAt - 1 ) : ( uiMask - 1 ) ); - PMETHOD pMethod; hb_reta( 2 ); - while( uiAt != uiLimit ) + if( uiClass && uiClass <= s_uiClasses && cMsg && *cMsg ) { - if( ! strcmp( pClass->pMethods[ uiAt ].pMessage->pSymbol->szName, cMsg ) ) + PHB_DYNS pMsg = hb_dynsymFindName( cMsg ); + + if( pMsg ) { - pMethod = pClass->pMethods + uiAt; - hb_stornl( pMethod->ulCalls, -1, 1 ); - hb_stornl( pMethod->ulTime, -1, 2 ); - return; + PCLASS pClass = s_pClasses + ( uiClass - 1 ); + USHORT uiAt = ( USHORT ) ( ( hb_cls_MsgToNum( pMsg ) % pClass->uiHashKey ) * BUCKET ); + USHORT uiMask = ( USHORT ) ( pClass->uiHashKey * BUCKET ); + USHORT uiLimit = ( USHORT ) ( uiAt ? ( uiAt - 1 ) : ( uiMask - 1 ) ); + PMETHOD pMethod; + + while( uiAt != uiLimit ) + { + if( pClass->pMethods[ uiAt ].pMessage->pSymbol->pDynSym = pMsg ) + { + pMethod = pClass->pMethods + uiAt; + hb_stornl( pMethod->ulCalls, -1, 1 ); + hb_stornl( pMethod->ulTime, -1, 2 ); + return; + } + uiAt++; + if( uiAt == uiMask ) + uiAt = 0; + } } - uiAt++; - if( uiAt == uiMask ) - uiAt = 0; } #else hb_reta( 2 ); diff --git a/harbour/source/vm/garbage.c b/harbour/source/vm/garbage.c index ba15791d22..3d0344abed 100644 --- a/harbour/source/vm/garbage.c +++ b/harbour/source/vm/garbage.c @@ -59,6 +59,8 @@ #include "hbvm.h" #include "error.ch" +#if !defined( HB_GC_PTR ) + /* holder of memory block information */ /* NOTE: USHORT is used intentionally to fill up the structure to * full 16 bytes (on 16/32 bit environment) @@ -80,6 +82,9 @@ typedef struct HB_GARBAGE_ #endif #define HB_GC_PTR( p ) ( ( HB_GARBAGE_PTR ) ( ( BYTE * ) ( p ) - HB_GARBAGE_SIZE ) ) + +#endif /* !defined( HB_GC_PTR ) */ + #define HB_MEM_PTR( p ) ( ( void * ) ( ( BYTE * ) ( p ) + HB_GARBAGE_SIZE ) ) /* we may use a cache later */ @@ -178,18 +183,21 @@ void hb_gcFree( void *pBlock ) } /* increment reference counter */ +#undef hb_gcRefInc void hb_gcRefInc( void * pBlock ) { hb_xRefInc( HB_GC_PTR( pBlock ) ); } /* decrement reference counter, return TRUE when 0 reached */ +#undef hb_gcRefDec BOOL hb_gcRefDec( void * pBlock ) { return hb_xRefDec( HB_GC_PTR( pBlock ) ); } /* decrement reference counter and free the block when 0 reached */ +#undef hb_gcRefFree void hb_gcRefFree( void * pBlock ) { if( pBlock ) @@ -234,6 +242,7 @@ void hb_gcRefFree( void * pBlock ) } /* return number of references */ +#undef hb_gcRefCount HB_COUNTER hb_gcRefCount( void * pBlock ) { return hb_xRefCount( HB_GC_PTR( pBlock ) ); diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index 47f761d626..8920429670 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -3273,8 +3273,8 @@ static LONG hb_vmEnumEnd( void ) { /* restore the value of variable before the FOREACH loop */ hb_itemMove( hb_itemUnRefOnce( hb_stackItemFromTop( -1 ) ), hb_stackItemFromTop( -2 ) ); - hb_stackDec(); hb_stackPop(); + hb_stackDec(); } return lOldBase; diff --git a/harbour/source/vm/maindllp.c b/harbour/source/vm/maindllp.c index 9fb50788c0..3465042cdc 100644 --- a/harbour/source/vm/maindllp.c +++ b/harbour/source/vm/maindllp.c @@ -156,16 +156,16 @@ char * hb_parc( int iParam, ... ) PHB_ITEM hb_param( int iParam, long lMask ) /* retrieve a generic parameter */ { - PHB_ITEM pReturn; - FARPROC pParam=GetProcAddress( GetModuleHandle( NULL ), "_hb_param" ); - if (pParam) - pReturn=((HB_PARAM)pParam)(iParam,lMask); + PHB_ITEM pReturn = NULL; + FARPROC pParam = GetProcAddress( GetModuleHandle( NULL ), "_hb_param" ); + if( pParam ) + pReturn = ( ( HB_PARAM ) pParam )( iParam, lMask ); return pReturn; } PHB_ITEM hb_paramError( int iParam ) /* Returns either the generic parameter or a NIL item if param not provided */ { - PHB_ITEM pReturn; + PHB_ITEM pReturn = NULL; FARPROC pParamError=GetProcAddress( GetModuleHandle( NULL ), "_hb_paramError" ); if (pParamError) pReturn=((HB_PARAMERROR)pParamError)(iParam); @@ -173,7 +173,7 @@ PHB_ITEM hb_paramError( int iParam ) /* Returns either the generic parameter or } int hb_pcount( void ) /* returns the number of suplied parameters */ { - int iReturn; + int iReturn = 0; FARPROC pCounts=GetProcAddress(GetModuleHandle( NULL ), "_hb_pcount" ); if (pCounts) iReturn=((HB_PCOUNTS)pCounts)(); @@ -250,7 +250,6 @@ void hb_retnlen( double dNumber, int iWidth, int iDec ) /* returns a double, wit FARPROC pRet=GetProcAddress(GetModuleHandle( NULL ), "_hb_retnlen" ); if (pRet) ((HB_RETNLEN)pRet)(dNumber,iWidth,iDec); - } void hb_retndlen( double dNumber, int iWidth, int iDec ) /* returns a double, with specific width and decimals */ @@ -283,7 +282,7 @@ void hb_reta( ULONG ulLen ) /* returns an array with a specific length */ ULONG hb_parinfa( int iParamNum, ULONG uiArrayIndex ) /* retrieve length or element type of an array parameter */ { - ULONG ulReturn; + ULONG ulReturn = 0; FARPROC pParinfa=GetProcAddress( GetModuleHandle( NULL ), "_hb_parinfa" ); if (pParinfa) ulReturn=((HB_PARINFA)pParinfa)(iParamNum,uiArrayIndex); @@ -292,7 +291,7 @@ ULONG hb_parinfa( int iParamNum, ULONG uiArrayIndex ) /* retrieve length or elem ULONG hb_parinfo( int iParam ) /* Determine the param count or data type */ { - ULONG ulReturn; + ULONG ulReturn = 0; FARPROC pParinfo=GetProcAddress( GetModuleHandle( NULL ), "_hb_parinfo" ); if (pParinfo) ulReturn=((HB_PARINFO)pParinfo)(iParam); @@ -818,7 +817,7 @@ void hb_xexit( void ) /* Deinitialize fixed memory s void * hb_xalloc( ULONG ulSize ) /* allocates memory, returns NULL on failure */ { - void * pRet; + void * pRet = NULL; HB_XALLOC pXalloc = (HB_XALLOC)GetProcAddress( GetModuleHandle( NULL ), "_hb_xalloc" ); if (pXalloc) pRet=pXalloc(ulSize); @@ -827,7 +826,7 @@ void * hb_xalloc( ULONG ulSize ) /* allocates memory, returns NUL void * hb_xgrab( ULONG ulSize ) /* allocates memory, exits on failure */ { - void * pRet; + void * pRet = NULL; HB_XGRAB pXgrab = (HB_XGRAB)GetProcAddress( GetModuleHandle( NULL ), "_hb_xgrab" ); if (pXgrab) pRet=pXgrab(ulSize); @@ -843,7 +842,7 @@ void hb_xfree( void * pMem ) /* frees memory */ void * hb_xrealloc( void * pMem, ULONG ulSize ) /* reallocates memory */ { - void * pRet; + void * pRet = NULL; HB_XREALLOC pXrealloc = (HB_XREALLOC)GetProcAddress( GetModuleHandle( NULL ), "_hb_xrealloc" ); if (pXrealloc) pRet= (void*)pXrealloc( pMem, ulSize );