--- freem/src/xecline.c 2025/02/28 20:51:20 1.2 +++ freem/src/xecline.c 2025/05/05 14:53:17 1.22 @@ -1,23 +1,11 @@ /* - * * - * * * - * * * - * *************** - * * * * * - * * MUMPS * - * * * * * - * *************** - * * * - * * * - * * - * - * xecline.c + * $Id: xecline.c,v 1.22 2025/05/05 14:53:17 snw Exp $ * freem interpreter proper * * - * Author: Serena Willis + * Author: Serena Willis * 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. @@ -35,6 +23,64 @@ * You should have received a copy of the GNU Affero Public License * along with FreeM. If not, see . * + * $Log: xecline.c,v $ + * Revision 1.22 2025/05/05 14:53:17 snw + * Modify rpm spec to include documentation TODO + * + * Revision 1.21 2025/05/01 17:02:30 snw + * Further debugging improvements + * + * Revision 1.20 2025/04/30 17:19:16 snw + * Improve backtraces in debugger + * + * Revision 1.19 2025/04/30 14:41:03 snw + * Further debugger work + * + * Revision 1.18 2025/04/29 18:46:17 snw + * Begin work on interactive debugger + * + * Revision 1.17 2025/04/28 19:38:55 snw + * Add trace mode + * + * Revision 1.16 2025/04/28 14:52:54 snw + * Temporarily revert global handler refactor and fix reference regression in xecline + * + * Revision 1.15 2025/04/15 16:49:36 snw + * Make use of logprintf throughout codebase + * + * Revision 1.14 2025/04/13 04:22:43 snw + * Fix snprintf calls + * + * Revision 1.13 2025/04/10 01:24:39 snw + * Remove C++ style comments + * + * 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 @@ -137,13 +183,14 @@ int xecline(int typ) short new_and_set = FALSE; short new_object = FALSE; short destructor_run = FALSE; - short debug_mode = FALSE; short libcall = FALSE; char *namold; long rouoldc; unsigned long jobtime; char label[256], routine[256]; + char tracestr[512]; + char *vn; char *an; char *tmp; @@ -158,6 +205,7 @@ int xecline(int typ) char *reeval_codptr; char reeval_code[512]; + char entryref[256]; int i; int j; @@ -207,6 +255,9 @@ int xecline(int typ) next_line: /* entry point for next command line */ + if (debug_mode) { + debug_mode = debugger (DEBENTRY_LINE, entryref); + } job_set_status (pid, JSTAT_INTERPRETER); @@ -255,6 +306,11 @@ next_line: /* entry point for n codptr = code; next_cmnd: /* continue line entry point */ + getraddress (entryref, nstx); + if (debug_mode) { + debug_mode = debugger (DEBENTRY_CMD, entryref); + } + if (sigint_in_for) goto for_quit; if (forsw && (forpost[forx][0] != '\0')) { @@ -512,14 +568,14 @@ next0: else if (tmp2[0] == '<') { /* call write output to %-array */ FILE *pipdes; - char key[STRLEN + 1 /*was 256 */ ]; - char data[STRLEN + 1 /*was 256 */ ]; + char key[STRLEN]; + char data[STRLEN]; char data_kill[256]; data_kill[255] = EOL; - for (i = 0; i < STRLEN + 1; i++) vn[i] = EOL; + for (i = 0; i < STRLEN - 1; i++) vn[i] = EOL; - snprintf (key, 255, "^$JOB\202%d\202PIPE_GLVN\201", pid); + snprintf (key, STRLEN - 1, "^$JOB\202%d\202PIPE_GLVN\201", pid); ssvn (get_sym, key, vn); if (vn[0] == '^') { @@ -537,7 +593,7 @@ next0: symtab (kill_sym, vn, data); } - snprintf (key, 255, "^$JOB\202%d\202PIPE_GLVN\201", pid); + snprintf (key, STRLEN - 1, "^$JOB\202%d\202PIPE_GLVN\201", pid); ssvn (get_sym, key, vn); data[0] = '0'; @@ -566,7 +622,7 @@ next0: int glvn_len = 0; while (fgets (data, STRLEN, pipdes)) { - snprintf (key, 255, "^$JOB\202%d\202PIPE_GLVN\201", pid); + snprintf (key, STRLEN - 1, "^$JOB\202%d\202PIPE_GLVN\201", pid); ssvn (get_sym, key, vn); glvn_len = stlen (vn); @@ -627,7 +683,7 @@ next0: for (i = 0; i < STRLEN + 1; i++) vn[i] = EOL; - snprintf (key, 255, "^$JOB\202%d\202PIPE_GLVN\201", pid); + snprintf (key, STRLEN - 1, "^$JOB\202%d\202PIPE_GLVN\201", pid); ssvn (get_sym, key, vn); if (vn[0] == '^') { @@ -656,7 +712,7 @@ next0: int glvn_len = 0; for (i = 1; i <= k; i++) { - snprintf (key, 255, "^$JOB\202%d\202PIPE_GLVN\201", pid); + snprintf (key, STRLEN - 1, "^$JOB\202%d\202PIPE_GLVN\201", pid); ssvn (get_sym, key, vn); glvn_len = stlen (vn); @@ -826,6 +882,8 @@ again: } } + if (trace_mode) tracestr[0] = '\0'; + switch (mcmnd) { case MAP: @@ -891,8 +949,7 @@ set0: if (isalpha (vn[0]) && *(codptr + 1) == ':') { char sc_string[255]; - register int sci; - + codptr += 2; expr (NAME); @@ -928,8 +985,7 @@ set0: if (*++codptr != '=') { -/* SET A++ or SET A-- equivalent to SET A+=1 SET A-=1 currently disabled */ -//#ifdef NEVER + /* unary ++/-- */ if ((ch == '+' || ch == '-') && ch == *codptr) { codptr++; setop = ch; @@ -938,7 +994,6 @@ set0: goto set2; } -//#endif /* NEVER */ merr_raise (ASSIGNER); break; @@ -951,10 +1006,15 @@ set0: ch = *codptr; - if (ch == '.') { - setref = TRUE; - codptr++; - expr (NAME); + if (ch == '.') { + if (!isdigit (*(codptr + 1))) { + setref = TRUE; + codptr++; + expr (NAME); + } + else { + expr (STRING); + } } else { expr (STRING); @@ -1024,7 +1084,9 @@ set2: if (new_and_set == TRUE) new_and_set = FALSE; if (new_object == TRUE) new_object = FALSE; +/* set1: +*/ if (*codptr != ',') break; if (*++codptr == '@') goto again; @@ -1076,8 +1138,8 @@ set: goto err; } - expr (STRING); - + expr (STRING); + if (merr () > OK) goto err; stcpy (tmp2, argptr); @@ -1588,7 +1650,7 @@ set10: } if (stcat (tmp2, &tmp3[arg4]) == 0) { - merr_raise (M56); //JPW + merr_raise (M56); /* snw */ goto err; } @@ -2021,8 +2083,8 @@ set10: goto err; } - sec += day * 86400 + timezone; - day = timezone; + sec += day * 86400 + FreeM_timezone; + day = FreeM_timezone; sh_ts.tv_sec = sec; @@ -2042,7 +2104,7 @@ set10: clock = time (0L); ctdata = localtime (&clock); - if (day -= (timezone = ctdata->tm_tzadj)) { + if (day -= (FreeM_timezone = ctdata->tm_tzadj)) { sec -= day; tzoffset += day; stime (&sec); @@ -2335,6 +2397,10 @@ s_end: case QUIT: + if (trace_mode) { + fprintf (stderr, ">> TRACE: $STACK = %d QUIT CMD = %c\r\n", nstx, nestc[nstx]); + } + if (tp_level > 0) { merr_raise (M42); goto err; @@ -2364,10 +2430,13 @@ s_end: if (nestc[nstx] == '$') { /* extrinsic function/variable */ + if (trace_mode) { + fprintf (stderr, ">> TRACE: QUIT FROM EXTRINSIC\r\n"); + } + #ifdef DEBUG_NEWSTACK printf ("EXTRINSIC\r\n"); #endif - //printf (" extr_types[%d] = '%d'\r\n", nstx, extr_types[nstx]); if (*codptr == EOL || *codptr == SP) { #ifdef DEBUG_NEWSTACK @@ -2394,6 +2463,10 @@ s_end: else { expr (STRING); + + if (trace_mode) { + fprintf (stderr, ">> TRACE: QUIT FROM SUBROUTINE\r\n"); + } if (ierr != OK - CTRLB && merr () != OK && merr () != INRPT) { @@ -2560,7 +2633,6 @@ quit0: printf ("CHECK 03 (Stack PUSH)\r\n"); #endif - if (++nstx > NESTLEVLS) { nstx--; merr_raise (STKOV); @@ -2586,7 +2658,7 @@ quit0: nestn[nstx] = 0; /* no overring of routine */ nestr[nstx] = roucur - rouptr; /* save roucur: only for $V(26) needed */ ztrap[nstx][0] = EOL; - + forsw = TRUE; ftyp = 0; /* no args is FOREVER */ @@ -3030,6 +3102,21 @@ do_xecute: do_goto: + if (trace_mode) { + char rn[256]; + stcpy (rn, rou_name); + stcnv_m2c (rn); + + switch (mcmnd) { + case DO: + snprintf (tracestr, sizeof (tracestr) - 1, "rtn = %s $stack = %d do ", rn, nstx); + break; + case GOTO: + snprintf (tracestr, sizeof (tracestr) - 1, "rtn = %s $stack = %d goto ", rn, nstx); + break; + } + } + offset = 0; label[0] = routine[0] = EOL; dofram0 = 0; @@ -3064,6 +3151,14 @@ do_goto: stcpy (label, varnam); + if (trace_mode) { + char ttt[256]; + stcpy (ttt, label); + stcnv_m2c (ttt); + + strcat (tracestr, ttt); + } + ch = *++codptr; } @@ -3079,7 +3174,12 @@ do_goto: /* unless argument is numeric, expr returns wrong codptr */ if ((ch = *codptr) != SP && (ch != EOL) && (ch != ',') && (ch != '^')) ch = *++codptr; - + + if (trace_mode) { + char ttt[256]; + snprintf (ttt, 255, "+%d", offset); + strcat (tracestr, ttt); + } } if (ch == '^') { /* parse routine */ @@ -3089,12 +3189,26 @@ do_goto: if (merr () > OK) goto err; stcpy (routine, varnam); + + if (trace_mode) { + char ttt[256]; + char ttx[256]; + + stcpy (ttt, routine); + stcnv_m2c (ttt); + snprintf (ttx, 255, "^%s", ttt); + strcat (tracestr, ttx); + } dosave[0] = EOL; ch = *++codptr; loadsw = TRUE; } + if (trace_mode) { + fprintf (stderr, ">> TRACE: %s\r\n", tracestr); + } + if (ch == '(' && mcmnd == DO) { /* parse parameter */ if (offset) { @@ -3753,7 +3867,7 @@ off3: break; case KILL: - + /* argumentless: KILL all local variables */ if (((ch = *codptr) == SP) || ch == EOL) { symtab (kill_all, "", ""); @@ -3787,8 +3901,10 @@ off3: if (destructor_ct) { for (cd = 0; cd < destructor_ct; cd++) { - strcat (destc, destructors[cd]); - strcat (destc, ","); + if (strlen (destructors[cd]) > 0) { + strcat (destc, destructors[cd]); + strcat (destc, ","); + } } destructor_ct = 0; @@ -3936,7 +4052,7 @@ off3: stcpy (objvar, vn); - symtab (dat, objvar, datres); + symtab (fra_dat, objvar, datres); dat_res = atoi (datres); if (dat_res > 0) { @@ -3970,6 +4086,7 @@ off3: if (merr () > OK) goto err; + /* TODO: check this snprintf for proper sizing */ snprintf (&tmp3[1], 255, "%s\201", &constructor[1]); goto private; @@ -3990,8 +4107,9 @@ off3: goto set2; } +/* post_new: - +*/ ch = nstx; while (nestc[ch] == FOR) ch--; /* FOR does not define a NEW level */ @@ -4320,7 +4438,7 @@ use0: /* entry point for proces break; case 2: - crlf[io] = tvexpr (argptr); + frm_crlf[io] = tvexpr (argptr); break; case 3: @@ -4422,7 +4540,7 @@ use_socket: /* need to evaluate the following 6 lines carefully - smw 2023-10-15 */ if (k != HOME) { - crlf[k] = FALSE; + frm_crlf[k] = FALSE; fm_nodelay[k] = FALSE; xpos[k] = 0; ypos[k] = 0; @@ -4848,7 +4966,8 @@ open_socket: if (merr () > OK) break; } else { - halt:i = 0; +halt: + i = 0; } cleanup (); @@ -5047,24 +5166,37 @@ open_socket: expr (STRING); if (merr () > OK) break; - switch (intexpr (argptr)) { - - case 2: - DSM2err = TRUE; - break; /* enable DSM V 2 error processing */ - - case -2: - DSM2err = FALSE; - break; /* enable normal error processing */ - - case 0: - breakon = FALSE; - break; /* disable CTRL/C */ - - default: - breakon = TRUE; - break; /* enable CTRL/C */ + { + char brkstr[256]; + + stcpy (brkstr, argptr); + stcnv_m2c (brkstr); + + if (strcmp (brkstr, "DEBUG") == 0) { + debug_mode = TRUE; + } + else { + switch (intexpr (argptr)) { + + case 2: + DSM2err = TRUE; + break; /* enable DSM V 2 error processing */ + + case -2: + DSM2err = FALSE; + break; /* enable normal error processing */ + + case 0: + breakon = FALSE; + break; /* disable CTRL/C */ + + default: + breakon = TRUE; + break; /* enable CTRL/C */ + } + } } + break; case VIEW: @@ -5080,15 +5212,11 @@ open_socket: #endif if (nestc[nstx] == BREAK) { -// printf ("nestc[nstx] was BREAK\r\n"); if (repQUIT) continue; merr_raise (OK - CTRLB); goto zgo; /*cont. single step */ } -// else { -// printf ("nestc[nstx] was _not_ BREAK\r\n"); -// } if (nestc[nstx] == FOR) { @@ -5538,7 +5666,7 @@ zgo: for (; beg < end; beg += UNSIGN (*beg) + 2) { - if (crlf[io]) { + if (frm_crlf[io]) { write_m ("\012\201"); } else { @@ -5554,7 +5682,7 @@ zgo: rouins = beg; } - if (crlf[io]) { + if (frm_crlf[io]) { write_m ("\012\201"); } else { @@ -5664,9 +5792,6 @@ zgo: } case ZWRITE: - - -zwrite: { short k; char w_tmp[512]; @@ -5790,7 +5915,6 @@ zwritep: expr (NAME); - //if (varnam[0] == '^') merr_raise (GLOBER); if (merr () > OK) goto err; codptr++; @@ -5823,16 +5947,16 @@ zwritep: } if (varnam[0] != '^') { - symtab (dat, varnam, tmp2); + symtab (fra_dat, varnam, tmp2); zwmode = 'L'; } else { if (varnam[1] == '$') { - ssvn (dat, varnam, tmp2); + ssvn (fra_dat, varnam, tmp2); zwmode = '$'; } else { - global (dat, varnam, tmp2); + global (fra_dat, varnam, tmp2); zwmode = '^'; } } @@ -5943,21 +6067,21 @@ zwritep: switch (zwmode) { case 'L': - symtab (dat, tmp, tmp3); + symtab (fra_dat, tmp, tmp3); symtab (get_sym, tmp, &w_tmp[1]); break; case '$': - ssvn (dat, tmp, tmp3); + ssvn (fra_dat, tmp, tmp3); ssvn (get_sym, tmp, &w_tmp[1]); break; case '^': - global (dat, tmp, tmp3); + global (fra_dat, tmp, tmp3); global (get_sym, tmp, &w_tmp[1]); break; @@ -6032,62 +6156,7 @@ zwritep: break; - case ZALLOCATE: - - /* 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 */ - - + /* user defined Z-COMMAND */ case PRIVATE: private: /* for in-MUMPS defined commands */ @@ -6626,15 +6695,15 @@ evthandler: /* for event hand /* run the next iteration of GTK's event loop */ - //TODO: replace with libXt event loop - //gtk_main_iteration_do (TRUE); + /* TODO: replace with libXt event loop */ + /* gtk_main_iteration_do (TRUE); */ /* dequeue any events */ evt_count = mwapi_dequeue_events (syn_handlers); if (evt_count) { /* write them out */ - //printf ("event handlers = '%s'\r\n", syn_handlers); + /* printf ("event handlers = '%s'\r\n", syn_handlers); */ syn_event_entry_nstx = nstx; @@ -6692,8 +6761,7 @@ syn_evt_loop_bottom: if (ch != ',' && merr () == OK) { merr_raise (SPACER); } - else if ((ierr <= OK) || (debug_mode == TRUE)) { - if (debug_mode) goto direct_mode; + else if (ierr <= OK) { if (*++codptr != SP && *codptr != EOL) goto again; merr_raise (ARGLIST); @@ -6735,6 +6803,7 @@ err: } } + if (merr () > OK ) { char er_buf[ERRLEN]; @@ -6744,8 +6813,9 @@ err: stcpy (er_buf, errmes[merr ()]); stcnv_m2c (er_buf); + #if !defined(MSDOS) - m_log (LOG_ERR, er_buf); + logprintf (FM_LOG_DEBUG, "xecline: interpreter error %d [%s]", ierr, er_buf); #endif } @@ -7079,7 +7149,7 @@ restart: DSW &= ~BIT0; /* enable ECHO */ - // print here + /* print here */ { char *t_rtn; char *t_nsn = (char *) malloc (STRLEN * sizeof (char)); @@ -7116,6 +7186,7 @@ restart: free (t_nsn); + } @@ -7177,9 +7248,6 @@ restore: goto next_cmnd; } - else { - if (debug_mode) goto direct_mode; - } if (libcall == TRUE) { /* library mode: don't go to direct mode, just return */ return merr (); @@ -7210,10 +7278,10 @@ direct_mode: if (quiet_mode == FALSE) { if (tp_level == 0) { - snprintf (fmrl_prompt, 255, "\r\n%s> ", nsname); + snprintf (fmrl_prompt, sizeof (fmrl_prompt) - 1, "\r\n%s.%s> ", shm_env, nsname); } else { - snprintf (fmrl_prompt, 255, "\r\nTL%d:%s> ", tp_level, nsname); + snprintf (fmrl_prompt, sizeof (fmrl_prompt) - 1 , "\r\nTL%d:%s.%s> ", tp_level, shm_env, nsname); } } set_io (UNIX); @@ -7238,10 +7306,10 @@ direct_mode: if (fmrl_buf[0] == '?') { char kb[20]; - char db[255]; + char db[STRLEN]; - snprintf (kb, 19, "%%SYS.HLP\201"); - snprintf (db, 19, "\201"); + snprintf (kb, sizeof (kb) - 1, "%%SYS.HLP\201"); + snprintf (db, STRLEN - 1, "\201"); symtab (kill_sym, kb, db); @@ -7251,18 +7319,11 @@ direct_mode: stcpy (code, "DO ^%ZHELP\201"); if (strlen (fmrl_buf) > 1) { - snprintf (db, 254, "%s\201", &fmrl_buf[1]); + snprintf (db, STRLEN - 1, "%s\201", &fmrl_buf[1]); symtab (set_sym, kb, db); } } - else if (strcmp (fmrl_buf, "step") == 0) { - debug_mode = TRUE; - goto zgo; - } - else if ((strcmp (fmrl_buf, "cont") == 0) || (strcmp (fmrl_buf, "continue") == 0)) { - debug_mode = FALSE; - } else if (strcmp (fmrl_buf, "rbuf") == 0) { rbuf_dump (); } @@ -7320,7 +7381,7 @@ direct_mode: } else if (isdigit(fmrl_buf[0]) || (fmrl_buf[0] == '(') || (fmrl_buf[0] == '-') || (fmrl_buf[0] == '\'') || (fmrl_buf[0] == '+') || (fmrl_buf[0] == '$') || (fmrl_buf[0] == '^')) { - snprintf (code, 255, "W %s", fmrl_buf); + snprintf (code, STRLEN - 1, "W %s", fmrl_buf); stcnv_c2m (code); set_io (MUMPS); @@ -7402,10 +7463,10 @@ direct_mode: char fmrl_prompt[256]; if (tp_level == 0) { - snprintf (fmrl_prompt, 256, "\r\n%s> \201", nsname); + snprintf (fmrl_prompt, sizeof (fmrl_prompt) - 1, "\r\n%s> \201", nsname); } else { - snprintf (fmrl_prompt, 256, "\r\nTL%d:%s> \201", tp_level, nsname); + snprintf (fmrl_prompt, sizeof (fmrl_prompt) - 1, "\r\nTL%d:%s> \201", tp_level, nsname); } write_m (fmrl_prompt); @@ -7417,17 +7478,12 @@ direct_mode: #endif if (merr () > OK) goto err; - - - // printf ("zbflag = %d\r\n", zbflag); if (code[0] == EOL && zbflag && nestc[nstx] == BREAK) { - //printf ("cont single step\r\n"); debug_mode = TRUE; merr_raise (OK - CTRLB); - //printf ("ierr now '%d'\r\n", ierr); goto zgo; } /* single step */ } @@ -7493,7 +7549,7 @@ void rbuf_dump(void) for (i = 0; i < NO_OF_RBUF; i++) { - sprintf (flgs, ""); + flgs[0] = '\0'; if (ages[i] == 0) { sprintf (rnam, "---------");