diff --git a/changelog.txt b/changelog.txt index 6abd60d..ea5125c 100644 --- a/changelog.txt +++ b/changelog.txt @@ -1,6 +1,10 @@ BREXX CMS Change LOG ==================== +0.9.10- 15 Dec 2020 +F0036 - X2D fixes + - Added OP_PLUS bytecode for unary plus expressions + - Added check if a real is an int F0035 - Code reformatting Added -D__CMS__ to CMAKE so that the right #ifdefs work including code reformatting diff --git a/compile.h b/compile.h index 9cdcc81..f363359 100644 --- a/compile.h +++ b/compile.h @@ -190,6 +190,7 @@ enum mnemonic_type { ,OP_BCONCAT /* concat two strings with space */ ,OP_NEG + ,OP_PLUS ,OP_INC ,OP_DEC diff --git a/config.h b/config.h index 1b60238..04c64ca 100644 --- a/config.h +++ b/config.h @@ -1,7 +1,7 @@ /* Modified for VM/370 CMS and GCC by Robert O'Hara, July 2010. */ /* The one version to rule them all! */ -#define CMS_VERSION "F0035" +#define CMS_VERSION "0.9.10" /* #define CMS_VERSION "0.9.8" #define CMS_VERSION "F0020" diff --git a/datatype.c b/datatype.c index 537d02b..70fd1e6 100644 --- a/datatype.c +++ b/datatype.c @@ -18,34 +18,10 @@ * */ -#include #include #include #include "lstring.h" -static int isRealAnInt(double d) { - int len; - double x; - double epsilon; - Context *context = (Context *) CMSGetPG(); - - if (d == 0.0) return TRUE; - - /* Calculate precision (epsilon) - REXX DIGITS less size of int bit of the number */ - if (d < 0.0) d = (-1.0) * d; - len = context->lstring_lNumericDigits; - len -= log10(d); - if (len < 1) len = 1; - epsilon = pow(10.0, -(double) len) / - 2.01; /* 2.01 rather 2.0 just to tune rounding */ - - /* Is the difference between the nearest integer less that the epsilon */ - x = d - floor(d); - if (x > 0.5) x = 1.0 - x; - if (x < epsilon) return TRUE; - return FALSE; -} - /* --------------- Ldatatype ----------------- */ /* returns -1 on error type */ int __CDECL @@ -113,13 +89,13 @@ Ldatatype(const PLstr str, char type) { break; case 'W': if (LTYPE(*str) == LINTEGER_TY) return TRUE; - if (LTYPE(*str) == LREAL_TY) return isRealAnInt(LREAL(*str)); + if (LTYPE(*str) == LREAL_TY) return Disint(LREAL(*str)); int tp = _Lisnum(str); if (tp == LSTRING_TY) return FALSE; else if (tp == LINTEGER_TY) return TRUE; else { L2real(str); - return isRealAnInt(LREAL(*str)); + return Disint(LREAL(*str)); } case 'X': /* check blanks in allowed places */ diff --git a/expr.c b/expr.c index 19faf72..abd5bc0 100644 --- a/expr.c +++ b/expr.c @@ -390,22 +390,23 @@ Exp7(void) { _symbol = (context->nextsymbsymbol); if (((context->nextsymbsymbol) == not_sy) || + ((context->nextsymbsymbol) == plus_sy) || ((context->nextsymbsymbol) == minus_sy)) { nextsymbol(); prefix = TRUE; } else prefix = FALSE; - if (!prefix && ((context->nextsymbsymbol) == plus_sy)) - nextsymbol(); - Exp8(); + if (prefix) { if ((context->compileCompileCodeLen) == pos) (context->lstring_Lerror)(ERR_INVALID_EXPRESSION, 0); InsTmp(pos, TRUE); if (_symbol == not_sy) _CodeAddByte(OP_NOT); + else if (_symbol == plus_sy) + _CodeAddByte(OP_PLUS); else _CodeAddByte(OP_NEG); TraceByte(operator_middle); diff --git a/interpre.c b/interpre.c index f625a44..27f0a64 100644 --- a/interpre.c +++ b/interpre.c @@ -2219,6 +2219,12 @@ RxInterpret(void) { (context->interpre_RxStckTop)--; goto chk4trace; + case OP_PLUS: + DEBUGDISPLAY("PLUS"); + Lplus(STACKP(1), STACKTOP); + (context->interpre_RxStckTop)--; + goto chk4trace; + case OP_INC: DEBUGDISPLAY("INC"); Linc((context->interpre_RxStck)[(context diff --git a/lstring.c b/lstring.c index 42c71e9..da47872 100644 --- a/lstring.c +++ b/lstring.c @@ -1,44 +1,4 @@ -/* Modified for VM/370 CMS and GCC by Robert O'Hara, July 2010. */ -/* - * $Id: lstring.c,v 1.11 2009/06/02 09:40:53 bnv Exp $ - * $Log: lstring.c,v $ - * Revision 1.11 2009/06/02 09:40:53 bnv - * MVS/CMS corrections - * - * Revision 1.10 2008/07/15 07:40:54 bnv - * #include changed from <> to "" - * - * Revision 1.9 2008/07/14 13:08:16 bnv - * MVS,CMS support - * - * Revision 1.8 2004/03/26 22:51:11 bnv - * values to limits - * - * Revision 1.7 2003/02/26 16:29:24 bnv - * Changed: READLINE definitions - * - * Revision 1.6 2002/06/11 12:37:15 bnv - * Added: CDECL - * - * Revision 1.5 2002/06/06 08:21:29 bnv - * Added: Readline support - * - * Revision 1.4 2001/06/25 18:49:48 bnv - * Header changed to Id - * - * Revision 1.3 1999/11/26 12:52:25 bnv - * Added: Windows CE support - * Added: Lwscpy, for unicode string copy - * Changed: _Lisnum, it creates immediately a double number contained in - * the string, for faster access. The value is hold in _lLastScannedNumber - * - * Revision 1.2 1999/05/14 13:11:47 bnv - * Minor changes - * - * Revision 1.1 1998/07/02 17:18:00 bnv - * Initial Version - * - */ +/* BREXX lstring.c */ #define __LSTRING_C__ @@ -64,6 +24,9 @@ #if defined(__CMS__) || defined(__MVS__) +/* C90 does not have round() */ +#define round(N) floor(0.5+(N)) + # include # define MAXLONG LONG_MAX @@ -360,9 +323,6 @@ _Lsubstr(const PLstr to, const PLstr from, size_t start, size_t length) { /* _Lisnum - returns if it is possible to convert */ /* a LSTRING to NUMBER */ /* a LREAL_TY or LINTEGER_TY */ -/* There is one possibility that is missing... */ -/* that is to hold an integer number as a real in a string. */ -/* ie. ' 2.0 ' this should be LINTEGER not LREAL */ /* -------------------------------------------------------- */ int __CDECL _Lisnum(const PLstr s) { @@ -377,17 +337,6 @@ _Lisnum(const PLstr s) { (context->lstring_lLastScannedNumber) = 0.0; -/* --- -#ifdef USEOPTION - if (LOPT(*s) & (LOPTINT | LOPTREAL)) { - if (LOPT(*s) & LOPTINT) - return LINTEGER_TY; - else - return LREAL_TY; - } -#endif ---- */ - ch = LSTR(*s); if (ch == NULL) return LSTRING_TY; LASCIIZ(*s); /* ///// Remember to erase LASCIIZ @@ -496,14 +445,14 @@ _Lisnum(const PLstr s) { (context->lstring_lLastScannedNumber) *= pow(10.0, (double) exponent); #endif - if ((context->lstring_lLastScannedNumber) > LONG_MAX) - R = TRUE; /* Treat it as real number */ - if (sign) (context->lstring_lLastScannedNumber) = -(context->lstring_lLastScannedNumber); - if (R) return LREAL_TY; + if (fabs(context->lstring_lLastScannedNumber) > LONG_MAX) + return LREAL_TY; /* Always treat big nums as reals */ + + if (R && !Disint(context->lstring_lLastScannedNumber)) return LREAL_TY; return LINTEGER_TY; } /* _Lisnum */ @@ -555,7 +504,7 @@ L2int(const PLstr s) { switch (_Lisnum(s)) { case LINTEGER_TY: /*///LINT(*s) = atol( LSTR(*s) ); */ - LINT(*s) = (long) (context->lstring_lLastScannedNumber); + LINT(*s) = (long) round(context->lstring_lLastScannedNumber); break; case LREAL_TY: @@ -625,35 +574,47 @@ _L2num(const PLstr s, const int type) { } } /* _L2num */ +/* ------------------ Disint ------------------- */ +/* Is a double an int */ +int Disint(double d) { + int len; + double x; + double epsilon; + Context *context = (Context *) CMSGetPG(); + + if (d == 0.0) return TRUE; + + /* Calculate precision (epsilon) - REXX DIGITS less size of int bit of the number */ + if (d < 0.0) d = (-1.0) * d; + len = context->lstring_lNumericDigits; + len -= (int)log10(d); + if (len < 1) len = 1; + epsilon = pow(10.0, -(double) len) / + 2.01; /* 2.01 rather 2.0 just to tune rounding */ + + /* Is the difference between the nearest integer less that the epsilon */ + x = d - floor(d); + if (x > 0.5) x = 1.0 - x; + if (x < epsilon) return TRUE; + return FALSE; +} /* Disint */ + + /* ------------------ L2num ------------------- */ void __CDECL L2num(const PLstr s) { Context *context = (Context *) CMSGetPG(); switch (_Lisnum(s)) { case LINTEGER_TY: - /*//LINT(*s) = atol( LSTR(*s) ); */ - LINT(*s) = (long) (context->lstring_lLastScannedNumber); + LINT(*s) = (long) round(context->lstring_lLastScannedNumber); LTYPE(*s) = LINTEGER_TY; LLEN(*s) = sizeof(long); break; case LREAL_TY: - /*///LREAL(*s) = strtod( LSTR(*s), NULL ); */ LREAL(*s) = (context->lstring_lLastScannedNumber); -/* -//// Numbers like 2.0 should be treated as real and not as integer -//// because in cases like factorial while give an error result -//// if ((double)((long)LREAL(*s)) == LREAL(*s)) { -//// LINT(*s) = (long)LREAL(*s); -//// LTYPE(*s) = LINTEGER_TY; -//// LLEN(*s) = sizeof(long); -//// } else { -*/ LTYPE(*s) = LREAL_TY; LLEN(*s) = sizeof(double); -/* -//// } -*/ break; default: @@ -677,7 +638,7 @@ Lrdint(const PLstr s) { switch (_Lisnum(s)) { case LINTEGER_TY: /*///return atol( LSTR(*s) ); */ - return (long) (context->lstring_lLastScannedNumber); + return (long) round(context->lstring_lLastScannedNumber); case LREAL_TY: /*///d = strtod( LSTR(*s), NULL ); diff --git a/lstring.h b/lstring.h index 99de7cf..b7329b3 100644 --- a/lstring.h +++ b/lstring.h @@ -479,12 +479,16 @@ void __CDECL Lmult(const PLstr to, const PLstr A, const PLstr B); void __CDECL Lneg(const PLstr to, const PLstr num); +void __CDECL Lplus(const PLstr to, const PLstr num); + void __CDECL Lsub(const PLstr to, const PLstr A, const PLstr B); void __CDECL Labs(const PLstr result, const PLstr num); int __CDECL Lsign(const PLstr num); +int __CDECL Disint(double d); /* Is a double an int */ + #ifndef __CMS__ void __CDECL Lpow(const PLstr result, const PLstr num, const PLstr p); diff --git a/neg.c b/neg.c index e57b570..4ced3fc 100644 --- a/neg.c +++ b/neg.c @@ -32,3 +32,20 @@ Lneg(const PLstr to, const PLstr num) { LLEN(*to) = sizeof(double); } } /* Lneg */ + +/* ------------------- Lneg ------------------ */ +void __CDECL +Lplus(const PLstr to, const PLstr num) { + L2NUM(num); + + if (LTYPE(*num) == LINTEGER_TY) { + LINT(*to) = LINT(*num); + LTYPE(*to) = LINTEGER_TY; + LLEN(*to) = sizeof(long); + } else { + LREAL(*to) = LREAL(*num); + LTYPE(*to) = LREAL_TY; + LLEN(*to) = sizeof(double); + } +} /* Lpos */ + diff --git a/template.c b/template.c index 795f65c..947b14c 100644 --- a/template.c +++ b/template.c @@ -132,6 +132,11 @@ C_template(void) { _CodeAddByte(OP_NEG); TraceByte(nothing_middle); } + else { + _CodeInsByte(pos, OP_PUSHTMP); + _CodeAddByte(OP_PLUS); + TraceByte(nothing_middle); + } _CodeAddByte(OP_TR_REL); break;