diff --git a/harbour/ChangeLog b/harbour/ChangeLog index ee49dfc696..bd500c1235 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,18 @@ +2001-07-20 13:10 GMT+2 Martin Vopgel + * source/rtl/math.c + * include/hbmath.h + ! Added typedefs for non-matherr-math libraries + ! Fixed bug concerning custom math handler return values + + * contrib/libct/ctmath.c + * contrib/libct/ctmath.h + ! Changes analog to the changes in rtl/math.c + ! minor bug fixes and cleanups + + * contrib/libct/makefile.bc + ! typo fixed + + 2001-07-20 13:35 GMT+3 Alexander Kresin * source/rtl/memofile.c ! A bug fixed, which appeared while reading an empty file diff --git a/harbour/contrib/libct/ctmath.c b/harbour/contrib/libct/ctmath.c index a1e644e977..cf1eeeb801 100644 --- a/harbour/contrib/libct/ctmath.c +++ b/harbour/contrib/libct/ctmath.c @@ -58,43 +58,65 @@ /* -------------- */ /* initialization */ /* -------------- */ -static HB_MATH_HANDLERHANDLE s_ctMathHandler; /* TODO: make this thread safe */ +static HB_MATH_HANDLERHANDLE s_ctMathHandler = NULL; /* TODO: make this thread safe */ int ct_math_init (void) { HB_TRACE(HB_TR_DEBUG, ("ctmath_init()")); - s_ctMathHandler = hb_installMathHandler (ct_matherr); - - /* CT3 math handler is inactive by default */ - hb_setMathHandlerStatus (s_ctMathHandler, CT_MATHERR_STATUS_INACTIVE); - return; + + if (hb_isMathHandler()) + { + s_ctMathHandler = hb_installMathHandler (ct_matherr); + /* CT3 math handler is inactive by default */ + hb_setMathHandlerStatus (s_ctMathHandler, CT_MATHERR_STATUS_INACTIVE); + return (1); + } + return (0); } int ct_math_exit (void) { HB_TRACE(HB_TR_DEBUG, ("ctmath_exit()")); - hb_deinstallMathHandler (s_ctMathHandler); - return; + if (hb_isMathHandler()) + { + hb_deinstallMathHandler (s_ctMathHandler); + } + return (1); } +static int s_ct_matherr_status = CT_MATHERR_STATUS_INACTIVE; /* TODO: make this thread safe */ void ct_setmatherrstatus (int iStatus) { HB_TRACE(HB_TR_DEBUG, ("ct_setmatherrstatus (%i)", iStatus)); - if (s_ctMathHandler != NULL) - { - hb_setMathHandlerStatus (s_ctMathHandler, iStatus); - } + s_ct_matherr_status = iStatus; return; } int ct_getmatherrstatus (void) { HB_TRACE(HB_TR_DEBUG, ("ct_getmatherrstatus()")); - if (s_ctMathHandler != NULL) + return (s_ct_matherr_status); +} + +/* functions to "bracket" CT3 math code */ +void ct_matherrbegin (void) +{ + HB_TRACE(HB_TR_DEBUG, ("ct_matherrbegin()")); + if (hb_isMathHandler() && (s_ct_matherr_status == CT_MATHERR_STATUS_ACTIVE)) { - return (hb_getMathHandlerStatus (s_ctMathHandler)); + hb_setMathHandlerStatus (s_ctMathHandler, CT_MATHERR_STATUS_ACTIVE); } - return (0); + return; +} + +void ct_matherrend (void) +{ + HB_TRACE(HB_TR_DEBUG, ("ct_matherrend()")); + if (hb_isMathHandler()) + { + hb_setMathHandlerStatus (s_ctMathHandler, CT_MATHERR_STATUS_INACTIVE); + } + return; } /* ------------------------- */ @@ -107,6 +129,7 @@ void ct_setmatherrmode (int iMode) s_ct_matherr_mode = iMode; return; } + int ct_getmatherrmode (void) { HB_TRACE(HB_TR_DEBUG, ("ct_getmatherrmode()")); @@ -144,7 +167,8 @@ int ct_getmatherrmode (void) * CT_ERROR_MATHLIB_TLOSS total loss of significance will result, such as exp (1000) * CT_ERROR_MATHLIB_PLOSS partial loss of significance will result, such as sin (10e70) * - * The CT3 library redirects these errors to its own math handler. + * The CT3 library redirects these errors within its math routines + * to its own math handler. * The behaviour of this handler depends on the values of * and : * @@ -266,20 +290,20 @@ HB_FUNC (SETMATHERR) /* -------------- */ /* math handler */ /* -------------- */ -int ct_matherr (struct exception * err) +int ct_matherr (HB_MATH_EXCEPTION * pexc) { int retval = 0; int imatherr = ct_getmatherrmode(); - HB_TRACE(HB_TR_DEBUG, ("ct_matherr (%p)", err)); + HB_TRACE(HB_TR_DEBUG, ("ct_matherr (%p)", pexc)); if ((imatherr == CT_MATHERR_MODE_USER) || (imatherr == CT_MATHERR_MODE_USERDEFAULT)) { PHB_ITEM pMatherrResult, pArg1, pArg2; ULONG ulSubCode; - switch (err->type) + switch (pexc->type) { case DOMAIN: /* a domain error has occured, such as sqrt( -1 ) */ @@ -304,15 +328,15 @@ int ct_matherr (struct exception * err) ulSubCode = CT_ERROR_MATHLIB; break; } - pArg1 = hb_itemPutND (NULL, err->arg1); - pArg2 = hb_itemPutND (NULL, err->arg2); + pArg1 = hb_itemPutND (NULL, pexc->arg1); + pArg2 = hb_itemPutND (NULL, pexc->arg2); pMatherrResult = ct_error_subst (ES_ERROR, EG_NUMERR, ulSubCode, - NULL, err->name, 0, EF_CANSUBSTITUTE, + NULL, pexc->name, 0, EF_CANSUBSTITUTE, 2, pArg1, pArg2); if ((pMatherrResult != NULL) && (HB_IS_NUMERIC (pMatherrResult))) { - err->retval = hb_itemGetND (pMatherrResult); + pexc->retval = hb_itemGetND (pMatherrResult); retval = 1; } @@ -325,53 +349,53 @@ int ct_matherr (struct exception * err) ((imatherr == CT_MATHERR_MODE_DEFAULT) || (imatherr == CT_MATHERR_MODE_USERDEFAULT))) { /* find some appropiate return values */ - switch (err->type) + switch (pexc->type) { case DOMAIN: /* a domain error has occured, such as sqrt( -1 ) */ - err->retval = 0.0; + pexc->retval = 0.0; retval = 1; break; case SING: /* a singularity will result, such as pow( 0, -2 ) */ - if (err->arg1 < 0) /* it is just a guess that the resulting singularity - has the same sign as the first argument */ - err->retval = -DBL_MAX; + if (pexc->arg1 < 0) /* it is just a guess that the resulting singularity + has the same sign as the first argument */ + pexc->retval = -DBL_MAX; else - err->retval = DBL_MAX; + pexc->retval = DBL_MAX; retval = 1; break; case OVERFLOW: /* an overflow will result, such as pow( 10, 100 ) */ - if (err->arg1 < 0) /* it is just a guess that the resulting singularity - has the same sign as the first argument */ - err->retval = -DBL_MAX; + if (pexc->arg1 < 0) /* it is just a guess that the resulting singularity + has the same sign as the first argument */ + pexc->retval = -DBL_MAX; else - err->retval = DBL_MAX; + pexc->retval = DBL_MAX; retval = 1; break; case UNDERFLOW: /* an underflow will result, such as pow( 10, -100 ) */ - if (err->arg1 < 0) /* it is just a guess that the resulting singularity - has the same sign as the first argument */ - err->retval = -DBL_MIN; + if (pexc->arg1 < 0) /* it is just a guess that the resulting singularity + has the same sign as the first argument */ + pexc->retval = -DBL_MIN; else - err->retval = DBL_MIN; + pexc->retval = DBL_MIN; retval = 1; break; case TLOSS: /* total loss of significance will result, such as exp( 1000 ) */ - err->retval = 1.0; + pexc->retval = 1.0; retval = 1; break; case PLOSS: /* partial loss of significance will result, such as sin( 10e70 ) */ - err->retval = 1.0; + pexc->retval = 1.0; retval = 1; break; default: /* unknown math lib error */ - err->retval = 0.0; + pexc->retval = 0.0; retval = 1; break; } diff --git a/harbour/contrib/libct/ctmath.h b/harbour/contrib/libct/ctmath.h index eb65a0f0c2..3a912c7e06 100644 --- a/harbour/contrib/libct/ctmath.h +++ b/harbour/contrib/libct/ctmath.h @@ -70,6 +70,10 @@ extern int ct_getmatherrstatus (void); extern void ct_setmatherrmode (int iMode); extern int ct_getmatherrmode (void); +/* functions to bracket CT3 math code */ +void ct_matherrbegin (void); +void ct_matherrend (void); + /* stati and modes for math error correction */ #define CT_MATHERR_STATUS_NOTFOUND HB_MATH_HANDLER_STATUS_NOTFOUND /* math handler is not installed */ #define CT_MATHERR_STATUS_INACTIVE HB_MATH_HANDLER_STATUS_INACTIVE /* math handler is installed but inactive */ @@ -81,7 +85,7 @@ extern int ct_getmatherrmode (void); #define CT_MATHERR_MODE_USERDEFAULT 3 /* error will be thrown, but if user fails, default correction will be used */ /* CT3 math error handler */ -extern int ct_matherr (struct exception * err); +extern int ct_matherr (HB_MATH_EXCEPTION * pexc); /* set & get precision */ extern void ct_setprecision (int iPrecision); diff --git a/harbour/contrib/libct/makefile.bc b/harbour/contrib/libct/makefile.bc index fbd946787c..b7a2b55649 100644 --- a/harbour/contrib/libct/makefile.bc +++ b/harbour/contrib/libct/makefile.bc @@ -106,8 +106,8 @@ TOOLS_LIB_OBJS = \ $(OBJ_DIR)\charrepl.obj \ $(OBJ_DIR)\charsort.obj \ $(OBJ_DIR)\charswap.obj \ - $(OBJ_DIR)\ct.c \ - $(OBJ_DIR)\ctmath.c \ + $(OBJ_DIR)\ct.obj \ + $(OBJ_DIR)\ctmath.obj \ $(OBJ_DIR)\ctset.obj \ $(OBJ_DIR)\ctstr.obj \ $(OBJ_DIR)\ctchksum.obj \ diff --git a/harbour/include/hbmath.h b/harbour/include/hbmath.h index 08d47980fa..6cac23e28d 100644 --- a/harbour/include/hbmath.h +++ b/harbour/include/hbmath.h @@ -87,7 +87,17 @@ extern int hb_getMathError (void); extern void hb_resetMathError (void); extern int hb_isMathHandler (void); -typedef int (* HB_MATH_HANDLERPROC)(struct exception *err); +typedef struct _HB_MATH_EXCEPTION +{ + int type; + char *name; + double arg1; + double arg2; + double retval; +} HB_MATH_EXCEPTION; + +typedef int (* HB_MATH_HANDLERPROC)(HB_MATH_EXCEPTION *err); + typedef struct HB_MATH_HANDLERCHAINELEMENT_ { HB_MATH_HANDLERPROC handlerproc; diff --git a/harbour/source/rtl/math.c b/harbour/source/rtl/math.c index 2dcb59c44e..ab8b92706c 100644 --- a/harbour/source/rtl/math.c +++ b/harbour/source/rtl/math.c @@ -8,10 +8,10 @@ * * Copyright 1999 Matthew Hamilton * - * Functions for user defined math error handlers + * Functions for user defined math error handlers * Copyright 2001 IntTec GmbH, Freiburg, Germany, * Author: Martin Vogel - * + * * www - http://www.harbour-project.org * * This program is free software; you can redistribute it and/or modify @@ -92,7 +92,7 @@ static PHB_MATH_HANDLERCHAINELEMENT s_pChain = NULL; /* TODO: make this thread s /* install custom math handler */ HB_MATH_HANDLERHANDLE hb_installMathHandler (HB_MATH_HANDLERPROC handlerproc) { - + PHB_MATH_HANDLERCHAINELEMENT pChain, pNewChainelement; HB_TRACE(HB_TR_DEBUG, ("hb_installMathHandler (%p)", handlerproc)); @@ -121,7 +121,7 @@ HB_MATH_HANDLERHANDLE hb_installMathHandler (HB_MATH_HANDLERPROC handlerproc) /* deinstall custom math handler */ int hb_deinstallMathHandler (HB_MATH_HANDLERHANDLE handle) { - + PHB_MATH_HANDLERCHAINELEMENT pChain; HB_TRACE(HB_TR_DEBUG, ("hb_deinstallMathHandler (%p)", handle)); @@ -136,7 +136,7 @@ int hb_deinstallMathHandler (HB_MATH_HANDLERHANDLE handle) else { pChain = s_pChain; - + while (pChain != NULL) { if (pChain->pnext == (PHB_MATH_HANDLERCHAINELEMENT)handle) @@ -159,7 +159,7 @@ int hb_deinstallMathHandler (HB_MATH_HANDLERHANDLE handle) int hb_setMathHandlerStatus (HB_MATH_HANDLERHANDLE handle, int status) { int oldstatus = HB_MATH_HANDLER_STATUS_NOTFOUND; - + HB_TRACE(HB_TR_DEBUG, ("hb_setMathHandlerStatus (%p, %i)", handle, status)); if (handle != NULL) { @@ -191,18 +191,30 @@ int matherr( struct exception * err ) PHB_MATH_HANDLERCHAINELEMENT pChain = s_pChain; int retval = -1; + double dretval = 0.0; + HB_MATH_EXCEPTION exc; HB_TRACE(HB_TR_DEBUG, ("matherr(%p)", err)); - + /* call custom math handlers */ + exc.type = err->type; + exc.name = err->name; + exc.arg1 = err->arg1; + exc.arg2 = err->arg2; + exc.retval = err->retval; + while (pChain != NULL) { int ret; if (pChain->status == HB_MATH_HANDLER_STATUS_ACTIVE) { - ret = (*(pChain->handlerproc))(err); - /* store the maximum return value */ - retval = (retval <= ret ? ret : retval); + ret = (*(pChain->handlerproc))(&exc); + /* store the math return value from the handler that returns the largest integer */ + if (ret > retval) + { + dretval = exc.retval; + retval = ret; + } } pChain = pChain->pnext; } @@ -242,9 +254,10 @@ int matherr( struct exception * err ) { /* default behaviour */ err->retval = 0.0; - return 1; /* don't print any message and don't set errno */ + return (1); /* don't print any message and don't set errno */ } - + + err->retval = dretval; return (retval); }