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

2006-06-19 23:10 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* 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
This commit is contained in:
Przemyslaw Czerpak
2006-06-19 21:11:59 +00:00
parent fb60be5866
commit 5f67da8896
11 changed files with 352 additions and 313 deletions
Download Patch File Download Diff File Expand all files Collapse all files

32
harbour/ChangeLog
View File

@@ -8,6 +8,38 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
* 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

1
harbour/include/Makefile
View File

@@ -9,6 +9,7 @@ C_HEADERS=\
extend.h \
hbapi.h \
hbapicdp.h \
hbapicls.h \
hbapierr.h \
hbapifs.h \
hbapigt.h \

12
harbour/include/hbapi.h
View File

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

10
harbour/include/hbmath.h
View File

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

5
harbour/include/hbtypes.h
View File

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

53
harbour/source/compiler/genc.c
View File

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

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

@@ -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 ) /* ([<nNewMode>]) -> <nOldMode> */
}
/* 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 <exception handled flag> 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 <exception handled flag> 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 */

143
harbour/source/vm/classes.c
View File

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

9
harbour/source/vm/garbage.c
View File

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

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

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

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

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