version 1.7, 2025/03/22 03:39:23
|
version 1.14, 2025/04/14 23:20:23
|
Line 24
|
Line 24
|
* along with FreeM. If not, see <https://www.gnu.org/licenses/>. |
* along with FreeM. If not, see <https://www.gnu.org/licenses/>. |
* |
* |
* $Log$ |
* $Log$ |
|
* Revision 1.14 2025/04/14 23:20:23 snw |
|
* Restore support for any 8-bit character in |
|
* |
|
* Revision 1.13 2025/04/13 04:22:43 snw |
|
* Fix snprintf calls |
|
* |
|
* 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 |
* 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 |
* Fix reverse query polyfill call-in from C side and make NAME exprs silently truncate long names in obsolete MDC dialects |
* |
* |
Line 135
|
Line 156
|
#define GET 'Y' |
#define GET 'Y' |
#define GETX ':' |
#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 (); |
long time (); |
#endif |
#endif |
void cond_round (char *a, int digits); |
void cond_round (char *a, int digits); |
Line 366 scan_name:
|
Line 387 scan_name:
|
merr_raise (INVEXPR); |
merr_raise (INVEXPR); |
return; |
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; |
lastch = ch; |
} |
} |
Line 383 scan_name:
|
Line 419 scan_name:
|
else { /* local variable name */ |
else { /* local variable name */ |
|
|
while (isalnum (ch = *++codptr)) { |
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; |
varnam[i] = EOL; |
Line 523 var1:
|
Line 576 var1:
|
|
|
case 'd': /* $DATA */ |
case 'd': /* $DATA */ |
|
|
ch = dat; |
ch = fra_dat; |
|
|
glv_fcn: |
glv_fcn: |
|
|
Line 725 d_o_n:
|
Line 778 d_o_n:
|
|
|
if (merr () == UNDEF) { |
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 (); |
merr_clear (); |
|
|
if (*++codptr == ',') { |
if (*++codptr == ',') { |
Line 910 undefglvn:
|
Line 963 undefglvn:
|
stcpy (refsav[refsx], zref); |
stcpy (refsav[refsx], zref); |
stcpy (refsav[refsx++] + 256, zloc); |
stcpy (refsav[refsx++] + 256, zloc); |
|
|
ierr -= M7; //smw TODO HUH?? |
ierr -= M7; |
arg--; |
arg--; |
|
|
goto nextchr; |
goto nextchr; |
Line 1637 uparrow:
|
Line 1690 uparrow:
|
|
|
case 'c': /* $CHARACTER */ |
case 'c': /* $CHARACTER */ |
|
|
{ |
{ |
short l, l1, m, n; |
short l, l1, m, n; |
|
|
l1 = f; |
l1 = f; |
Line 1648 uparrow:
|
Line 1701 uparrow:
|
n = 1; |
n = 1; |
l = 0; |
l = 0; |
|
|
|
|
for (;;) { |
for (;;) { |
|
|
if ((ch = a[i++]) == EOL) { |
if ((ch = a[i++]) == EOL) { |
Line 4535 extra_fun:
|
Line 4589 extra_fun:
|
|
|
|
|
if (obj_field) { |
if (obj_field) { |
char t_objf[255]; |
char t_objf[STRLEN]; |
|
|
snprintf (t_objf, 254, "%s\201", object_instance); |
snprintf (t_objf, STRLEN - 1, "%s\201", object_instance); |
|
|
dofram0 = dofrmptr; |
dofram0 = dofrmptr; |
*dofrmptr++ = DELIM; |
*dofrmptr++ = DELIM; |
Line 4552 extra_fun:
|
Line 4606 extra_fun:
|
obj_field = FALSE; |
obj_field = FALSE; |
|
|
|
|
//dofram0 = dofrmptr; |
/* dofram0 = dofrmptr; */ |
|
|
i = 0; |
i = 0; |
codptr++; |
codptr++; |
Line 4614 extra_fun:
|
Line 4668 extra_fun:
|
|
|
obj_field = FALSE; |
obj_field = FALSE; |
|
|
//dofram0 = 0; |
/* dofram0 = 0; */ |
if (*codptr == '(') codptr += 2; |
if (*codptr == '(') codptr += 2; |
|
|
} |
} |
Line 4690 extra_fun:
|
Line 4744 extra_fun:
|
/* save off the return type to be checked by QUIT code */ |
/* save off the return type to be checked by QUIT code */ |
extr_types[nstx + 1] = ret_type; |
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; |
if (*reg == TAB || *reg == SP) goto off; |
Line 4825 off:
|
Line 4879 off:
|
else { |
else { |
/* PARSE FORMALLIST */ |
/* PARSE FORMALLIST */ |
short fl_type; |
short fl_type; |
short fl_mandatory; |
/* re-enable following 3 later */ |
short fl_byref; |
/*short fl_mandatory;*/ |
|
/*short fl_byref;*/ |
|
/*short lastparm;*/ |
char fl_typestr[255]; |
char fl_typestr[255]; |
char fl_mand; |
char fl_mand; |
short dtcheck_result; |
short dtcheck_result; |
register short typei; |
register short typei; |
short lastparm; |
|
short gotparm; |
short gotparm; |
int paramct; |
int paramct; |
|
|
fl_type = DT_AUTO; |
fl_type = DT_AUTO; |
fl_mandatory = TRUE; |
/* re-enable following 3 later */ |
fl_byref = FALSE; |
/*fl_mandatory = TRUE;*/ |
|
/*fl_byref = FALSE;*/ |
|
/*lastparm = FALSE;*/ |
dtcheck_result = FALSE; |
dtcheck_result = FALSE; |
lastparm = FALSE; |
|
gotparm = FALSE; |
gotparm = FALSE; |
paramct = 0; |
paramct = 0; |
|
|
Line 4862 off:
|
Line 4918 off:
|
fl_typestr[typei] = '\0'; |
fl_typestr[typei] = '\0'; |
fl_mand = *(reg + 1); |
fl_mand = *(reg + 1); |
|
|
|
/* |
if ((fl_mand == 'o') || (fl_mand == 'O')) { |
if ((fl_mand == 'o') || (fl_mand == 'O')) { |
fl_mandatory = FALSE; |
fl_mandatory = FALSE; |
} |
} |
Line 4876 off:
|
Line 4933 off:
|
|
|
goto errexfun; |
goto errexfun; |
} |
} |
|
*/ |
|
|
|
if ((fl_mand != 'o') && (fl_mand != 'O')) { |
|
merr_raise (INVLIBOPT); |
|
dofrmptr = dofram0; |
|
|
|
errex = TRUE; |
|
|
|
nstx--; |
|
estack--; |
|
|
|
goto errexfun; |
|
} |
|
|
|
|
} |
} |
else if ((ch == ',') || (ch == ')')) { |
else if ((ch == ',') || (ch == ')')) { |
|
|
|
/* re-enable later |
if (ch == ')') { |
if (ch == ')') { |
lastparm = TRUE; |
lastparm = TRUE; |
} |
} |
|
*/ |
|
|
gotparm = TRUE; |
gotparm = TRUE; |
paramct++; |
paramct++; |
Line 4918 off:
|
Line 4992 off:
|
|
|
if (dtcheck_result == FALSE) { |
if (dtcheck_result == FALSE) { |
merr_raise (TYPMISMATCH); |
merr_raise (TYPMISMATCH); |
dofrmptr = dofram0; // reset frame pointer |
dofrmptr = dofram0; /* reset frame pointer */ |
|
|
errex = TRUE; |
errex = TRUE; |
|
|
Line 5439 errexfun:
|
Line 5513 errexfun:
|
ilong = ilong1 - (ilong * 86400); |
ilong = ilong1 - (ilong * 86400); |
|
|
lintstr (&a[i], ilong); |
lintstr (&a[i], ilong); |
|
|
// printf ("unix epoch = %d\r\n", horolog_to_unix (a)); |
|
|
|
goto exec; |
goto exec; |
|
|
Line 5483 errexfun:
|
Line 5555 errexfun:
|
{ |
{ |
char doggie_bag[50]; |
char doggie_bag[50]; |
|
|
snprintf (doggie_bag, 49, ".%ld\201", ilong); |
snprintf (doggie_bag, sizeof (doggie_bag) - 1, ".%ld\201", ilong); |
stcat (a, doggie_bag); |
stcat (a, doggie_bag); |
} |
} |
} |
} |
Line 5492 errexfun:
|
Line 5564 errexfun:
|
|
|
case SVNsystem: |
case SVNsystem: |
|
|
snprintf (a, 512, "%d,\"%s\"\201", MDC_VENDOR_ID, jour_hostid); |
sprintf (a, "%d,\"%s\"\201", MDC_VENDOR_ID, jour_hostid); |
goto exec; |
goto exec; |
|
|
|
|
Line 5504 errexfun:
|
Line 5576 errexfun:
|
|
|
case SVNtlevel: |
case SVNtlevel: |
|
|
snprintf (a, 255, "%d\201", tp_level); |
sprintf (a, "%d\201", tp_level); |
goto exec; |
goto exec; |
|
|
|
|
Line 5517 errexfun:
|
Line 5589 errexfun:
|
|
|
case SVNecode: |
case SVNecode: |
|
|
//write_m ("in SVNecode\r\n\201"); |
/* write_m ("in SVNecode\r\n\201"); */ |
|
|
if (stlen (user_ecode)) { |
if (stlen (user_ecode)) { |
stcpy (a, user_ecode); |
stcpy (a, user_ecode); |
Line 5532 errexfun:
|
Line 5604 errexfun:
|
case SVNestack: |
case SVNestack: |
{ |
{ |
char esbuf[256]; |
char esbuf[256]; |
snprintf (esbuf, 255, "%d\201", estack); |
sprintf (esbuf, "%d\201", estack); |
|
|
stcpy (a, esbuf); |
stcpy (a, esbuf); |
goto exec; |
goto exec; |
Line 5541 errexfun:
|
Line 5613 errexfun:
|
|
|
|
|
case SVNetrap: |
case SVNetrap: |
// write_m ("in SVNetrap\r\n\201"); |
/* write_m ("in SVNetrap\r\n\201"); */ |
stcpy (a, etrap); |
stcpy (a, etrap); |
goto exec; |
goto exec; |
|
|
Line 5565 errexfun:
|
Line 5637 errexfun:
|
/* $DEVICE */ |
/* $DEVICE */ |
case 'd': |
case 'd': |
if (devstat[io].mdc_err == 0) { |
if (devstat[io].mdc_err == 0) { |
snprintf (a, 3, "0\201\0"); |
sprintf (a, "0\201\0"); |
} |
} |
else { |
else { |
snprintf (a, 120, "%d,%d,%s\201\0", devstat[io].mdc_err, devstat[io].frm_err, devstat[io].err_txt); |
sprintf (a, "%d,%d,%s\201\0", devstat[io].mdc_err, devstat[io].frm_err, devstat[io].err_txt); |
} |
} |
|
|
goto exec; |
goto exec; |
|
|
/* $STORAGE */ |
/* $STORAGE */ |
case 's': |
case 's': |
snprintf (a, 255 , "%ld\201", DEFPSIZE); |
sprintf (a, "%ld\201", DEFPSIZE); |
goto exec; |
goto exec; |
|
|
/* $WITH */ |
/* $WITH */ |
Line 5625 errexfun:
|
Line 5697 errexfun:
|
goto exec; |
goto exec; |
|
|
|
|
///* $ZX (number of columns) */ |
/* $ZX (number of columns) */ |
//case 'X': |
case 'X': |
//intstr (a, n_columns); |
intstr (a, n_columns); |
// goto exec; |
goto exec; |
|
|
///* $ZY (number of rows) */ |
/* $ZY (number of rows) */ |
//case 'Y': |
case 'Y': |
//intstr (a, n_lines); |
intstr (a, n_lines); |
//goto exec; |
goto exec; |
|
|
/* $ZERROR */ |
/* $ZERROR */ |
case 'E': |
case 'E': |
Line 5696 errexfun:
|
Line 5768 errexfun:
|
char zdf_key[50]; |
char zdf_key[50]; |
char fmt_string[128]; |
char fmt_string[128]; |
|
|
snprintf (zdf_key, 49, "^$JOB\202%d\202ZDATE_FORMAT\201", pid); |
snprintf (zdf_key, sizeof (zdf_key) - 1, "^$JOB\202%d\202ZDATE_FORMAT\201", pid); |
ssvn (get_sym, zdf_key, fmt_string); |
ssvn (get_sym, zdf_key, fmt_string); |
stcnv_c2m (fmt_string); |
stcnv_c2m (fmt_string); |
|
|