version 1.14, 2025/04/13 04:22:43
|
version 1.30, 2025/05/20 16:20:42
|
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.30 2025/05/20 16:20:42 snw |
|
* Update ROUTINE SSVN after ZEDIT and ZSAVE |
|
* |
|
* Revision 1.29 2025/05/20 14:56:56 snw |
|
* Fix direct-mode interface to online help |
|
* |
|
* Revision 1.28 2025/05/20 14:36:06 snw |
|
* Documentation updates; raise ZCMMND instead of NOSTAND for restricted_mode restrictions |
|
* |
|
* Revision 1.27 2025/05/19 21:29:29 snw |
|
* Add basic tab completion to direct mode |
|
* |
|
* Revision 1.26 2025/05/19 02:03:31 snw |
|
* Reverse-engineer and document argumented ZPRINT (thanks to D. Wicksell) |
|
* |
|
* Revision 1.25 2025/05/18 18:15:38 snw |
|
* Add ZEDIT command for editing routines |
|
* |
|
* Revision 1.24 2025/05/14 12:22:04 snw |
|
* Further work on shared memory |
|
* |
|
* Revision 1.23 2025/05/06 16:10:06 snw |
|
* Add extra blank before readline call on NetBSD |
|
* |
|
* 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 |
* Revision 1.14 2025/04/13 04:22:43 snw |
* Fix snprintf calls |
* Fix snprintf calls |
* |
* |
Line 147 void rbuf_dump(void);
|
Line 195 void rbuf_dump(void);
|
short rbuf_slot_from_name(char *); |
short rbuf_slot_from_name(char *); |
short is_standard(void); |
short is_standard(void); |
|
|
|
#ifdef HAVE_LIBREADLINE |
|
char *m_commands[] = { |
|
"?", |
|
"@", |
|
"!<", |
|
"!>", |
|
"!!", |
|
"ablock", |
|
"astart", |
|
"astop", |
|
"aunblock", |
|
"break", |
|
"close", |
|
"do", |
|
"else", |
|
"events", |
|
"for", |
|
"goto", |
|
"halt", |
|
"hang", |
|
"history", |
|
"if", |
|
"job", |
|
"jobtab", |
|
"kill", |
|
"ksubscripts", |
|
"kvalue", |
|
"lock", |
|
"locktab", |
|
"merge", |
|
"new", |
|
"open", |
|
"quit", |
|
"rbuf", |
|
"rcl", |
|
"read", |
|
"set", |
|
"shmpages", |
|
"shmstat", |
|
"tcommit", |
|
"then", |
|
"trantab", |
|
"trollback", |
|
"tstart", |
|
"use", |
|
"view", |
|
"wh", |
|
"write", |
|
"xecute", |
|
"zassert", |
|
"zbreak", |
|
"zconst", |
|
"zedit", |
|
"zgoto", |
|
"zhalt", |
|
"zinsert", |
|
"zjob", |
|
"zload", |
|
"zmap", |
|
"znew", |
|
"zprint", |
|
"zquit", |
|
"zremove", |
|
"zsave", |
|
"zthrow", |
|
"ztrap", |
|
"zunmap", |
|
"zwatch", |
|
"zwith", |
|
"zwrite", |
|
"ABLOCK", |
|
"ASTART", |
|
"ASTOP", |
|
"AUNBLOCK", |
|
"BREAK", |
|
"CLOSE", |
|
"DO", |
|
"ELSE", |
|
"FOR", |
|
"GOTO", |
|
"HALT", |
|
"HANG", |
|
"IF", |
|
"JOB", |
|
"KILL", |
|
"KSUBSCRIPTS", |
|
"KVALUE", |
|
"LOCK", |
|
"MERGE", |
|
"NEW", |
|
"OPEN", |
|
"QUIT", |
|
"READ", |
|
"SET", |
|
"TCOMMIT", |
|
"THEN", |
|
"TROLLBACK", |
|
"TSTART", |
|
"USE", |
|
"VIEW", |
|
"WRITE", |
|
"XECUTE", |
|
"ZASSERT", |
|
"ZBREAK", |
|
"ZCONST", |
|
"ZEDIT", |
|
"ZGOTO", |
|
"ZHALT", |
|
"ZINSERT", |
|
"ZJOB", |
|
"ZLOAD", |
|
"ZMAP", |
|
"ZNEW", |
|
"ZPRINT", |
|
"ZQUIT", |
|
"ZREMOVE", |
|
"ZSAVE", |
|
"ZTHROW", |
|
"ZTRAP", |
|
"ZUNMAP", |
|
"ZWATCH", |
|
"ZWITH", |
|
"ZWRITE", |
|
NULL |
|
}; |
|
|
|
char **command_completion(const char *, int, int); |
|
char *command_generator(const char *, int); |
|
|
|
char **command_completion(const char *text, int start, int end) |
|
{ |
|
if (start > 0) return NULL; |
|
rl_attempted_completion_over = 1; |
|
return rl_completion_matches(text, command_generator); |
|
} |
|
|
|
char *command_generator(const char *text, int state) |
|
{ |
|
static int list_index, len; |
|
char *name; |
|
|
|
if (!state) { |
|
list_index = 0; |
|
len = strlen(text); |
|
} |
|
|
|
while ((name = m_commands[list_index++])) { |
|
if (strncmp(name, text, len) == 0) { |
|
return strdup(name); |
|
} |
|
} |
|
|
|
return NULL; |
|
} |
|
#endif |
|
|
/* |
/* |
* xecline(): |
* xecline(): |
* typ (where to go on function entry): 1 = restart |
* typ (where to go on function entry): 1 = restart |
Line 159 int xecline(int typ)
|
Line 363 int xecline(int typ)
|
short new_and_set = FALSE; |
short new_and_set = FALSE; |
short new_object = FALSE; |
short new_object = FALSE; |
short destructor_run = FALSE; |
short destructor_run = FALSE; |
short debug_mode = FALSE; |
|
short libcall = FALSE; |
short libcall = FALSE; |
char *namold; |
char *namold; |
long rouoldc; |
long rouoldc; |
unsigned long jobtime; |
unsigned long jobtime; |
char label[256], routine[256]; |
char label[256], routine[256]; |
|
|
|
char tracestr[512]; |
|
|
char *vn; |
char *vn; |
char *an; |
char *an; |
char *tmp; |
char *tmp; |
Line 180 int xecline(int typ)
|
Line 385 int xecline(int typ)
|
|
|
char *reeval_codptr; |
char *reeval_codptr; |
char reeval_code[512]; |
char reeval_code[512]; |
|
char entryref[256]; |
|
|
int i; |
int i; |
int j; |
int j; |
Line 229 int xecline(int typ)
|
Line 435 int xecline(int typ)
|
|
|
next_line: /* entry point for next command line */ |
next_line: /* entry point for next command line */ |
|
|
|
if (debug_mode) { |
|
debug_mode = debugger (DEBENTRY_LINE, entryref); |
|
} |
|
|
job_set_status (pid, JSTAT_INTERPRETER); |
job_set_status (pid, JSTAT_INTERPRETER); |
|
|
if (then_ctr > 0) { |
if (then_ctr > 0) { |
Line 277 next_line: /* entry point for n
|
Line 486 next_line: /* entry point for n
|
codptr = code; |
codptr = code; |
|
|
next_cmnd: /* continue line entry point */ |
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 (sigint_in_for) goto for_quit; |
|
|
if (forsw && (forpost[forx][0] != '\0')) { |
if (forsw && (forpost[forx][0] != '\0')) { |
Line 497 next0:
|
Line 711 next0:
|
if (ch == '!') { /* UNIXCALL */ |
if (ch == '!') { /* UNIXCALL */ |
|
|
if (restricted_mode) { |
if (restricted_mode) { |
merr_raise (NOSTAND); |
merr_raise (CMMND); |
goto err; |
goto err; |
} |
} |
|
|
Line 848 again:
|
Line 1062 again:
|
} |
} |
} |
} |
|
|
|
if (trace_mode) tracestr[0] = '\0'; |
|
|
switch (mcmnd) { |
switch (mcmnd) { |
|
|
case MAP: |
case MAP: |
Line 970 set0:
|
Line 1186 set0:
|
|
|
ch = *codptr; |
ch = *codptr; |
|
|
if (ch == '.') { |
if (ch == '.') { |
setref = TRUE; |
if (!isdigit (*(codptr + 1))) { |
codptr++; |
setref = TRUE; |
expr (NAME); |
codptr++; |
|
expr (NAME); |
|
} |
|
else { |
|
expr (STRING); |
|
} |
} |
} |
else { |
else { |
expr (STRING); |
expr (STRING); |
Line 2356 s_end:
|
Line 2577 s_end:
|
|
|
case QUIT: |
case QUIT: |
|
|
|
if (trace_mode) { |
|
fprintf (stderr, ">> TRACE: $STACK = %d QUIT CMD = %c\r\n", nstx, nestc[nstx]); |
|
} |
|
|
if (tp_level > 0) { |
if (tp_level > 0) { |
merr_raise (M42); |
merr_raise (M42); |
goto err; |
goto err; |
Line 2385 s_end:
|
Line 2610 s_end:
|
if (nestc[nstx] == '$') { /* extrinsic function/variable */ |
if (nestc[nstx] == '$') { /* extrinsic function/variable */ |
|
|
|
|
|
if (trace_mode) { |
|
fprintf (stderr, ">> TRACE: QUIT FROM EXTRINSIC\r\n"); |
|
} |
|
|
#ifdef DEBUG_NEWSTACK |
#ifdef DEBUG_NEWSTACK |
printf ("EXTRINSIC\r\n"); |
printf ("EXTRINSIC\r\n"); |
#endif |
#endif |
Line 2414 s_end:
|
Line 2643 s_end:
|
else { |
else { |
|
|
expr (STRING); |
expr (STRING); |
|
|
|
if (trace_mode) { |
|
fprintf (stderr, ">> TRACE: QUIT FROM SUBROUTINE\r\n"); |
|
} |
|
|
if (ierr != OK - CTRLB && merr () != OK && merr () != INRPT) { |
if (ierr != OK - CTRLB && merr () != OK && merr () != INRPT) { |
|
|
Line 2580 quit0:
|
Line 2813 quit0:
|
printf ("CHECK 03 (Stack PUSH)\r\n"); |
printf ("CHECK 03 (Stack PUSH)\r\n"); |
#endif |
#endif |
|
|
|
|
if (++nstx > NESTLEVLS) { |
if (++nstx > NESTLEVLS) { |
nstx--; |
nstx--; |
merr_raise (STKOV); |
merr_raise (STKOV); |
Line 2606 quit0:
|
Line 2838 quit0:
|
nestn[nstx] = 0; /* no overring of routine */ |
nestn[nstx] = 0; /* no overring of routine */ |
nestr[nstx] = roucur - rouptr; /* save roucur: only for $V(26) needed */ |
nestr[nstx] = roucur - rouptr; /* save roucur: only for $V(26) needed */ |
ztrap[nstx][0] = EOL; |
ztrap[nstx][0] = EOL; |
|
|
|
|
forsw = TRUE; |
forsw = TRUE; |
ftyp = 0; /* no args is FOREVER */ |
ftyp = 0; /* no args is FOREVER */ |
Line 3050 do_xecute:
|
Line 3282 do_xecute:
|
|
|
do_goto: |
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; |
offset = 0; |
label[0] = routine[0] = EOL; |
label[0] = routine[0] = EOL; |
dofram0 = 0; |
dofram0 = 0; |
Line 3084 do_goto:
|
Line 3331 do_goto:
|
|
|
stcpy (label, varnam); |
stcpy (label, varnam); |
|
|
|
if (trace_mode) { |
|
char ttt[256]; |
|
stcpy (ttt, label); |
|
stcnv_m2c (ttt); |
|
|
|
strcat (tracestr, ttt); |
|
} |
|
|
ch = *++codptr; |
ch = *++codptr; |
} |
} |
|
|
Line 3099 do_goto:
|
Line 3354 do_goto:
|
|
|
/* unless argument is numeric, expr returns wrong codptr */ |
/* unless argument is numeric, expr returns wrong codptr */ |
if ((ch = *codptr) != SP && (ch != EOL) && (ch != ',') && (ch != '^')) ch = *++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 */ |
if (ch == '^') { /* parse routine */ |
Line 3109 do_goto:
|
Line 3369 do_goto:
|
if (merr () > OK) goto err; |
if (merr () > OK) goto err; |
|
|
stcpy (routine, varnam); |
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; |
dosave[0] = EOL; |
ch = *++codptr; |
ch = *++codptr; |
loadsw = TRUE; |
loadsw = TRUE; |
} |
} |
|
|
|
if (trace_mode) { |
|
fprintf (stderr, ">> TRACE: %s\r\n", tracestr); |
|
} |
|
|
if (ch == '(' && mcmnd == DO) { /* parse parameter */ |
if (ch == '(' && mcmnd == DO) { /* parse parameter */ |
|
|
if (offset) { |
if (offset) { |
Line 4440 use_socket:
|
Line 4714 use_socket:
|
if (k > MAXSEQ) goto open_socket; |
if (k > MAXSEQ) goto open_socket; |
|
|
if (restricted_mode) { |
if (restricted_mode) { |
merr_raise (NOSTAND); |
merr_raise (CMMND); |
goto err; |
goto err; |
} |
} |
|
|
Line 4872 open_socket:
|
Line 5146 open_socket:
|
if (merr () > OK) break; |
if (merr () > OK) break; |
} |
} |
else { |
else { |
halt:i = 0; |
halt: |
|
i = 0; |
} |
} |
|
|
cleanup (); |
cleanup (); |
Line 5071 open_socket:
|
Line 5346 open_socket:
|
expr (STRING); |
expr (STRING); |
if (merr () > OK) break; |
if (merr () > OK) break; |
|
|
switch (intexpr (argptr)) { |
{ |
|
char brkstr[256]; |
case 2: |
|
DSM2err = TRUE; |
stcpy (brkstr, argptr); |
break; /* enable DSM V 2 error processing */ |
stcnv_m2c (brkstr); |
|
|
case -2: |
if (strcmp (brkstr, "DEBUG") == 0) { |
DSM2err = FALSE; |
debug_mode = TRUE; |
break; /* enable normal error processing */ |
} |
|
else { |
case 0: |
switch (intexpr (argptr)) { |
breakon = FALSE; |
|
break; /* disable CTRL/C */ |
case 2: |
|
DSM2err = TRUE; |
default: |
break; /* enable DSM V 2 error processing */ |
breakon = TRUE; |
|
break; /* enable CTRL/C */ |
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; |
break; |
|
|
case VIEW: |
case VIEW: |
Line 5178 open_socket:
|
Line 5466 open_socket:
|
break; |
break; |
|
|
/* Z-COMMANDS */ |
/* Z-COMMANDS */ |
|
case ZEDIT: |
|
merr_raise (cmd_zedit (&ra)); |
|
MRESCHECK(ra); |
|
break; |
|
|
case ZGO: |
case ZGO: |
|
|
/* ZGO with arguments: same as GOTO but with BREAK on */ |
/* ZGO with arguments: same as GOTO but with BREAK on */ |
Line 5317 zgo:
|
Line 5610 zgo:
|
merr_raise (NOPGM); |
merr_raise (NOPGM); |
|
|
break; |
break; |
} /*error */ |
} /* error */ |
|
|
stcpy (varnam, rou_name); |
stcpy (varnam, rou_name); |
} |
} |
Line 5335 zgo:
|
Line 5628 zgo:
|
} |
} |
|
|
zsave (varnam); |
zsave (varnam); |
|
ssvn_routine_update (); |
break; |
break; |
|
|
|
|
Line 5453 zgo:
|
Line 5747 zgo:
|
if (*codptr == EOL || *codptr == SP) { |
if (*codptr == EOL || *codptr == SP) { |
merr_raise (ARGLIST); |
merr_raise (ARGLIST); |
break; |
break; |
} /*error */ |
} /* error */ |
|
|
dosave[0] = EOL; |
dosave[0] = EOL; |
|
|
/* parse stringlit */ |
/* parse strlit */ |
expr (STRING); |
expr (STRING); |
|
|
if (merr () > OK) break; |
if (merr () > OK) break; |
Line 5566 zgo:
|
Line 5860 zgo:
|
} |
} |
|
|
if ((*(beg + 1)) == EOL) break; |
if ((*(beg + 1)) == EOL) break; |
|
|
write_m (beg + 1); |
write_m (beg + 1); |
if (merr () > OK) break; |
if (merr () > OK) break; |
} |
} |
Line 6653 syn_evt_loop_bottom:
|
Line 6947 syn_evt_loop_bottom:
|
if (ch != ',' && merr () == OK) { |
if (ch != ',' && merr () == OK) { |
merr_raise (SPACER); |
merr_raise (SPACER); |
} |
} |
else if ((ierr <= OK) || (debug_mode == TRUE)) { |
else if (ierr <= OK) { |
if (debug_mode) goto direct_mode; |
|
if (*++codptr != SP && *codptr != EOL) goto again; |
if (*++codptr != SP && *codptr != EOL) goto again; |
|
|
merr_raise (ARGLIST); |
merr_raise (ARGLIST); |
Line 6696 err:
|
Line 6989 err:
|
} |
} |
} |
} |
|
|
|
|
if (merr () > OK ) { |
if (merr () > OK ) { |
|
|
char er_buf[ERRLEN]; |
char er_buf[ERRLEN]; |
Line 6705 err:
|
Line 6999 err:
|
stcpy (er_buf, errmes[merr ()]); |
stcpy (er_buf, errmes[merr ()]); |
stcnv_m2c (er_buf); |
stcnv_m2c (er_buf); |
|
|
|
|
#if !defined(MSDOS) |
#if !defined(MSDOS) |
m_log (LOG_ERR, er_buf); |
logprintf (FM_LOG_DEBUG, "xecline: interpreter error %d [%s]", ierr, er_buf); |
#endif |
#endif |
|
|
} |
} |
Line 7077 restart:
|
Line 7372 restart:
|
|
|
|
|
free (t_nsn); |
free (t_nsn); |
|
|
} |
} |
|
|
|
|
Line 7138 restore:
|
Line 7434 restore:
|
|
|
goto next_cmnd; |
goto next_cmnd; |
} |
} |
else { |
|
if (debug_mode) goto direct_mode; |
|
} |
|
|
|
if (libcall == TRUE) { /* library mode: don't go to direct mode, just return */ |
if (libcall == TRUE) { /* library mode: don't go to direct mode, just return */ |
return merr (); |
return merr (); |
Line 7169 direct_mode:
|
Line 7462 direct_mode:
|
int hist_idx; |
int hist_idx; |
HIST_ENTRY *hist_ent; |
HIST_ENTRY *hist_ent; |
|
|
|
rl_attempted_completion_function = command_completion; |
|
|
if (quiet_mode == FALSE) { |
if (quiet_mode == FALSE) { |
if (tp_level == 0) { |
if (tp_level == 0) { |
snprintf (fmrl_prompt, sizeof (fmrl_prompt) - 1, "\r\n%s.%s> ", shm_env, nsname); |
snprintf (fmrl_prompt, sizeof (fmrl_prompt) - 1, "\r\n%s.%s> ", shm_env, nsname); |
Line 7180 direct_mode:
|
Line 7475 direct_mode:
|
set_io (UNIX); |
set_io (UNIX); |
|
|
job_set_status (pid, JSTAT_DIRECTMODE); |
job_set_status (pid, JSTAT_DIRECTMODE); |
|
|
|
#if defined(__NetBSD__) |
|
printf ("\r\n"); |
|
#endif |
|
|
/* readline() does its own malloc() */ |
/* readline() does its own malloc() */ |
fmrl_buf = readline (fmrl_prompt); |
fmrl_buf = readline (fmrl_prompt); |
|
|
Line 7191 direct_mode:
|
Line 7490 direct_mode:
|
|
|
goto halt; |
goto halt; |
} |
} |
|
|
|
|
if (strlen (fmrl_buf) > 0) { |
if (strlen (fmrl_buf) > 0) { |
add_history (fmrl_buf); |
add_history (fmrl_buf); |
Line 7201 direct_mode:
|
Line 7501 direct_mode:
|
char kb[20]; |
char kb[20]; |
char db[STRLEN]; |
char db[STRLEN]; |
|
|
snprintf (kb, sizeof (kb) - 1, "%%SYS.HLP\201"); |
snprintf (kb, sizeof (kb) - 1, "%%SYSHLP\201"); |
snprintf (db, STRLEN - 1, "\201"); |
snprintf (db, STRLEN - 1, "\201"); |
|
|
symtab (kill_sym, kb, db); |
symtab (kill_sym, kb, db); |
Line 7217 direct_mode:
|
Line 7517 direct_mode:
|
} |
} |
|
|
} |
} |
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) { |
else if (strcmp (fmrl_buf, "rbuf") == 0) { |
rbuf_dump (); |
rbuf_dump (); |
} |
} |