diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 1524458087..50820fe365 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,60 @@ +2001-07-17 20:00 MEST Martin Vogel + + * source/rtl/math.c + * include/hbmath.h + * memory leak fixed in hb_deinstallMathHandler() + * various HB_TRACEs added + * new status flag added + + + contrib/libct/ct.c + + lib main module with functions CTINIT(), CTEXIT(), CSETARGERR() and + error handling added + + + contrib/libct/ctmath.c + + contrib/libct/ctmath.h + + math main module added + + functions SETMATHERR(), SETPREC(), GETPREC() added + + + contrib/libct/cterror.ch + + error codes added + + * contrib/libct/ctset.c + * contrib/libct/ctset.h + * contrib/libct/ctstr.c + * contrib/libct/ctstr.h + * string switch functions moved to ctstr.c, ctset.c will be main module + for switch functions + * new switchable argument error handling added, see CSETARGERR() + + * contrib/libct/addascii.c + * contrib/libct/asciisum.c + * contrib/libct/ascpos.c + * contrib/libct/atadjust.c + * contrib/libct/atnum.c + * contrib/libct/atrepl.c + * contrib/libct/charevod.c + * contrib/libct/charmirr.c + * contrib/libct/charmix.c + * contrib/libct/charone.c + * contrib/libct/charonly.c + * contrib/libct/charop.c + * contrib/libct/charrepl.c + * contrib/libct/charsort.c + * contrib/libct/charswap.c + * contrib/libct/token1.c + * contrib/libct/wordrepl.c + * new switchable argument error handling added, see CSETARGERR() + + * contrib/libct/Makefile + * contrib/libct/makefile.bc + * contrib/libct/makefile.vc + + ct.c + + ctmath.c + + * contrib/libct/ctflist.c + * contrib/libct/readme.txt + + new functions and their (short) description added + 2001-07-17 18:35 GMT+3 Alexander Kresin * source/rdd/dbfntx1.c * Fixed few bugs, reported by John M. S. Chiang, diff --git a/harbour/contrib/libct/Makefile b/harbour/contrib/libct/Makefile index a305f76cbd..72575fb05c 100644 --- a/harbour/contrib/libct/Makefile +++ b/harbour/contrib/libct/Makefile @@ -21,6 +21,8 @@ C_SOURCES = \ charrepl.c \ charsort.c \ charswap.c \ + ct.c \ + ctmath.c \ ctset.c \ ctstr.c \ ctchksum.c \ @@ -33,7 +35,7 @@ C_SOURCES = \ PRG_SOURCES= \ ctmisc.prg \ -LIBNAME=ct3 +LIBNAME=libct include $(TOP)$(ROOT)config/lib.cf diff --git a/harbour/contrib/libct/addascii.c b/harbour/contrib/libct/addascii.c index f83fc83f46..eabc32c15d 100644 --- a/harbour/contrib/libct/addascii.c +++ b/harbour/contrib/libct/addascii.c @@ -124,6 +124,11 @@ HB_FUNC (ADDASCII) { + int iNoRet; + + /* suppressing return value ? */ + iNoRet = ct_getref(); + if (ISCHAR (1)) { @@ -133,23 +138,29 @@ HB_FUNC (ADDASCII) size_t sPos; long lValue; int iCarryOver; - int iNoRet; if (ISNUM (3)) sPos = hb_parnl (3); else sPos = sLen; - /* suppressing return value ? */ - iNoRet = ct_getref(); - if ((sPos > sLen) || !(ISNUM (2))) { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_ADDASCII, + NULL, "ADDASCII", 0, EF_CANDEFAULT, 4, + hb_paramError (1), hb_paramError (2), + hb_paramError (3), hb_paramError (4)); + } + /* return string unchanged */ if (iNoRet) hb_retl (0); else hb_retclen (pcSource, sLen); + return; } @@ -199,7 +210,28 @@ HB_FUNC (ADDASCII) } else { - hb_retc (""); + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_ADDASCII, + NULL, "ADDASCII", 0, EF_CANSUBSTITUTE, 4, + hb_paramError (1), hb_paramError (2), + hb_paramError (3), hb_paramError (4)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + if (iNoRet) + hb_retl (0); + else + hb_retc (""); + } return; } diff --git a/harbour/contrib/libct/asciisum.c b/harbour/contrib/libct/asciisum.c index b73dc2601a..8a47385cde 100644 --- a/harbour/contrib/libct/asciisum.c +++ b/harbour/contrib/libct/asciisum.c @@ -112,7 +112,23 @@ HB_FUNC (ASCIISUM) } else { - hb_retnl (0); + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_ASCIISUM, + NULL, "ASCIISUM", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnl (0); + } } return; diff --git a/harbour/contrib/libct/ascpos.c b/harbour/contrib/libct/ascpos.c index 08103d7d63..894d59ff1c 100644 --- a/harbour/contrib/libct/ascpos.c +++ b/harbour/contrib/libct/ascpos.c @@ -101,7 +101,26 @@ static void do_ascpos (int iSwitch) } else { - hb_retnl (0); + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, + (iSwitch == DO_ASCPOS_VALPOS ? CT_ERROR_VALPOS : CT_ERROR_ASCPOS), + NULL, + (iSwitch == DO_ASCPOS_VALPOS ? "VALPOS" : "ASCPOS"), + 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnl (0); + } } return; diff --git a/harbour/contrib/libct/atadjust.c b/harbour/contrib/libct/atadjust.c index eb1cf9898c..ad6984f4c3 100644 --- a/harbour/contrib/libct/atadjust.c +++ b/harbour/contrib/libct/atadjust.c @@ -130,6 +130,15 @@ HB_FUNC (ATADJUST) if (sIgnore >= sStrLen) { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_ATADJUST, + NULL, "ATADJUST", 0, EF_CANDEFAULT, 6, + hb_paramError (1), hb_paramError (2), + hb_paramError (3), hb_paramError (4), + hb_paramError (5), hb_paramError (6)); + } hb_retclen (pcString, sStrLen); return; } @@ -142,6 +151,15 @@ HB_FUNC (ATADJUST) /* check for wrong adjust position */ if (sAdjustPosition == 0) { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_ATADJUST, + NULL, "ATADJUST", 0, EF_CANDEFAULT, 6, + hb_paramError (1), hb_paramError (2), + hb_paramError (3), hb_paramError (4), + hb_paramError (5), hb_paramError (6)); + } hb_retclen (pcString, sStrLen); return; } @@ -310,10 +328,29 @@ HB_FUNC (ATADJUST) } else /* ((ISCHAR (1)) && (ISCHAR (2)) && (ISNUM (3))) */ { - if (ISCHAR (2)) - hb_retclen (hb_parc (2), hb_parclen (2)); + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_ATADJUST, + NULL, "ATADJUST", 0, EF_CANSUBSTITUTE, 6, + hb_paramError (1), hb_paramError (2), + hb_paramError (3), hb_paramError (4), + hb_paramError (5), hb_paramError (6)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } else - hb_retc (""); + { + if (ISCHAR (2)) + hb_retclen (hb_parc (2), hb_parclen (2)); + else + hb_retc (""); + } } return; diff --git a/harbour/contrib/libct/atnum.c b/harbour/contrib/libct/atnum.c index 2bdb5ba620..9b2f3bfe67 100644 --- a/harbour/contrib/libct/atnum.c +++ b/harbour/contrib/libct/atnum.c @@ -94,16 +94,44 @@ static void do_atnum (int iSwitch) switch (iSwitch) { case DO_ATNUM_AFTERATNUM: - case DO_ATNUM_BEFORATNUM: { /* AFTERATNUM */ + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_AFTERATNUM, + NULL, "AFTERATNUM", 0, EF_CANDEFAULT, 4, + hb_paramError (1), hb_paramError (2), + hb_paramError (3), hb_paramError (4)); + }; + hb_retc (""); + }; break; + + case DO_ATNUM_BEFORATNUM: + { /* BEFORATNUM */ + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_BEFORATNUM, + NULL, "BEFORATNUM", 0, EF_CANDEFAULT, 4, + hb_paramError (1), hb_paramError (2), + hb_paramError (3), hb_paramError (4)); + }; hb_retc (""); }; break; case DO_ATNUM_ATNUM: { /* ATNUM */ + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_ATNUM, + NULL, "ATNUM", 0, EF_CANDEFAULT, 4, + hb_paramError (1), hb_paramError (2), + hb_paramError (3), hb_paramError (4)); + }; hb_retnl (0); }; break; } @@ -272,14 +300,52 @@ static void do_atnum (int iSwitch) case DO_ATNUM_BEFORATNUM: { /* AFTERATNUM */ - /* BEFORATNUM */ - hb_retc (""); + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, + (iSwitch == DO_ATNUM_AFTERATNUM ? CT_ERROR_AFTERATNUM : CT_ERROR_BEFORATNUM), + NULL, + (iSwitch == DO_ATNUM_AFTERATNUM ? "AFTERATNUM" : "BEFORATNUM"), + 0, EF_CANSUBSTITUTE, 4, + hb_paramError (1), hb_paramError (2), + hb_paramError (3), hb_paramError (4)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retc (""); + } }; break; - + case DO_ATNUM_ATNUM: { /* ATNUM */ - hb_retnl (0); + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_ATNUM, + NULL, "ATNUM", 0, EF_CANSUBSTITUTE, 4, + hb_paramError (1), hb_paramError (2), + hb_paramError (3), hb_paramError (4)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnl (0); + } }; break; } diff --git a/harbour/contrib/libct/atrepl.c b/harbour/contrib/libct/atrepl.c index b6791e0568..79a574535d 100644 --- a/harbour/contrib/libct/atrepl.c +++ b/harbour/contrib/libct/atrepl.c @@ -152,6 +152,15 @@ HB_FUNC (ATREPL) if (sIgnore >= sStrLen) { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_ATREPL, + NULL, "ATREPL", 0, EF_CANDEFAULT, 6, + hb_paramError (1), hb_paramError (2), + hb_paramError (3), hb_paramError (4), + hb_paramError (5), hb_paramError (6)); + } hb_retclen (pcString, sStrLen); return; } @@ -346,7 +355,26 @@ HB_FUNC (ATREPL) } else /* ((ISCHAR (1)) && (ISCHAR (2))) */ { - hb_retclen (hb_parc (2), hb_parclen (2)); + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_ATREPL, + NULL, "ATREPL", 0, EF_CANSUBSTITUTE, 6, + hb_paramError (1), hb_paramError (2), + hb_paramError (3), hb_paramError (4), + hb_paramError (5), hb_paramError (6)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retclen (hb_parc (2), hb_parclen (2)); + } } return; diff --git a/harbour/contrib/libct/charevod.c b/harbour/contrib/libct/charevod.c index ad9b235abc..2214f25a46 100644 --- a/harbour/contrib/libct/charevod.c +++ b/harbour/contrib/libct/charevod.c @@ -78,6 +78,15 @@ static void do_charevod (int iSwitch) if (sLen == 0) { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, + (iSwitch == DO_CHAREVOD_CHAREVEN ? CT_ERROR_CHAREVEN : CT_ERROR_CHARODD), + NULL, + (iSwitch == DO_CHAREVOD_CHAREVEN ? "CHAREVEN" : "CHARODD"), + 0, EF_CANDEFAULT, 1, hb_paramError (1)); + } hb_retc (""); return; } @@ -103,7 +112,26 @@ static void do_charevod (int iSwitch) } else { - hb_retc (""); + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, + (iSwitch == DO_CHAREVOD_CHAREVEN ? CT_ERROR_CHAREVEN : CT_ERROR_CHARODD), + NULL, + (iSwitch == DO_CHAREVOD_CHAREVEN ? "CHAREVEN" : "CHARODD"), + 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retc (""); + } } } diff --git a/harbour/contrib/libct/charmirr.c b/harbour/contrib/libct/charmirr.c index ce1bee995a..a2017b5422 100644 --- a/harbour/contrib/libct/charmirr.c +++ b/harbour/contrib/libct/charmirr.c @@ -125,6 +125,13 @@ HB_FUNC (CHARMIRR) if (sStrLen == 0) { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CHARMIRR, + NULL, "CHARMIRR", 0, EF_CANDEFAULT, 2, + hb_paramError (1), hb_paramError (2)); + } if (iNoRet) hb_retl (0); else @@ -167,10 +174,27 @@ HB_FUNC (CHARMIRR) } else /* if (ISCHAR (1)) */ { - if (iNoRet) - hb_retl (0); + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CHARMIRR, + NULL, "CHARMIRR", 0, EF_CANSUBSTITUTE, 2, + hb_paramError (1), hb_paramError (2)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } else - hb_retc (""); + { + if (iNoRet) + hb_retl (0); + else + hb_retc (""); + } } return; diff --git a/harbour/contrib/libct/charmix.c b/harbour/contrib/libct/charmix.c index da585aed4c..3a63735113 100644 --- a/harbour/contrib/libct/charmix.c +++ b/harbour/contrib/libct/charmix.c @@ -120,6 +120,13 @@ HB_FUNC (CHARMIX) if (sLen1 == 0) { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CHARMIX, + NULL, "CHARMIX", 0, EF_CANDEFAULT, 2, + hb_paramError (1), hb_paramError (2)); + } hb_retc (""); return; } @@ -130,6 +137,13 @@ HB_FUNC (CHARMIX) sLen2 = hb_parclen (2); if (sLen2 == 0) { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CHARMIX, + NULL, "CHARMIX", 0, EF_CANDEFAULT, 2, + hb_paramError (1), hb_paramError (2)); + } hb_retclen (pcString1, sLen1); return; } @@ -156,7 +170,24 @@ HB_FUNC (CHARMIX) } else { - hb_retc (""); + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CHARMIX, + NULL, "CHARMIX", 0, EF_CANSUBSTITUTE, 2, + hb_paramError (1), hb_paramError (2)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retc (""); + } } } diff --git a/harbour/contrib/libct/charone.c b/harbour/contrib/libct/charone.c index a99f9d4775..a94ea594ed 100644 --- a/harbour/contrib/libct/charone.c +++ b/harbour/contrib/libct/charone.c @@ -233,7 +233,27 @@ static void do_charone (int iSwitch) } else /* if (ISCHAR (1)) */ { - hb_retc (""); + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, + (iSwitch == DO_CHARONE_CHARONE ? CT_ERROR_CHARONE : CT_ERROR_WORDONE), + NULL, + (iSwitch == DO_CHARONE_CHARONE ? "CHARONE" : "WORDONE"), + 0, EF_CANSUBSTITUTE, 2, + hb_paramError (1), hb_paramError (2)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retc (""); + } } return; diff --git a/harbour/contrib/libct/charonly.c b/harbour/contrib/libct/charonly.c index e32fceaa3e..17cb9f3b16 100644 --- a/harbour/contrib/libct/charonly.c +++ b/harbour/contrib/libct/charonly.c @@ -121,7 +121,51 @@ static void do_charonly (int iSwitch) } else /* if (ISCHAR (1) && ISCHAR (2)) */ { - hb_retc (""); + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + switch (iSwitch) + { + case DO_CHARONLY_CHARONLY: + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CHARONLY, + NULL, "CHARONLY", 0, EF_CANSUBSTITUTE, 2, + hb_paramError (1), hb_paramError (2)); + }; break; + + case DO_CHARONLY_WORDONLY: + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_WORDONLY, + NULL, "WORDONLY", 0, EF_CANSUBSTITUTE, 2, + hb_paramError (1), hb_paramError (2)); + }; break; + + case DO_CHARONLY_CHARREM: + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CHARREM, + NULL, "CHARREM", 0, EF_CANSUBSTITUTE, 2, + hb_paramError (1), hb_paramError (2)); + }; break; + + case DO_CHARONLY_WORDREM: + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_WORDREM, + NULL, "WORDREM", 0, EF_CANSUBSTITUTE, 2, + hb_paramError (1), hb_paramError (2)); + }; break; + } + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retc (""); + } } return; diff --git a/harbour/contrib/libct/charop.c b/harbour/contrib/libct/charop.c index be969ab689..b2def87ace 100644 --- a/harbour/contrib/libct/charop.c +++ b/harbour/contrib/libct/charop.c @@ -94,12 +94,6 @@ static void do_charop (int iSwitch) unsigned char *pucString = ( unsigned char * ) hb_parc (1); unsigned char *pucResult = ( unsigned char * ) hb_xgrab (sStrLen); - if (pucResult == NULL) - { - hb_ret(); - return; - } - switch (iSwitch) { /* NOT */ @@ -206,8 +200,16 @@ static void do_charop (int iSwitch) } else + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CHARADD, + NULL, "CHARADD", 0, EF_CANDEFAULT, 2, + hb_paramError (1), hb_paramError (2)); + } hb_xmemcpy (pucResult, pucString, sStrLen); - + } }; break; /* SUB */ @@ -223,8 +225,16 @@ static void do_charop (int iSwitch) } else + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CHARSUB, + NULL, "CHARSUB", 0, EF_CANDEFAULT, 2, + hb_paramError (1), hb_paramError (2)); + } hb_xmemcpy (pucResult, pucString, sStrLen); - + } }; break; /* AND */ @@ -240,8 +250,16 @@ static void do_charop (int iSwitch) } else + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CHARAND, + NULL, "CHARAND", 0, EF_CANDEFAULT, 2, + hb_paramError (1), hb_paramError (2)); + } hb_xmemcpy (pucResult, pucString, sStrLen); - + } }; break; /* OR */ @@ -257,8 +275,16 @@ static void do_charop (int iSwitch) } else + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CHAROR, + NULL, "CHAROR", 0, EF_CANDEFAULT, 2, + hb_paramError (1), hb_paramError (2)); + } hb_xmemcpy (pucResult, pucString, sStrLen); - + } }; break; /* XOR */ @@ -274,8 +300,16 @@ static void do_charop (int iSwitch) } else + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CHARXOR, + NULL, "CHARXOR", 0, EF_CANDEFAULT, 2, + hb_paramError (1), hb_paramError (2)); + } hb_xmemcpy (pucResult, pucString, sStrLen); - + } }; break; }; /* endswitch (iSwitch) */ @@ -291,7 +325,94 @@ static void do_charop (int iSwitch) } else /* if (ISCHAR (1)) */ { - hb_ret(); + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + switch (iSwitch) + { + case DO_CHAROP_CHARADD: + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CHARADD, + NULL, "CHARADD", 0, EF_CANSUBSTITUTE, 2, + hb_paramError (1), hb_paramError (2)); + }; break; + + case DO_CHAROP_CHARSUB: + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CHARSUB, + NULL, "CHARSUB", 0, EF_CANSUBSTITUTE, 2, + hb_paramError (1), hb_paramError (2)); + }; break; + + case DO_CHAROP_CHARAND: + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CHARAND, + NULL, "CHARAND", 0, EF_CANSUBSTITUTE, 2, + hb_paramError (1), hb_paramError (2)); + }; break; + + case DO_CHAROP_CHARNOT: + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CHARNOT, + NULL, "CHARNOT", 0, EF_CANSUBSTITUTE, 1, + hb_paramError (1)); + }; break; + + case DO_CHAROP_CHAROR: + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CHAROR, + NULL, "CHAROR", 0, EF_CANSUBSTITUTE, 2, + hb_paramError (1), hb_paramError (2)); + }; break; + + case DO_CHAROP_CHARXOR: + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CHARXOR, + NULL, "CHARXOR", 0, EF_CANSUBSTITUTE, 2, + hb_paramError (1), hb_paramError (2)); + }; break; + + case DO_CHAROP_CHARSHL: + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CHARSHL, + NULL, "CHARSHL", 0, EF_CANSUBSTITUTE, 1, + hb_paramError (1)); + }; break; + + case DO_CHAROP_CHARSHR: + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CHARSHR, + NULL, "CHARSHR", 0, EF_CANSUBSTITUTE, 1, + hb_paramError (1)); + }; break; + + case DO_CHAROP_CHARRLL: + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CHARRLL, + NULL, "CHARRLL", 0, EF_CANSUBSTITUTE, 1, + hb_paramError (1)); + }; break; + + case DO_CHAROP_CHARRLR: + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CHARRLR, + NULL, "CHARRLR", 0, EF_CANSUBSTITUTE, 1, + hb_paramError (1)); + }; break; + + } + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_ret(); + } } return; diff --git a/harbour/contrib/libct/charrepl.c b/harbour/contrib/libct/charrepl.c index 5fd6653ef2..1d70973525 100644 --- a/harbour/contrib/libct/charrepl.c +++ b/harbour/contrib/libct/charrepl.c @@ -220,19 +220,37 @@ HB_FUNC (CHARREPL) (ISCHAR (2)) && ((sReplaceLen = (size_t)hb_parclen (3)) > 0)) */ { - if (iNoRet) + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) { - hb_retl (0); + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CHARREPL, + NULL, "CHARREPL", 0, EF_CANSUBSTITUTE, 4, + hb_paramError (1), hb_paramError (2), + hb_paramError (3), hb_paramError (4)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); } else { - if (ISCHAR (2)) + if (iNoRet) { - hb_retclen (hb_parc (2), hb_parclen (2)); + hb_retl (0); } else { - hb_retc (""); + if (ISCHAR (2)) + { + hb_retclen (hb_parc (2), hb_parclen (2)); + } + else + { + hb_retc (""); + } } } } diff --git a/harbour/contrib/libct/charsort.c b/harbour/contrib/libct/charsort.c index 185b271742..28da8dd55e 100644 --- a/harbour/contrib/libct/charsort.c +++ b/harbour/contrib/libct/charsort.c @@ -215,6 +215,16 @@ HB_FUNC (CHARSORT) ((ssElementPos+ssCompareLen) > sElementLen) || (sSortLen+sIgnore > sStrLen)) { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CHARSORT, + NULL, "CHARSORT", 0, EF_CANDEFAULT, 7, + hb_paramError (1), hb_paramError (2), + hb_paramError (3), hb_paramError (4), + hb_paramError (5), hb_paramError (6), + hb_paramError (7)); + } if (iNoRet) hb_retl (0); else @@ -241,10 +251,30 @@ HB_FUNC (CHARSORT) } else /* if (ISCHAR (1)) */ { - if (iNoRet) - hb_retl (0); + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CHARSORT, + NULL, "CHARSORT", 0, EF_CANSUBSTITUTE, 7, + hb_paramError (1), hb_paramError (2), + hb_paramError (3), hb_paramError (4), + hb_paramError (5), hb_paramError (6), + hb_paramError (7)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } else - hb_retc (""); + { + if (iNoRet) + hb_retl (0); + else + hb_retc (""); + } } } diff --git a/harbour/contrib/libct/charswap.c b/harbour/contrib/libct/charswap.c index a852f18da9..39c03756ed 100644 --- a/harbour/contrib/libct/charswap.c +++ b/harbour/contrib/libct/charswap.c @@ -169,13 +169,40 @@ static void do_charswap (int iSwitch) } else /* if (ISCHAR (1)) */ { - if (iNoRet) + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) { - hb_retl (0); + + if (iSwitch == DO_CHARSWAP_CHARSWAP) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CHARSWAP, + NULL, "CHARSWAP", 0, EF_CANSUBSTITUTE, 1, + hb_paramError (1)); + } + else + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_WORDSWAP, + NULL, "WORDSWAP", 0, EF_CANSUBSTITUTE, 2, + hb_paramError (1), hb_paramError (2)); + } + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); } else { - hb_retc (""); + if (iNoRet) + { + hb_retl (0); + } + else + { + hb_retc (""); + } } } diff --git a/harbour/contrib/libct/ct.c b/harbour/contrib/libct/ct.c new file mode 100644 index 0000000000..2d76006167 --- /dev/null +++ b/harbour/contrib/libct/ct.c @@ -0,0 +1,370 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * CT3 general functions + * + * Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany + * Author: Martin Vogel + * + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + + +#include "ct.h" +#include "hbvm.h" +#include "hbstack.h" + +/* throwing a CT-subsystem error without value substitution + - function adapted from errorapi.c */ +USHORT ct_error (USHORT uiSeverity, ULONG ulGenCode, ULONG ulSubCode, + char * szDescription, char * szOperation, USHORT uiOsCode, + USHORT uiFlags, USHORT uiArgCount, ...) +{ + USHORT uiAction; + PHB_ITEM pError; + + PHB_ITEM pArray, pArg; + va_list va; + USHORT uiArgPos; + BOOL bRelease = TRUE; + + HB_TRACE(HB_TR_DEBUG, ("ct_error (%hu, %lu, %lu, %s, %s, %hu, %hu, %hu", + uiSeverity, ulGenCode, ulSubCode, szDescription, + szOperation, uiOsCode, uiFlags, uiArgCount)); + + pArray = hb_itemArrayNew (uiArgCount); + + /* Build the array from the passed arguments. */ + va_start (va, uiArgCount); + + for (uiArgPos = 1; uiArgPos <= uiArgCount; uiArgPos++) + { + PHB_ITEM pTemp; + hb_itemArrayPut (pArray, uiArgPos, pTemp = va_arg (va, PHB_ITEM)); + HB_TRACE(HB_TR_DEBUG, ("\t%p,",pTemp)); + } + va_end (va); + HB_TRACE(HB_TR_DEBUG, (")")); + + pError = hb_errRT_New (uiSeverity, CT_SUBSYSTEM, ulGenCode, ulSubCode, + szDescription, szOperation, uiOsCode, uiFlags); + + /* Assign the new array to the object data item. */ + hb_vmPushSymbol (hb_dynsymGet ("_ARGS")->pSymbol); + hb_vmPush (pError); + hb_vmPush (pArray); + hb_vmDo (1); + + /* Release the Array. */ + if (bRelease) + { + hb_itemRelease (pArray); + } + + /* launch error codeblock */ + uiAction = hb_errLaunch (pError); + + /* release error codeblock */ + hb_errRelease (pError); + + return (uiAction); +} + + +/* throwing a CT-subsystem error with value substitution + - function adapted from errorapi.c */ +PHB_ITEM ct_error_subst (USHORT uiSeverity, ULONG ulGenCode, ULONG ulSubCode, + char * szDescription, char * szOperation, USHORT uiOsCode, + USHORT uiFlags, USHORT uiArgCount, ...) +{ + PHB_ITEM pRetVal; + PHB_ITEM pError; + + PHB_ITEM pArray; + va_list va; + USHORT uiArgPos; + + HB_TRACE(HB_TR_DEBUG, ("ct_error_subst (%hu, %lu, %lu, %s, %s, %hu, %hu, %hu", + uiSeverity, ulGenCode, ulSubCode, szDescription, + szOperation, uiOsCode, uiFlags, uiArgCount)); + + pArray = hb_itemArrayNew (uiArgCount); + + /* Build the array from the passed arguments. */ + va_start (va, uiArgCount); + for (uiArgPos = 1; uiArgPos <= uiArgCount; uiArgPos++) + { + PHB_ITEM pTemp; + hb_itemArrayPut (pArray, uiArgPos, pTemp = va_arg (va, PHB_ITEM)); + HB_TRACE(HB_TR_DEBUG, ("\t%p,",pTemp)); + } + va_end (va); + HB_TRACE(HB_TR_DEBUG, (")")); + + pError = hb_errRT_New_Subst (uiSeverity, CT_SUBSYSTEM, ulGenCode, ulSubCode, + szDescription, szOperation, uiOsCode, uiFlags); + + /* Assign the new array to the object data item. */ + hb_vmPushSymbol (hb_dynsymGet ("_ARGS")->pSymbol); + hb_vmPush (pError); + hb_vmPush (pArray); + hb_vmDo (1); + + /* Release the Array. */ + hb_itemRelease (pArray); + + /* launch error codeblock */ + pRetVal = hb_errLaunchSubst (pError); + hb_errRelease (pError); + + return (pRetVal); +} + + +/* argument error behaviour */ +static int s_iArgErrMode = CT_ARGERR_IGNORE; + +void ct_setargerrormode (int iMode) +{ + HB_TRACE(HB_TR_DEBUG, ("ct_setargerrormode(%i)",iMode)); + s_iArgErrMode = iMode; +} + +int ct_getargerrormode (void) +{ + HB_TRACE(HB_TR_DEBUG, ("ct_getargerrormode()")); + return (s_iArgErrMode); +} + +/* $DOC$ + * $FUNCNAME$ + * CSETARGERR() + * $CATEGORY$ + * CT3 general functions + * $ONELINER$ + * Sets argument error behaviour + * $SYNTAX$ + * CSETARGERR ([]) -> + * $ARGUMENTS$ + * [] New argument error throwing mode + * $RETURNS$ + * The current or old argument error throwing mode. + * $DESCRIPTION$ + * All CT3 functions are very compliant in their reaction to wrong + * parameters. By using the CSETARGERR() function, you can make the + * library throw an error with the severity . It is then + * up to the error handler to substitute the return value. + * can be one of the severity modes defined in ct.ch: + * CT_ARGERR_WHOCARES corresponds to ES_WHOCARES + * CT_ARGERR_WARNING corresponds to ES_WARNING + * CT_ARGERR_ERROR corresponds to ES_ERROR + * CT_ARGERR_CATASTROPHIC corresponds to ES_CATASTROPHIC + * CT_ARGERR_IGNORE + * The last is the default behaviour and switches any argument error + * throwing off. + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Ready + * $COMPLIANCE$ + * CSETARGERR() is a new function in Harbour's CT3 library. + * $PLATFORMS$ + * All + * $FILES$ + * Source is ct.c, library is ct3. + * $SEEALSO$ + * $END$ + */ + +HB_FUNC (CSETARGERR) +{ + + hb_retni (ct_getargerrormode()); + + if (ISNUM (1)) + { + int iNewMode = hb_parni (1); + if ((iNewMode == CT_ARGERR_WHOCARES) || + (iNewMode == CT_ARGERR_WARNING) || + (iNewMode == CT_ARGERR_ERROR) || + (iNewMode == CT_ARGERR_CATASTROPHIC)|| + (iNewMode == CT_ARGERR_IGNORE)) + { + ct_setargerrormode (hb_parni (1)); + } + else + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CSETARGERR, + NULL, "CSETARGERR", 0, EF_CANDEFAULT, 1, hb_paramError (1)); + } + } + } + else if (hb_pcount() > 0) /* more than one param but not integer */ + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CSETARGERR, + NULL, "CSETARGERR", 0, EF_CANDEFAULT, 1, hb_paramError (1)); + } + } + + return; + +} + + +/* initialization */ +static int s_initialized = 0; /* TODO: make this thread safe */ + +/* $DOC$ + * $FUNCNAME$ + * CTINIT() + * $CATEGORY$ + * CT3 general functions + * $ONELINER$ + * Initializes the CT3 library + * $SYNTAX$ + * CTINIT () -> lInitialized + * $ARGUMENTS$ + * None + * $RETURNS$ + * lInitialized .T. if the function has been correctly initialized + * $DESCRIPTION$ + * The CTINIT() function initializes the CT3 library. Always call it + * once somewhere at the beginning of your program. + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Ready + * $COMPLIANCE$ + * CTINIT() is a new function in Harbour's CT3 library. + * $PLATFORMS$ + * All + * $FILES$ + * Source is ct.c, library is ct3. + * $SEEALSO$ + * $END$ + */ + +HB_FUNC (CTINIT) +{ + + if (s_initialized == 0) + { + int iSuccess; + iSuccess = ct_str_init(); + iSuccess |= ct_math_init(); + s_initialized = iSuccess; + } + + if (hb_pcount() > 0) /* CTINIT accepts no params */ + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CTINIT, + NULL, "CTINIT", 0, EF_CANDEFAULT, 1, hb_paramError (1)); + } + } + + hb_retl (s_initialized); + +} + + +/* $DOC$ + * $FUNCNAME$ + * CTEXIT() + * $CATEGORY$ + * CT3 general functions + * $ONELINER$ + * Uninitializes the CT3 library + * $SYNTAX$ + * CTEXIT () -> nil + * $ARGUMENTS$ + * none + * $RETURNS$ + * nil + * $DESCRIPTION$ + * The CTEXIT() function uninitializes the CT3 library. Always call it + * somewhere at the end of your program. + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Ready + * $COMPLIANCE$ + * CTEXIT() is a new function in Harbour's CT3 library. + * $PLATFORMS$ + * All + * $FILES$ + * Source is ct.c, library is ct3. + * $SEEALSO$ + * $END$ + */ + +HB_FUNC (CTEXIT) +{ + ct_str_exit(); + ct_math_exit(); + + s_initialized = 0; + + if (hb_pcount() > 0) /* CTEXIT accepts no params */ + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CTEXIT, + NULL, "CTEXIT", 0, EF_CANDEFAULT, 1, hb_paramError (1)); + } + } + + hb_ret(); +} diff --git a/harbour/contrib/libct/ct.ch b/harbour/contrib/libct/ct.ch index 1e674aff80..9ad8e5a068 100644 --- a/harbour/contrib/libct/ct.ch +++ b/harbour/contrib/libct/ct.ch @@ -56,6 +56,28 @@ #ifndef _CT_CH #define _CT_CH 1 +/* subsystem name */ +#define CT_SUBSYSTEM "CT" + +/* CSETARGERR() argument error behaviour */ +#include "error.ch" +#define CT_ARGERR_WHOCARES ES_WHOCARES +#define CT_ARGERR_WARNING ES_WARNING +#define CT_ARGERR_ERROR ES_ERROR +#define CT_ARGERR_CATASTROPHIC ES_CATASTROPHIC +#define CT_ARGERR_IGNORE -1 + +/* SETMATHERR() stati and modes for math error correction */ +#define CT_MATHERR_STATUS_NOTFOUND -1 /* math handler is not installed */ +#define CT_MATHERR_STATUS_INACTIVE 0 /* math handler is installed but inactive */ +#define CT_MATHERR_STATUS_ACTIVE 1 /* math handler is installed and active */ + +#define CT_MATHERR_MODE_NONE 0 /* no correction at all, program will exit */ +#define CT_MATHERR_MODE_DEFAULT 1 /* default return value will be used, no error msgs ! */ +#define CT_MATHERR_MODE_USER 2 /* error will be thrown to user who is responsible for error correction */ +#define CT_MATHERR_MODE_USERDEFAULT 3 /* error will be thrown, but if user fails, default correction will be used */ + +/* SETATLIKE() modes */ #define CT_SETATLIKE_EXACT 0 #define CT_SETATLIKE_WILDCARD 1 diff --git a/harbour/contrib/libct/ct.h b/harbour/contrib/libct/ct.h index 867db31c37..917a28cff6 100644 --- a/harbour/contrib/libct/ct.h +++ b/harbour/contrib/libct/ct.h @@ -58,8 +58,35 @@ #include "hbapi.h" #include "hbapiitm.h" +#include "hbapierr.h" +#include "error.ch" +#include "hbmath.h" -#include "ctset.h" #include "ctstr.h" +#include "ctmath.h" +#include "ctset.h" + +#include "cterror.ch" + +#define CT_SUBSYSTEM "CT" + +/* CT subsystem error throwing functions */ +extern USHORT ct_error (USHORT uiSeverity, ULONG ulGenCode, ULONG ulSubCode, + char * szDescription, char * szOperation, USHORT uiOsCode, + USHORT uiFlags, USHORT uiArgCount, ...); + +extern PHB_ITEM ct_error_subst (USHORT uiSeverity, ULONG ulGenCode, ULONG ulSubCode, + char * szDescription, char * szOperation, USHORT uiOsCode, + USHORT uiFlags, USHORT uiArgCount, ...); + +/* set argument error behaviour */ +extern void ct_setargerrormode (int iMode); +extern int ct_getargerrormode (void); + +#define CT_ARGERR_WHOCARES ES_WHOCARES +#define CT_ARGERR_WARNING ES_WARNING +#define CT_ARGERR_ERROR ES_ERROR +#define CT_ARGERR_CATASTROPHIC ES_CATASTROPHIC +#define CT_ARGERR_IGNORE -1 #endif diff --git a/harbour/contrib/libct/cterror.ch b/harbour/contrib/libct/cterror.ch new file mode 100644 index 0000000000..b1e31b637c --- /dev/null +++ b/harbour/contrib/libct/cterror.ch @@ -0,0 +1,716 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Header file for CT error codes + * + * Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany + * Author: Martin Vogel + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + +/* NOTE: This file is also used by C code. */ + +#ifndef _CTERROR_CH +#define _CTERROR_CH + +/* sub code ranges */ +#define CT_ERROR_MATHLIB_RANGEL 100 /* math lib errors */ +#define CT_ERROR_MATHLIB_RANGEH 199 + +#define CT_ERROR_GENERAL_RANGEL 1000 /* general functions */ +#define CT_ERROR_GENERAL_RANGEH 1099 + +#define CT_ERROR_WINDOW_RANGEL 1110 /* windowing functions */ +#define CT_ERROR_WINDOW_RANGEH 1399 + +#define CT_ERROR_EXTDRV_RANGEL 1410 /* extended driver functions */ +#define CT_ERROR_EXTDRV_RANGEH 1999 + +#define CT_ERROR_SERIAL_RANGEL 2110 /* serial communication functions */ +#define CT_ERROR_SERIAL_RANGEH 2599 + +#define CT_ERROR_STRING_RANGEL 3110 /* string functions */ +#define CT_ERROR_STRING_RANGEH 4099 + +#define CT_ERROR_NUMBIT_RANGEL 4110 /* number and bit manipulation functions */ +#define CT_ERROR_NUMBIT_RANGEH 4399 + +#define CT_ERROR_VIDEO_RANGEL 4410 /* video functions */ +#define CT_ERROR_VIDEO_RANGEH 5099 + +#define CT_ERROR_DISC_RANGEL 5110 /* disc functions */ +#define CT_ERROR_DISC_RANGEH 5699 + +#define CT_ERROR_PRINT_RANGEL 5710 /* printer functions */ +#define CT_ERROR_PRINT_RANGEH 5899 + +#define CT_ERROR_DATE_RANGEL 5910 /* date & time functions */ +#define CT_ERROR_DATE_RANGEH 6199 + +#define CT_ERROR_DBF_RANGEL 6210 /* DBF functions */ +#define CT_ERROR_DBF_RANGEH 6299 + +#define CT_ERROR_SWITCH_RANGEL 6310 /* switch functions */ +#define CT_ERROR_SWITCH_RANGEH 6799 + +#define CT_ERROR_SYSINF_RANGEL 6810 /* system info functions */ +#define CT_ERROR_SYSINF_RANGEH 7099 + +#define CT_ERROR_MISC_RANGEL 7110 /* misc. functions */ +#define CT_ERROR_MISC_RANGEH 7399 + +#define CT_ERROR_MATH_RANGEL 7410 /* math functions */ +#define CT_ERROR_MATH_RANGEH 7699 + +#define CT_ERROR_PEEK_RANGEL 7810 /* peek & poke functions */ +#define CT_ERROR_PEEK_RANGEH 7899 + +#define CT_ERROR_GETREAD_RANGEL 7910 /* get & read functions */ +#define CT_ERROR_GETREAD_RANGEH 8099 + +/* C math lib error sub codes */ +#define CT_ERROR_MATHLIB 100 /* unknown math lib error */ +#define CT_ERROR_MATHLIB_DOMAIN 101 /* a domain error has occured, such as sqrt( -1 ) */ +#define CT_ERROR_MATHLIB_SING 102 /* a singularity will result, such as pow( 0, -2 ) */ +#define CT_ERROR_MATHLIB_OVERFLOW 103 /* an overflow will result, such as pow( 10, 100 ) */ +#define CT_ERROR_MATHLIB_UNDERFLOW 104 /* an underflow will result, such as pow( 10, -100 ) */ +#define CT_ERROR_MATHLIB_TLOSS 105 /* total loss of significance will result, such as exp( 1000 ) */ +#define CT_ERROR_MATHLIB_PLOSS 106 /* partial loss of significance will result, such as sin( 10e70 ) */ + +/* + * function error sub codes + * + * The sub code simply defines the function that throws the error. + * The last digit stands for the type of the return value of the function: + * + * 0 == NIL + * 1 == String/Memo + * 2 == Numeric (Integer) + * 3 == Numeric (Float) + * 4 == Boolean + * 5 == Date + * 6 == Block + * 7 == Array + * 8 == Object + * 9 == can not be specified + * + * This can be useful for custom errorblocks, since the CT3 library allows + * to set a return value when (for example) an argument error occurs. + * + */ + +/* general functions */ +#define CT_ERROR_CTINIT 1014 +#define CT_ERROR_CTEXIT 1020 +#define CT_ERROR_CSETARGERR 1032 + +/* windowing functions */ +#define CT_ERROR_WACLOSE 1112 +#define CT_ERROR_WBOARD 1122 +#define CT_ERROR_WBOX 1132 +#define CT_ERROR_WCENTER 1142 +#define CT_ERROR_WCLOSE 1152 +#define CT_ERROR_WCOL 1162 +#define CT_ERROR_WFCOL 1172 +#define CT_ERROR_WFLASTCOL 1192 +#define CT_ERROR_WFORMAT 1202 +#define CT_ERROR_WFROW 1212 +#define CT_ERROR_WLASTCOL 1222 +#define CT_ERROR_WLASTROW 1232 +#define CT_ERROR_WNUM 1242 +#define CT_ERROR_WMODE 1252 +#define CT_ERROR_WMOVE 1262 +#define CT_ERROR_WOPEN 1272 +#define CT_ERROR_WROW 1282 +#define CT_ERROR_WSELECT 1292 +#define CT_ERROR_WSETMOVE 1304 +#define CT_ERROR_WSETSHADOW 1312 +#define CT_ERROR_WSTEP 1322 + +/* extended driver */ +#define CT_ERROR_CGA40 1414 +#define CT_ERROR_CGA80 1424 +#define CT_ERROR_DSETKBIOS 1434 +#define CT_ERROR_DSETNOLINE 1444 +#define CT_ERROR_DSETQFILE 1454 +#define CT_ERROR_DSETTYPE 1462 +#define CT_ERROR_DSETWINDOW 1474 +#define CT_ERROR_EGA43 1484 +#define CT_ERROR_FIRSTCOL 1492 +#define CT_ERROR_FIRSTROW 1502 +#define CT_ERROR_GETBOXGROW 1512 +#define CT_ERROR_GETCURSOR 1522 +#define CT_ERROR_GETKXLAT 1532 +#define CT_ERROR_GETKXTAB 1541 +#define CT_ERROR_GETLINES 1552 +#define CT_ERROR_GETMODE 1561 +#define CT_ERROR_GETPAGE 1572 +#define CT_ERROR_GETPBIOS 1582 +#define CT_ERROR_GETPXLAT 1591 +#define CT_ERROR_GETSCRMODE 1602 +#define CT_ERROR_GETTAB 1611 +#define CT_ERROR_INKEYTRAP 1622 +#define CT_ERROR_INPUTMODE 1632 +#define CT_ERROR_KEYREAD 1641 +#define CT_ERROR_KEYSEND 1654 +#define CT_ERROR_MAXCOL 1662 +#define CT_ERROR_MAXPAGE 1672 +#define CT_ERROR_MAXROW 1682 +#define CT_ERROR_MONOCHROME 1694 +#define CT_ERROR_PAGECOPY 1704 +#define CT_ERROR_PRINTERROR 1712 +#define CT_ERROR_SETBELL 1721 +#define CT_ERROR_SETBOXGROW 1731 +#define CT_ERROR_SETCURSOR 1742 +#define CT_ERROR_SETKXLAT 1754 +#define CT_ERROR_SETKXTAB 1764 +#define CT_ERROR_SETLINES 1771 +#define CT_ERROR_SETMAXCOL 1784 +#define CT_ERROR_SETMAXROW 1794 +#define CT_ERROR_SETPAGE 1804 +#define CT_ERROR_SETPBIOS 1814 +#define CT_ERROR_SETPXLAT 1824 +#define CT_ERROR_SETQNAME 1834 +#define CT_ERROR_SETSCRMODE 1844 +#define CT_ERROR_SETTAB 1854 +#define CT_ERROR_TRAPANYKEY 1861 +#define CT_ERROR_TRAPINPUT 1871 +#define CT_ERROR_TRAPSHIFT 1881 +#define CT_ERROR_VGA28 1894 +#define CT_ERROR_VGA50 1904 + +/* serial communication */ +#define CT_ERROR_COM_BREAK 2114 +#define CT_ERROR_COM_CLOSE 2124 +#define CT_ERROR_COM_COUNT 2132 +#define CT_ERROR_COM_CRC 2142 +#define CT_ERROR_COM_CTS 2154 +#define CT_ERROR_COM_DCD 2164 +#define CT_ERROR_COM_DOSCON 2171 +#define CT_ERROR_COM_DSR 2184 +#define CT_ERROR_COM_DTR 2194 +#define CT_ERROR_COM_ERRCHR 2204 +#define CT_ERROR_COM_EVENT 2212 +#define CT_ERROR_COM_FLUSH 2224 +#define CT_ERROR_COM_GETIO 2232 +#define CT_ERROR_COM_GETIRQ 2242 +#define CT_ERROR_COM_HARD 2254 +#define CT_ERROR_COM_INIT 2264 +#define CT_ERROR_COM_KEY 2274 +#define CT_ERROR_COM_LSR 2282 +#define CT_ERROR_COM_MCR 2292 +#define CT_ERROR_COM_MSR 2302 +#define CT_ERROR_COM_NUM 2312 +#define CT_ERROR_COM_OPEN 2324 +#define CT_ERROR_COM_READ 2331 +#define CT_ERROR_COM_REMOTE 2344 +#define CT_ERROR_COM_RING 2354 +#define CT_ERROR_COM_RTS 2364 +#define CT_ERROR_COM_SCOUNT 2372 +#define CT_ERROR_COM_SEND 2382 +#define CT_ERROR_COM_SETIO 2394 +#define CT_ERROR_COM_SETIRQ 2404 +#define CT_ERROR_COM_SFLUSH 2414 +#define CT_ERROR_COM_SKEY 2424 +#define CT_ERROR_COM_SMODE 2432 +#define CT_ERROR_COM_SOFT 2444 +#define CT_ERROR_COM_SOFT_R 2454 +#define CT_ERROR_COM_SOFT_S 2464 +#define CT_ERROR_XMOBLOCK 2471 +#define CT_ERROR_XMOCHECK 2482 +#define CT_ERROR_ZEROINSERT 2491 +#define CT_ERROR_ZEROREMOVE 2501 + +/* string functions */ +#define CT_ERROR_ADDASCII 3111 +#define CT_ERROR_AFTERATNUM 3121 +#define CT_ERROR_ASCIISUM 3132 +#define CT_ERROR_ASCPOS 3142 +#define CT_ERROR_ATADJUST 3151 +#define CT_ERROR_ATNUM 3162 +#define CT_ERROR_ATREPL 3171 +#define CT_ERROR_ATTOKEN 3182 +#define CT_ERROR_BEFORATNUM 3191 +#define CT_ERROR_CENTER 3201 +#define CT_ERROR_CHARADD 3211 +#define CT_ERROR_CHARAND 3221 +#define CT_ERROR_CHAREVEN 3231 +#define CT_ERROR_CHARHIST 3247 +#define CT_ERROR_CHARLIST 3251 +#define CT_ERROR_CHARMIRR 3261 +#define CT_ERROR_CHARMIX 3271 +#define CT_ERROR_CHARNOLIST 3281 +#define CT_ERROR_CHARNOT 3291 +#define CT_ERROR_CHARODD 3301 +#define CT_ERROR_CHARONE 3311 +#define CT_ERROR_CHARONLY 3321 +#define CT_ERROR_CHAROR 3331 +#define CT_ERROR_CHARPACK 3341 +#define CT_ERROR_CHARRELA 3352 +#define CT_ERROR_CHARRELREP 3361 +#define CT_ERROR_CHARREM 3371 +#define CT_ERROR_CHARREPL 3381 +#define CT_ERROR_CHARRLL 3391 +#define CT_ERROR_CHARRLR 3401 +#define CT_ERROR_CHARSHL 3411 +#define CT_ERROR_CHARSHR 3421 +#define CT_ERROR_CHARSLIST 3431 +#define CT_ERROR_CHARSORT 3441 +#define CT_ERROR_CHARSPREAD 3451 +#define CT_ERROR_CHARSUB 3461 +#define CT_ERROR_CHARSWAP 3471 +#define CT_ERROR_CHARUNPACK 3481 +#define CT_ERROR_CHARXOR 3491 +#define CT_ERROR_CHECKSUM 3502 +#define CT_ERROR_COUNTLEFT 3512 +#define CT_ERROR_COUNTRIGHT 3522 +#define CT_ERROR_CRYPT 3531 +#define CT_ERROR_CSETATMUPA 3544 +#define CT_ERROR_CSETREF 3554 +#define CT_ERROR_EXPAND 3561 +#define CT_ERROR_JUSTLEFT 3571 +#define CT_ERROR_JUSTRIGHT 3581 +#define CT_ERROR_LIKE 3594 +#define CT_ERROR_LTOC 3601 +#define CT_ERROR_MAXLINE 3612 +#define CT_ERROR_NUMAT 3622 +#define CT_ERROR_NUMLINE 3632 +#define CT_ERROR_NUMTOKEN 3642 +#define CT_ERROR_PADLEFT 3651 +#define CT_ERROR_PADRIGHT 3661 +#define CT_ERROR_POSALPHA 3672 +#define CT_ERROR_POSCHAR 3681 +#define CT_ERROR_POSDEL 3691 +#define CT_ERROR_POSDIFF 3702 +#define CT_ERROR_POSEQUAL 3712 +#define CT_ERROR_POSINS 3721 +#define CT_ERROR_POSLOWER 3732 +#define CT_ERROR_POSRANGE 3742 +#define CT_ERROR_POSREPL 3751 +#define CT_ERROR_POSUPPER 3762 +#define CT_ERROR_RANGEREM 3771 +#define CT_ERROR_RANGEREPL 3781 +#define CT_ERROR_REMALL 3791 +#define CT_ERROR_REMLEFT 3801 +#define CT_ERROR_REMRIGHT 3811 +#define CT_ERROR_REPLALL 3821 +#define CT_ERROR_REPLLEFT 3831 +#define CT_ERROR_REPLRIGHT 3841 +#define CT_ERROR_RESTTOKEN 3851 +#define CT_ERROR_SAVETOKEN 3861 +#define CT_ERROR_SETATLIKE 3872 +#define CT_ERROR_STRDIFF 3882 +#define CT_ERROR_STRSWAP 3891 +#define CT_ERROR_TABEXPAND 3901 +#define CT_ERROR_TABPACK 3911 +#define CT_ERROR_TOKEN 3921 +#define CT_ERROR_TOKENAT 3932 +#define CT_ERROR_TOKENEND 3944 +#define CT_ERROR_TOKENINIT 3954 +#define CT_ERROR_TOKENLOWER 3961 +#define CT_ERROR_TOKENNEXT 3971 +#define CT_ERROR_TOKENSEP 3981 +#define CT_ERROR_TOKENUPPER 3991 +#define CT_ERROR_VALPOS 4002 +#define CT_ERROR_WORDONE 4011 +#define CT_ERROR_WORDONLY 4021 +#define CT_ERROR_WORDREM 4031 +#define CT_ERROR_WORDREPL 4041 +#define CT_ERROR_WORDSWAP 4051 +#define CT_ERROR_WORDTOCHAR 4061 + +/* number and bit manipulation */ +#define CT_ERROR_BITTOC 4111 +#define CT_ERROR_CELSIUS 4123 +#define CT_ERROR_CLEARBIT 4132 +#define CT_ERROR_CTOBIT 4142 +#define CT_ERROR_CTOF 4153 +#define CT_ERROR_CTON 4162 +#define CT_ERROR_EXPONENT 4172 +#define CT_ERROR_FAHRENHEIT 4183 +#define CT_ERROR_FTOC 4191 +#define CT_ERROR_INFINITY 4203 +#define CT_ERROR_INTNEG 4212 +#define CT_ERROR_INTPOS 4222 +#define CT_ERROR_ISBIT 4234 +#define CT_ERROR_LTON 4242 +#define CT_ERROR_MANTISSA 4253 +#define CT_ERROR_NTOC 4261 +#define CT_ERROR_NUMAND 4272 +#define CT_ERROR_NUMCOUNT 4282 +#define CT_ERROR_NUMHIGH 4292 +#define CT_ERROR_NUMLOW 4302 +#define CT_ERROR_NUMMIRR 4312 +#define CT_ERROR_NUMNOT 4322 +#define CT_ERROR_NUMOR 4332 +#define CT_ERROR_NUMROL 4342 +#define CT_ERROR_NUMXOR 4352 +#define CT_ERROR_RAND 4363 +#define CT_ERROR_RANDOM 4372 +#define CT_ERROR_SETBIT 4382 + +/* video functions */ +#define CT_ERROR_CHARPIX 4412 +#define CT_ERROR_CHARWIN 4421 +#define CT_ERROR_CLEAREOL 4431 +#define CT_ERROR_CLEARSLOW 4441 +#define CT_ERROR_CLEARWIN 4451 +#define CT_ERROR_CLEOL 4461 +#define CT_ERROR_CLWIN 4471 +#define CT_ERROR_COLORREPL 4481 +#define CT_ERROR_COLORTON 4492 +#define CT_ERROR_COLORWIN 4501 +#define CT_ERROR_EGAPALETTE 4514 +#define CT_ERROR_ENHANCED 4521 +#define CT_ERROR_FILESCREEN 4532 +#define CT_ERROR_FONTLOAD 4542 +#define CT_ERROR_FONTRESET 4554 +#define CT_ERROR_FONTROTATE 4561 +#define CT_ERROR_FONTSELECT 4572 +#define CT_ERROR_GETCLEARA 4582 +#define CT_ERROR_GETCLEARB 4592 +#define CT_ERROR_GETFONT 4601 +#define CT_ERROR_GETSCRSTR 4611 +#define CT_ERROR_GETVGAPAL 4622 +#define CT_ERROR_INVERTATTR 4632 +#define CT_ERROR_INVERTWIN 4641 +#define CT_ERROR_ISCGA 4654 +#define CT_ERROR_ISEGA 4664 +#define CT_ERROR_ISHERCULES 4674 +#define CT_ERROR_ISMCGA 4684 +#define CT_ERROR_ISMONO 4694 +#define CT_ERROR_ISPGA 4704 +#define CT_ERROR_ISVGA 4714 +#define CT_ERROR_MAXFONT 4722 +#define CT_ERROR_MONISWITCH 4734 +#define CT_ERROR_NTOCOLOR 4741 +#define CT_ERROR_NUMCOL 4752 +#define CT_ERROR_RESTCURSOR 4761 +#define CT_ERROR_SAVECURSOR 4772 +#define CT_ERROR_SAYDOWN 4781 +#define CT_ERROR_SAYMOVEIN 4791 +#define CT_ERROR_SAYSCREEN 4801 +#define CT_ERROR_SAYSPREAD 4811 +#define CT_ERROR_SCREENATTR 4822 +#define CT_ERROR_SCREENFILE 4832 +#define CT_ERROR_SCREENMARK 4844 +#define CT_ERROR_SCREENMIX 4851 +#define CT_ERROR_SCREENSIZE 4862 +#define CT_ERROR_SCREENSTR 4871 +#define CT_ERROR_SETCLEARA 4881 +#define CT_ERROR_SETCLEARB 4891 +#define CT_ERROR_SETFONT 4902 +#define CT_ERROR_SETRC 4911 +#define CT_ERROR_SETSCRSTR 4924 +#define CT_ERROR_STANDARD 4931 +#define CT_ERROR_STRSCREEN 4941 +#define CT_ERROR_UNSELECTED 4951 +#define CT_ERROR_UNTEXTWIN 4961 +#define CT_ERROR_VGAPALETTE 4974 +#define CT_ERROR_VIDEOINIT 4989 +#define CT_ERROR_VIDEOSETUP 4992 +#define CT_ERROR_VIDEOTYPE 5002 + +/* disc functions */ +#define CT_ERROR_DELETEFILE 5112 +#define CT_ERROR_DIRCHANGE 5122 +#define CT_ERROR_DIRMAKE 5132 +#define CT_ERROR_DIRNAME 5141 +#define CT_ERROR_DIRREMOVE 5152 +#define CT_ERROR_DISKCHANGE 5164 +#define CT_ERROR_DISKCHECK 5172 +#define CT_ERROR_DISKFORMAT 5182 +#define CT_ERROR_DISKFREE 5192 +#define CT_ERROR_DISKNAME 5201 +#define CT_ERROR_DISKREADY 5214 +#define CT_ERROR_DISKREADYW 5224 +#define CT_ERROR_DISKSPEED 5232 +#define CT_ERROR_DISKSTAT 5242 +#define CT_ERROR_DISKTOTAL 5252 +#define CT_ERROR_DISKTYPE 5262 +#define CT_ERROR_DRIVETYPE 5272 +#define CT_ERROR_FILEAPPEND 5282 +#define CT_ERROR_FILEATTR 5292 +#define CT_ERROR_FILECCLOSE 5304 +#define CT_ERROR_FILECCONT 5312 +#define CT_ERROR_FILECDATI 5324 +#define CT_ERROR_FILECHECK 5332 +#define CT_ERROR_FILECOPEN 5344 +#define CT_ERROR_FILECOPY 5352 +#define CT_ERROR_FILEDATE 5365 +#define CT_ERROR_FILEDELETE 5374 +#define CT_ERROR_FILEMOVE 5382 +#define CT_ERROR_FILESEEK 5391 +#define CT_ERROR_FILESIZE 5402 +#define CT_ERROR_FILESTR 5411 +#define CT_ERROR_FILETIME 5421 +#define CT_ERROR_FILEVALID 5434 +#define CT_ERROR_FLOPPYTYPE 5442 +#define CT_ERROR_GETSHARE 5452 +#define CT_ERROR_NUMDISKF 5462 +#define CT_ERROR_NUMDISKH 5472 +#define CT_ERROR_NUMDISKL 5482 +#define CT_ERROR_RENAMEFILE 5492 +#define CT_ERROR_RESTFSEEK 5501 +#define CT_ERROR_SAVEFSEEK 5511 +#define CT_ERROR_SETFATTR 5522 +#define CT_ERROR_SETFCREATE 5532 +#define CT_ERROR_SETFDATI 5544 +#define CT_ERROR_SETSHARE 5554 +#define CT_ERROR_STRFILE 5562 +#define CT_ERROR_TEMPFILE 5571 +#define CT_ERROR_TRUENAME 5581 +#define CT_ERROR_VOLSERIAL 5592 +#define CT_ERROR_VOLUME 5604 + +/* printer functions */ +#define CT_ERROR_NUMPRINTER 5712 +#define CT_ERROR_PRINTFILE 5724 +#define CT_ERROR_PRINTINIT 5732 +#define CT_ERROR_PRINTREADY 5744 +#define CT_ERROR_PRINTSCR 5751 +#define CT_ERROR_PRINTSCRX 5764 +#define CT_ERROR_PRINTSEND 5772 +#define CT_ERROR_PRINTSTAT 5782 +#define CT_ERROR_SPOOLACTIV 5794 +#define CT_ERROR_SPOOLADD 5804 +#define CT_ERROR_SPOOLCOUNT 5812 +#define CT_ERROR_SPOOLDEL 5824 +#define CT_ERROR_SPOOLENTRY 5831 +#define CT_ERROR_SPOOLFLUSH 5844 +#define CT_ERROR_TOF 5854 + +/* date & time functions */ +#define CT_ERROR_ADDMONTH 5915 +#define CT_ERROR_BOM 5925 +#define CT_ERROR_BOQ 5935 +#define CT_ERROR_BOY 5945 +#define CT_ERROR_CTODOW 5952 +#define CT_ERROR_CTOMONTH 5962 +#define CT_ERROR_DMY 5971 +#define CT_ERROR_DOY 5982 +#define CT_ERROR_EOM 5995 +#define CT_ERROR_EOQ 6005 +#define CT_ERROR_EOY 6015 +#define CT_ERROR_ISLEAP 6024 +#define CT_ERROR_LASTDAYOM 6032 +#define CT_ERROR_MDY 6041 +#define CT_ERROR_NTOCDOW 6051 +#define CT_ERROR_NTOCMONTH 6061 +#define CT_ERROR_QUARTER 6072 +#define CT_ERROR_SECTOTIME 6081 +#define CT_ERROR_SETDATE 6094 +#define CT_ERROR_SETTIME 6104 +#define CT_ERROR_SHOWTIME 6111 +#define CT_ERROR_STOD 6125 +#define CT_ERROR_TIMETOSEC 6132 +#define CT_ERROR_TIMEVALID 6144 +#define CT_ERROR_WAITPERIOD 6154 +#define CT_ERROR_WEEK 6162 +#define CT_ERROR_WOM 6172 + +/* DBF functions */ +#define CT_ERROR_DBFDSKSIZE 6212 +#define CT_ERROR_DBFSIZE 6222 +#define CT_ERROR_FIELDDECI 6232 +#define CT_ERROR_FIELDNUM 6242 +#define CT_ERROR_FIELDSIZE 6252 +#define CT_ERROR_FIELDTYPE 6261 +#define CT_ERROR_ISDBT 6274 + +/* switch and state functions */ +#define CT_ERROR_CSETALL 6310 /* TODO: change last digit */ +#define CT_ERROR_CSETCLIP 6320 +#define CT_ERROR_CSETDATE 6330 +#define CT_ERROR_CSETDECI 6340 +#define CT_ERROR_CSETDEFA 6350 +#define CT_ERROR_CSETFUNC 6360 +#define CT_ERROR_CSETKEY 6370 +#define CT_ERROR_CSETLDEL 6380 +#define CT_ERROR_CSETMARG 6390 +#define CT_ERROR_CSETPATH 6400 +#define CT_ERROR_CSETRDEL 6410 +#define CT_ERROR_CSETRDONLY 6420 +#define CT_ERROR_CSETSAFETY 6430 +#define CT_ERROR_CSETSNOW 6440 +#define CT_ERROR_CSETALTE 6450 +#define CT_ERROR_CSETBELL 6460 +#define CT_ERROR_CSETCARR 6470 +#define CT_ERROR_CSETCENT 6480 +#define CT_ERROR_CSETCONF 6490 +#define CT_ERROR_CSETCONS 6500 +#define CT_ERROR_CSETCURS 6510 +#define CT_ERROR_CSETDELE 6520 +#define CT_ERROR_CSETDELI 6530 +#define CT_ERROR_CSETDEVI 6540 +#define CT_ERROR_CSETESCA 6550 +#define CT_ERROR_CSETEXAC 6560 +#define CT_ERROR_CSETEXCL 6570 +#define CT_ERROR_CSETFIXE 6580 +#define CT_ERROR_CSETINTE 6590 +#define CT_ERROR_CSETPRIN 6600 +#define CT_ERROR_CSETSCOR 6610 +#define CT_ERROR_CSETSOFT 6620 +#define CT_ERROR_CSETUNIQ 6630 +#define CT_ERROR_CSETWRAP 6640 +#define CT_ERROR_ISDEBUG 6650 +#define CT_ERROR_KSETCAPS 6660 +#define CT_ERROR_KSETINS 6670 +#define CT_ERROR_KSETNUM 6680 +#define CT_ERROR_KSETSCROLL 6690 +#define CT_ERROR_LASTKFUNC 6700 +#define CT_ERROR_LASTKLINE 6710 +#define CT_ERROR_LASTKPROC 6720 +#define CT_ERROR_NUMFKEY 6730 +#define CT_ERROR_SETLASTKEY 6740 + +/* system info functions */ +#define CT_ERROR_BIOSDATE 6810 /* TODO: change last digit */ +#define CT_ERROR_BOOTCOLD 6820 +#define CT_ERROR_BOOTWARM 6830 +#define CT_ERROR_CPUTYPE 6840 +#define CT_ERROR_DOSPARAM 6850 +#define CT_ERROR_ENVPARAM 6860 +#define CT_ERROR_ERRORACT 6870 +#define CT_ERROR_ERRORBASE 6880 +#define CT_ERROR_ERRORCODE 6890 +#define CT_ERROR_ERRORORG 6900 +#define CT_ERROR_EXENAME 6910 +#define CT_ERROR_FILESFREE 6920 +#define CT_ERROR_FILESMAX 6930 +#define CT_ERROR_GETCOUNTRY 6940 +#define CT_ERROR_ISANSI 6950 +#define CT_ERROR_ISAT 6960 +#define CT_ERROR_ISMATH 6970 +#define CT_ERROR_MEMSIZE 6980 +#define CT_ERROR_NUMBUFFERS 6990 +#define CT_ERROR_NUMFILES 7000 +#define CT_ERROR_OSVER 7010 +#define CT_ERROR_PCTYPE 7020 +#define CT_ERROR_SSETBREAK 7030 +#define CT_ERROR_SSETVERIFY 7040 + +/* 3.3 misc. functions */ +#define CT_ERROR_ALLOFREE 7110 /* TODO: change last digit */ +#define CT_ERROR_BLANK 7120 +#define CT_ERROR_COMPLEMENT 7130 +#define CT_ERROR_DATATYPE 7140 +#define CT_ERROR_GETTIC 7150 +#define CT_ERROR_KBDDISABLE 7160 +#define CT_ERROR_KBDEMULATE 7170 +#define CT_ERROR_KBDSPEED 7180 +#define CT_ERROR_KBDSTAT 7190 +#define CT_ERROR_KBDTYPE 7200 +#define CT_ERROR_KEYSEC 7210 +#define CT_ERROR_KEYTIME 7220 +#define CT_ERROR_MILLISEC 7230 +#define CT_ERROR_NUL 7240 +#define CT_ERROR_SCANKEY 7250 +#define CT_ERROR_SETTIC 7260 +#define CT_ERROR_SHOWKEY 7270 +#define CT_ERROR_SOUND 7280 +#define CT_ERROR_SPEED 7290 +#define CT_ERROR_STACKFREE 7300 +#define CT_ERROR_TOOLVER 7310 +#define CT_ERROR_XTOC 7320 + +/* math functions */ +#define CT_ERROR_ACOS 7413 +#define CT_ERROR_ASIN 7423 +#define CT_ERROR_ATAN 7433 +#define CT_ERROR_ATN2 7443 +#define CT_ERROR_CEILING 7452 +#define CT_ERROR_COS 7463 +#define CT_ERROR_COT 7473 +#define CT_ERROR_DTOR 7483 +#define CT_ERROR_EXPA 7493 +#define CT_ERROR_FACT 7502 +#define CT_ERROR_FLOOR 7512 +#define CT_ERROR_FV 7523 +#define CT_ERROR_GETPREC 7532 +#define CT_ERROR_LOG10 7543 +#define CT_ERROR_LOGA 7553 +#define CT_ERROR_PAYMENT 7563 +#define CT_ERROR_PERIODS 7572 +#define CT_ERROR_PI 7583 +#define CT_ERROR_PV 7593 +#define CT_ERROR_RATE 7603 +#define CT_ERROR_ROOT 7613 +#define CT_ERROR_RTOD 7623 +#define CT_ERROR_SETMATHERR 7632 +#define CT_ERROR_SETPREC 7642 +#define CT_ERROR_SIGN 7652 +#define CT_ERROR_SIN 7663 +#define CT_ERROR_TAN 7673 + +/* peek and poke functions */ +#define CT_ERROR_INBYTE 7810 /* TODO: change last digit */ +#define CT_ERROR_INWORD 7820 +#define CT_ERROR_OUTBYTE 7830 +#define CT_ERROR_OUTWORD 7840 +#define CT_ERROR_PEEKBYTE 7850 +#define CT_ERROR_PEEKSTR 7860 +#define CT_ERROR_PEEKWORD 7870 +#define CT_ERROR_POKEBYTE 7880 +#define CT_ERROR_POKEWORD 7890 + +/* GET/READ functions */ +#define CT_ERROR_COUNTGETS 7910 /* TODO: change last digit */ +#define CT_ERROR_CURRENTGET 7920 +#define CT_ERROR_GETFLDCOL 7930 +#define CT_ERROR_GETFLDROW 7940 +#define CT_ERROR_GETFLDVAR 7950 +#define CT_ERROR_GETINPUT 7960 +#define CT_ERROR_GETSECRET 7970 +#define CT_ERROR_RESTGETS 7980 +#define CT_ERROR_RESTSETKEY 7990 +#define CT_ERROR_SAVEGETS 8000 +#define CT_ERROR_SAVESETKEY 8010 + +/* TODO: add network functions */ + +#endif /* _CTERROR_CH */ + diff --git a/harbour/contrib/libct/ctflist.txt b/harbour/contrib/libct/ctflist.txt index 70dd6f4a6d..87359d4143 100644 --- a/harbour/contrib/libct/ctflist.txt +++ b/harbour/contrib/libct/ctflist.txt @@ -30,6 +30,14 @@ ; Please review the following function status ; ; +; 0. general functions +; ======================= +; +CTINIT ;R; !NEW! +CTEXIT ;R; !NEW! +CSETARGERR ;R; !NEW! +; +; ; 1.1 windowing functions ; ======================= ; @@ -589,19 +597,23 @@ ATN2 ;N; CEILING ;N; COS ;N; COT ;N; -DTOR ;N; +DTOR ;N; +EXPA ;N; !NEW! FACT ;N; FLOOR ;N; FV ;N; -GETPREC ;N; +GETPREC ;N; +LOGA ;N; !NEW! LOG10 ;N; PAYMENT ;N; PERIODS ;N; PI ;N; PV ;N; -RATE ;N; +RATE ;N; +ROOT ;N; !NEW! RTOD ;N; -SETPREC ;N; +SETMATHERR ;R; !NEW! +SETPREC ;N; SIGN ;N; SIN ;N; TAN ;N; diff --git a/harbour/contrib/libct/ctmath.c b/harbour/contrib/libct/ctmath.c new file mode 100644 index 0000000000..a1e644e977 --- /dev/null +++ b/harbour/contrib/libct/ctmath.c @@ -0,0 +1,500 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * internal and switch functions for CT3 math functions + * + * Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany + * Author: Martin Vogel + * + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + + +#include "ct.h" + +/* -------------- */ +/* initialization */ +/* -------------- */ +static HB_MATH_HANDLERHANDLE s_ctMathHandler; /* 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; +} + +int ct_math_exit (void) +{ + HB_TRACE(HB_TR_DEBUG, ("ctmath_exit()")); + hb_deinstallMathHandler (s_ctMathHandler); + return; +} + +void ct_setmatherrstatus (int iStatus) +{ + HB_TRACE(HB_TR_DEBUG, ("ct_setmatherrstatus (%i)", iStatus)); + if (s_ctMathHandler != NULL) + { + hb_setMathHandlerStatus (s_ctMathHandler, iStatus); + } + return; +} + +int ct_getmatherrstatus (void) +{ + HB_TRACE(HB_TR_DEBUG, ("ct_getmatherrstatus()")); + if (s_ctMathHandler != NULL) + { + return (hb_getMathHandlerStatus (s_ctMathHandler)); + } + return (0); +} + +/* ------------------------- */ +/* handling of mathlib error */ +/* ------------------------- */ +static int s_ct_matherr_mode = CT_MATHERR_MODE_DEFAULT; /* TODO: make this thread safe */ +void ct_setmatherrmode (int iMode) +{ + HB_TRACE(HB_TR_DEBUG, ("ct_setmatherrmode (%i)", iMode)); + s_ct_matherr_mode = iMode; + return; +} +int ct_getmatherrmode (void) +{ + HB_TRACE(HB_TR_DEBUG, ("ct_getmatherrmode()")); + return (s_ct_matherr_mode); +} + + +/* $DOC$ + * $FUNCNAME$ + * SETMATHERR() + * $CATEGORY$ + * CT3 math functions + * $ONELINER$ + * Sets the math error correction status and mode + * $SYNTAX$ + * SETMATHERR ([] [,<[@]nMode>]) -> nOldStatus + * $ARGUMENTS$ + * [] new math error correction status + * [<[@]nMode>] new math error correction mode OR + * placeholder for current mode (if passed by reference) + * $RETURNS$ + * nOldStatus old (if nStatus is a valid value, see below) or + * current mode of math error correction + * $DESCRIPTION$ + * Most math functions within the CT3 library (and in Harbour itself) rely on the + * standard C math library which, on some platforms, calls a certain, + * user-definable error handling routine when one of the following + * mathematical errors occur (constants defined in cterror.ch): + * + * CT_ERROR_MATHLIB unknown math lib error + * CT_ERROR_MATHLIB_DOMAIN a domain error has occured, such as sqrt (-1) + * CT_ERROR_MATHLIB_SING a singularity will result, such as pow (0, -2) + * CT_ERROR_MATHLIB_OVERFLOW an overflow will result, such as pow (10, 100) + * CT_ERROR_MATHLIB_UNDERFLOW an underflow will result, such as pow (10, -100) + * 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 behaviour of this handler depends on the values of + * and : + * + * The values of and specify whether the CT3 + * math handler is active. It can be one of the following values + * (defined in ct.ch): + * + * CT_MATHERR_STATUS_NOTFOUND math handler is not installed + * CT_MATHERR_STATUS_INACTIVE math handler is installed but inactive + * CT_MATHERR_STATUS_ACTIVE math handler is installed and active + * + * Be aware that, if CT_MATHERR_STATUS_NOTFOUND is used as argument, + * SETMATHERR() will NOT deinstall the math handler. The math handler + * is installed by CTINIT(), remains inactive at first, and is deinstalled + * by CTEXIT(). + * + * The value of specifies the behaviour of the CT3 math handler + * if it is installed and active. It can be one of the following values: + * + * CT_MATHERR_MODE_NONE no correction at all, program will exit + * CT_MATHERR_MODE_DEFAULT default return value will be used, no error msgs ! + * CT_MATHERR_MODE_USER error will be thrown to user who is responsible for error correction + * CT_MATHERR_MODE_USERDEFAULT error will be thrown, but if user fails, default correction will be used + * + * The default behaviour is CT_MATHERR_MODE_DEFAULT. + * + * Be aware that, if is passed by reference, SETMATHERR() will + * store the current value in <@nMode> rather than setting a new one. + * + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Ready + * $COMPLIANCE$ + * SETMATHERR() is a new function in Harbour's CT3 library. + * $PLATFORMS$ + * All + * $FILES$ + * Source is ctmath.c, library is ct3. + * $SEEALSO$ + * CTINIT() CTEXIT() + * $END$ + */ + +HB_FUNC (SETMATHERR) +{ + + hb_retni (ct_getmatherrstatus()); + + /* set new status if first parameter is one of + {CT_MATHERR_STATUS_INACTIVE, CT_MATHERR_STATUS_ACTIVE}, but + ignore CT_MATHERR_STATUS_NOTFOUND !! */ + if (ISNUM (1)) + { + int iNewStatus = hb_parni (1); + if ((iNewStatus == CT_MATHERR_STATUS_INACTIVE) || + (iNewStatus == CT_MATHERR_STATUS_INACTIVE)) + { + ct_setmatherrstatus (iNewStatus); + } + else + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_SETMATHERR, + NULL, "SETMATHERR", 0, EF_CANDEFAULT, 2, + hb_paramError (1), hb_paramError (2)); + } + } + } + + /* set new mode, if ISNUM(2) but !ISBYREF(2) */ + if (ISNUM (2)) + { + if (ISBYREF (2)) + { + /* store current mode in second parameter */ + hb_storni (ct_getmatherrmode(), 2); + } + else + { + int iNewMode = hb_parni (2); + if ((iNewMode == CT_MATHERR_MODE_NONE) || + (iNewMode == CT_MATHERR_MODE_DEFAULT) || + (iNewMode == CT_MATHERR_MODE_USER) || + (iNewMode == CT_MATHERR_MODE_USERDEFAULT)) + { + ct_setmatherrmode (hb_parni(2)); + } + else + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_SETMATHERR, + NULL, "SETMATHERR", 0, EF_CANDEFAULT, 2, + hb_paramError (1), hb_paramError (2)); + } + } + } + } + else if (hb_pcount() > 1) /* more than 1 param, but second is not integer ! */ + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_SETMATHERR, + NULL, "SETMATHERR", 0, EF_CANDEFAULT, 2, + hb_paramError (1), hb_paramError (2)); + } + } + + return; + +} + + +/* -------------- */ +/* math handler */ +/* -------------- */ +int ct_matherr (struct exception * err) +{ + + int retval = 0; + int imatherr = ct_getmatherrmode(); + + HB_TRACE(HB_TR_DEBUG, ("ct_matherr (%p)", err)); + + if ((imatherr == CT_MATHERR_MODE_USER) || (imatherr == CT_MATHERR_MODE_USERDEFAULT)) + { + PHB_ITEM pMatherrResult, pArg1, pArg2; + ULONG ulSubCode; + + switch (err->type) + { + case DOMAIN: + /* a domain error has occured, such as sqrt( -1 ) */ + ulSubCode = CT_ERROR_MATHLIB_DOMAIN; break; + case SING: + /* a singularity will result, such as pow( 0, -2 ) */ + ulSubCode = CT_ERROR_MATHLIB_SING; break; + case OVERFLOW: + /* an overflow will result, such as pow( 10, 100 ) */ + ulSubCode = CT_ERROR_MATHLIB_OVERFLOW; break; + case UNDERFLOW: + /* an underflow will result, such as pow( 10, -100 ) */ + ulSubCode = CT_ERROR_MATHLIB_UNDERFLOW; break; + case TLOSS: + /* total loss of significance will result, such as exp( 1000 ) */ + ulSubCode = CT_ERROR_MATHLIB_TLOSS; break; + case PLOSS: + /* partial loss of significance will result, such as sin( 10e70 ) */ + ulSubCode = CT_ERROR_MATHLIB_PLOSS; break; + default: + /* unknown math lib error */ + ulSubCode = CT_ERROR_MATHLIB; break; + } + + pArg1 = hb_itemPutND (NULL, err->arg1); + pArg2 = hb_itemPutND (NULL, err->arg2); + pMatherrResult = ct_error_subst (ES_ERROR, EG_NUMERR, ulSubCode, + NULL, err->name, 0, EF_CANSUBSTITUTE, + 2, pArg1, pArg2); + + if ((pMatherrResult != NULL) && (HB_IS_NUMERIC (pMatherrResult))) + { + err->retval = hb_itemGetND (pMatherrResult); + retval = 1; + } + + hb_itemRelease (pMatherrResult); + hb_itemRelease (pArg1); + hb_itemRelease (pArg2); + } + + if ((retval == 0) && + ((imatherr == CT_MATHERR_MODE_DEFAULT) || (imatherr == CT_MATHERR_MODE_USERDEFAULT))) + { + /* find some appropiate return values */ + switch (err->type) + { + case DOMAIN: + /* a domain error has occured, such as sqrt( -1 ) */ + err->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; + else + err->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; + else + err->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; + else + err->retval = DBL_MIN; + retval = 1; + break; + case TLOSS: + /* total loss of significance will result, such as exp( 1000 ) */ + err->retval = 1.0; + retval = 1; + break; + case PLOSS: + /* partial loss of significance will result, such as sin( 10e70 ) */ + err->retval = 1.0; + retval = 1; + break; + default: + /* unknown math lib error */ + err->retval = 0.0; + retval = 1; + break; + } + } + + return (retval); + +} + + +/* ---------------- */ +/* math precision */ +/* ---------------- */ +static int s_ct_precision = 16; /* TODO: make this thread safe */ + +void ct_setprecision (int iPrecision) +{ + HB_TRACE(HB_TR_DEBUG, ("ct_setprecision (%i)", iPrecision)); + s_ct_precision = iPrecision; + return; +} +int ct_getprecision (void) +{ + HB_TRACE(HB_TR_DEBUG, ("ct_getprecision()")); + return (s_ct_precision); +} + + +/* $DOC$ + * $FUNCNAME$ + * SETPREC() + * $CATEGORY$ + * CT3 math functions + * $ONELINER$ + * Set precision of math functions + * $SYNTAX$ + * SETPREC () -> cEmptyString + * $ARGUMENTS$ + * digit count between 1 and 16, defaults to 16 + * $RETURNS$ + * cEmptyString this function always returns an empty string + * $DESCRIPTION$ + * Be aware that calls to this functions do _NOT_ affect the + * calculation precision of the math functions at the moment. + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Ready + * $COMPLIANCE$ + * SETPREC() is compatible with CT3's SETPREC. + * $PLATFORMS$ + * All + * $FILES$ + * Source is ctmath.c, library is ct3. + * $SEEALSO$ + * $END$ + */ + +HB_FUNC (SETPREC) +{ + + if ((ISNUM (1)) && + (hb_parni (1) >= 1) && + (hb_parni (1) <= 16)) + { + ct_setprecision (hb_parni (1)); + } + else + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_SETPREC, + NULL, "SETPREC", 0, EF_CANDEFAULT, 1, hb_paramError (1)); + } + } + + hb_retc (""); + +} + + +/* $DOC$ + * $FUNCNAME$ + * GETPREC() + * $CATEGORY$ + * CT3 math functions + * $ONELINER$ + * Get precision of math functions + * $SYNTAX$ + * GETPREC () -> nDigits + * $ARGUMENTS$ + * $RETURNS$ + * nDigits digit count between 1 and 16 + * $DESCRIPTION$ + * Be aware that calls to this functions do _NOT_ affect the + * calculation precision of the math functions at the moment. + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Ready + * $COMPLIANCE$ + * GETPREC() is compatible with CT3's GETPREC. + * $PLATFORMS$ + * All + * $FILES$ + * Source is ctmath.c, library is ct3. + * $SEEALSO$ + * $END$ + */ + +HB_FUNC (GETPREC) +{ + + hb_retni (ct_getprecision ()); + if (hb_pcount() > 0) + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_GETPREC, + NULL, "GETPREC", 0, EF_CANDEFAULT, 1, hb_paramError (1)); + } + } + +} diff --git a/harbour/contrib/libct/ctmath.h b/harbour/contrib/libct/ctmath.h new file mode 100644 index 0000000000..eb65a0f0c2 --- /dev/null +++ b/harbour/contrib/libct/ctmath.h @@ -0,0 +1,92 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * CTOOLS for Harbour, Math header file + * + * Copyright 2001 Alejandro de garate + * + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + +#ifndef _CTMATH_H +#define _CTMATH_H + +#include +#include +#include + +/* initialization */ +extern int ct_math_init (void); +extern int ct_math_exit (void); + +/* set & get math error correction status */ +extern void ct_setmatherrstatus (int iStatus); +extern int ct_getmatherrstatus (void); + +/* set & get math error correction mode */ +extern void ct_setmatherrmode (int iMode); +extern int ct_getmatherrmode (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 */ +#define CT_MATHERR_STATUS_ACTIVE HB_MATH_HANDLER_STATUS_ACTIVE /* math handler is installed and active */ + +#define CT_MATHERR_MODE_NONE 0 /* no correction at all, program will exit */ +#define CT_MATHERR_MODE_DEFAULT 1 /* default return value will be used, no error msgs ! */ +#define CT_MATHERR_MODE_USER 2 /* error will be thrown to user who is responsible for error correction */ +#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); + +/* set & get precision */ +extern void ct_setprecision (int iPrecision); +extern int ct_getprecision(); + +#endif /* CTMATH_H */ + + diff --git a/harbour/contrib/libct/ctset.c b/harbour/contrib/libct/ctset.c index 0d6f3968e9..48fef91ac3 100644 --- a/harbour/contrib/libct/ctset.c +++ b/harbour/contrib/libct/ctset.c @@ -6,9 +6,6 @@ * Harbour Project source code: * CT3 switch functions * - * - CSETREF() - * - CSETATMUPA() - * - SETATLIKE() * * Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany * Author: Martin Vogel @@ -60,306 +57,3 @@ #include "ct.h" -/* - * CSETREF() stuff - */ - -static int siRefSwitch = 0; /* TODO: make this tread safe */ - -void ct_setref (int iNewSwitch) -{ - HB_TRACE(HB_TR_DEBUG, ("ct_setref(%i)",iNewSwitch)); - siRefSwitch = iNewSwitch; - return; -} - - -int ct_getref (void) -{ - HB_TRACE(HB_TR_DEBUG, ("ct_getref()")); - return (siRefSwitch); -} - - -/* $DOC$ - * $FUNCNAME$ - * CSETREF() - * $CATEGORY$ - * CT3 string functions - * $ONELINER$ - * Determine return value of reference sensitive CT3 string functions - * $SYNTAX$ - * CSETREF ([]) -> lOldSwitch - * $ARGUMENTS$ - * [] .T. -> suppress return value - * .F. -> do not suppress return value - * $RETURNS$ - * lOldSwitch old (if lNewSwitch is a logical value) or - * current state of the switch - * $DESCRIPTION$ - * Within the CT3 functions, the following functions do not - * change the length of a string passed as parameter while - * transforming this string: - * - * ADDASCII() BLANK() CHARADD() - * CHARAND() CHARMIRR() CHARNOT() - * CHAROR() CHARRELREP() CHARREPL() - * CHARSORT() CHARSWAP() CHARXOR() - * CRYPT() JUSTLEFT() JUSTRIGHT() - * POSCHAR() POSREPL() RANGEREPL() - * REPLALL() REPLLEFT() REPLRIGHT() - * TOKENLOWER() TOKENUPPER() WORDREPL() - * WORDSWAP() - * - * Thus, these functions allow to pass the string by reference [@] to - * the function so that it may not be necessary to return the transformed - * string. By calling CSETREF (.T.), the above mentioned functions return - * the value .F. instead of the transformed string if the string is - * passed by reference to the function. - * The switch is turned off (.F.) by default. - * - * $EXAMPLES$ - * $TESTS$ - * $STATUS$ - * Ready - * $COMPLIANCE$ - * This function is fully CT3 compatible. - * $PLATFORMS$ - * All - * $FILES$ - * Source is ctset.c, library is ct3. - * $SEEALSO$ - * ADDASCII() BLANK() CHARADD() - * CHARAND() CHARMIRR() CHARNOT() - * CHAROR() CHARRELREP() CHARREPL() - * CHARSORT() CHARSWAP() CHARXOR() - * CRYPT() JUSTLEFT() JUSTRIGHT() - * POSCHAR() POSREPL() RANGEREPL() - * REPLALL() REPLLEFT() REPLRIGHT() - * TOKENLOWER() TOKENUPPER() WORDREPL() - * WORDSWAP() - * $END$ - */ - -HB_FUNC (CSETREF) -{ - - hb_retl (ct_getref()); - - if (ISLOG (1)) - ct_setref (hb_parl (1)); - - return; - -} - - -/* - * CSETATMUPA() stuff - */ - -static int siAtMupaSwitch = 0; /* TODO: make this tread safe */ - -void ct_setatmupa (int iNewSwitch) -{ - HB_TRACE(HB_TR_DEBUG, ("ct_setatmupa(%i)",iNewSwitch)); - siAtMupaSwitch = iNewSwitch; - return; -} - - -int ct_getatmupa (void) -{ - HB_TRACE(HB_TR_DEBUG, ("ct_getatmupa()")); - return (siAtMupaSwitch); -} - - -/* $DOC$ - * $FUNCNAME$ - * CSETATMUPA() - * $CATEGORY$ - * CT3 string functions - * $ONELINER$ - * Determine "multi-pass" behaviour in some string functions - * $SYNTAX$ - * CSETATMUPA ([]) -> lOldSwitch - * $ARGUMENTS$ - * [] .T. -> turn "multi-pass" on - * .F. -> turn "multi-pass" off - * $RETURNS$ - * lOldSwitch old (if lNewSwitch is a logical value) or - * current state of the switch - * $DESCRIPTION$ - * CSETATMUPA determines how the following CT3 string functions - * - * ATNUM() AFTERATNUM() BEFORATNUM() - * ATREPL() NUMAT() ATADJUST() - * WORDTOCHAR() WORDREPL() - * - * perform their work. See the respective function documentation for a - * further description how the switch influences these functions. - * - * $EXAMPLES$ - * $TESTS$ - * $STATUS$ - * Ready - * $COMPLIANCE$ - * This function is fully CT3 compatible. - * $PLATFORMS$ - * All - * $FILES$ - * Source is ctset.c, library is ct3. - * $SEEALSO$ - * ATNUM() AFTERATNUM() BEFORATNUM() - * ATREPL() NUMAT() ATADJUST() - * WORDTOCHAR() WORDREPL() - * $END$ - */ - - -HB_FUNC (CSETATMUPA) -{ - - hb_retl (ct_getatmupa()); - - if (ISLOG (1)) - ct_setatmupa (hb_parl (1)); - - return; - -} - - -/* - * SETATLIKE() stuff - */ - -static int siAtLikeMode = 0; /* TODO: make this tread safe */ -static int scAtLikeChar = '?'; /* TODO: make this tread safe */ - -void ct_setatlike (int iNewMode) -{ - HB_TRACE(HB_TR_DEBUG, ("ct_setatlike(%i)",iNewMode)); - siAtLikeMode = iNewMode; - return; -} - - -int ct_getatlike (void) -{ - HB_TRACE(HB_TR_DEBUG, ("ct_getatlike()")); - return (siAtLikeMode); -} - - -void ct_setatlikechar (char cNewChar) -{ - HB_TRACE(HB_TR_DEBUG, ("ct_setatlikechar(\'%c\')",cNewChar)); - scAtLikeChar = cNewChar; - return; -} - - -char ct_getatlikechar (void) -{ - HB_TRACE(HB_TR_DEBUG, ("ct_getatlikechar()")); - return (scAtLikeChar); -} - - -/* $DOC$ - * $FUNCNAME$ - * SETATLIKE() - * $CATEGORY$ - * CT3 string functions - * $ONELINER$ - * Determine scan behaviour in some string functions - * $SYNTAX$ - * SETATLIKE ([] [, <[@]cWildcard>]) --> nOldMode - * $ARGUMENTS$ - * [] CT_SETATLIKE_EXACT -> characters are compared exactly - * CT_SETATLIKE_WILDCARD -> characters are compared using - * a wildcard character - * The default value is CT_SETATLIKE_EXACT. - * [<[@]cWildcard>] determines the character that is subsequently used - * as a wildcard character for substring scanning. - * The default value is "?". - * NEW: If this parameter is passed by reference [@], - * the current wildcard character is stored in - * . - * $RETURNS$ - * nOldMode old (if nMode is a numeric value) or - * current state of the switch - * $DESCRIPTION$ - * In the following CT3 functions, strings are compared on a character - * base: - * - * ATADJUST() ATNUM() AFTERATNUM() - * BEFOREATNUM() ATREPL() NUMAT() - * STRDIFF() - * - * With the SETATLIKE function, one can determine when characters are - * considered to match within these functions. If CT_SETATLIKE_WILDCARD - * is set (e.g. "?"), then "?" matches every other character. - * - * can be one of the following values that are defined - * in ct.ch - * - * Definition | Value - * ----------------------|------ - * CT_SETATLIKE_EXACT | 0 - * CT_SETATLIKE_WILDCARD | 1 - * - * $EXAMPLES$ - * $TESTS$ - * $STATUS$ - * Ready - * $COMPLIANCE$ - * This function is fully CT3 compatible, but allows to pass the - * second parameter by reference so that the current wildcard character - * can be determined. - * $PLATFORMS$ - * All - * $FILES$ - * Source is ctset.c, header is ct.ch, library is ct3. - * $SEEALSO$ - * $END$ - */ - -HB_FUNC (SETATLIKE) -{ - - hb_retni (ct_getatlike()); - - /* set new mode if first parameter is CT_SETATLIKE_EXACT (==0) - or CT_SETATLIKE_WILDCARD (==1) */ - if (ISNUM (1)) - { - int iNewMode = hb_parni (1); - if ((iNewMode == CT_SETATLIKE_EXACT) || - (iNewMode == CT_SETATLIKE_WILDCARD)) - ct_setatlike (iNewMode); - } - - /* set new wildcard character, if ISCHAR(2) but !ISBYREF(2) */ - if (ISCHAR (2)) - { - if (ISBYREF (2)) - { - /* new behaviour: store the current wildcard char in second parameter */ - char cResult; - cResult = ct_getatlikechar(); - hb_storclen (&cResult, 1, 2); - } - else - { - char *pcNewChar = hb_parc (2); - if (hb_parclen (2) > 0) - ct_setatlikechar (*pcNewChar); - } - } - - return; - -} diff --git a/harbour/contrib/libct/ctset.h b/harbour/contrib/libct/ctset.h index 02708e97e3..920296fbd7 100644 --- a/harbour/contrib/libct/ctset.h +++ b/harbour/contrib/libct/ctset.h @@ -56,18 +56,6 @@ #ifndef _CTSET_H #define _CTSET_H 1 -void ct_setref (int); -int ct_getref (void); -void ct_setatmupa (int); -int ct_getatmupa (void); -void ct_setatlike (int); -int ct_getatlike (void); -void ct_setatlikechar (char); -char ct_getatlikechar (void); - -#define CT_SETATLIKE_EXACT 0 -#define CT_SETATLIKE_WILDCARD 1 - #endif diff --git a/harbour/contrib/libct/ctstr.c b/harbour/contrib/libct/ctstr.c index 10e14bb517..04634a1d8f 100644 --- a/harbour/contrib/libct/ctstr.c +++ b/harbour/contrib/libct/ctstr.c @@ -4,7 +4,7 @@ /* * Harbour Project source code: - * internal functions for CT3 string functions + * internal and switch functions for CT3 string functions * * Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany * Author: Martin Vogel @@ -56,6 +56,22 @@ #include "ct.h" +/* -------------- */ +/* initialization */ +/* -------------- */ +int ct_str_init (void) +{ + HB_TRACE(HB_TR_DEBUG, ("ctstr_init()")); + return(1); +} + +int ct_str_exit (void) +{ + HB_TRACE(HB_TR_DEBUG, ("ctstr_exit()")); + return(1); +} + + /* -------------------------- */ /* search for exact substring */ /* -------------------------- */ @@ -272,6 +288,362 @@ char *ct_at_charset_backward (char *pcString, size_t sStrLen, } +/* + * CSETREF() stuff + */ + +static int siRefSwitch = 0; /* TODO: make this tread safe */ + +void ct_setref (int iNewSwitch) +{ + HB_TRACE(HB_TR_DEBUG, ("ct_setref(%i)",iNewSwitch)); + siRefSwitch = iNewSwitch; + return; +} + + +int ct_getref (void) +{ + HB_TRACE(HB_TR_DEBUG, ("ct_getref()")); + return (siRefSwitch); +} + + +/* $DOC$ + * $FUNCNAME$ + * CSETREF() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Determine return value of reference sensitive CT3 string functions + * $SYNTAX$ + * CSETREF ([]) -> lOldSwitch + * $ARGUMENTS$ + * [] .T. -> suppress return value + * .F. -> do not suppress return value + * $RETURNS$ + * lOldSwitch old (if lNewSwitch is a logical value) or + * current state of the switch + * $DESCRIPTION$ + * Within the CT3 functions, the following functions do not + * change the length of a string passed as parameter while + * transforming this string: + * + * ADDASCII() BLANK() CHARADD() + * CHARAND() CHARMIRR() CHARNOT() + * CHAROR() CHARRELREP() CHARREPL() + * CHARSORT() CHARSWAP() CHARXOR() + * CRYPT() JUSTLEFT() JUSTRIGHT() + * POSCHAR() POSREPL() RANGEREPL() + * REPLALL() REPLLEFT() REPLRIGHT() + * TOKENLOWER() TOKENUPPER() WORDREPL() + * WORDSWAP() + * + * Thus, these functions allow to pass the string by reference [@] to + * the function so that it may not be necessary to return the transformed + * string. By calling CSETREF (.T.), the above mentioned functions return + * the value .F. instead of the transformed string if the string is + * passed by reference to the function. + * The switch is turned off (.F.) by default. + * + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Ready + * $COMPLIANCE$ + * This function is fully CT3 compatible. + * $PLATFORMS$ + * All + * $FILES$ + * Source is ctstr.c, library is ct3. + * $SEEALSO$ + * ADDASCII() BLANK() CHARADD() + * CHARAND() CHARMIRR() CHARNOT() + * CHAROR() CHARRELREP() CHARREPL() + * CHARSORT() CHARSWAP() CHARXOR() + * CRYPT() JUSTLEFT() JUSTRIGHT() + * POSCHAR() POSREPL() RANGEREPL() + * REPLALL() REPLLEFT() REPLRIGHT() + * TOKENLOWER() TOKENUPPER() WORDREPL() + * WORDSWAP() + * $END$ + */ + +HB_FUNC (CSETREF) +{ + + hb_retl (ct_getref()); + + if (ISLOG (1)) + { + ct_setref (hb_parl (1)); + } + else if (hb_pcount() > 0) /* 1 params, but is not logical ! */ + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CSETREF, + NULL, "CSETREF", 0, EF_CANDEFAULT, 1, hb_paramError (1)); + } + } + + return; + +} + + +/* + * CSETATMUPA() stuff + */ + +static int siAtMupaSwitch = 0; /* TODO: make this tread safe */ + +void ct_setatmupa (int iNewSwitch) +{ + HB_TRACE(HB_TR_DEBUG, ("ct_setatmupa(%i)",iNewSwitch)); + siAtMupaSwitch = iNewSwitch; + return; +} + + +int ct_getatmupa (void) +{ + HB_TRACE(HB_TR_DEBUG, ("ct_getatmupa()")); + return (siAtMupaSwitch); +} + + +/* $DOC$ + * $FUNCNAME$ + * CSETATMUPA() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Determine "multi-pass" behaviour in some string functions + * $SYNTAX$ + * CSETATMUPA ([]) -> lOldSwitch + * $ARGUMENTS$ + * [] .T. -> turn "multi-pass" on + * .F. -> turn "multi-pass" off + * $RETURNS$ + * lOldSwitch old (if lNewSwitch is a logical value) or + * current state of the switch + * $DESCRIPTION$ + * CSETATMUPA determines how the following CT3 string functions + * + * ATNUM() AFTERATNUM() BEFORATNUM() + * ATREPL() NUMAT() ATADJUST() + * WORDTOCHAR() WORDREPL() + * + * perform their work. See the respective function documentation for a + * further description how the switch influences these functions. + * + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Ready + * $COMPLIANCE$ + * This function is fully CT3 compatible. + * $PLATFORMS$ + * All + * $FILES$ + * Source is ctstr.c, library is ct3. + * $SEEALSO$ + * ATNUM() AFTERATNUM() BEFORATNUM() + * ATREPL() NUMAT() ATADJUST() + * WORDTOCHAR() WORDREPL() + * $END$ + */ + + +HB_FUNC (CSETATMUPA) +{ + + hb_retl (ct_getatmupa()); + + if (ISLOG (1)) + { + ct_setatmupa (hb_parl (1)); + } + else if (hb_pcount() > 0) /* 1 params, but is not logical ! */ + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CSETATMUPA, + NULL, "CSETATMUPA", 0, EF_CANDEFAULT, 1, hb_paramError (1)); + } + } + + return; + +} + + +/* + * SETATLIKE() stuff + */ + +static int siAtLikeMode = 0; /* TODO: make this tread safe */ +static int scAtLikeChar = '?'; /* TODO: make this tread safe */ + +void ct_setatlike (int iNewMode) +{ + HB_TRACE(HB_TR_DEBUG, ("ct_setatlike(%i)",iNewMode)); + siAtLikeMode = iNewMode; + return; +} + + +int ct_getatlike (void) +{ + HB_TRACE(HB_TR_DEBUG, ("ct_getatlike()")); + return (siAtLikeMode); +} + + +void ct_setatlikechar (char cNewChar) +{ + HB_TRACE(HB_TR_DEBUG, ("ct_setatlikechar(\'%c\')",cNewChar)); + scAtLikeChar = cNewChar; + return; +} + + +char ct_getatlikechar (void) +{ + HB_TRACE(HB_TR_DEBUG, ("ct_getatlikechar()")); + return (scAtLikeChar); +} + + +/* $DOC$ + * $FUNCNAME$ + * SETATLIKE() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Determine scan behaviour in some string functions + * $SYNTAX$ + * SETATLIKE ([] [, <[@]cWildcard>]) --> nOldMode + * $ARGUMENTS$ + * [] CT_SETATLIKE_EXACT -> characters are compared exactly + * CT_SETATLIKE_WILDCARD -> characters are compared using + * a wildcard character + * The default value is CT_SETATLIKE_EXACT. + * [<[@]cWildcard>] determines the character that is subsequently used + * as a wildcard character for substring scanning. + * The default value is "?". + * NEW: If this parameter is passed by reference [@], + * the current wildcard character is stored in + * . + * $RETURNS$ + * nOldMode old (if nMode is a numeric value) or + * current state of the switch + * $DESCRIPTION$ + * In the following CT3 functions, strings are compared on a character + * base: + * + * ATADJUST() ATNUM() AFTERATNUM() + * BEFOREATNUM() ATREPL() NUMAT() + * STRDIFF() + * + * With the SETATLIKE function, one can determine when characters are + * considered to match within these functions. If CT_SETATLIKE_WILDCARD + * is set (e.g. "?"), then "?" matches every other character. + * + * can be one of the following values that are defined + * in ct.ch + * + * Definition | Value + * ----------------------|------ + * CT_SETATLIKE_EXACT | 0 + * CT_SETATLIKE_WILDCARD | 1 + * + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Ready + * $COMPLIANCE$ + * This function is fully CT3 compatible, but allows to pass the + * second parameter by reference so that the current wildcard character + * can be determined. + * $PLATFORMS$ + * All + * $FILES$ + * Source is ctstr.c, header is ct.ch, library is ct3. + * $SEEALSO$ + * $END$ + */ + +HB_FUNC (SETATLIKE) +{ + + hb_retni (ct_getatlike()); + + /* set new mode if first parameter is CT_SETATLIKE_EXACT (==0) + or CT_SETATLIKE_WILDCARD (==1) */ + if (ISNUM (1)) + { + int iNewMode = hb_parni (1); + if ((iNewMode == CT_SETATLIKE_EXACT) || + (iNewMode == CT_SETATLIKE_WILDCARD)) + { + ct_setatlike (iNewMode); + } + else + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_SETATLIKE, + NULL, "SETATLIKE", 0, EF_CANDEFAULT, 2, + hb_paramError (1), hb_paramError (2)); + } + } + } + + /* set new wildcard character, if ISCHAR(2) but !ISBYREF(2) */ + if (ISCHAR (2)) + { + if (ISBYREF (2)) + { + /* new behaviour: store the current wildcard char in second parameter */ + char cResult; + cResult = ct_getatlikechar(); + hb_storclen (&cResult, 1, 2); + } + else + { + char *pcNewChar = hb_parc (2); + if (hb_parclen (2) > 0) + ct_setatlikechar (*pcNewChar); + } + } + else if (hb_pcount() > 1) /* more than 2 params, but second is not string ! */ + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_SETATLIKE, + NULL, "SETATLIKE", 0, EF_CANDEFAULT, 2, + hb_paramError (1), hb_paramError (2)); + } + } + + return; + +} + + + + + + + + + diff --git a/harbour/contrib/libct/ctstr.h b/harbour/contrib/libct/ctstr.h index c8d67bb823..a6088fbb7a 100644 --- a/harbour/contrib/libct/ctstr.h +++ b/harbour/contrib/libct/ctstr.h @@ -56,24 +56,39 @@ #ifndef _CTSTR_H #define _CTSTR_H 1 -char *ct_at_exact_forward (char *pcString, size_t sStrLen, - char *pcMatch, size_t sMatchLen, - size_t *psMatchStrLen); -char *ct_at_exact_backward (char *pcString, size_t sStrLen, - char *pcMatch, size_t sMatchLen, - size_t *psMatchStrLen); -char *ct_at_wildcard_forward (char *pcString, size_t sStrLen, - char *pcMatch, size_t sMatchLen, - char cWildCard, size_t *psMatchStrLen); -char *ct_at_wildcard_backward (char *pcString, size_t sStrLen, - char *pcMatch, size_t sMatchLen, - char cWildCard, size_t *psMatchStrLen); -char *ct_at_charset_forward (char *pcString, size_t sStrLen, - char *pcCharSet, size_t sCharSetLen, - size_t *psMatchedCharPos); -char *ct_at_charset_backward (char *pcString, size_t sStrLen, - char *pcCharSet, size_t sCharSetLen, - size_t *psMatchedCharPos); +extern int ct_str_init (void); +extern int ct_str_exit (void); + +extern char *ct_at_exact_forward (char *pcString, size_t sStrLen, + char *pcMatch, size_t sMatchLen, + size_t *psMatchStrLen); +extern char *ct_at_exact_backward (char *pcString, size_t sStrLen, + char *pcMatch, size_t sMatchLen, + size_t *psMatchStrLen); +extern char *ct_at_wildcard_forward (char *pcString, size_t sStrLen, + char *pcMatch, size_t sMatchLen, + char cWildCard, size_t *psMatchStrLen); +extern char *ct_at_wildcard_backward (char *pcString, size_t sStrLen, + char *pcMatch, size_t sMatchLen, + char cWildCard, size_t *psMatchStrLen); +extern char *ct_at_charset_forward (char *pcString, size_t sStrLen, + char *pcCharSet, size_t sCharSetLen, + size_t *psMatchedCharPos); +extern char *ct_at_charset_backward (char *pcString, size_t sStrLen, + char *pcCharSet, size_t sCharSetLen, + size_t *psMatchedCharPos); + +extern void ct_setref (int iNewSwitch); +extern int ct_getref (void); +extern void ct_setatmupa (int iNewSwitch); +extern int ct_getatmupa (void); +extern void ct_setatlike (int iNewSwitch); +extern int ct_getatlike (void); +extern void ct_setatlikechar (char cNewChar); +extern char ct_getatlikechar (void); + +#define CT_SETATLIKE_EXACT 0 +#define CT_SETATLIKE_WILDCARD 1 #endif diff --git a/harbour/contrib/libct/makefile.bc b/harbour/contrib/libct/makefile.bc index 64d1a0029d..fbd946787c 100644 --- a/harbour/contrib/libct/makefile.bc +++ b/harbour/contrib/libct/makefile.bc @@ -77,7 +77,7 @@ LDFLAGS = $(LDFLAGS) # Macros to access our library names # -TOOLS_LIB = $(LIB_DIR)\ct3.lib +TOOLS_LIB = $(LIB_DIR)\libct.lib HARBOUR_EXE = $(BIN_DIR)\harbour.exe @@ -106,6 +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)\ctset.obj \ $(OBJ_DIR)\ctstr.obj \ $(OBJ_DIR)\ctchksum.obj \ @@ -198,6 +200,14 @@ $(OBJ_DIR)\charswap.obj : $(TOOLS_DIR)\charswap.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, +$(OBJ_DIR)\ct.obj : $(TOOLS_DIR)\ct.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\ctmath.obj : $(TOOLS_DIR)\ctmath.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + $(OBJ_DIR)\ctset.obj : $(TOOLS_DIR)\ctset.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, diff --git a/harbour/contrib/libct/makefile.vc b/harbour/contrib/libct/makefile.vc index d1e249730d..606557bd69 100644 --- a/harbour/contrib/libct/makefile.vc +++ b/harbour/contrib/libct/makefile.vc @@ -76,7 +76,7 @@ LDFLAGS = $(LDFLAGS) # Macros to access our library names # -TOOLS_LIB = $(LIB_DIR)\ct3.lib +TOOLS_LIB = $(LIB_DIR)\libct.lib HARBOUR_EXE = $(BIN_DIR)\harbour.exe @@ -126,6 +126,8 @@ TOOLS_LIB_OBJS = \ $(OBJ_DIR)\charrepl.obj \ $(OBJ_DIR)\charsort.obj \ $(OBJ_DIR)\charswap.obj \ + $(OBJ_DIR)\ct.obj \ + $(OBJ_DIR)\ctmath.obj \ $(OBJ_DIR)\ctset.obj \ $(OBJ_DIR)\ctstr.obj \ $(OBJ_DIR)\ctchksum.obj \ @@ -162,6 +164,8 @@ CLEAN: -@if exist $(OBJ_DIR)\charrepl.* del $(OBJ_DIR)\charrepl.* -@if exist $(OBJ_DIR)\charsort.* del $(OBJ_DIR)\charsort.* -@if exist $(OBJ_DIR)\charswap.* del $(OBJ_DIR)\charswap.* + -@if exist $(OBJ_DIR)\ct.* del $(OBJ_DIR)\ct.* + -@if exist $(OBJ_DIR)\ctmath.* del $(OBJ_DIR)\ctmath.* -@if exist $(OBJ_DIR)\ctset.* del $(OBJ_DIR)\ctset.* -@if exist $(OBJ_DIR)\ctstr.* del $(OBJ_DIR)\ctstr.* -@if exist $(OBJ_DIR)\ctchksum.* del $(OBJ_DIR)\ctchksum.* diff --git a/harbour/contrib/libct/readme.txt b/harbour/contrib/libct/readme.txt index d2dbe09c89..be72185559 100644 --- a/harbour/contrib/libct/readme.txt +++ b/harbour/contrib/libct/readme.txt @@ -37,9 +37,17 @@ Martin Vogel + CHARSUB() subtracts corresponding ASCII values ++ CSETARGERR() set behaviour on argument errors + ++ CTINIT() library init function + ++ CTEXIT() library exit function + * SETATLIKE() 2nd parameter can be passed by reference so that SETATLIKE can store the acutal wildcard character in it ++ SETMATHERR() math error handling + * TOKEN() New 5th and 6th parameter where the function can store the tokenizer before and after the extracted token. diff --git a/harbour/contrib/libct/tests/addascii.prg b/harbour/contrib/libct/tests/addascii.prg index 4df79f2f88..2798ed7cf0 100644 --- a/harbour/contrib/libct/tests/addascii.prg +++ b/harbour/contrib/libct/tests/addascii.prg @@ -111,6 +111,8 @@ local cStr := "This is a test!" qout ("End test of ADDASCII()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/token1.c b/harbour/contrib/libct/token1.c index 44b2cb34ee..f9955f7ef0 100644 --- a/harbour/contrib/libct/token1.c +++ b/harbour/contrib/libct/token1.c @@ -364,7 +364,10 @@ static void do_token1 (int iSwitch) { case DO_TOKEN1_TOKEN: { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); char cRet; + if (ISBYREF (5)) { cRet = (char)siPreSeparator; @@ -378,25 +381,93 @@ static void do_token1 (int iSwitch) 6); } - }; /* no "break" here !! */ + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_TOKEN, + NULL, "TOKEN", 0, EF_CANSUBSTITUTE, 6, + hb_paramError (1), hb_paramError (2), + hb_paramError (3), hb_paramError (4), + hb_paramError (5), hb_paramError (6)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + if (!iNoRef) + { + hb_retc (""); + } + else + { + hb_retl (0); + } + } + }; break; case DO_TOKEN1_TOKENLOWER: case DO_TOKEN1_TOKENUPPER: { - if (!iNoRef) + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) { - hb_retc (""); + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, + (iSwitch == DO_TOKEN1_TOKENLOWER ? CT_ERROR_TOKENLOWER : CT_ERROR_TOKENUPPER), + NULL, + (iSwitch == DO_TOKEN1_TOKENLOWER ? "TOKENLOWER" : "TOKENUPPER"), + 0, EF_CANSUBSTITUTE, 4, + hb_paramError (1), hb_paramError (2), + hb_paramError (3), hb_paramError (4)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); } else { - hb_retl (0); + if (!iNoRef) + { + hb_retc (""); + } + else + { + hb_retl (0); + } } }; break; case DO_TOKEN1_NUMTOKEN: case DO_TOKEN1_ATTOKEN: { - hb_retnl (0); + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, + (iSwitch == DO_TOKEN1_NUMTOKEN ? CT_ERROR_NUMTOKEN : CT_ERROR_ATTOKEN), + NULL, + (iSwitch == DO_TOKEN1_NUMTOKEN ? "NUMTOKEN" : "ATTOKEN"), + 0, EF_CANSUBSTITUTE, + (iSwitch == DO_TOKEN1_NUMTOKEN ? 3 : 4), + hb_paramError (1), hb_paramError (2), + hb_paramError (3), hb_paramError (4)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnl (0); + } }; break; } } diff --git a/harbour/contrib/libct/wordrepl.c b/harbour/contrib/libct/wordrepl.c index 2feb804a0b..b5364cbe07 100644 --- a/harbour/contrib/libct/wordrepl.c +++ b/harbour/contrib/libct/wordrepl.c @@ -234,19 +234,37 @@ HB_FUNC (WORDREPL) (ISCHAR (2)) && ((sReplaceLen = (size_t)hb_parclen (3))/2 > 0)) */ { - if (iNoRet) + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) { - hb_retl (0); + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_WORDREPL, + NULL, "WORDREPL", 0, EF_CANSUBSTITUTE, 4, + hb_paramError (1), hb_paramError (2), + hb_paramError (3), hb_paramError (4)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); } else { - if (ISCHAR (2)) + if (iNoRet) { - hb_retclen (hb_parc (2), hb_parclen (2)); + hb_retl (0); } else { - hb_retc (""); + if (ISCHAR (2)) + { + hb_retclen (hb_parc (2), hb_parclen (2)); + } + else + { + hb_retc (""); + } } } } diff --git a/harbour/include/hbmath.h b/harbour/include/hbmath.h index 2561269ce0..08d47980fa 100644 --- a/harbour/include/hbmath.h +++ b/harbour/include/hbmath.h @@ -101,6 +101,7 @@ extern int hb_deinstallMathHandler (HB_MATH_HANDLERHANDLE handle); extern int hb_setMathHandlerStatus (HB_MATH_HANDLERHANDLE handle, int status); extern int hb_getMathHandlerStatus (HB_MATH_HANDLERHANDLE handle); +#define HB_MATH_HANDLER_STATUS_NOTFOUND ((int)-1) #define HB_MATH_HANDLER_STATUS_INACTIVE ((int)0) #define HB_MATH_HANDLER_STATUS_ACTIVE ((int)1) diff --git a/harbour/source/rtl/math.c b/harbour/source/rtl/math.c index d2f553ccdf..2dcb59c44e 100644 --- a/harbour/source/rtl/math.c +++ b/harbour/source/rtl/math.c @@ -69,17 +69,20 @@ static int s_internal_math_error = 0; /* TOFIX: This is not thread safe. */ int hb_getMathError( void ) { + HB_TRACE(HB_TR_DEBUG, ("hb_getMathError()")); return( s_internal_math_error ); } void hb_resetMathError( void ) { + HB_TRACE(HB_TR_DEBUG, ("hb_resetMathError()")); s_internal_math_error = 0; } /* math handler present ? */ int hb_isMathHandler( void ) { + HB_TRACE(HB_TR_DEBUG, ("hb_isMathHandler()")); return (1); } @@ -92,6 +95,7 @@ HB_MATH_HANDLERHANDLE hb_installMathHandler (HB_MATH_HANDLERPROC handlerproc) PHB_MATH_HANDLERCHAINELEMENT pChain, pNewChainelement; + HB_TRACE(HB_TR_DEBUG, ("hb_installMathHandler (%p)", handlerproc)); pNewChainelement = hb_xgrab (sizeof (HB_MATH_HANDLERCHAINELEMENT)); pNewChainelement->handlerproc = handlerproc; pNewChainelement->status = HB_MATH_HANDLER_STATUS_ACTIVE; @@ -120,11 +124,13 @@ int hb_deinstallMathHandler (HB_MATH_HANDLERHANDLE handle) PHB_MATH_HANDLERCHAINELEMENT pChain; + HB_TRACE(HB_TR_DEBUG, ("hb_deinstallMathHandler (%p)", handle)); if (handle != NULL) { if (s_pChain == (PHB_MATH_HANDLERCHAINELEMENT)handle) { s_pChain = ((PHB_MATH_HANDLERCHAINELEMENT)handle)->pnext; + hb_xfree ((void *)handle); return (0); } else @@ -152,16 +158,29 @@ int hb_deinstallMathHandler (HB_MATH_HANDLERHANDLE handle) /* set custom math handler status */ int hb_setMathHandlerStatus (HB_MATH_HANDLERHANDLE handle, int status) { - int oldstatus = ((PHB_MATH_HANDLERCHAINELEMENT)handle)->status; - ((PHB_MATH_HANDLERCHAINELEMENT)handle)->status = status; - + int oldstatus = HB_MATH_HANDLER_STATUS_NOTFOUND; + + HB_TRACE(HB_TR_DEBUG, ("hb_setMathHandlerStatus (%p, %i)", handle, status)); + if (handle != NULL) + { + oldstatus = ((PHB_MATH_HANDLERCHAINELEMENT)handle)->status; + ((PHB_MATH_HANDLERCHAINELEMENT)handle)->status = status; + } return (oldstatus); } /* get custom math handler status */ int hb_getMathHandlerStatus (HB_MATH_HANDLERHANDLE handle) { - return (((PHB_MATH_HANDLERCHAINELEMENT)handle)->status); + HB_TRACE(HB_TR_DEBUG, ("hb_getMathHandlerStatus (%p)", handle)); + if (handle != NULL) + { + return (((PHB_MATH_HANDLERCHAINELEMENT)handle)->status); + } + else + { + return (HB_MATH_HANDLER_STATUS_NOTFOUND); + } } @@ -236,37 +255,44 @@ int matherr( struct exception * err ) int hb_getMathError (void) { + HB_TRACE(HB_TR_DEBUG, ("hb_getMathError()")); return (0); } void hb_resetMathError (void) { + HB_TRACE(HB_TR_DEBUG, ("hb_resetMathError()")); return; } int hb_isMathHandler (void) { + HB_TRACE(HB_TR_DEBUG, ("hb_isMathHandler()")); return (0); } HB_MATH_HANDLERHANDLE hb_installMathHandler (HB_MATH_HANDLERPROC handlerproc) { + HB_TRACE(HB_TR_DEBUG, ("hb_installMathHandler (%p)", handlerproc)); return ((HB_MATH_HANDLERHANDLE)NULL); } int hb_deinstallMathHandler (HB_MATH_HANDLERHANDLE handle) { + HB_TRACE(HB_TR_DEBUG, ("hb_deinstallMathHandler (%p)", handle)); return (-1); } int hb_setMathHandlerStatus (HB_MATH_HANDLERHANDLE handle, int status) { - return (0); + HB_TRACE(HB_TR_DEBUG, ("hb_setMathHandlerStatus (%p, %i)", handle, status)); + return (HB_MATH_HANDLER_STATUS_NOTFOUND); } int hb_getMathHandlerStatus (HB_MATH_HANDLERHANDLE handle) { - return (0); + HB_TRACE(HB_TR_DEBUG, ("hb_getMathHandlerStatus (%p)", handle)); + return (HB_MATH_HANDLER_STATUS_NOTFOUND); } #endif