d0p1/ack
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

Many more changes

Browse source
This commit is contained in:
ceriel 1990-11-06 12:23:41 +00:00
parent b28f5a1824
commit 87a8061e1c
14 changed files with 570 additions and 240 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

133
util/grind/c.c
View file

@ -70,35 +70,36 @@ static struct langdep c = {
struct langdep *c_dep = &c; struct langdep *c_dep = &c;
static int static int
printchar(c, esc) printchar(f, c, esc)
FILE *f;
int c; int c;
{ {
c &= 0377; c &= 0377;
switch(c) { switch(c) {
case '\n': case '\n':
fputs("\\n", db_out); fputs("\\n", f);
break; break;
case '\t': case '\t':
fputs("\\t", db_out); fputs("\\t", f);
break; break;
case '\b': case '\b':
fputs("\\b", db_out); fputs("\\b", f);
break; break;
case '\r': case '\r':
fputs("\\r", db_out); fputs("\\r", f);
break; break;
case '\f': case '\f':
fputs("\\f", db_out); fputs("\\f", f);
break; break;
case '\\': case '\\':
fputs("\\\\", db_out); fputs("\\\\", f);
break; break;
case '\'': case '\'':
case '"': case '"':
fprintf(db_out, c == esc ? "\\%c" : "%c", c); fprintf(f, c == esc ? "\\%c" : "%c", c);
break; break;
default: default:
fprintf(db_out, (c >= 040 && c < 0177) ? "%c" : "\\%03o", c); fprintf(f, (c >= 040 && c < 0177) ? "%c" : "\\%03o", c);
break; break;
} }
} }
@ -108,20 +109,21 @@ print_char(c)
int c; int c;
{ {
putc('\'', db_out); putc('\'', db_out);
printchar(c, '\''); printchar(db_out, c, '\'');
putc('\'', db_out); putc('\'', db_out);
} }
static int static int
print_string(s, len) print_string(f, s, len)
FILE *f;
char *s; char *s;
int len; int len;
{ {
register char *str = s; register char *str = s;
putc('"', db_out); putc('"', f);
while (*str && len-- > 0) printchar(*str++, '"'); while (*str && len-- > 0) printchar(f, *str++, '"');
putc('"', db_out); putc('"', f);
} }
extern long int_size; extern long int_size;
@ -463,124 +465,125 @@ get_string(c)
} }
static int static int
print_op(p) print_op(f, p)
FILE *f;
p_tree p; p_tree p;
{ {
switch(p->t_oper) { switch(p->t_oper) {
case OP_UNOP: case OP_UNOP:
switch(p->t_whichoper) { switch(p->t_whichoper) {
case E_MIN: case E_MIN:
fputs("-(", db_out); fputs("-(", f);
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
putc(')', db_out); putc(')', f);
break; break;
case E_PLUS: case E_PLUS:
fputs("+(", db_out); fputs("+(", f);
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
putc(')', db_out); putc(')', f);
break; break;
case E_NOT: case E_NOT:
fputs("!(", db_out); fputs("!(", f);
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
putc(')', db_out); putc(')', f);
break; break;
case E_DEREF: case E_DEREF:
fputs("*(", db_out); fputs("*(", f);
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
putc(')', db_out); putc(')', f);
break; break;
case E_BNOT: case E_BNOT:
fputs("~(", db_out); fputs("~(", f);
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
putc(')', db_out); putc(')', f);
break; break;
case E_ADDR: case E_ADDR:
fputs("&(", db_out); fputs("&(", f);
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
putc(')', db_out); putc(')', f);
break; break;
} }
break; break;
case OP_BINOP: case OP_BINOP:
if (p->t_whichoper == E_ARRAY) { if (p->t_whichoper == E_ARRAY) {
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
fputs("[", db_out); fputs("[", f);
print_node(p->t_args[1], 0); print_node(f, p->t_args[1], 0);
fputs("]", db_out); fputs("]", f);
break; break;
} }
if (p->t_whichoper == E_DERSELECT) { if (p->t_whichoper == E_DERSELECT) {
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
fputs("->", db_out); fputs("->", f);
print_node(p->t_args[1], 0); print_node(f, p->t_args[1], 0);
break; break;
} }
if (p->t_whichoper == E_SELECT) { if (p->t_whichoper == E_SELECT) {
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
fputs(".", db_out); fputs(".", f);
print_node(p->t_args[1], 0); print_node(f, p->t_args[1], 0);
break; break;
} }
fputs("(", db_out); fputs("(", f);
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
switch(p->t_whichoper) { switch(p->t_whichoper) {
case E_LSFT: case E_LSFT:
fputs("<<", db_out); fputs("<<", f);
break; break;
case E_RSFT: case E_RSFT:
fputs(">>", db_out); fputs(">>", f);
break; break;
case E_AND: case E_AND:
fputs("&&", db_out); fputs("&&", f);
break; break;
case E_BAND: case E_BAND:
fputs("&", db_out); fputs("&", f);
break; break;
case E_OR: case E_OR:
fputs("||", db_out); fputs("||", f);
break; break;
case E_BOR: case E_BOR:
fputs("|", db_out); fputs("|", f);
break; break;
case E_BXOR: case E_BXOR:
fputs("^", db_out); fputs("^", f);
break; break;
case E_ZDIV: case E_ZDIV:
fputs("/", db_out); fputs("/", f);
break; break;
case E_ZMOD: case E_ZMOD:
fputs("%", db_out); fputs("%", f);
break; break;
case E_PLUS: case E_PLUS:
fputs("+", db_out); fputs("+", f);
break; break;
case E_MIN: case E_MIN:
fputs("-", db_out); fputs("-", f);
break; break;
case E_MUL: case E_MUL:
fputs("*", db_out); fputs("*", f);
break; break;
case E_EQUAL: case E_EQUAL:
fputs("==", db_out); fputs("==", f);
break; break;
case E_NOTEQUAL: case E_NOTEQUAL:
fputs("!=", db_out); fputs("!=", f);
break; break;
case E_LTEQUAL: case E_LTEQUAL:
fputs("<=", db_out); fputs("<=", f);
break; break;
case E_GTEQUAL: case E_GTEQUAL:
fputs(">=", db_out); fputs(">=", f);
break; break;
case E_LT: case E_LT:
fputs("<", db_out); fputs("<", f);
break; break;
case E_GT: case E_GT:
fputs(">", db_out); fputs(">", f);
break; break;
} }
print_node(p->t_args[1], 0); print_node(f, p->t_args[1], 0);
fputs(")", db_out); fputs(")", f);
break; break;
} }
} }

2
util/grind/char.ct
View file

@ -12,7 +12,7 @@ STIDF:a-zA-Z_
STSTR:"' STSTR:"'
STDOT:. STDOT:.
STNUM:0-9 STNUM:0-9
STSIMP:-,!<>{}:`?\\ STSIMP:-+,!<>{}:`?\\
%T#include "class.h" %T#include "class.h"
%Tchar tkclass[] = { %Tchar tkclass[] = {
%p %p

61
util/grind/commands.g
View file

@ -56,10 +56,11 @@ commands
lastcom = 0; lastcom = 0;
} }
if (errorgiven) { if (errorgiven) {
freenode(com); if (com != run_command) freenode(com);
com = 0; com = 0;
} }
else { else {
log(com);
eval(com); eval(com);
if (repeatable(com)) { if (repeatable(com)) {
lastcom = com; lastcom = com;
@ -72,6 +73,7 @@ commands
} }
} }
} else if (lastcom && ! errorgiven) { } else if (lastcom && ! errorgiven) {
log(lastcom);
eval(lastcom); eval(lastcom);
} }
if (give_prompt) { if (give_prompt) {
@ -81,7 +83,6 @@ commands
} }
} }
]* ]*
{ signal_child(SIGKILL); }
; ;
command_line(p_tree *p;) command_line(p_tree *p;)
@ -111,20 +112,48 @@ command_line(p_tree *p;)
| WHICH qualified_name(p){ *p = mknode(OP_WHICH, *p); } | WHICH qualified_name(p){ *p = mknode(OP_WHICH, *p); }
| able_command(p) | able_command(p)
| '!' { shellescape(); | '!' { shellescape();
errorgiven = 1; /* to prevent execution of lastcomm */ *p = mknode(OP_SHELL);
} }
| source_command(p)
| log_command(p)
| frame_command(p)
| |
] ]
; ;
frame_command(p_tree *p;)
:
FRAME
[ { *p = mknode(OP_FRAME, (p_tree) 0); }
| count(p) { *p = mknode(OP_FRAME, *p); }
| '-' count(p) { *p = mknode(OP_DOWN, *p); }
| '+' count(p) { *p = mknode(OP_UP, *p); }
]
;
source_command(p_tree *p;)
:
SOURCE { extended_charset = 1; }
name(p) { (*p)->t_idf = str2idf((*p)->t_str, 0); }
{ *p = mknode(OP_SOURCE, *p);
extended_charset = 0;
}
;
log_command(p_tree *p;)
:
LOG { extended_charset = 1; }
[ name(p) { (*p)->t_idf = str2idf((*p)->t_str, 0); }
| { *p = 0; }
]
{ *p = mknode(OP_LOG, *p);
extended_charset = 0;
}
;
where_command(p_tree *p;) where_command(p_tree *p;)
: :
WHERE { *p = mknode(OP_WHERE, (p_tree) 0); } WHERE opt_num(p) { *p = mknode(OP_WHERE, *p); }
[ count(&(*p)->t_args[0])?
| '-' count(&(*p)->t_args[0])
{ (*p)->t_args[0]->t_ival = - (*p)->t_args[0]->t_ival; }
]
; ;
list_command(p_tree *p;) list_command(p_tree *p;)
@ -161,6 +190,7 @@ help_command(p_tree *p;)
{ *p = mknode(OP_HELP, (p_tree) 0); } { *p = mknode(OP_HELP, (p_tree) 0); }
[ name(&(*p)->t_args[0])? [ name(&(*p)->t_args[0])?
| '?' { (*p)->t_args[0] = mknode(OP_NAME, str2idf("help",0), (char *) 0); } | '?' { (*p)->t_args[0] = mknode(OP_NAME, str2idf("help",0), (char *) 0); }
| '!' { (*p)->t_args[0] = mknode(OP_NAME, (struct idf *) 0, "!"); }
] ]
; ;
@ -175,6 +205,9 @@ run_command(p_tree *p;)
} }
else *p = run_command; else *p = run_command;
} }
[ '?' { *p = mknode(OP_PRCOMM, *p); }
|
]
; ;
stop_command(p_tree *p;) stop_command(p_tree *p;)
@ -447,6 +480,15 @@ count(p_tree *p;)
INTEGER { *p = mknode(OP_INTEGER, tok.ival); } INTEGER { *p = mknode(OP_INTEGER, tok.ival); }
; ;
opt_num(p_tree *p;)
:
count(p)
|
'-' count(p) { (*p)->t_ival = - (*p)->t_ival; }
|
{ *p = 0; }
;
qualified_name(p_tree *p;) qualified_name(p_tree *p;)
: :
name(p) name(p)
@ -487,6 +529,9 @@ name(p_tree *p;)
| HELP | HELP
| DISABLE | DISABLE
| ENABLE | ENABLE
| SOURCE
| FRAME
| LOG
] { *p = mknode(OP_NAME, tok.idf, tok.str); } ] { *p = mknode(OP_NAME, tok.idf, tok.str); }
; ;

250
util/grind/do_comm.c
View file

@ -25,6 +25,12 @@ extern int interrupted;
p_tree print_command; p_tree print_command;
/*ARGSUSED*/
do_noop(p)
p_tree p;
{
}
/* ------------------------------------------------------------- */ /* ------------------------------------------------------------- */
/* implementation of the help command */ /* implementation of the help command */
@ -49,9 +55,27 @@ do_help(p)
fputs(" <wsize> is the last <cnt> given, or 10.\n", db_out); fputs(" <wsize> is the last <cnt> given, or 10.\n", db_out);
return; return;
case XFILE: case XFILE:
fputs("file [ <name> ]\n", db_out); fputs("file [ <name> | ? ]\n", db_out);
fputs(" Print the name of the current source file, or change the\n", db_out); fputs(" Print the name of the current source file, or change the\n", db_out);
fputs(" current source file to <name>.\n", db_out); fputs(" current source file to <name>, or print the files that\n", db_out);
fputs(" the debugger knows about.\n", db_out);
return;
case SOURCE:
fputs("source <filename>\n", db_out);
fputs(" Read commands from the file <filename>\n", db_out);
return;
case FRAME:
fputs("frame [ [ + | - ] <num> ]\n", db_out);
fputs(" Sets the 'current' frame to frame <num>. The currently active\n", db_out);
fputs(" procedure has frame 0. If <num> is not given, print the 'current' frame.\n", db_out);
fputs(" If <num> is given with a + or -, go up or down <num> frames relative\n", db_out);
fputs(" to the current one.\n", db_out);
return;
case LOG:
fputs("log [ <name> | off ]\n", db_out);
fputs(" Creates a logfile <name> of the commands given.\n", db_out);
fputs(" When no argument is given, the current logfile is printed.\n", db_out);
fputs(" If the argument is 'off', logging is turned off.\n", db_out);
return; return;
case RUN: case RUN:
fputs("run [ <args> ] [ < <infile> ] [ > <outfile> ]\n", db_out); fputs("run [ <args> ] [ < <infile> ] [ > <outfile> ]\n", db_out);
@ -59,8 +83,9 @@ do_help(p)
fputs(" possible redirection of standard input and/or standard output.\n", db_out); fputs(" possible redirection of standard input and/or standard output.\n", db_out);
return; return;
case RERUN: case RERUN:
fputs("rerun\n", db_out); fputs("rerun [ ? ]\n", db_out);
fputs(" repeats the last run command.\n", db_out); fputs(" If the ? is given, prints the last run command;\n", db_out);
fputs(" otherwise repeats the last run command.\n", db_out);
return; return;
case STOP: case STOP:
fputs("stop [ <pos> ] [ if <cond> ]\n", db_out); fputs("stop [ <pos> ] [ if <cond> ]\n", db_out);
@ -112,9 +137,9 @@ do_help(p)
fputs(" Assign the value of <exp> to <desig>.\n", db_out); fputs(" Assign the value of <exp> to <desig>.\n", db_out);
return; return;
case PRINT: case PRINT:
fputs("print <exp> [ , <exp> ] ...\n", db_out); fputs("print [ <exp> [ , <exp> ] ...]\n", db_out);
fputs("p <exp> [ , <exp> ] ...\n", db_out); fputs("p [ <exp> [ , <exp> ] ...]\n", db_out);
fputs(" Print the value of each <exp>.\n", db_out); fputs(" Print the value of each <exp>, or repeat the last print command\n", db_out);
return; return;
case DISPLAY: case DISPLAY:
fputs("display <exp> [ , <exp> ] ...\n", db_out); fputs("display <exp> [ , <exp> ] ...\n", db_out);
@ -160,22 +185,32 @@ do_help(p)
fputs(" If no <num> is given, enable the current stopping point (not effective).\n", db_out); fputs(" If no <num> is given, enable the current stopping point (not effective).\n", db_out);
return; return;
} }
else if (p && p->t_str) {
if (! strcmp(p->t_str, "!")) {
fputs("! <shell command>\n", db_out);
fputs(" Execute the given shell command.\n", db_out);
return;
}
}
fputs("cont [ <cnt> ] [ at <line> ]\n", db_out); fputs("cont [ <cnt> ] [ at <line> ]\n", db_out);
fputs("delete [ <num> [ , <num> ] ... ]\n", db_out); fputs("delete [ <num> [ , <num> ] ... ]\n", db_out);
fputs("disable [ <num> [ , <num> ] ... ]\n", db_out); fputs("disable [ <num> [ , <num> ] ... ]\n", db_out);
fputs("display <exp> [ , <exp> ] ...\n", db_out); fputs("display <exp> [ , <exp> ] ...\n", db_out);
fputs("dump\n", db_out); fputs("dump\n", db_out);
fputs("enable [ <num> [ , <num> ] ... ]\n", db_out); fputs("enable [ <num> [ , <num> ] ... ]\n", db_out);
fputs("file [ <name> ]\n", db_out); fputs("file [ <name> | ? ]\n", db_out);
fputs("find <name>\n", db_out); fputs("find <name>\n", db_out);
fputs("frame [ [ + | - ] <num> ]\n", db_out);
fputs("help [ <commandname> ]\n", db_out); fputs("help [ <commandname> ]\n", db_out);
fputs("list [ <start> | <func> ] [ , <cnt> | - [ <end> ] ]\n", db_out); fputs("list [ <start> | <func> ] [ , <cnt> | - [ <end> ] ]\n", db_out);
fputs("log [ <name> | off ]\n", db_out);
fputs("next [ <cnt> ]\n", db_out); fputs("next [ <cnt> ]\n", db_out);
fputs("print <exp> [ , <exp> ] ...\n", db_out); fputs("print [ <exp> [ , <exp> ] ... ]\n", db_out);
fputs("rerun\n", db_out); fputs("rerun [ ? ]\n", db_out);
fputs("restore <num>\n", db_out); fputs("restore [ <num> ]\n", db_out);
fputs("run [ <args> ] [ < <infile> ] [ > <outfile> ]\n", db_out); fputs("run [ <args> ] [ < <infile> ] [ > <outfile> ]\n", db_out);
fputs("set <desig> to <exp>\n", db_out); fputs("set <desig> to <exp>\n", db_out);
fputs("source <filename>\n", db_out);
fputs("status\n", db_out); fputs("status\n", db_out);
fputs("step [ <cnt> ]\n", db_out); fputs("step [ <cnt> ]\n", db_out);
fputs("stop [ <pos> ] [ if <cond> ]\n", db_out); fputs("stop [ <pos> ] [ if <cond> ]\n", db_out);
@ -183,6 +218,7 @@ do_help(p)
fputs("when [ <pos> ] [ if <cond> ] { <command> [ ; <command> ] ... } \n", db_out); fputs("when [ <pos> ] [ if <cond> ] { <command> [ ; <command> ] ... } \n", db_out);
fputs("where [ <cnt> ]\n", db_out); fputs("where [ <cnt> ]\n", db_out);
fputs("which <name>\n", db_out); fputs("which <name>\n", db_out);
fputs("! <shell command>\n", db_out);
} }
/* ------------------------------------------------------------- */ /* ------------------------------------------------------------- */
@ -608,6 +644,30 @@ do_regs(p)
/* implementation of the where command */ /* implementation of the where command */
static t_addr where_PC;
static int
where_entry(num)
int num;
{
t_addr *buf;
t_addr AB;
p_scope sc;
if (! (buf = get_EM_regs(num))) return 0;
AB = buf[1];
where_PC = buf[2];
if (! AB) return 0;
sc = base_scope(get_scope_from_addr(where_PC));
if (! sc || sc->sc_start > where_PC) return 0;
fprintf(db_out, "%s(", sc->sc_definedby->sy_idf->id_text);
print_params(sc->sc_definedby->sy_type, AB, has_static_link(sc));
fputs(") ", db_out);
print_position(where_PC, 0);
fputs("\n", db_out);
return 1;
}
/*ARGSUSED*/ /*ARGSUSED*/
do_where(p) do_where(p)
p_tree p; p_tree p;
@ -636,20 +696,8 @@ do_where(p)
} }
else if (p) maxcnt = p->t_ival; else if (p) maxcnt = p->t_ival;
for (cnt = maxcnt; cnt != 0; cnt--) { for (cnt = maxcnt; cnt != 0; cnt--) {
t_addr AB;
if (interrupted) return; if (interrupted) return;
if (! (buf = get_EM_regs(i++))) break; if (! where_entry(i++)) return;
AB = buf[1];
PC = buf[2];
if (! AB) break;
sc = base_scope(get_scope_from_addr(PC));
if (! sc || sc->sc_start > PC) break;
fprintf(db_out, "%s(", sc->sc_definedby->sy_idf->id_text);
print_params(sc->sc_definedby->sy_type, AB, has_static_link(sc));
fputs(") ", db_out);
print_position(PC, 0);
fputs("\n", db_out);
} }
} }
@ -735,7 +783,7 @@ do_print(p)
break; break;
default: default:
if (interrupted || ! eval_expr(p, &buf, &size, &tp)) return; if (interrupted || ! eval_expr(p, &buf, &size, &tp)) return;
print_node(p, 0); print_node(db_out, p, 0);
fputs(" = ", db_out); fputs(" = ", db_out);
if (p->t_oper == OP_FORMAT) { if (p->t_oper == OP_FORMAT) {
format = p->t_args[1]->t_str; format = p->t_args[1]->t_str;
@ -774,3 +822,155 @@ do_set(p)
free(buf); free(buf);
} }
/* ------------------------------------------------------------- */
/* implementation of the source command */
extern FILE *db_in;
do_source(p)
p_tree p;
{
FILE *old_db_in = db_in;
p = p->t_args[0];
if ((db_in = fopen(p->t_str, "r")) == NULL) {
db_in = old_db_in;
error("could not open %s", p->t_str);
return;
}
Commands();
fclose(db_in);
db_in = old_db_in;
}
/* ------------------------------------------------------------- */
do_prcomm(p)
p_tree p;
{
print_node(db_out, p->t_args[0], 1);
}
/* ------------------------------------------------------------- */
/* stack frame commands: frame, down, up */
extern int stack_offset;
static
frame_pos(diff)
int diff;
{
if (stack_offset+diff < 0) diff = - stack_offset;
if (! where_entry(stack_offset+diff)) {
error("no frame %d", stack_offset+diff);
return;
}
stack_offset += diff;
list_position(get_position_from_addr(where_PC));
CurrentScope = get_scope_from_addr(where_PC);
}
do_frame(p)
p_tree p;
{
if (p->t_args[0]) {
frame_pos((int) p->t_args[0]->t_ival - stack_offset);
}
else frame_pos(0);
}
do_up(p)
p_tree p;
{
if (p->t_args[0]) {
frame_pos((int) p->t_args[0]->t_ival);
}
else frame_pos(1);
}
do_down(p)
p_tree p;
{
if (p->t_args[0]) {
frame_pos(-(int) p->t_args[0]->t_ival);
}
else frame_pos(-1);
}
/* ------------------------------------------------------------- */
/* log command */
static char *logfile;
static FILE *logfd;
do_log(p)
p_tree p;
{
p = p->t_args[0];
if (p) {
if (logfd && ! strcmp(p->t_str, "off")) {
fprintf(db_out, "stopped logging on %s\n", logfile);
fclose(logfd);
logfd = NULL;
return;
}
if (logfd) {
error("already logging on %s", logfile);
return;
}
logfile = p->t_str;
if ((logfd = fopen(logfile, "w")) == NULL) {
error("could not open %s", logfile);
return;
}
fprintf(db_out, "started logging on %s\n", logfile);
}
else if (logfd) {
fprintf(db_out, "the current logfile is %s\n", logfile);
}
else {
error("no current logfile");
}
}
extern int item_count;
extern int in_wheninvoked;
log(p)
p_tree p;
{
register p_tree p1;
if (logfd && ! in_wheninvoked) {
switch(p->t_oper) {
case OP_SOURCE:
case OP_LOG:
break;
case OP_DELETE:
case OP_ENABLE:
case OP_DISABLE:
/* Change absolute item numbers into relative ones
for safer replay
*/
p1 = p->t_args[0];
while (p1 && p1->t_oper == OP_LINK) {
register p_tree p2 = p1->t_args[0];
if (p2->t_ival > 0) {
p2->t_ival = item_count - p2->t_ival;
}
p1 = p1->t_args[1];
}
if (p1 && p1->t_ival > 0) {
p1->t_ival = item_count - p1->t_ival;
}
/* Fall through */
default:
print_node(logfd, p, 1);
fflush(logfd);
break;
}
}
}

6
util/grind/expr.c
View file

@ -1197,7 +1197,7 @@ eval_desig(p, paddr, psize, ptp)
} }
break; break;
default: default:
print_node(p, 0); print_node(db_out, p, 0);
fputs(" not a designator\n", db_out); fputs(" not a designator\n", db_out);
break; break;
} }
@ -1216,7 +1216,7 @@ eval_desig(p, paddr, psize, ptp)
} }
break; break;
default: default:
print_node(p, 0); print_node(db_out, p, 0);
fputs(" not a designator\n", db_out); fputs(" not a designator\n", db_out);
break; break;
} }
@ -1233,7 +1233,7 @@ eval_desig(p, paddr, psize, ptp)
*ptp = (*ptp)->ty_cross; *ptp = (*ptp)->ty_cross;
if (! *ptp) { if (! *ptp) {
*ptp = void_type; *ptp = void_type;
print_node(p, 0); print_node(db_out, p, 0);
fputs(" designator has unknown type\n", db_out); fputs(" designator has unknown type\n", db_out);
retval = 0; retval = 0;
*psize = 0; *psize = 0;

9
util/grind/itemlist.cc
View file

@ -24,10 +24,10 @@ typedef struct item {
struct itemlist { struct itemlist {
p_item il_first, il_last; p_item il_first, il_last;
int il_count;
}; };
static struct itemlist item_list; static struct itemlist item_list;
int item_count;
static int static int
in_item_list(p) in_item_list(p)
@ -47,7 +47,7 @@ pr_item(i)
p_item i; p_item i;
{ {
fprintf(db_out, "(%d)\t", i->i_itemno); fprintf(db_out, "(%d)\t", i->i_itemno);
print_node(i->i_node, 0); print_node(db_out, i->i_node, 0);
fputs(i->i_disabled ? " (disabled)\n": "\n", db_out); fputs(i->i_disabled ? " (disabled)\n": "\n", db_out);
} }
@ -143,7 +143,7 @@ add_to_item_list(p)
else { else {
item_list.il_last->i_next = i; item_list.il_last->i_next = i;
} }
i->i_itemno = ++item_list.il_count; i->i_itemno = ++item_count;
item_list.il_last = i; item_list.il_last = i;
pr_item(i); pr_item(i);
return 1; return 1;
@ -156,6 +156,7 @@ remove_from_item_list(n)
register p_item i = item_list.il_first, prev = 0; register p_item i = item_list.il_first, prev = 0;
p_tree p; p_tree p;
if (n <= 0) n = item_count - n;
while (i) { while (i) {
if (i->i_itemno == n) break; if (i->i_itemno == n) break;
prev = i; prev = i;
@ -184,6 +185,7 @@ get_from_item_list(n)
{ {
register p_item i = item_list.il_first; register p_item i = item_list.il_first;
if (n <= 0) n = item_count - n;
while (i) { while (i) {
if (i->i_itemno == n) return i->i_node; if (i->i_itemno == n) return i->i_node;
i = i->i_next; i = i->i_next;
@ -197,6 +199,7 @@ able_item(n, kind)
register p_item i = item_list.il_first; register p_item i = item_list.il_first;
register p_tree p; register p_tree p;
if (n <= 0) n = item_count - n;
while (i) { while (i) {
if (i->i_itemno == n) break; if (i->i_itemno == n) break;
i = i->i_next; i = i->i_next;

2
util/grind/main.c
View file

@ -2,6 +2,7 @@
#include <stdio.h> #include <stdio.h>
#include <varargs.h> #include <varargs.h>
#include <signal.h>
#include "tokenname.h" #include "tokenname.h"
#include "position.h" #include "position.h"
@ -77,6 +78,7 @@ main(argc, argv)
} }
prompt(); prompt();
Commands(); Commands();
signal_child(SIGKILL);
if (eof_seen) putc('\n', db_out); if (eof_seen) putc('\n', db_out);
exit(0); exit(0);
} }

74
util/grind/modula-2.c
View file

@ -77,7 +77,8 @@ print_char(c)
} }
static int static int
print_string(s, len) print_string(f, s, len)
FILE *f;
char *s; char *s;
int len; int len;
{ {
@ -87,7 +88,7 @@ print_string(s, len)
while (*str) { while (*str) {
if (*str++ == '\'') delim = '"'; if (*str++ == '\'') delim = '"';
} }
fprintf(db_out, "%c%.*s%c", delim, len, s, delim); fprintf(f, "%c%.*s%c", delim, len, s, delim);
} }
extern long int_size; extern long int_size;
@ -457,92 +458,93 @@ get_string(c)
} }
static int static int
print_op(p) print_op(f, p)
FILE *f;
p_tree p; p_tree p;
{ {
switch(p->t_oper) { switch(p->t_oper) {
case OP_UNOP: case OP_UNOP:
switch(p->t_whichoper) { switch(p->t_whichoper) {
case E_MIN: case E_MIN:
fputs("-", db_out); fputs("-", f);
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
break; break;
case E_PLUS: case E_PLUS:
fputs("+", db_out); fputs("+", f);
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
break; break;
case E_NOT: case E_NOT:
fputs("~", db_out); fputs("~", f);
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
break; break;
case E_DEREF: case E_DEREF:
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
fputs("^", db_out); fputs("^", f);
break; break;
} }
break; break;
case OP_BINOP: case OP_BINOP:
if (p->t_whichoper == E_ARRAY) { if (p->t_whichoper == E_ARRAY) {
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
fputs("[", db_out); fputs("[", f);
print_node(p->t_args[1], 0); print_node(f, p->t_args[1], 0);
fputs("]", db_out); fputs("]", f);
break; break;
} }
if (p->t_whichoper == E_SELECT) { if (p->t_whichoper == E_SELECT) {
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
fputs(".", db_out); fputs(".", f);
print_node(p->t_args[1], 0); print_node(f, p->t_args[1], 0);
break; break;
} }
fputs("(", db_out); fputs("(", f);
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
switch(p->t_whichoper) { switch(p->t_whichoper) {
case E_AND: case E_AND:
fputs("&", db_out); fputs("&", f);
break; break;
case E_OR: case E_OR:
fputs("|", db_out); fputs("|", f);
break; break;
case E_DIV: case E_DIV:
fputs("/", db_out); fputs("/", f);
break; break;
case E_MOD: case E_MOD:
fputs(" MOD ", db_out); fputs(" MOD ", f);
break; break;
case E_IN: case E_IN:
fputs(" IN ", db_out); fputs(" IN ", f);
break; break;
case E_PLUS: case E_PLUS:
fputs("+", db_out); fputs("+", f);
break; break;
case E_MIN: case E_MIN:
fputs("-", db_out); fputs("-", f);
break; break;
case E_MUL: case E_MUL:
fputs("*", db_out); fputs("*", f);
break; break;
case E_EQUAL: case E_EQUAL:
fputs("=", db_out); fputs("=", f);
break; break;
case E_NOTEQUAL: case E_NOTEQUAL:
fputs("#", db_out); fputs("#", f);
break; break;
case E_LTEQUAL: case E_LTEQUAL:
fputs("<=", db_out); fputs("<=", f);
break; break;
case E_GTEQUAL: case E_GTEQUAL:
fputs(">=", db_out); fputs(">=", f);
break; break;
case E_LT: case E_LT:
fputs("<", db_out); fputs("<", f);
break; break;
case E_GT: case E_GT:
fputs(">", db_out); fputs(">", f);
break; break;
} }
print_node(p->t_args[1], 0); print_node(f, p->t_args[1], 0);
fputs(")", db_out); fputs(")", f);
break; break;
} }
} }

7
util/grind/operators.ot
View file

@ -34,3 +34,10 @@ OP_BINOP 2 0
OP_FORMAT 2 0 OP_FORMAT 2 0
OP_DISABLE 1 do_disable OP_DISABLE 1 do_disable
OP_ENABLE 1 do_enable OP_ENABLE 1 do_enable
OP_SHELL 0 do_noop
OP_SOURCE 1 do_source
OP_PRCOMM 1 do_prcomm
OP_UP 1 do_up
OP_DOWN 1 do_down
OP_FRAME 1 do_frame
OP_LOG 1 do_log

2
util/grind/position.h
View file

@ -7,7 +7,7 @@
typedef unsigned int t_lineno; typedef unsigned int t_lineno;
typedef long t_addr; typedef long t_addr;
#define ILL_ADDR ((t_addr) -1) #define ILL_ADDR ((t_addr) -1)
#define NO_ADDR ((t_addr) -3) #define NO_ADDR ((t_addr) 0)
typedef struct pos { typedef struct pos {
t_lineno lineno; t_lineno lineno;

32
util/grind/print.c
View file

@ -283,21 +283,37 @@ print_val(tp, tp_sz, addr, compressed, indent, format)
} }
fprintf(db_out, currlang->addr_fmt, get_int(addr, pointer_size, T_UNSIGNED)); fprintf(db_out, currlang->addr_fmt, get_int(addr, pointer_size, T_UNSIGNED));
break; break;
case T_POINTER: case T_POINTER: {
if (format && strindex(format,'s') && t_addr a = get_int(addr, tp_sz, T_UNSIGNED);
fprintf(db_out, currlang->addr_fmt, a);
if (format && strindex(format, 's') &&
(tp->ty_ptrto == char_type || tp->ty_ptrto == uchar_type)) { (tp->ty_ptrto == char_type || tp->ty_ptrto == uchar_type)) {
t_addr a = get_int(addr, tp_sz, T_UNSIGNED);
char *naddr = malloc(512); char *naddr = malloc(512);
if (naddr && get_string(511L, a, naddr)) { if (! naddr) {
print_val(string_type, 512L, naddr, 0, indent, format); fputs(" (could not allocate memory)", db_out);
break;
}
if (! get_string(511L, a, naddr)) {
fputs(" (not a valid pointer)", db_out);
free(naddr); free(naddr);
break; break;
} }
if (naddr) free(naddr); fputs(" (", db_out);
print_val(string_type, 512L, naddr, 0, indent, format);
fputs(")", db_out);
free(naddr);
break;
}
if (tp->ty_ptrto->ty_class == T_PROCEDURE) {
p_scope sc = get_scope_from_addr(a);
if (sc && sc->sc_definedby && a == sc->sc_start) {
fprintf(db_out, " (%s)", sc->sc_definedby->sy_idf->id_text);
}
} }
fprintf(db_out, currlang->addr_fmt, get_int(addr, pointer_size, T_UNSIGNED));
break; break;
}
case T_FILE: case T_FILE:
fprintf(db_out, "<file>"); fprintf(db_out, "<file>");
break; break;
@ -363,7 +379,7 @@ print_val(tp, tp_sz, addr, compressed, indent, format)
print_integer(tp, get_int(addr, tp_sz, T_INTEGER), format); print_integer(tp, get_int(addr, tp_sz, T_INTEGER), format);
break; break;
case T_STRING: case T_STRING:
(*currlang->printstring)(addr, (int) tp_sz); (*currlang->printstring)(db_out, addr, (int) tp_sz);
break; break;
default: default:
assert(0); assert(0);

14
util/grind/run.c
View file

@ -31,6 +31,7 @@ extern char *progname;
extern int child_interrupted; extern int child_interrupted;
extern int interrupted; extern int interrupted;
extern int stop_reason; extern int stop_reason;
extern int stack_offset;
extern t_lineno currline; extern t_lineno currline;
static int child_pid; /* process id of child */ static int child_pid; /* process id of child */
@ -386,6 +387,7 @@ could_send(m, stop_message)
if (m->m_type & M_DB_RUN) { if (m->m_type & M_DB_RUN) {
disable_intr = 0; disable_intr = 0;
stop_reason = 0; stop_reason = 0;
stack_offset = 0;
} }
if (!child_interrupted && (! uputm(m) || ! ugetm(&answer))) { if (!child_interrupted && (! uputm(m) || ! ugetm(&answer))) {
child_dead = 1; child_dead = 1;
@ -458,10 +460,12 @@ could_send(m, stop_message)
} }
static int static int
getbytes(size, from, to, kind) getbytes(size, from, to, kind, errmess)
long size; long size;
t_addr from; t_addr from;
char *to; char *to;
int kind;
int errmess;
{ {
struct message_hdr m; struct message_hdr m;
@ -475,10 +479,10 @@ getbytes(size, from, to, kind)
switch(answer.m_type) { switch(answer.m_type) {
case M_FAIL: case M_FAIL:
error("could not get value"); if (errmess) error("could not get value");
return 0; return 0;
case M_INTR: case M_INTR:
error("interrupted"); if (errmess) error("interrupted");
return 0; return 0;
case M_DATA: case M_DATA:
return ureceive(to, BUFTOI(answer.m_buf+1, (int)LS)); return ureceive(to, BUFTOI(answer.m_buf+1, (int)LS));
@ -494,7 +498,7 @@ get_bytes(size, from, to)
t_addr from; t_addr from;
char *to; char *to;
{ {
return getbytes(size, from, to, M_GETBYTES); return getbytes(size, from, to, M_GETBYTES, 1);
} }
int int
@ -503,7 +507,7 @@ get_string(size, from, to)
t_addr from; t_addr from;
char *to; char *to;
{ {
int retval = getbytes(size, from, to, M_GETSTR); int retval = getbytes(size, from, to, M_GETSTR, 0);
to[(int)BUFTOI(answer.m_buf+1, (int)LS)] = 0; to[(int)BUFTOI(answer.m_buf+1, (int)LS)] = 0;
return retval; return retval;

3
util/grind/tokenname.c
View file

@ -60,6 +60,9 @@ struct tokenname tkidf[] = { /* names of the identifier tokens */
{HELP, "help"}, {HELP, "help"},
{DISABLE,"disable"}, {DISABLE,"disable"},
{ENABLE,"enable"}, {ENABLE,"enable"},
{SOURCE, "source"},
{FRAME, "frame"},
{LOG, "log"},
{-1, "quit"}, {-1, "quit"},
{0, ""} {0, ""}
}; };

215
util/grind/tree.c
View file

@ -151,200 +151,239 @@ get_addr_from_node(p)
return a; return a;
} }
print_node(p, top_level) static int ommit_commas = 0;
print_node(f, p, top_level)
register p_tree p; register p_tree p;
register FILE *f;
{ {
if (!p) return; if (!p) return;
switch(p->t_oper) { switch(p->t_oper) {
case OP_LOG:
fputs("log ", f);
print_node(f, p->t_args[0], 0);
break;
case OP_PRCOMM:
fputs("rerun ?", f);
break;
case OP_RUN:
fputs("run ", f);
ommit_commas = 1;
print_node(f, p->t_args[0], 0);
ommit_commas = 0;
break;
case OP_LIST: case OP_LIST:
fputs("list ", db_out); fputs("list ", f);
if (p->t_args[0]) { if (p->t_args[0]) {
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
if (p->t_args[1]) { if (p->t_args[1]) {
if (p->t_args[1]->t_ival >= 0) { if (p->t_args[1]->t_ival >= 0) {
fputs(", ", db_out); fputs(", ", f);
print_node(p->t_args[1], 0); print_node(f, p->t_args[1], 0);
} }
else { else {
if (p->t_args[1]->t_ival < -100000000) { if (p->t_args[1]->t_ival < -100000000) {
fputs("-", db_out); fputs("-", f);
} }
else print_node(p->t_args[1], 0); else print_node(f, p->t_args[1], 0);
} }
} }
} }
break; break;
case OP_PRINT: case OP_PRINT:
fputs("print ", db_out); fputs("print ", f);
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
break;
case OP_SOURCE:
fputs("source ", f);
print_node(f, p->t_args[0], 0);
break; break;
case OP_ENABLE: case OP_ENABLE:
fputs("enable ", db_out); fputs("enable ", f);
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
break; break;
case OP_DISABLE: case OP_DISABLE:
fputs("disable ", db_out); fputs("disable ", f);
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
break; break;
case OP_DISPLAY: case OP_DISPLAY:
fputs("display ", db_out); fputs("display ", f);
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
break; break;
case OP_LINK: case OP_LINK:
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
fputs(", ", db_out); if (! ommit_commas) fputs(", ", f);
print_node(p->t_args[1], 0); else putc(' ', f);
print_node(f, p->t_args[1], 0);
break; break;
case OP_FILE: case OP_FILE:
fputs("file ", db_out); fputs("file ", f);
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
break;
case OP_FRAME:
fputs("frame ", f);
print_node(f, p->t_args[0], 0);
break;
case OP_UP:
fputs("frame +", f);
print_node(f, p->t_args[0], 0);
break;
case OP_DOWN:
fputs("frame -", f);
print_node(f, p->t_args[0], 0);
break; break;
case OP_SET: case OP_SET:
fputs("set ", db_out); fputs("set ", f);
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
fputs(" to ", db_out); fputs(" to ", f);
print_node(p->t_args[1], 0); print_node(f, p->t_args[1], 0);
break; break;
case OP_FIND: case OP_FIND:
fputs("find ", db_out); fputs("find ", f);
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
break; break;
case OP_WHICH: case OP_WHICH:
fputs("which ", db_out); fputs("which ", f);
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
break; break;
case OP_DELETE: case OP_DELETE:
fputs("delete ", db_out); fputs("delete ", f);
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
break; break;
case OP_REGS: case OP_REGS:
fputs("regs ", db_out); fputs("regs ", f);
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
break; break;
case OP_NEXT: case OP_NEXT:
fputs("next ", db_out); fputs("next ", f);
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
break; break;
case OP_STEP: case OP_STEP:
fputs("step ", db_out); fputs("step ", f);
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
break; break;
case OP_STATUS: case OP_STATUS:
fputs("status", db_out); fputs("status", f);
break; break;
case OP_DUMP: case OP_DUMP:
fputs("dump ", db_out); fputs("dump ", f);
print_position(p->t_address, 1); print_position(p->t_address, 1);
break; break;
case OP_RESTORE: case OP_RESTORE:
fputs("restore ", db_out); fputs("restore ", f);
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
break; break;
case OP_WHERE: case OP_WHERE:
fputs("where ", db_out); fputs("where ", f);
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
break; break;
case OP_HELP: case OP_HELP:
fputs("help ", db_out); fputs("help ", f);
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
break; break;
case OP_CONT: case OP_CONT:
fputs("cont", db_out); fputs("cont", f);
if (p->t_args[0]) { if (p->t_args[0]) {
fprintf(db_out, " %ld", p->t_args[0]->t_ival); fprintf(f, " %ld", p->t_args[0]->t_ival);
} }
if (p->t_args[1]) { if (p->t_args[1]) {
fputs(" ", db_out); fputs(" ", f);
print_node(p->t_args[1], 0); print_node(f, p->t_args[1], 0);
} }
break; break;
case OP_WHEN: case OP_WHEN:
fputs("when ", db_out); fputs("when ", f);
if (p->t_address != NO_ADDR) { if (p->t_address != NO_ADDR) {
print_position(p->t_address, 1); print_position(p->t_address, 1);
} }
else print_node(p->t_args[0], 0); else print_node(f, p->t_args[0], 0);
if (p->t_args[1]) { if (p->t_args[1]) {
fputs(" if ", db_out); fputs(" if ", f);
print_node(p->t_args[1], 0); print_node(f, p->t_args[1], 0);
} }
p = p->t_args[2]; p = p->t_args[2];
fputs(" { ", db_out); fputs(" { ", f);
while (p && p->t_oper == OP_LINK) { while (p && p->t_oper == OP_LINK) {
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
fputs("; ", db_out); fputs("; ", f);
p = p->t_args[1]; p = p->t_args[1];
} }
print_node(p, 0); print_node(f, p, 0);
fputs(" }", db_out); fputs(" }", f);
break; break;
case OP_STOP: case OP_STOP:
fputs("stop ", db_out); fputs("stop ", f);
if (p->t_address != NO_ADDR) { if (p->t_address != NO_ADDR) {
print_position(p->t_address, 1); print_position(p->t_address, 1);
} }
else print_node(p->t_args[0], 0); else print_node(f, p->t_args[0], 0);
if (p->t_args[1]) { if (p->t_args[1]) {
fputs(" if ", db_out); fputs(" if ", f);
print_node(p->t_args[1], 0); print_node(f, p->t_args[1], 0);
} }
break; break;
case OP_TRACE: case OP_TRACE:
fputs("trace ", db_out); fputs("trace ", f);
if (p->t_args[2]) { if (p->t_args[2]) {
fputs("on ", db_out); fputs("on ", f);
print_node(p->t_args[2], 0); print_node(f, p->t_args[2], 0);
fputs(" ", db_out); fputs(" ", f);
} }
if (p->t_address != NO_ADDR) { if (p->t_address != NO_ADDR) {
print_position(p->t_address, 1); print_position(p->t_address, 1);
} }
else print_node(p->t_args[0], 0); else print_node(f, p->t_args[0], 0);
if (p->t_args[1]) { if (p->t_args[1]) {
fputs(" if ", db_out); fputs(" if ", f);
print_node(p->t_args[1], 0); print_node(f, p->t_args[1], 0);
} }
break; break;
case OP_AT: case OP_AT:
fprintf(db_out, "at \"%s\":%ld", p->t_filename, p->t_lino); fprintf(f, "at \"%s\":%ld", p->t_filename, p->t_lino);
break; break;
case OP_IN: case OP_IN:
fputs("in ", db_out); fputs("in ", f);
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
fputs(" ", db_out); fputs(" ", f);
print_node(p->t_args[1], 0); print_node(f, p->t_args[1], 0);
break; break;
case OP_SELECT: case OP_SELECT:
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
fputs("`", db_out); fputs("`", f);
print_node(p->t_args[1], 0); print_node(f, p->t_args[1], 0);
break;
case OP_OUTPUT:
fprintf(f, "> %s ", p->t_str);
break;
case OP_INPUT:
fprintf(f, "< %s ", p->t_str);
break; break;
case OP_NAME: case OP_NAME:
fputs(p->t_str, db_out); fputs(p->t_str, f);
break; break;
case OP_INTEGER: case OP_INTEGER:
fprintf(db_out, currlang->decint_fmt, p->t_ival); fprintf(f, currlang->decint_fmt, p->t_ival);
break; break;
case OP_STRING: case OP_STRING:
(*currlang->printstring)(p->t_sval, strlen(p->t_sval)); (*currlang->printstring)(f, p->t_sval, strlen(p->t_sval));
break; break;
case OP_REAL: case OP_REAL:
fprintf(db_out, currlang->real_fmt, p->t_fval); fprintf(f, currlang->real_fmt, p->t_fval);
break; break;
case OP_FORMAT: case OP_FORMAT:
print_node(p->t_args[0], 0); print_node(f, p->t_args[0], 0);
fputs("\\", db_out); fputs("\\", f);
print_node(p->t_args[1], 0); print_node(f, p->t_args[1], 0);
break; break;
case OP_UNOP: case OP_UNOP:
case OP_BINOP: case OP_BINOP:
(*currlang->printop)(p); (*currlang->printop)(f, p);
break; break;
default: default:
assert(0); assert(0);
} }
if (top_level) fputs("\n", db_out); if (top_level) fputs("\n", f);
} }
int int
@ -377,6 +416,8 @@ in_status(com)
p_tree com; p_tree com;
{ {
switch(com->t_oper) { switch(com->t_oper) {
case OP_PRCOMM:
/* not really in status but may not be removed */
case OP_STOP: case OP_STOP:
case OP_WHEN: case OP_WHEN:
case OP_TRACE: case OP_TRACE:
@ -408,6 +449,8 @@ newfile(id)
find_language(strrindex(id->id_text, '.')); find_language(strrindex(id->id_text, '.'));
} }
int in_wheninvoked;
perform(p, a) perform(p, a)
register p_tree p; register p_tree p;
t_addr a; t_addr a;
@ -416,6 +459,7 @@ perform(p, a)
case OP_WHEN: case OP_WHEN:
if (p->t_args[1] && ! eval_cond(p->t_args[1])) break; if (p->t_args[1] && ! eval_cond(p->t_args[1])) break;
p = p->t_args[2]; p = p->t_args[2];
in_wheninvoked++;
while (p && p->t_oper == OP_LINK) { while (p && p->t_oper == OP_LINK) {
if (interrupted) return; if (interrupted) return;
if (p->t_args[0]) eval(p->t_args[0]); if (p->t_args[0]) eval(p->t_args[0]);
@ -423,6 +467,7 @@ perform(p, a)
} }
if (interrupted) return; if (interrupted) return;
if (p) eval(p); if (p) eval(p);
in_wheninvoked--;
break; break;
case OP_TRACE: case OP_TRACE:
if (p->t_args[0] && p->t_args[0]->t_oper == OP_IN) { if (p->t_args[0] && p->t_args[0]->t_oper == OP_IN) {