--- freem/src/expr.c 2025/01/19 02:04:04 1.1
+++ freem/src/expr.c 2025/03/30 01:36:58 1.11
@@ -1,23 +1,11 @@
/*
- * *
- * * *
- * * *
- * ***************
- * * * * *
- * * MUMPS *
- * * * * *
- * ***************
- * * *
- * * *
- * *
- *
- * expr.c
+ * $Id: expr.c,v 1.11 2025/03/30 01:36:58 snw Exp $
* expression parser
*
*
- * Author: Serena Willis <jpw@coherent-logic.com>
+ * Author: Serena Willis <snw@coherent-logic.com>
* 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,31 @@
* You should have received a copy of the GNU Affero Public License
* along with FreeM. If not, see <https://www.gnu.org/licenses/>.
*
+ * $Log: expr.c,v $
+ * 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,15 +147,12 @@
#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 ();
-void zdate ();
-void zkey ();
-void ztime ();
-int levenshtein ();
+void cond_round (char *a, int digits);
+void zkey (char *a, long type);
+int levenshtein (char *word1, char *word2);
time_t horolog_to_unix (char *horo);
extern int xecline(int typ);
short rbuf_slot_from_name(char *);
@@ -181,6 +191,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;
@@ -209,14 +228,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 */
@@ -337,8 +378,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;
}
@@ -354,7 +410,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;
@@ -494,7 +567,7 @@ var1:
case 'd': /* $DATA */
- ch = dat;
+ ch = fra_dat;
glv_fcn:
@@ -1608,7 +1681,9 @@ uparrow:
case 'c': /* $CHARACTER */
- {
+ {
+ char chrtmp[256];
+ long pnum;
short l, l1, m, n;
l1 = f;
@@ -1619,6 +1694,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) {
@@ -2227,7 +2311,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';
@@ -5546,7 +5630,7 @@ errexfun:
/* $STORAGE */
case 's':
- snprintf (a, 255 , "%d\201", DEFPSIZE);
+ snprintf (a, 255 , "%ld\201", DEFPSIZE);
goto exec;
/* $WITH */