|
|
| version 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, "---------"); |