--- freem/src/expr.c 2025/03/09 15:20:18 1.4 +++ freem/src/expr.c 2025/04/10 01:24:38 1.12 @@ -1,23 +1,11 @@ /* - * * - * * * - * * * - * *************** - * * * * * - * * MUMPS * - * * * * * - * *************** - * * * - * * * - * * - * - * expr.c + * $Id: expr.c,v 1.12 2025/04/10 01:24:38 snw Exp $ * expression parser * * * Author: Serena Willis * Copyright (C) 1998 MUG Deutschland - * Copyright (C) 2020, 2023 Coherent Logic Development LLC + * Copyright (C) 2020, 2023, 2025 Coherent Logic Development LLC * * * This file is part of FreeM. @@ -35,6 +23,34 @@ * You should have received a copy of the GNU Affero Public License * along with FreeM. If not, see . * + * $Log: expr.c,v $ + * Revision 1.12 2025/04/10 01:24:38 snw + * Remove C++ style comments + * + * Revision 1.11 2025/03/30 01:36:58 snw + * Make it easier to bring back fma_gedit, fix double-free in global handler, limit $CHAR to 7-bit ASCII + * + * Revision 1.10 2025/03/24 04:13:11 snw + * Replace action macro dat with fra_dat to avoid symbol conflict on OS/2 + * + * Revision 1.9 2025/03/24 01:32:22 snw + * Guard declaration of time function in expr.c for portability + * + * Revision 1.8 2025/03/22 04:47:18 snw + * Silently truncate long names in STRING exprs when evaluates to an obsolete MDC standard + * + * Revision 1.7 2025/03/22 03:39:23 snw + * Fix reverse query polyfill call-in from C side and make NAME exprs silently truncate long names in obsolete MDC dialects + * + * Revision 1.6 2025/03/22 03:05:19 snw + * Comply with X11-96/13 portable length of names + * + * Revision 1.5 2025/03/09 19:14:24 snw + * First phase of REUSE compliance and header reformat + * + * + * SPDX-FileCopyrightText: (C) 2025 Coherent Logic Development LLC + * SPDX-License-Identifier: AGPL-3.0-or-later **/ #if !defined(__osf__) @@ -134,7 +150,7 @@ #define GET 'Y' #define GETX ':' -#if !defined(__OpenBSD__) && !defined(_AIX) && !defined(__osf__) && !defined(MSDOS) && !defined(__vax__) +#if !defined(__OpenBSD__) && !defined(_AIX) && !defined(__osf__) && !defined(MSDOS) && !defined(__vax__) && !defined(__OS2__) long time (); #endif void cond_round (char *a, int digits); @@ -178,6 +194,15 @@ void expr (short extyp) volatile int ch = 0; short group; /* flag to scan grouped patterns */ + + int max_namlen = 255; + + if ((rtn_dialect () == D_MDS) || (rtn_dialect () == D_M5) || (rtn_dialect () == D_FREEM)) { + max_namlen = 255; + } + else { + max_namlen = 8; + } #ifdef DEBUG_NEWPTR int loop; @@ -206,14 +231,36 @@ void expr (short extyp) (((ch == '/' && varnam[i - 1] != '/') || (ch == '%' && varnam[i - 1] == '/')) && (varnam[1] == '.' || varnam[1] == '/'))))) || (f != '^') && (ch == '.')) { - - varnam[i++] = ch; - + if ((i + 1) <= max_namlen) { + varnam[i++] = ch; + } + else { + if ((rtn_dialect () == D_M77) || + (rtn_dialect () == D_M84) || + (rtn_dialect () == D_M90) || + (rtn_dialect () == D_M95)) { + /* silently truncate... yeah, the standard is stupid af */ + continue; + } + else { + merr_raise (M56); + return; + } + } } - varnam[i] = EOL; + varnam[i] = EOL; + + #if 0 + { + char gooby[256]; + stcpy (gooby, varnam); + stcnv_m2c (gooby); + printf ("name = '%s'\r\n", gooby); + } + #endif if (ch == '(') { /* it's an array */ @@ -334,8 +381,23 @@ scan_name: merr_raise (INVEXPR); return; } - - varnam[i++] = ch; + + if ((i + 1) <= max_namlen) { + varnam[i++] = ch; + } + else { + if ((rtn_dialect () == D_M77) || + (rtn_dialect () == D_M84) || + (rtn_dialect () == D_M90) || + (rtn_dialect () == D_M95)) { + /* silently truncate... yeah, the standard is stupid af */ + continue; + } + else { + merr_raise (M56); + return; + } + } lastch = ch; } @@ -351,7 +413,24 @@ scan_name: else { /* local variable name */ while (isalnum (ch = *++codptr)) { - varnam[i++] = ch; + + if ((i + 1) <= max_namlen) { + varnam[i++] = ch; + } + else { + if ((rtn_dialect () == D_M77) || + (rtn_dialect () == D_M84) || + (rtn_dialect () == D_M90) || + (rtn_dialect () == D_M95)) { + /* silently truncate... yeah, the standard is stupid af */ + continue; + } + else { + merr_raise (M56); + return; + } + } + } varnam[i] = EOL; @@ -491,7 +570,7 @@ var1: case 'd': /* $DATA */ - ch = dat; + ch = fra_dat; glv_fcn: @@ -693,7 +772,7 @@ d_o_n: if (merr () == UNDEF) { - //smw 15 nov 2023 merr_raise (ierr < 0 ? OK - CTRLB : OK); + /* smw 15 nov 2023 merr_raise (ierr < 0 ? OK - CTRLB : OK); */ merr_clear (); if (*++codptr == ',') { @@ -878,7 +957,7 @@ undefglvn: stcpy (refsav[refsx], zref); stcpy (refsav[refsx++] + 256, zloc); - ierr -= M7; //smw TODO HUH?? + ierr -= M7; arg--; goto nextchr; @@ -1605,7 +1684,9 @@ uparrow: case 'c': /* $CHARACTER */ - { + { + char chrtmp[256]; + long pnum; short l, l1, m, n; l1 = f; @@ -1616,6 +1697,15 @@ uparrow: n = 1; l = 0; + stcpy (chrtmp, a); + stcnv_m2c (chrtmp); + pnum = atol (chrtmp); + + if (pnum > 127) { + merr_raise (MXNUM); + return; + } + for (;;) { if ((ch = a[i++]) == EOL) { @@ -2224,7 +2314,7 @@ f20: stcnv_c2m (qryarg_ext); /* put the $QUERY argument into the local variable %INT.REVQ */ - symtab (set_sym, "%INT.REVQ\201\201", qryarg_ext); + symtab (set_sym, "%INTREVQ\201\201", qryarg_ext); /* set up for calling into polyfill wrapper */ code[0] = '\201'; @@ -4520,7 +4610,7 @@ extra_fun: obj_field = FALSE; - //dofram0 = dofrmptr; + /* dofram0 = dofrmptr; */ i = 0; codptr++; @@ -4582,7 +4672,7 @@ extra_fun: obj_field = FALSE; - //dofram0 = 0; + /* dofram0 = 0; */ if (*codptr == '(') codptr += 2; } @@ -4658,7 +4748,7 @@ extra_fun: /* save off the return type to be checked by QUIT code */ extr_types[nstx + 1] = ret_type; - //printf ("return_type = '%s' *reg = '%c'\r\n", return_type, *reg); + /* printf ("return_type = '%s' *reg = '%c'\r\n", return_type, *reg); */ } if (*reg == TAB || *reg == SP) goto off; @@ -4793,21 +4883,23 @@ off: else { /* PARSE FORMALLIST */ short fl_type; - short fl_mandatory; - short fl_byref; + /* re-enable following 3 later */ + /*short fl_mandatory;*/ + /*short fl_byref;*/ + /*short lastparm;*/ char fl_typestr[255]; char fl_mand; short dtcheck_result; register short typei; - short lastparm; short gotparm; int paramct; fl_type = DT_AUTO; - fl_mandatory = TRUE; - fl_byref = FALSE; + /* re-enable following 3 later */ + /*fl_mandatory = TRUE;*/ + /*fl_byref = FALSE;*/ + /*lastparm = FALSE;*/ dtcheck_result = FALSE; - lastparm = FALSE; gotparm = FALSE; paramct = 0; @@ -4830,6 +4922,7 @@ off: fl_typestr[typei] = '\0'; fl_mand = *(reg + 1); + /* if ((fl_mand == 'o') || (fl_mand == 'O')) { fl_mandatory = FALSE; } @@ -4844,12 +4937,29 @@ off: goto errexfun; } + */ + + if ((fl_mand != 'o') && (fl_mand != 'O')) { + merr_raise (INVLIBOPT); + dofrmptr = dofram0; + + errex = TRUE; + + nstx--; + estack--; + + goto errexfun; + } + + } else if ((ch == ',') || (ch == ')')) { + /* re-enable later if (ch == ')') { lastparm = TRUE; } + */ gotparm = TRUE; paramct++; @@ -4886,7 +4996,7 @@ off: if (dtcheck_result == FALSE) { merr_raise (TYPMISMATCH); - dofrmptr = dofram0; // reset frame pointer + dofrmptr = dofram0; /* reset frame pointer */ errex = TRUE; @@ -5407,8 +5517,6 @@ errexfun: ilong = ilong1 - (ilong * 86400); lintstr (&a[i], ilong); - -// printf ("unix epoch = %d\r\n", horolog_to_unix (a)); goto exec; @@ -5485,7 +5593,7 @@ errexfun: case SVNecode: - //write_m ("in SVNecode\r\n\201"); + /* write_m ("in SVNecode\r\n\201"); */ if (stlen (user_ecode)) { stcpy (a, user_ecode); @@ -5509,7 +5617,7 @@ errexfun: case SVNetrap: -// write_m ("in SVNetrap\r\n\201"); +/* write_m ("in SVNetrap\r\n\201"); */ stcpy (a, etrap); goto exec; @@ -5593,15 +5701,15 @@ errexfun: goto exec; - ///* $ZX (number of columns) */ - //case 'X': - //intstr (a, n_columns); - // goto exec; - - ///* $ZY (number of rows) */ - //case 'Y': - //intstr (a, n_lines); - //goto exec; + /* $ZX (number of columns) */ + case 'X': + intstr (a, n_columns); + goto exec; + + /* $ZY (number of rows) */ + case 'Y': + intstr (a, n_lines); + goto exec; /* $ZERROR */ case 'E':