version 1.1.1.1, 2025/01/19 02:04:04
|
version 1.12, 2025/04/09 19:52:02
|
Line 1
|
Line 1
|
/* |
/* |
* * |
* $Id$ |
* * * |
|
* * * |
|
* *************** |
|
* * * * * |
|
* * MUMPS * |
|
* * * * * |
|
* *************** |
|
* * * |
|
* * * |
|
* * |
|
* |
|
* xecline.c |
|
* freem interpreter proper |
* freem interpreter proper |
* |
* |
* |
* |
* Author: Serena Willis <jpw@coherent-logic.com> |
* Author: Serena Willis <snw@coherent-logic.com> |
* Copyright (C) 1998 MUG Deutschland |
* Copyright (C) 1998 MUG Deutschland |
* Copyright (C) 2020 Coherent Logic Development LLC |
* Copyright (C) 2020, 2025 Coherent Logic Development LLC |
* |
* |
* |
* |
* This file is part of FreeM. |
* This file is part of FreeM. |
Line 35
|
Line 23
|
* You should have received a copy of the GNU Affero Public License |
* You should have received a copy of the GNU Affero Public License |
* along with FreeM. If not, see <https://www.gnu.org/licenses/>. |
* along with FreeM. If not, see <https://www.gnu.org/licenses/>. |
* |
* |
|
* $Log$ |
|
* Revision 1.12 2025/04/09 19:52:02 snw |
|
* Eliminate as many warnings as possible while building with -Wall |
|
* |
|
* Revision 1.11 2025/04/02 03:02:42 snw |
|
* Stop requiring users to pass -e to fmadm when -u or -g are passed |
|
* |
|
* Revision 1.10 2025/03/27 03:27:35 snw |
|
* Install init scripts to share/freem/examples/init and fix regression in method dispatch |
|
* |
|
* Revision 1.9 2025/03/24 04:13:12 snw |
|
* Replace action macro dat with fra_dat to avoid symbol conflict on OS/2 |
|
* |
|
* Revision 1.8 2025/03/24 04:05:36 snw |
|
* Replace crlf with frm_crlf to avoid symbol conflict with readline on OS/2 |
|
* |
|
* Revision 1.7 2025/03/22 22:52:24 snw |
|
* Add STRLEN_GBL macro to manage global string length |
|
* |
|
* Revision 1.6 2025/03/22 21:44:32 snw |
|
* Make the startup messages fewer and add environment name to direct-mode prompt |
|
* |
|
* Revision 1.5 2025/03/09 19:50:47 snw |
|
* Second phase of REUSE compliance and header reformat |
|
* |
|
* |
|
* SPDX-FileCopyrightText: (C) 2025 Coherent Logic Development LLC |
|
* SPDX-License-Identifier: AGPL-3.0-or-later |
**/ |
**/ |
|
|
#include <stdlib.h> |
#include <stdlib.h> |
Line 891 set0:
|
Line 907 set0:
|
|
|
if (isalpha (vn[0]) && *(codptr + 1) == ':') { |
if (isalpha (vn[0]) && *(codptr + 1) == ':') { |
char sc_string[255]; |
char sc_string[255]; |
register int sci; |
|
|
|
codptr += 2; |
codptr += 2; |
expr (NAME); |
expr (NAME); |
|
|
Line 1024 set2:
|
Line 1039 set2:
|
|
|
if (new_and_set == TRUE) new_and_set = FALSE; |
if (new_and_set == TRUE) new_and_set = FALSE; |
if (new_object == TRUE) new_object = FALSE; |
if (new_object == TRUE) new_object = FALSE; |
|
/* |
set1: |
set1: |
|
*/ |
if (*codptr != ',') break; |
if (*codptr != ',') break; |
|
|
if (*++codptr == '@') goto again; |
if (*++codptr == '@') goto again; |
Line 1076 set:
|
Line 1093 set:
|
goto err; |
goto err; |
} |
} |
|
|
expr (STRING); |
expr (STRING); |
|
|
if (merr () > OK) goto err; |
if (merr () > OK) goto err; |
|
|
stcpy (tmp2, argptr); |
stcpy (tmp2, argptr); |
Line 2021 set10:
|
Line 2038 set10:
|
goto err; |
goto err; |
} |
} |
|
|
sec += day * 86400 + timezone; |
sec += day * 86400 + FreeM_timezone; |
day = timezone; |
day = FreeM_timezone; |
|
|
sh_ts.tv_sec = sec; |
sh_ts.tv_sec = sec; |
|
|
Line 2042 set10:
|
Line 2059 set10:
|
clock = time (0L); |
clock = time (0L); |
ctdata = localtime (&clock); |
ctdata = localtime (&clock); |
|
|
if (day -= (timezone = ctdata->tm_tzadj)) { |
if (day -= (FreeM_timezone = ctdata->tm_tzadj)) { |
sec -= day; |
sec -= day; |
tzoffset += day; |
tzoffset += day; |
stime (&sec); |
stime (&sec); |
Line 3753 off3:
|
Line 3770 off3:
|
break; |
break; |
|
|
case KILL: |
case KILL: |
|
|
/* argumentless: KILL all local variables */ |
/* argumentless: KILL all local variables */ |
if (((ch = *codptr) == SP) || ch == EOL) { |
if (((ch = *codptr) == SP) || ch == EOL) { |
symtab (kill_all, "", ""); |
symtab (kill_all, "", ""); |
Line 3787 off3:
|
Line 3804 off3:
|
if (destructor_ct) { |
if (destructor_ct) { |
|
|
for (cd = 0; cd < destructor_ct; cd++) { |
for (cd = 0; cd < destructor_ct; cd++) { |
strcat (destc, destructors[cd]); |
if (strlen (destructors[cd]) > 0) { |
strcat (destc, ","); |
strcat (destc, destructors[cd]); |
|
strcat (destc, ","); |
|
} |
} |
} |
|
|
destructor_ct = 0; |
destructor_ct = 0; |
Line 3936 off3:
|
Line 3955 off3:
|
|
|
stcpy (objvar, vn); |
stcpy (objvar, vn); |
|
|
symtab (dat, objvar, datres); |
symtab (fra_dat, objvar, datres); |
dat_res = atoi (datres); |
dat_res = atoi (datres); |
|
|
if (dat_res > 0) { |
if (dat_res > 0) { |
Line 3990 off3:
|
Line 4009 off3:
|
goto set2; |
goto set2; |
} |
} |
|
|
|
/* |
post_new: |
post_new: |
|
*/ |
ch = nstx; |
ch = nstx; |
|
|
while (nestc[ch] == FOR) ch--; /* FOR does not define a NEW level */ |
while (nestc[ch] == FOR) ch--; /* FOR does not define a NEW level */ |
Line 4320 use0: /* entry point for proces
|
Line 4340 use0: /* entry point for proces
|
break; |
break; |
|
|
case 2: |
case 2: |
crlf[io] = tvexpr (argptr); |
frm_crlf[io] = tvexpr (argptr); |
break; |
break; |
|
|
case 3: |
case 3: |
Line 4422 use_socket:
|
Line 4442 use_socket:
|
|
|
/* need to evaluate the following 6 lines carefully - smw 2023-10-15 */ |
/* need to evaluate the following 6 lines carefully - smw 2023-10-15 */ |
if (k != HOME) { |
if (k != HOME) { |
crlf[k] = FALSE; |
frm_crlf[k] = FALSE; |
fm_nodelay[k] = FALSE; |
fm_nodelay[k] = FALSE; |
xpos[k] = 0; |
xpos[k] = 0; |
ypos[k] = 0; |
ypos[k] = 0; |
Line 5538 zgo:
|
Line 5558 zgo:
|
|
|
for (; beg < end; beg += UNSIGN (*beg) + 2) { |
for (; beg < end; beg += UNSIGN (*beg) + 2) { |
|
|
if (crlf[io]) { |
if (frm_crlf[io]) { |
write_m ("\012\201"); |
write_m ("\012\201"); |
} |
} |
else { |
else { |
Line 5554 zgo:
|
Line 5574 zgo:
|
rouins = beg; |
rouins = beg; |
} |
} |
|
|
if (crlf[io]) { |
if (frm_crlf[io]) { |
write_m ("\012\201"); |
write_m ("\012\201"); |
} |
} |
else { |
else { |
Line 5664 zgo:
|
Line 5684 zgo:
|
} |
} |
|
|
case ZWRITE: |
case ZWRITE: |
|
|
|
|
zwrite: |
|
{ |
{ |
short k; |
short k; |
char w_tmp[512]; |
char w_tmp[512]; |
Line 5823 zwritep:
|
Line 5840 zwritep:
|
} |
} |
|
|
if (varnam[0] != '^') { |
if (varnam[0] != '^') { |
symtab (dat, varnam, tmp2); |
symtab (fra_dat, varnam, tmp2); |
zwmode = 'L'; |
zwmode = 'L'; |
} |
} |
else { |
else { |
if (varnam[1] == '$') { |
if (varnam[1] == '$') { |
ssvn (dat, varnam, tmp2); |
ssvn (fra_dat, varnam, tmp2); |
zwmode = '$'; |
zwmode = '$'; |
} |
} |
else { |
else { |
global (dat, varnam, tmp2); |
global (fra_dat, varnam, tmp2); |
zwmode = '^'; |
zwmode = '^'; |
} |
} |
} |
} |
Line 5943 zwritep:
|
Line 5960 zwritep:
|
switch (zwmode) { |
switch (zwmode) { |
|
|
case 'L': |
case 'L': |
symtab (dat, tmp, tmp3); |
symtab (fra_dat, tmp, tmp3); |
symtab (get_sym, tmp, &w_tmp[1]); |
symtab (get_sym, tmp, &w_tmp[1]); |
|
|
break; |
break; |
|
|
|
|
case '$': |
case '$': |
ssvn (dat, tmp, tmp3); |
ssvn (fra_dat, tmp, tmp3); |
ssvn (get_sym, tmp, &w_tmp[1]); |
ssvn (get_sym, tmp, &w_tmp[1]); |
|
|
break; |
break; |
|
|
|
|
case '^': |
case '^': |
global (dat, tmp, tmp3); |
global (fra_dat, tmp, tmp3); |
global (get_sym, tmp, &w_tmp[1]); |
global (get_sym, tmp, &w_tmp[1]); |
|
|
break; |
break; |
Line 6032 zwritep:
|
Line 6049 zwritep:
|
break; |
break; |
|
|
|
|
case ZALLOCATE: |
/* user defined Z-COMMAND */ |
|
|
/* argumentless is not permitted */ |
|
if (*codptr == SP || *codptr == EOL) { |
|
merr_raise (ARGLIST); |
|
break; |
|
} |
|
|
|
expr (NAME); |
|
|
|
if (merr () > OK) goto err; |
|
|
|
tmp[0] = SP; |
|
stcpy (&tmp[1], varnam); |
|
stcat (tmp, "\001\201"); |
|
|
|
frm_timeout = (-1L); /* no timeout */ |
|
|
|
if (*++codptr == ':') { |
|
codptr++; |
|
|
|
expr (STRING); |
|
|
|
frm_timeout = intexpr (argptr); |
|
|
|
if (merr () > OK) goto err; |
|
if (frm_timeout < 0L) frm_timeout = 0L; |
|
} |
|
|
|
lock (tmp, frm_timeout, ZALLOCATE); |
|
break; |
|
|
|
|
|
case ZDEALLOCATE: |
|
|
|
tmp[0] = SP; |
|
|
|
if (*codptr == SP || *codptr == EOL) { |
|
tmp[1] = EOL; |
|
} |
|
else { |
|
expr (NAME); |
|
|
|
if (merr () > OK) goto err; |
|
|
|
stcpy (&tmp[1], varnam); |
|
|
|
codptr++; |
|
} |
|
|
|
lock (tmp, -1L, ZDEALLOCATE); /* -1: no timeout */ |
|
break; |
|
|
|
/* user defined Z-COMMAND */ |
|
|
|
|
|
case PRIVATE: |
case PRIVATE: |
|
|
private: /* for in-MUMPS defined commands */ |
private: /* for in-MUMPS defined commands */ |
Line 7210 direct_mode:
|
Line 7172 direct_mode:
|
|
|
if (quiet_mode == FALSE) { |
if (quiet_mode == FALSE) { |
if (tp_level == 0) { |
if (tp_level == 0) { |
snprintf (fmrl_prompt, 255, "\r\n%s> ", nsname); |
snprintf (fmrl_prompt, 255, "\r\n%s.%s> ", shm_env, nsname); |
} |
} |
else { |
else { |
snprintf (fmrl_prompt, 255, "\r\nTL%d:%s> ", tp_level, nsname); |
snprintf (fmrl_prompt, 255, "\r\nTL%d:%s.%s> ", tp_level, shm_env, nsname); |
} |
} |
} |
} |
set_io (UNIX); |
set_io (UNIX); |
Line 7484 void rbuf_dump(void)
|
Line 7446 void rbuf_dump(void)
|
|
|
|
|
printf ("ROUTINE BUFFER CONFIGURATION\r\n"); |
printf ("ROUTINE BUFFER CONFIGURATION\r\n"); |
printf (" ROUTINE BUFFER COUNT: %d\r\n", NO_OF_RBUF); |
printf (" ROUTINE BUFFER COUNT: %ld\r\n", NO_OF_RBUF); |
printf (" MAX. ROUTINE BUFFER COUNT: %d\r\n", MAXNO_OF_RBUF); |
printf (" MAX. ROUTINE BUFFER COUNT: %d\r\n", MAXNO_OF_RBUF); |
printf (" DEFAULT ROUTINE BUFFER SIZE (EACH): %d BYTES\r\n", DEFPSIZE0 - 1); |
printf (" DEFAULT ROUTINE BUFFER SIZE (EACH): %d BYTES\r\n", DEFPSIZE0 - 1); |
printf (" CURRENT ROUTINE BUFFER SIZE (EACH): %d BYTES\r\n\r\n", PSIZE0 - 1); |
printf (" CURRENT ROUTINE BUFFER SIZE (EACH): %ld BYTES\r\n\r\n", PSIZE0 - 1); |
printf ("BUFFERS IN USE:\r\n\r\n"); |
printf ("BUFFERS IN USE:\r\n\r\n"); |
|
|
|
|
for (i = 0; i < NO_OF_RBUF; i++) { |
for (i = 0; i < NO_OF_RBUF; i++) { |
|
|
sprintf (flgs, ""); |
flgs[0] = '\0'; |
|
|
if (ages[i] == 0) { |
if (ages[i] == 0) { |
sprintf (rnam, "---------"); |
sprintf (rnam, "---------"); |