version 1.6, 2025/03/22 21:44:32
|
version 1.26, 2025/05/19 02:03:31
|
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.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 |
|
* 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 |
* Revision 1.6 2025/03/22 21:44:32 snw |
* Make the startup messages fewer and add environment name to direct-mode prompt |
* Make the startup messages fewer and add environment name to direct-mode prompt |
* |
* |
Line 135 int xecline(int typ)
|
Line 195 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 156 int xecline(int typ)
|
Line 217 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 205 int xecline(int typ)
|
Line 267 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 253 next_line: /* entry point for n
|
Line 318 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 510 next0:
|
Line 580 next0:
|
else if (tmp2[0] == '<') { /* call write output to %-array */ |
else if (tmp2[0] == '<') { /* call write output to %-array */ |
|
|
FILE *pipdes; |
FILE *pipdes; |
char key[STRLEN + 1 /*was 256 */ ]; |
char key[STRLEN]; |
char data[STRLEN + 1 /*was 256 */ ]; |
char data[STRLEN]; |
char data_kill[256]; |
char data_kill[256]; |
data_kill[255] = EOL; |
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); |
ssvn (get_sym, key, vn); |
|
|
if (vn[0] == '^') { |
if (vn[0] == '^') { |
Line 535 next0:
|
Line 605 next0:
|
symtab (kill_sym, vn, data); |
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); |
ssvn (get_sym, key, vn); |
|
|
data[0] = '0'; |
data[0] = '0'; |
Line 564 next0:
|
Line 634 next0:
|
int glvn_len = 0; |
int glvn_len = 0; |
|
|
while (fgets (data, STRLEN, pipdes)) { |
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); |
ssvn (get_sym, key, vn); |
|
|
glvn_len = stlen (vn); |
glvn_len = stlen (vn); |
Line 625 next0:
|
Line 695 next0:
|
|
|
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); |
ssvn (get_sym, key, vn); |
|
|
if (vn[0] == '^') { |
if (vn[0] == '^') { |
Line 654 next0:
|
Line 724 next0:
|
int glvn_len = 0; |
int glvn_len = 0; |
|
|
for (i = 1; i <= k; i++) { |
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); |
ssvn (get_sym, key, vn); |
|
|
glvn_len = stlen (vn); |
glvn_len = stlen (vn); |
Line 824 again:
|
Line 894 again:
|
} |
} |
} |
} |
|
|
|
if (trace_mode) tracestr[0] = '\0'; |
|
|
switch (mcmnd) { |
switch (mcmnd) { |
|
|
case MAP: |
case MAP: |
Line 889 set0:
|
Line 961 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 926 set0:
|
Line 997 set0:
|
|
|
if (*++codptr != '=') { |
if (*++codptr != '=') { |
|
|
/* SET A++ or SET A-- equivalent to SET A+=1 SET A-=1 currently disabled */ |
/* unary ++/-- */ |
//#ifdef NEVER |
|
if ((ch == '+' || ch == '-') && ch == *codptr) { |
if ((ch == '+' || ch == '-') && ch == *codptr) { |
codptr++; |
codptr++; |
setop = ch; |
setop = ch; |
Line 936 set0:
|
Line 1006 set0:
|
|
|
goto set2; |
goto set2; |
} |
} |
//#endif /* NEVER */ |
|
|
|
merr_raise (ASSIGNER); |
merr_raise (ASSIGNER); |
break; |
break; |
Line 949 set0:
|
Line 1018 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 1022 set2:
|
Line 1096 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 1074 set:
|
Line 1150 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 1586 set10:
|
Line 1662 set10:
|
} |
} |
|
|
if (stcat (tmp2, &tmp3[arg4]) == 0) { |
if (stcat (tmp2, &tmp3[arg4]) == 0) { |
merr_raise (M56); //JPW |
merr_raise (M56); /* snw */ |
goto err; |
goto err; |
} |
} |
|
|
Line 2333 s_end:
|
Line 2409 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 2362 s_end:
|
Line 2442 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 |
//printf (" extr_types[%d] = '%d'\r\n", nstx, extr_types[nstx]); |
|
if (*codptr == EOL || *codptr == SP) { |
if (*codptr == EOL || *codptr == SP) { |
|
|
#ifdef DEBUG_NEWSTACK |
#ifdef DEBUG_NEWSTACK |
Line 2392 s_end:
|
Line 2475 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 2558 quit0:
|
Line 2645 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 2584 quit0:
|
Line 2670 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 3028 do_xecute:
|
Line 3114 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 3062 do_goto:
|
Line 3163 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 3077 do_goto:
|
Line 3186 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 3087 do_goto:
|
Line 3201 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 3751 off3:
|
Line 3879 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 3785 off3:
|
Line 3913 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 3934 off3:
|
Line 4064 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 3968 off3:
|
Line 4098 off3:
|
|
|
if (merr () > OK) goto err; |
if (merr () > OK) goto err; |
|
|
|
/* TODO: check this snprintf for proper sizing */ |
snprintf (&tmp3[1], 255, "%s\201", &constructor[1]); |
snprintf (&tmp3[1], 255, "%s\201", &constructor[1]); |
goto private; |
goto private; |
|
|
Line 3988 off3:
|
Line 4119 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 4318 use0: /* entry point for proces
|
Line 4450 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 4420 use_socket:
|
Line 4552 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 4846 open_socket:
|
Line 4978 open_socket:
|
if (merr () > OK) break; |
if (merr () > OK) break; |
} |
} |
else { |
else { |
halt:i = 0; |
halt: |
|
i = 0; |
} |
} |
|
|
cleanup (); |
cleanup (); |
Line 5045 open_socket:
|
Line 5178 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 5078 open_socket:
|
Line 5224 open_socket:
|
#endif |
#endif |
|
|
if (nestc[nstx] == BREAK) { |
if (nestc[nstx] == BREAK) { |
// printf ("nestc[nstx] was BREAK\r\n"); |
|
if (repQUIT) continue; |
if (repQUIT) continue; |
merr_raise (OK - CTRLB); |
merr_raise (OK - CTRLB); |
|
|
goto zgo; /*cont. single step */ |
goto zgo; /*cont. single step */ |
} |
} |
// else { |
|
// printf ("nestc[nstx] was _not_ BREAK\r\n"); |
|
// } |
|
|
|
if (nestc[nstx] == FOR) { |
if (nestc[nstx] == FOR) { |
|
|
Line 5156 open_socket:
|
Line 5298 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 5295 zgo:
|
Line 5442 zgo:
|
merr_raise (NOPGM); |
merr_raise (NOPGM); |
|
|
break; |
break; |
} /*error */ |
} /* error */ |
|
|
stcpy (varnam, rou_name); |
stcpy (varnam, rou_name); |
} |
} |
Line 5431 zgo:
|
Line 5578 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 5536 zgo:
|
Line 5683 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 5552 zgo:
|
Line 5699 zgo:
|
rouins = beg; |
rouins = beg; |
} |
} |
|
|
if (crlf[io]) { |
if (frm_crlf[io]) { |
write_m ("\012\201"); |
write_m ("\012\201"); |
} |
} |
else { |
else { |
Line 5662 zgo:
|
Line 5809 zgo:
|
} |
} |
|
|
case ZWRITE: |
case ZWRITE: |
|
|
|
|
zwrite: |
|
{ |
{ |
short k; |
short k; |
char w_tmp[512]; |
char w_tmp[512]; |
Line 5788 zwritep:
|
Line 5932 zwritep:
|
|
|
expr (NAME); |
expr (NAME); |
|
|
//if (varnam[0] == '^') merr_raise (GLOBER); |
|
if (merr () > OK) goto err; |
if (merr () > OK) goto err; |
|
|
codptr++; |
codptr++; |
Line 5821 zwritep:
|
Line 5964 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 5941 zwritep:
|
Line 6084 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 6030 zwritep:
|
Line 6173 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 6624 evthandler: /* for event hand
|
Line 6712 evthandler: /* for event hand
|
|
|
|
|
/* run the next iteration of GTK's event loop */ |
/* run the next iteration of GTK's event loop */ |
//TODO: replace with libXt event loop |
/* TODO: replace with libXt event loop */ |
//gtk_main_iteration_do (TRUE); |
/* gtk_main_iteration_do (TRUE); */ |
|
|
/* dequeue any events */ |
/* dequeue any events */ |
evt_count = mwapi_dequeue_events (syn_handlers); |
evt_count = mwapi_dequeue_events (syn_handlers); |
|
|
if (evt_count) { |
if (evt_count) { |
/* write them out */ |
/* write them out */ |
//printf ("event handlers = '%s'\r\n", syn_handlers); |
/* printf ("event handlers = '%s'\r\n", syn_handlers); */ |
|
|
syn_event_entry_nstx = nstx; |
syn_event_entry_nstx = nstx; |
|
|
Line 6690 syn_evt_loop_bottom:
|
Line 6778 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 6733 err:
|
Line 6820 err:
|
} |
} |
} |
} |
|
|
|
|
if (merr () > OK ) { |
if (merr () > OK ) { |
|
|
char er_buf[ERRLEN]; |
char er_buf[ERRLEN]; |
Line 6742 err:
|
Line 6830 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 7166 restart:
|
|
|
DSW &= ~BIT0; /* enable ECHO */ |
DSW &= ~BIT0; /* enable ECHO */ |
|
|
// print here |
/* print here */ |
{ |
{ |
char *t_rtn; |
char *t_rtn; |
char *t_nsn = (char *) malloc (STRLEN * sizeof (char)); |
char *t_nsn = (char *) malloc (STRLEN * sizeof (char)); |
Line 7114 restart:
|
Line 7203 restart:
|
|
|
|
|
free (t_nsn); |
free (t_nsn); |
|
|
} |
} |
|
|
|
|
Line 7175 restore:
|
Line 7265 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 7208 direct_mode:
|
Line 7295 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.%s> ", shm_env, nsname); |
snprintf (fmrl_prompt, sizeof (fmrl_prompt) - 1, "\r\n%s.%s> ", shm_env, nsname); |
} |
} |
else { |
else { |
snprintf (fmrl_prompt, 255, "\r\nTL%d:%s.%s> ", tp_level, shm_env, nsname); |
snprintf (fmrl_prompt, sizeof (fmrl_prompt) - 1 , "\r\nTL%d:%s.%s> ", tp_level, shm_env, nsname); |
} |
} |
} |
} |
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 7228 direct_mode:
|
Line 7319 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 7236 direct_mode:
|
Line 7328 direct_mode:
|
if (fmrl_buf[0] == '?') { |
if (fmrl_buf[0] == '?') { |
|
|
char kb[20]; |
char kb[20]; |
char db[255]; |
char db[STRLEN]; |
|
|
snprintf (kb, 19, "%%SYS.HLP\201"); |
snprintf (kb, sizeof (kb) - 1, "%%SYS.HLP\201"); |
snprintf (db, 19, "\201"); |
snprintf (db, STRLEN - 1, "\201"); |
|
|
symtab (kill_sym, kb, db); |
symtab (kill_sym, kb, db); |
|
|
Line 7249 direct_mode:
|
Line 7341 direct_mode:
|
stcpy (code, "DO ^%ZHELP\201"); |
stcpy (code, "DO ^%ZHELP\201"); |
|
|
if (strlen (fmrl_buf) > 1) { |
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); |
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) { |
else if (strcmp (fmrl_buf, "rbuf") == 0) { |
rbuf_dump (); |
rbuf_dump (); |
} |
} |
Line 7318 direct_mode:
|
Line 7403 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] == '^')) { |
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); |
stcnv_c2m (code); |
|
|
set_io (MUMPS); |
set_io (MUMPS); |
Line 7400 direct_mode:
|
Line 7485 direct_mode:
|
char fmrl_prompt[256]; |
char fmrl_prompt[256]; |
|
|
if (tp_level == 0) { |
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 { |
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); |
write_m (fmrl_prompt); |
Line 7415 direct_mode:
|
Line 7500 direct_mode:
|
#endif |
#endif |
|
|
if (merr () > OK) goto err; |
if (merr () > OK) goto err; |
|
|
|
|
// printf ("zbflag = %d\r\n", zbflag); |
|
|
|
if (code[0] == EOL && zbflag && nestc[nstx] == BREAK) { |
if (code[0] == EOL && zbflag && nestc[nstx] == BREAK) { |
|
|
//printf ("cont single step\r\n"); |
|
debug_mode = TRUE; |
debug_mode = TRUE; |
merr_raise (OK - CTRLB); |
merr_raise (OK - CTRLB); |
|
|
//printf ("ierr now '%d'\r\n", ierr); |
|
goto zgo; |
goto zgo; |
} /* single step */ |
} /* single step */ |
} |
} |
Line 7491 void rbuf_dump(void)
|
Line 7571 void rbuf_dump(void)
|
|
|
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, "---------"); |