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

Added 'file ?' and shell escape, and some re-organization

Browse source
This commit is contained in:
ceriel 1990-10-29 11:38:35 +00:00
parent 32f21c2bfa
commit 9da96274ae
22 changed files with 1911 additions and 648 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
util/grind/Amakefile
View file

@ -20,13 +20,13 @@ TOKENNAMES = tokenname.c [
]; ];
DBS_LLTARGETS = { DBS_LLTARGETS = {
dbx_string.c[type=C-src], db_symtab.c[type=C-src],
DBSpars.c[type=C-src], DBSpars.c[type=C-src],
DBSpars.h[type=C-incl] DBSpars.h[type=C-incl]
} ; } ;
DBS_LLSRC = { DBS_LLSRC = {
dbx_string.g db_symtab.g
} ; } ;
CMD_LLTARGETS = { CMD_LLTARGETS = {
@ -47,7 +47,6 @@ GENNEXTSRC = {
} ; } ;
CSRC = { CSRC = {
dbxread.c,
main.c, main.c,
list.c, list.c,
tree.c, tree.c,
@ -55,13 +54,12 @@ CSRC = {
position.c, position.c,
idf.c, idf.c,
run.c, run.c,
dump.c,
symbol.c, symbol.c,
print.c, print.c,
value.c, value.c,
type.c, type.c,
rd.c, rd.c,
help.c, do_comm.c,
modula-2.c, modula-2.c,
c.c c.c
} ; } ;

20
util/grind/c.c
View file

@ -106,9 +106,9 @@ static int
print_char(c) print_char(c)
int c; int c;
{ {
fputc('\'', db_out); putc('\'', db_out);
printchar(c, '\''); printchar(c, '\'');
fputc('\'', db_out); putc('\'', db_out);
} }
static int static int
@ -118,9 +118,9 @@ print_string(s, len)
{ {
register char *str = s; register char *str = s;
fputc('"', db_out); putc('"', db_out);
while (*str && len-- > 0) printchar(*str++, '"'); while (*str && len-- > 0) printchar(*str++, '"');
fputc('"', db_out); putc('"', db_out);
} }
extern long int_size; extern long int_size;
@ -471,32 +471,32 @@ print_op(p)
case E_MIN: case E_MIN:
fputs("-(", db_out); fputs("-(", db_out);
print_node(p->t_args[0], 0); print_node(p->t_args[0], 0);
fputc(')', db_out); putc(')', db_out);
break; break;
case E_PLUS: case E_PLUS:
fputs("+(", db_out); fputs("+(", db_out);
print_node(p->t_args[0], 0); print_node(p->t_args[0], 0);
fputc(')', db_out); putc(')', db_out);
break; break;
case E_NOT: case E_NOT:
fputs("!(", db_out); fputs("!(", db_out);
print_node(p->t_args[0], 0); print_node(p->t_args[0], 0);
fputc(')', db_out); putc(')', db_out);
break; break;
case E_DEREF: case E_DEREF:
fputs("*(", db_out); fputs("*(", db_out);
print_node(p->t_args[0], 0); print_node(p->t_args[0], 0);
fputc(')', db_out); putc(')', db_out);
break; break;
case E_BNOT: case E_BNOT:
fputs("~(", db_out); fputs("~(", db_out);
print_node(p->t_args[0], 0); print_node(p->t_args[0], 0);
fputc(')', db_out); putc(')', db_out);
break; break;
case E_ADDR: case E_ADDR:
fputs("&(", db_out); fputs("&(", db_out);
print_node(p->t_args[0], 0); print_node(p->t_args[0], 0);
fputc(')', db_out); putc(')', db_out);
break; break;
} }
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

20
util/grind/class.h
View file

@ -1,26 +1,11 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*
* Author: Ceriel J.H. Jacobs
*/
/* U S E O F C H A R A C T E R C L A S S E S */
/* $Header$ */ /* $Header$ */
/* As a starter, chars are divided into classes, according to which /* As a starter, chars are divided into classes, according to which
token they can be the start of. token they can be the start of.
At present such a class number is supposed to fit in 4 bits.
*/ */
#define class(ch) (tkclass[ch]) #define class(ch) (tkclass[ch])
/* Being the start of a token is, fortunately, a mutual exclusive
property, so, as there are less than 16 classes they can be
packed in 4 bits.
*/
#define STSKIP 0 /* spaces and so on: skipped characters */ #define STSKIP 0 /* spaces and so on: skipped characters */
#define STNL 1 /* newline character(s): update linenumber etc. */ #define STNL 1 /* newline character(s): update linenumber etc. */
#define STGARB 2 /* garbage ascii character: not allowed */ #define STGARB 2 /* garbage ascii character: not allowed */
@ -33,8 +18,9 @@
#define STEOI 9 /* End-Of-Information mark */ #define STEOI 9 /* End-Of-Information mark */
#define STSIMP 10 /* this character can occur as token */ #define STSIMP 10 /* this character can occur as token */
/* But occurring inside a token is not, so we need 1 bit for each /* But occurring inside a token is not an exclusive property,
class. This is implemented as a collection of tables to speed up so we need 1 bit for each class.
This is implemented as a collection of tables to speed up
the decision whether a character has a special meaning. the decision whether a character has a special meaning.
*/ */
#define in_idf(ch) ((unsigned)ch < 0177 && inidf[ch]) #define in_idf(ch) ((unsigned)ch < 0177 && inidf[ch])

88
util/grind/commands.g
View file

@ -108,6 +108,7 @@ command_line(p_tree *p;)
| FIND qualified_name(p){ *p = mknode(OP_FIND, *p); } | FIND qualified_name(p){ *p = mknode(OP_FIND, *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(); }
| |
] ]
; ;
@ -127,7 +128,7 @@ list_command(p_tree *p;)
: :
LIST LIST
[ [
| count(&t1) | position(&t1)
| qualified_name(&t1) | qualified_name(&t1)
] ]
[ ',' count(&t2) [ ',' count(&t2)
@ -201,7 +202,7 @@ continue_command(p_tree *p;)
[ INTEGER { l = tok.ival; } [ INTEGER { l = tok.ival; }
| { l = 1; } | { l = 1; }
] ]
position(&pos)? [ AT position(&pos) ]?
{ *p = mknode(OP_CONT, mknode(OP_INTEGER, l), pos); } { *p = mknode(OP_CONT, mknode(OP_INTEGER, l), pos); }
; ;
@ -332,9 +333,9 @@ condition(p_tree *p;)
where(p_tree *p;) where(p_tree *p;)
: :
IN qualified_name(p) { *p = mknode(OP_IN, *p, (p_tree) 0); } IN qualified_name(p) { *p = mknode(OP_IN, *p, (p_tree) 0); }
position(&((*p)->t_args[1]))? [ AT position(&((*p)->t_args[1])) ]?
| |
position(p) AT position(p)
; ;
expression(p_tree *p; int level;) expression(p_tree *p; int level;)
@ -404,7 +405,6 @@ position(p_tree *p;)
char *str; char *str;
} }
: :
AT
[ STRING { str = tok.str; } [ STRING { str = tok.str; }
':' ':'
| { if (! listfile) str = 0; | { if (! listfile) str = 0;
@ -597,4 +597,82 @@ init_del()
{ {
signal(SIGINT, catch_del); signal(SIGINT, catch_del);
} }
static int
ctch()
{
/* Only for shell escapes ... */
signal(SIGINT, ctch);
}
#define SHBUFSIZ 512
int
shellescape()
{
register char *p; /* walks through command */
static char previous[SHBUFSIZ]; /* previous command */
char comm[SHBUFSIZ]; /* space for command */
register int cnt; /* prevent array bound errors */
register int c; /* current char */
register int lastc = 0; /* will contain the previous char */
p = comm;
cnt = SHBUFSIZ-2;
while (c = getc(db_in), c != '\n') {
switch(c) {
case '!':
/*
* An unescaped ! expands to the previous
* command, but disappears if there is none
*/
if (lastc != '\\') {
if (*previous) {
int len = strlen(previous);
if ((cnt -= len) <= 0) break;
strcpy(p,previous);
p += len;
}
}
else {
*p++ = c;
}
continue;
case '%':
/*
* An unescaped % will expand to the current
* filename, but disappears is there is none
*/
if (lastc != '\\') {
if (listfile) {
int len = strlen(listfile->sy_idf->id_text);
if ((cnt -= len) <= 0) break;
strcpy(p,listfile->sy_idf->id_text);
p += len;
}
}
else {
*p++ = c;
}
continue;
default:
lastc = c;
if (cnt-- <= 0) break;
*p++ = c;
continue;
}
break;
}
*p = '\0';
if (c != '\n') {
warning("shell command too long");
while (c != '\n') c = getc(db_in);
}
ungetc(c, db_in);
strcpy(previous, comm);
signal(SIGINT, ctch);
cnt = system(comm);
signal(SIGINT, catch_del);
return cnt;
}
} }

889
util/grind/db_symtab.g Normal file
View file

@ -0,0 +1,889 @@
/* $Header$ */
/* Symbol table reader
*/
{
#include <alloc.h>
#include <stb.h>
#include <assert.h>
#include "position.h"
#include "file.h"
#include "type.h"
#include "symbol.h"
#include "scope.h"
#include "class.h"
#include "idf.h"
#include "rd.h"
extern char *strindex();
extern long str2long();
extern double atof();
extern long pointer_size;
static char *DbPtr; /* current pointer in DBX string */
static int AllowName; /* set if NAME legal at this point */
static long ival;
static double fval;
static char *strval;
static int last_index[2];
static struct outname *currnam;
static int saw_code;
static struct literal *get_literal_space();
static struct fields *get_field_space();
static end_field();
static char *string_val();
}
%start DbParser, debugger_string;
%prefix DBS;
%lexical DBSlex;
%onerror DBSonerror;
%token INTEGER, REAL, STRING, NAME;
debugger_string
{ register p_symbol s;
char *str;
p_type tmp = 0;
}
:
name(&str)
[ /* constant name */
{ s = NewSymbol(str, CurrentScope, CONST, currnam); }
'c' const_name(s)
| /* type name */
{ s = NewSymbol(str, CurrentScope, TYPE, currnam); }
't' type_name(&(s->sy_type), s)
{ if (! s->sy_type->ty_sym) s->sy_type->ty_sym = s;
if ((s->sy_type->ty_class == T_ENUM ||
s->sy_type->ty_class == T_SUBRANGE) &&
currnam->on_desc != 0) {
s->sy_type->ty_size = currnam->on_desc;
}
}
| /* tag name (only C?) */
{ s = NewSymbol(str, CurrentScope, TAG, currnam); }
'T' type_name(&(s->sy_type), s)
{ if (! s->sy_type->ty_sym) s->sy_type->ty_sym = s;
if (s->sy_type->ty_class != T_CROSS) {
resolve_cross(s->sy_type);
}
}
| /* end scope */
'E' INTEGER
{ close_scope(); }
| /* module begin */
{ s = NewSymbol(str, CurrentScope, MODULE, currnam); }
'M' INTEGER
{ open_scope(s, 1);
s->sy_name.nm_scope = CurrentScope;
CurrentScope->sc_start = currnam->on_valu;
CurrentScope->sc_proclevel = currnam->on_desc;
add_scope_addr(CurrentScope);
}
| /* external procedure */
{ s = NewSymbol(str, FileScope, PROC, currnam); }
'P' routine(s)
| /* private procedure */
{ s = NewSymbol(str, CurrentScope, PROC, currnam); }
'Q' routine(s)
| /* external function */
{ s = NewSymbol(str, FileScope, FUNCTION, currnam); }
'F' function(s)
| /* private function */
{ s = NewSymbol(str, CurrentScope, FUNCTION, currnam); }
'f' function(s)
| /* global variable, external */
/* maybe we already know it; but we need
the type information anyway for other
types.
*/
{ s = Lookup(findidf(str), FileScope, VAR);
if (s) {
tmp = s->sy_type;
s->sy_type = 0;
} else s = NewSymbol(str, FileScope, VAR, currnam);
}
'G' type(&(s->sy_type), (int *) 0, s)
{ if (tmp) s->sy_type = tmp; }
| /* static variable */
{ s = NewSymbol(str, CurrentScope, VAR, currnam); }
'S' type(&(s->sy_type), (int *) 0, s)
| /* static variable, local scope */
{ s = NewSymbol(str, CurrentScope, VAR, currnam); }
'V' type(&(s->sy_type), (int *) 0, s)
| /* register variable */
{ s = NewSymbol(str, CurrentScope, REGVAR, currnam); }
'r' type(&(s->sy_type), (int *) 0, s)
| /* value parameter */
{ s = NewSymbol(str, CurrentScope, LOCVAR, currnam); }
'p' type(&(s->sy_type), (int *) 0, s)
{ add_param_type('p', s); }
| /* value parameter but address passed */
{ s = NewSymbol(str, CurrentScope, VARPAR, currnam); }
'i' type(&(s->sy_type), (int *) 0, s)
{ add_param_type('i', s); }
| /* variable parameter */
{ s = NewSymbol(str, CurrentScope, VARPAR, currnam); }
'v' type(&(s->sy_type), (int *) 0, s)
{ add_param_type('v', s); }
| /* local variable */
{ s = NewSymbol(str, CurrentScope, LOCVAR, currnam); }
type_name(&(s->sy_type), s)
| /* function result in Pascal; ignore ??? */
{ s = NewSymbol(str, CurrentScope, LOCVAR, currnam); }
'X' type_name(&(s->sy_type), s)
]
';'?
;
name(char **s;)
:
/* anything up to a ':' */
NAME { *s = strval; }
;
const_name(p_symbol cst;)
{ int type_index[2];
long iconst;
register char *p;
}
:
'='
[
/*
'b' integer_const(&(cst->sy_const.co_ival)) /* boolean */
/* |
*/
'c' integer_const(&(cst->sy_const.co_ival)) /* character */
{ cst->sy_type = char_type; }
|
'i' integer_const(&(cst->sy_const.co_ival)) /* integer */
{ cst->sy_type = long_type; }
|
'r' real_const(&(cst->sy_const.co_rval)) /* real */
{ cst->sy_type = double_type; }
|
's' string_const /* string */
{ cst->sy_const.co_sval = string_val(strval);
cst->sy_type = string_type;
}
|
'e' type_index(type_index) ',' integer_const(&(cst->sy_const.co_ival))
/* enumeration constant;
* enumeration type, value
*/
{ cst->sy_type = *tp_lookup(type_index); }
|
'S' type_index(type_index)
{ cst->sy_type = *tp_lookup(type_index);
cst->sy_const.co_setval = p =
Malloc((unsigned) cst->sy_type->ty_size);
}
[ ',' integer_const(&iconst)
{ *p++ = iconst; }
]+
/* set constant:
* settype, values of the bytes
* in the set.
*/
]
;
integer_const(long *iconst;)
{ int sign = 0; }
:
[ '+' | '-' { sign = 1; } ]?
INTEGER { *iconst = sign ? -ival : ival; }
;
real_const(double *f;)
{ int sign = 0; }
:
[ '+' | '-' { sign = 1; } ]?
REAL { *f = sign ? fval : -fval; }
;
string_const
:
STRING /* has SINGLE quotes! */
;
type_name(p_type *t; p_symbol sy;)
{ int type_index[2]; p_type *p; }
:
type_index(type_index) { p = tp_lookup(type_index); }
[
{ if (*p && (*p)->ty_class != 0 &&
(*p)->ty_class != T_CROSS) {
error("Redefining (%d,%d) %d",
type_index[0],
type_index[1],
(*p)->ty_class);
}
}
'='
type(p, type_index, sy)
|
]
{ if (*p == 0) *p = new_type();
*t = *p;
}
;
type_index(int *type_index;)
:
[
INTEGER { type_index[0] = 0; type_index[1] = ival; }
|
'(' INTEGER { type_index[0] = ival; }
',' INTEGER { type_index[1] = ival; }
')'
]
{ last_index[0] = type_index[0];
last_index[1] = type_index[1];
}
;
function(p_symbol p;)
:
{ p->sy_type = new_type();
p->sy_type->ty_class = T_PROCEDURE;
p->sy_type->ty_size = pointer_size;
}
type(&(p->sy_type->ty_retval), (int *) 0, (p_symbol) 0)
{ if (CurrentScope != FileScope &&
saw_code) {
/* if saw_code is not set, it is a nested
procedure
*/
close_scope();
}
saw_code = 0;
open_scope(p, 1);
p->sy_name.nm_scope = CurrentScope;
CurrentScope->sc_start = currnam->on_valu;
add_scope_addr(CurrentScope);
CurrentScope->sc_proclevel = currnam->on_desc;
}
;
routine(p_symbol p;)
:
{ p->sy_type = new_type();
p->sy_type->ty_class = T_PROCEDURE;
p->sy_type->ty_size = pointer_size;
if (CurrentScope != FileScope &&
saw_code) {
/* if saw_code is not set, it is a nested
procedure
*/
close_scope();
}
saw_code = 0;
open_scope(p, 1);
p->sy_name.nm_scope = CurrentScope;
CurrentScope->sc_start = currnam->on_valu;
add_scope_addr(CurrentScope);
CurrentScope->sc_proclevel = currnam->on_desc;
}
INTEGER ';'
type(&(p->sy_type->ty_retval), (int *) 0, (p_symbol) 0)
;
type(p_type *ptp; int *type_index; p_symbol sy;)
{ register p_type tp = *ptp ? *ptp : new_type();
p_type t1 = 0, t2 = 0;
long ic1, ic2;
int A_used = 0;
int tclass;
int tp_index[2];
char *str;
}
:
[
/* type cross reference */
/* these are used in C for references to a struct, union or
* enum that has not been declared (yet)
*/
'x'
[ 's' /* struct */
{ tclass = T_STRUCT; }
| 'u' /* union */
{ tclass = T_UNION; }
| 'e' /* enum */
{ tclass = T_ENUM; }
]
{ AllowName = 1; }
name(&str)
{ sy = Lookfromscope(str2idf(str,0),TAG,CurrentScope);
if (sy &&
(sy->sy_type->ty_class == tclass ||
sy->sy_type->ty_class == T_CROSS)) {
if (tp != *ptp) free_type(tp);
tp = sy->sy_type;
}
else {
tp->ty_class = T_CROSS;
tp->ty_size = tclass;
sy = NewSymbol(str, CurrentScope, TAG, (struct outname *) 0);
sy->sy_type = tp;
}
}
|
/* subrange */
/* the integer_const's represent the lower and the upper bound.
* A subrange type defined as subrange of itself is an integer type.
* If the second integer_const == 0, but the first is not, we
* have a floating point type with size equal to the first
* integer_const.
* Upperbound -1 means unsigned int or unsigned long.
*/
'r' type_index(tp_index) ';'
[ 'A' integer_const(&ic1) { A_used = 1; }
| integer_const(&ic1)
]
';'
[ 'A' integer_const(&ic2) { A_used |= 2; }
| integer_const(&ic2)
]
{ if (tp != *ptp) free_type(tp);
tp = subrange_type(A_used,
tp_index,
ic1,
ic2,
type_index);
}
|
/* array; first type is bound type, next type
* is element type
*/
'a' type(&t1, (int *) 0, (p_symbol) 0) ';' type(&t2, (int *) 0, (p_symbol) 0)
{ if (tp != *ptp) free_type(tp);
tp = array_type(t1, t2);
}
|
/* structure type */
's' { tp->ty_class = T_STRUCT; }
structure_type(tp, sy)
|
/* union type */
'u' { tp->ty_class = T_UNION; }
structure_type(tp, sy)
|
/* enumeration type */
'e' { tp->ty_class = T_ENUM; }
enum_type(tp)
|
/* pointer type */
'*' { tp->ty_class = T_POINTER;
tp->ty_size = pointer_size;
}
type(&(tp->ty_ptrto), (int *) 0, (p_symbol) 0)
|
/* function type */
'f' { tp->ty_class = T_PROCEDURE;
tp->ty_size = pointer_size;
}
type(&(tp->ty_retval), (int *) 0, (p_symbol) 0)
/*
[ %prefer
',' param_list(tp)
|
]
*/
|
/* procedure type */
'Q' { tp->ty_class = T_PROCEDURE;
tp->ty_size = pointer_size;
}
type(&(tp->ty_retval), (int *) 0, (p_symbol) 0)
',' param_list(tp)
|
/* another procedure type */
'p' { tp->ty_class = T_PROCEDURE;
tp->ty_size = pointer_size;
tp->ty_retval = void_type;
}
param_list(tp)
|
/* set type */
/* the first integer_const represents the size in bytes,
* the second one represents the low bound
*/
'S' { tp->ty_class = T_SET; }
type(&(tp->ty_setbase), (int *) 0, (p_symbol) 0) ';'
[
integer_const(&(tp->ty_size)) ';'
integer_const(&(tp->ty_setlow)) ';'
|
{ set_bounds(tp); }
]
|
/* file type of Pascal */
'L' { tp->ty_class = T_FILE; }
type(&(tp->ty_fileof), (int *) 0, (p_symbol) 0)
|
type_name(ptp, (p_symbol) 0)
{ if (type_index &&
(*ptp)->ty_class == 0 &&
type_index[0] == last_index[0] &&
type_index[1] == last_index[1]) {
**ptp = *void_type;
if (*ptp != tp) free_type(tp);
}
tp = *ptp;
}
]
{ if (*ptp && *ptp != tp) **ptp = *tp;
else *ptp = tp;
}
;
structure_type(register p_type tp; p_symbol sy;)
{ register struct fields *fldp;
char *str;
}
:
integer_const(&(tp->ty_size)) /* size in bytes */
{ open_scope(sy, 0);
if (sy) sy->sy_name.nm_scope = CurrentScope;
}
[
name(&str) { fldp = get_field_space(tp, str); }
type(&(fldp->fld_type), (int *) 0, (p_symbol) 0) ','
integer_const(&(fldp->fld_pos)) ',' /* offset in bits */
integer_const(&(fldp->fld_bitsize)) ';' /* size in bits */
]*
';' { end_field(tp);
close_scope();
}
;
enum_type(register p_type tp;)
{ register struct literal *litp;
long maxval = 0;
register p_symbol s;
}
:
[ { litp = get_literal_space(tp); }
name(&(litp->lit_name))
integer_const(&(litp->lit_val)) ','
{ if (maxval < litp->lit_val) maxval = litp->lit_val;
AllowName = 1;
s = NewSymbol(litp->lit_name, CurrentScope, CONST, (struct outname *) 0);
s->sy_const.co_ival = litp->lit_val;
s->sy_type = tp;
}
]*
';' { end_literal(tp, maxval); }
;
param_list(p_type t;)
{ register struct param *p;
long iconst;
}
:
integer_const(&iconst) ';' /* number of parameters */
{ t->ty_nparams = iconst;
t->ty_params = p = (struct param *)
Malloc((unsigned)(t->ty_nparams * sizeof(struct param)));
}
[
[ 'p' { p->par_kind = 'p'; }
| 'v' { p->par_kind = 'v'; }
| 'i' { p->par_kind = 'i'; }
]
type(&(p->par_type), (int *) 0, (p_symbol) 0) ';'
{ t->ty_nbparams +=
param_size(p->par_type, p->par_kind);
p++;
}
]*
;
{
static char *db_string;
static char *DbOldPtr;
static struct outname *
DbString(n)
struct outname *n;
{
currnam = n;
DbPtr = n->on_mptr;
db_string = DbPtr;
AllowName = 1;
DbParser();
return currnam;
}
/*ARGSUSED*/
DBSmessage(n)
{
fatal("error in symbol table string \"%s\", DbPtr = \"%s\", DbOldPtr = \"%s\"",
db_string,
DbPtr,
DbOldPtr);
}
DBSonerror(tk, p)
int *p;
{
DbPtr = DbOldPtr;
/* ??? if (DBSsymb < 0) {
while (*p && *p != ';') p++;
if (*p) DbPtr = ";";
return;
}
*/
if (! tk) {
while (*p && *p != NAME) p++;
if (*p) {
AllowName = 1;
}
}
else if (tk == NAME) AllowName = 1;
}
DBSlex()
{
register char *cp = DbPtr;
int allow_name = AllowName;
register int c;
AllowName = 0;
DbOldPtr = cp;
c = *cp;
if (c == '\\' && *(cp+1) == '\0') {
currnam++;
cp = currnam->on_mptr;
DbOldPtr = cp;
c = *cp;
}
if (! c) {
DbPtr = cp;
return -1;
}
if ((! allow_name && is_token(c)) || c == ';') {
DbPtr = cp+1;
return c;
}
if (is_dig(c)) {
int retval = INTEGER;
while (++cp, is_dig(*cp)) /* nothing */;
c = *cp;
if (c == '.') {
retval = REAL;
while (++cp, is_dig(*cp)) /* nothing */;
c = *cp;
}
if (c == 'e' || c == 'E') {
char *oldcp = cp;
cp++;
c = *cp;
if (c == '-' || c == '+') {
cp++;
c = *cp;
}
if (is_dig(c)) {
retval = REAL;
while (++cp, is_dig(*cp)) /* nothing */;
}
else cp = oldcp;
}
c = *cp;
*cp = 0;
if (retval == INTEGER) {
ival = str2long(DbOldPtr, 10);
}
else {
fval = atof(DbOldPtr);
}
*cp = c;
DbPtr = cp;
return retval;
}
if (c == '\'') {
cp++;
strval = cp;
while ((c = *cp) && c != '\'') {
if (c == '\\') cp++; /* backslash escapes next character */
if (!(c = *cp)) break; /* but not a null byte */
cp++;
}
if (! c) DBSmessage(0); /* no return */
*cp = 0;
DbPtr = cp + 1;
return STRING;
}
strval = cp;
while ((c = *cp) && c != ':' && c != ',') cp++;
DbPtr = *cp ? cp+1 : cp;
*cp = 0;
return NAME;
}
static struct fields *
get_field_space(tp, s)
register p_type tp;
char *s;
{
register struct fields *p;
p_symbol sy;
if (! (tp->ty_nfields & 07)) {
tp->ty_fields = (struct fields *)
Realloc((char *) tp->ty_fields,
(tp->ty_nfields+8)*sizeof(struct fields));
}
p = &tp->ty_fields[tp->ty_nfields++];
p->fld_name = s;
p->fld_type = 0;
sy = NewSymbol(s, CurrentScope, FIELD, currnam);
sy->sy_field = p;
return p;
}
static
end_field(tp)
register p_type tp;
{
tp->ty_fields = (struct fields *)
Realloc((char *) tp->ty_fields,
tp->ty_nfields * sizeof(struct fields));
}
static struct literal *
get_literal_space(tp)
register p_type tp;
{
if (! (tp->ty_nenums & 07)) {
tp->ty_literals = (struct literal *)
Realloc((char *) tp->ty_literals,
(tp->ty_nenums+8)*sizeof(struct literal));
}
return &tp->ty_literals[tp->ty_nenums++];
}
static char *
string_val(s)
char *s;
{
register char *ns = s, *os = s;
register unsigned int i = 1;
for (;;) {
if (!*os) break;
i++;
if (*os == '\\') {
os++;
*ns++ = *os++;
}
else *ns++ = *os++;
}
*ns = '\0';
return Salloc(s, i);
}
static char *AckStrings; /* ACK a.out string table */
static struct outname *AckNames; /* ACK a.out symbol table entries */
static unsigned int NAckNames; /* Number of ACK symbol table entries */
static struct outname *EndAckNames; /* &AckNames[NAckNames] */
/* Read the symbol table from file 'f', which is supposed to be an
ACK a.out format file. Offer DBX strings to the DBX string parser.
*/
int
DbRead(f)
char *f;
{
struct outhead h;
register struct outname *n;
register struct outname *line_file = 0;
long OffsetStrings;
int had_lbrac = 0;
/* Open file, read header, and check magic word */
if (! rd_open(f)) {
fatal("%s: could not open", f);
}
rd_ohead(&h);
if (BADMAGIC(h) && h.oh_magic != O_CONVERTED) {
fatal("%s: not an object file", f);
}
/* Allocate space for name table and read it */
AckNames = (struct outname *)
Malloc((unsigned)(sizeof(struct outname) * h.oh_nname));
AckStrings = Malloc((unsigned) h.oh_nchar);
rd_name(AckNames, h.oh_nname);
rd_string(AckStrings, h.oh_nchar);
/* Adjust file offsets in name table to point at strings */
OffsetStrings = OFF_CHAR(h);
NAckNames = h.oh_nname;
EndAckNames = &AckNames[h.oh_nname];
for (n = EndAckNames; --n >= AckNames;) {
if (n->on_foff) {
if ((unsigned)(n->on_foff - OffsetStrings) >= h.oh_nchar) {
fatal("%s: error in object file", f);
}
n->on_mptr = AckStrings + (n->on_foff - OffsetStrings);
}
else n->on_mptr = 0;
}
/* Offer strings to the DBX string parser if they contain a ':'.
Also offer filename-line number information to add_position_addr().
Here, the order may be important.
*/
for (n = &AckNames[0]; n < EndAckNames; n++) {
int tp = n->on_type >> 8;
register p_symbol sym;
if (tp & (S_STB >> 8)) {
switch(tp) {
#ifdef N_BINCL
case N_BINCL:
n->on_valu = (long) line_file;
line_file = n;
break;
case N_EINCL:
if (line_file) {
line_file = (struct outname *) line_file->on_valu;
}
break;
#endif
case N_SO:
if (n->on_mptr[strlen(n->on_mptr)-1] == '/') {
/* another N_SO follows ... */
break;
}
while (CurrentScope != PervasiveScope) {
close_scope();
}
saw_code = 0;
sym = add_file(n->on_mptr);
if (! listfile) newfile(sym->sy_idf);
open_scope(sym, 0);
sym->sy_file->f_scope = CurrentScope;
FileScope = CurrentScope;
clean_tp_tab();
/* fall through */
case N_SOL:
if (! line_file) line_file = n;
else line_file->on_mptr = n->on_mptr;
break;
case N_MAIN:
newfile(FileScope->sc_definedby->sy_idf);
break;
case N_SLINE:
assert(line_file);
if (! saw_code && !CurrentScope->sc_bp_opp) {
CurrentScope->sc_bp_opp = n->on_valu;
if (! CurrentScope->sc_start) {
CurrentScope->sc_start = n->on_valu;
if (CurrentScope->sc_has_activation_record) {
add_scope_addr(CurrentScope);
}
}
}
saw_code = 1;
add_position_addr(line_file->on_mptr, n);
break;
case N_LBRAC: /* block, desc = nesting level */
if (had_lbrac) {
open_scope((p_symbol) 0, 0);
saw_code = 0;
}
else {
register p_scope sc =
get_scope_from_addr(n->on_valu);
if (!sc || sc->sc_bp_opp) {
had_lbrac = 1;
}
else CurrentScope = sc;
}
break;
#ifdef N_SCOPE
case N_SCOPE:
if (n->on_mptr && strindex(n->on_mptr, ':')) {
n = DbString(n);
}
break;
#endif
case N_RBRAC: /* end block, desc = nesting level */
had_lbrac = 0;
if (CurrentScope != FileScope) close_scope();
saw_code = 0;
break;
case N_FUN: /* function, value = address */
case N_GSYM: /* global variable */
case N_STSYM: /* data, static, value = address */
case N_LCSYM: /* bss, static, value = address */
case N_RSYM: /* register var, value = reg number */
case N_SSYM: /* struct/union el, value = offset */
case N_PSYM: /* parameter, value = offset from AP */
case N_LSYM: /* local sym, value = offset from FP */
if (had_lbrac) {
open_scope((p_symbol) 0, 0);
saw_code = 0;
had_lbrac = 0;
}
if (n->on_mptr && strindex(n->on_mptr, ':')) {
n = DbString(n);
}
break;
default:
/*
if (n->on_mptr && (n->on_type&S_TYP) >= S_MIN) {
struct idf *id = str2idf(n->on_mptr, 0);
sym = new_symbol();
sym->sy_next = id->id_def;
id->id_def = sym;
sym->sy_class = SYMENTRY;
sym->sy_onam = *n;
sym->sy_idf = id;
}
*/
break;
}
}
}
close_scope();
add_position_addr((char *) 0, (struct outname *) 0);
clean_tp_tab();
rd_close();
return (h.oh_magic == O_CONVERTED);
}
}

776
util/grind/do_comm.c Normal file
View file

@ -0,0 +1,776 @@
/* $Header$ */
/* Implementation of the do_ routines */
#include <stdio.h>
#include <assert.h>
#include <alloc.h>
#include "operator.h"
#include "position.h"
#include "tree.h"
#include "idf.h"
#include "Lpars.h"
#include "type.h"
#include "expr.h"
#include "symbol.h"
#include "scope.h"
#include "file.h"
#include "message.h"
extern FILE *db_out;
extern t_lineno listline, currline;
extern int stop_reason;
extern int interrupted;
p_tree print_command;
/* ------------------------------------------------------------- */
/* implementation of the help command */
do_help(p)
p_tree p;
{
p = p->t_args[0];
if (p && p->t_idf) switch(p->t_idf->id_reserved) {
case HELP:
fputs("help [ <commandname> ]\n", db_out);
fputs("? [ <commandname> ]\n", db_out);
fputs(" Print a command summary, or some more help on <commandname>.\n", db_out);
return;
case LIST:
fputs("list [ <start> | <func> ] [ , <cnt> | - [ <end> ] ]\n", db_out);
fputs("l [ <start> | <func> ] [ , <cnt> | - [ <end> ] ]\n", db_out);
fputs(" List lines from the current source file, starting with either\n", db_out);
fputs(" line <start> or some lines before the first statement of <func> or\n", db_out);
fputs(" the current line. Either list <cnt> lines or <wsize> lines,\n", db_out);
fputs(" except when a range is given.\n", db_out);
fputs(" <wsize> is the last <cnt> given, or 10.\n", db_out);
return;
case XFILE:
fputs("file [ <name> ]\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);
return;
case RUN:
fputs("run [ <args> ] [ < <infile> ] [ > <outfile> ]\n", db_out);
fputs(" Start executing debuggee with command line arguments <args> and\n", db_out);
fputs(" possible redirection of standard input and/or standard output.\n", db_out);
return;
case RERUN:
fputs("rerun\n", db_out);
fputs(" repeats the last run command.\n", db_out);
return;
case STOP:
fputs("stop [ <pos> ] [ if <cond> ]\n", db_out);
fputs(" Stop execution when position <pos> is reached, and then when\n", db_out);
fputs(" <cond> becomes true. If no <pos> is given, stop when <cond>\n", db_out);
fputs(" becomes true. If no <cond> is given, stop when <pos> is reached.\n", db_out);
fputs(" Either a position or a condition (or both) must be given.\n", db_out);
return;
case WHEN:
fputs("when [ <pos> ] [ if <cond> ] { <command> [ ; <command> ] ... } \n", db_out);
fputs(" Execute the <command>s when position <pos> is reached, and then when\n", db_out);
fputs(" <cond> becomes true. If no <pos> is given, do this when <cond>\n", db_out);
fputs(" becomes true. If no <cond> is given, do this when <pos> is reached.\n", db_out);
fputs(" Either a position or a condition (or both) must be given.\n", db_out);
return;
case CONT:
fputs("cont [ <cnt> ] [ at <line> ]\n", db_out);
fputs("c [ <cnt> ] [ at <line> ]\n", db_out);
fputs(" Continue execution, skipping <cnt> or 1 breakpoints;a\n", db_out);
fputs(" if <line> is given, continue at <line>.\n", db_out);
return;
case STEP:
case NEXT:
fputs("step [ <cnt> ]\n", db_out);
fputs("s [ <cnt> ]\n", db_out);
fputs("next [ <cnt> ]\n", db_out);
fputs("n [ <cnt> ]\n", db_out);
fputs(" Execute the next <cnt> or 1 source line(s).\n", db_out);
fputs(" Step (s) steps into function-calls.\n", db_out);
fputs(" Next (n) steps past function-calls.\n", db_out);
return;
case WHERE:
fputs("where [ <cnt> ]\n", db_out);
fputs("w [ <cnt> ]\n", db_out);
fputs(" List all, or the top <cnt> or the bottom -<cnt> active functions.\n", db_out);
return;
case STATUS:
fputs("status\n", db_out);
fputs(" display active traces, stops, whens, displays, and dumps.\n", db_out);
return;
case DELETE:
fputs("delete [ <num> [ , <num> ] ... ]\n", db_out);
fputs("d [ <num> [ , <num> ] ...] \n", db_out);
fputs(" Remove the command(s) corresponding to <num> (as displayed by 'status').\n", db_out);
fputs(" If no <num> is given, remove the current stopping point.\n", db_out);
return;
case SET:
fputs("set <desig> to <exp>\n", db_out);
fputs(" Assign the value of <exp> to <desig>.\n", db_out);
return;
case PRINT:
fputs("print <exp> [ , <exp> ] ...\n", db_out);
fputs("p <exp> [ , <exp> ] ...\n", db_out);
fputs(" Print the value of each <exp>.\n", db_out);
return;
case DISPLAY:
fputs("display <exp> [ , <exp> ] ...\n", db_out);
fputs(" Print the value of each <exp> whenever the debuggee stops.\n", db_out);
return;
case DUMP:
fputs("dump\n", db_out);
fputs(" Saves the state of the debuggee; it can be restored with the restore command.\n", db_out);
return;
case RESTORE:
fputs("restore [ <num> ]\n", db_out);
fputs("r [ <num> ]\n", db_out);
fputs(" Restore the state of the dump associated with <num>,\n", db_out);
fputs(" or restore the state of the last dump.\n", db_out);
return;
case TRACE:
fputs("trace [ on <exp> ] [ <pos> ] [ if <cond> ]\n", db_out);
fputs("t [ on <exp> ] [ <pos> ] [ if <cond> ]\n", db_out);
fputs(" Without args, display each source line before execution.\n", db_out);
fputs(" In addition, display <exp> in the on-clause.\n", db_out);
fputs(" If <pos> is given and indicates a function, only display\n", db_out);
fputs(" tracing information while executing this function.\n", db_out);
fputs(" If it indicates a line number, only display tracing information\n", db_out);
fputs(" whenever the source line is reached.\n", db_out);
fputs(" If <cond> is given, only display tracing info when it evaluates to non-zero.\n", db_out);
return;
case FIND:
fputs("find <name>\n", db_out);
fputs(" Prints the fully qualified name of all symbols matching <name>.\n", db_out);
return;
case WHICH:
fputs("which <name>\n", db_out);
fputs(" Prints the fully qualified name of <name>.\n", db_out);
return;
case DISABLE:
fputs("disable [ <num> [ , <num> ] ... ]\n", db_out);
fputs(" Disable the command(s) corresponding to <num> (as displayed by 'status').\n", db_out);
fputs(" If no <num> is given, disable the current stopping point.\n", db_out);
return;
case ENABLE:
fputs("enable [ <num> [ , <num> ] ... ]\n", db_out);
fputs(" Enable the command(s) corresponding to <num> (as displayed by 'status'.)\n", db_out);
fputs(" If no <num> is given, enable the current stopping point (not effective).\n", db_out);
return;
}
fputs("cont [ <cnt> ] [ at <line> ]\n", db_out);
fputs("delete [ <num> [ , <num> ] ... ]\n", db_out);
fputs("disable [ <num> [ , <num> ] ... ]\n", db_out);
fputs("display <exp> [ , <exp> ] ...\n", db_out);
fputs("dump\n", db_out);
fputs("enable [ <num> [ , <num> ] ... ]\n", db_out);
fputs("file [ <name> ]\n", db_out);
fputs("find <name>\n", db_out);
fputs("help [ <commandname> ]\n", db_out);
fputs("list [ <start> | <func> ] [ , <cnt> | - [ <end> ] ]\n", db_out);
fputs("next [ <cnt> ]\n", db_out);
fputs("print <exp> [ , <exp> ] ...\n", db_out);
fputs("rerun\n", db_out);
fputs("restore <num>\n", db_out);
fputs("run [ <args> ] [ < <infile> ] [ > <outfile> ]\n", db_out);
fputs("set <desig> to <exp>\n", db_out);
fputs("status\n", db_out);
fputs("step [ <cnt> ]\n", db_out);
fputs("stop [ <pos> ] [ if <cond> ]\n", db_out);
fputs("trace [ on <exp> ] [ <pos> ] [ if <cond> ]\n", db_out);
fputs("when [ <pos> ] [ if <cond> ] { <command> [ ; <command> ] ... } \n", db_out);
fputs("where [ <cnt> ]\n", db_out);
fputs("which <name>\n", db_out);
}
/* ------------------------------------------------------------- */
/* implementation of dump/restore commands */
extern long pointer_size;
extern p_tree get_from_item_list();
struct dump {
char *globals, *stack;
struct message_hdr mglobal, mstack;
struct dump *next;
};
static struct dump *last_dump;
do_dump(p)
p_tree p;
{
struct dump *d = (struct dump *) malloc(sizeof(struct dump));
if (! d) {
error("could not allocate enough memory");
return;
}
if (! get_dump(&d->mglobal, &d->globals, &d->mstack, &d->stack)) {
free((char *) d);
return;
}
p->t_args[0] = (struct tree *) d;
p->t_address = (t_addr) get_int(d->mglobal.m_buf+PC_OFF*pointer_size, pointer_size, T_UNSIGNED);
add_to_item_list(p);
d->next = last_dump;
last_dump = d;
}
do_restore(p)
p_tree p;
{
struct dump *d;
if (p->t_args[0]) {
p = get_from_item_list((int) p->t_args[0]->t_ival);
if (!p || p->t_oper != OP_DUMP) {
error("no such dump");
return;
}
d = (struct dump *) p->t_args[0];
}
else d = last_dump;
if (! d) {
error("no dumps");
return;
}
if (! put_dump(&d->mglobal, d->globals, &d->mstack, d->stack)) {
}
perform_items();
}
free_dump(p)
p_tree p;
{
struct dump *d = (struct dump *) p->t_args[0];
free(d->globals);
free(d->stack);
if (d == last_dump) last_dump = d->next;
else {
register struct dump *d1 = last_dump;
while (d1->next != d) d1 = d1->next;
d1->next = d->next;
}
free((char *) d);
}
/* ------------------------------------------------------------- */
/* implementation of the find command */
do_find(p)
p_tree p;
{
/* Print all identifications of p->t_args[0]. */
register p_symbol s;
p_tree arg;
p = p->t_args[0];
switch(p->t_oper) {
case OP_NAME:
s = p->t_idf->id_def;
while (s) {
pr_sym(s);
s = s->sy_next;
}
break;
case OP_SELECT:
arg = p->t_args[1];
assert(arg->t_oper == OP_NAME);
s = arg->t_idf->id_def;
while (s) {
if (consistent(p, s->sy_scope)) {
pr_sym(s);
}
s = s->sy_next;
}
break;
default:
assert(0);
}
}
/* ------------------------------------------------------------- */
/* implementation of the which command */
do_which(p)
p_tree p;
{
p_symbol sym = identify(p->t_args[0], 0xffff);
if ( sym) pr_sym(sym);
}
/* ------------------------------------------------------------- */
/* implementation of the list command */
extern t_addr get_addr_from_node();
do_list(p)
p_tree p;
{
int l1, l2;
static int wsize = 10;
if (p->t_args[1]) {
l2 = p->t_args[1]->t_ival;
if (l2 >= 0) {
if (l2 == 0) l2 = 1;
wsize = l2;
}
}
else l2 = wsize;
if (! p->t_args[0]) {
l1 = listline;
if (! l1) {
listline = currline - (wsize/2);
l1 = listline;
}
}
else {
if (p->t_args[0]->t_oper == OP_AT) {
l1 = p->t_args[0]->t_lino;
if (p->t_args[0]->t_filename) {
newfile(str2idf(p->t_args[0]->t_filename, 0));
}
}
else {
t_addr a = get_addr_from_node(p->t_args[0]);
p_position pos;
p_symbol oldlistfile = listfile;
if (a == ILL_ADDR) {
return;
}
pos = get_position_from_addr(a);
newfile(str2idf(pos->filename, 1));
if (listfile != oldlistfile) {
warning("switching to file %s", listfile->sy_idf->id_text);
}
l1 = pos->lineno - (l2 > 0 ? l2 : wsize)/2;
if (l1 < 1) l1 = 1;
}
}
if (listfile) {
if (l2 < 0) {
l2 = -l2;
if (l1 > l2) l2 = 1;
else l2 -= l1 - 1;
}
lines(listfile->sy_file, l1, l2);
listline = l1 + l2;
}
else error("no current file");
}
/* ------------------------------------------------------------- */
/* implementation of the file command */
do_file(p)
p_tree p;
{
FILE *f;
if (p->t_args[0]) {
if (! strcmp(p->t_args[0]->t_str, "?")) {
register p_symbol sym = PervasiveScope->sc_symbs;
while (sym) {
if (sym->sy_class == FILESYM) {
fprintf(db_out, "%s\n", sym->sy_idf->id_text);
}
sym = sym->sy_prev_sc;
}
return;
}
if ((f = fopen(p->t_args[0]->t_str, "r")) == NULL) {
error("could not open %s", p->t_args[0]->t_str);
return;
}
fclose(f);
newfile(p->t_args[0]->t_idf);
}
else if (listfile) fprintf(db_out, "%s\n", listfile->sy_idf->id_text);
else error("no current file");
}
/* ------------------------------------------------------------- */
/* implementation of stop/when command */
setstop(p, kind)
p_tree p;
int kind;
{
t_addr a = get_addr_from_node(p->t_args[0]);
if (a == ILL_ADDR) return 0;
p->t_address = a;
if (a != NO_ADDR) {
if (! set_or_clear_breakpoint(a, kind)) {
return 0;
}
}
return 1;
}
do_stop(p)
p_tree p;
{
if (! setstop(p, M_SETBP)) {
return;
}
add_to_item_list(p);
}
/* ------------------------------------------------------------- */
/* implementation of the trace command */
settrace(p, kind)
p_tree p;
int kind;
{
t_addr a, e;
a = get_addr_from_node(p->t_args[0]);
if (a == NO_ADDR) return 1;
if (a == ILL_ADDR) return 0;
if (p->t_args[0]->t_oper == OP_AT) {
e = a;
p->t_address = a;
}
else {
p_scope sc = get_next_scope_from_addr(a+1);
if (sc) e = sc->sc_start - 1;
else e = 0xffffffff;
}
return set_or_clear_trace(a, e, kind);
}
do_trace(p)
p_tree p;
{
p->t_address = NO_ADDR;
if (! settrace(p, M_SETTRACE)) {
return;
}
add_to_item_list(p);
}
/* ------------------------------------------------------------- */
/* implementation of the enable/disable commands */
static
able(p, kind)
p_tree p;
int kind;
{
if (!p) {
if (stop_reason) {
able_item(stop_reason, kind);
}
else {
error("no current stopping point");
}
return;
}
switch(p->t_oper) {
case OP_LINK:
able(p->t_args[0], kind);
able(p->t_args[1], kind);
break;
case OP_INTEGER:
able_item((int)p->t_ival, kind);
break;
default:
assert(0);
}
}
do_enable(p)
p_tree p;
{
able(p->t_args[0], 0);
}
do_disable(p)
p_tree p;
{
able(p->t_args[0], 1);
}
/* ------------------------------------------------------------- */
/* implementation of the cont command */
do_continue(p)
p_tree p;
{
int count;
if (p) {
count = p->t_args[0]->t_ival;
if (p->t_args[1]) {
t_addr a = get_addr_from_position(&(p->t_args[1]->t_pos));
p_scope sc = get_scope_from_addr(a);
if (a == ILL_ADDR || base_scope(sc) != base_scope(CurrentScope)) {
error("cannot continue at line %d",
p->t_args[1]->t_lino);
return;
}
if (! set_pc(a)) {
return;
}
}
}
else count = 1;
while (count--) {
if (! send_cont(count==0)) {
break;
}
}
if (count > 0) {
fprintf(db_out, "Only %d breakpoints skipped\n",
p->t_args[0]->t_ival - count);
}
}
/* ------------------------------------------------------------- */
/* implementation of the step command */
do_step(p)
p_tree p;
{
p = p->t_args[0];
if (! singlestep(M_SETSS, p ? p->t_ival : 1L)) {
}
}
/* ------------------------------------------------------------- */
/* implementation of the next command */
do_next(p)
p_tree p;
{
p = p->t_args[0];
if (! singlestep(M_SETSSF, p? p->t_ival : 1L)) {
}
}
extern t_addr *get_EM_regs();
/* ------------------------------------------------------------- */
/* implementation of the regs command (temporarily) */
do_regs(p)
p_tree p;
{
t_addr *buf;
int n = 0;
p = p->t_args[0];
if (p) n = p->t_ival;
if (! (buf = get_EM_regs(n))) {
return;
}
fprintf(db_out, "EM registers %d levels back:\n", n);
fprintf(db_out, "\tLocalBase =\t0x%lx\n\tArgumentBase =\t0x%lx\n",
(long) buf[LB_OFF], (long) buf[AB_OFF]);
fprintf(db_out, "\tProgramCounter=\t0x%lx\n\tHeapPointer = \t0x%lx\n",
(long) buf[PC_OFF],
(long) buf[HP_OFF]);
fprintf(db_out, "\tStackPointer =\t0x%lx\n", (long) buf[SP_OFF]);
}
/* ------------------------------------------------------------- */
/* implementation of the where command */
/*ARGSUSED*/
do_where(p)
p_tree p;
{
int i = 0;
unsigned int cnt;
unsigned int maxcnt = 0xffff;
p_scope sc;
t_addr *buf;
t_addr PC;
p = p->t_args[0];
if (p && p->t_ival < 0) {
for (;;) {
buf = get_EM_regs(i++);
if (! buf || ! buf[AB_OFF]) break;
PC = buf[PC_OFF];
sc = base_scope(get_scope_from_addr(PC));
if (! sc || sc->sc_start > PC) break;
if (interrupted) return;
}
i--;
maxcnt = - p->t_ival;
i -= maxcnt;
if (i < 0) i = 0;
}
else if (p) maxcnt = p->t_ival;
for (cnt = maxcnt; cnt != 0; cnt--) {
t_addr AB;
if (interrupted) return;
if (! (buf = get_EM_regs(i++))) break;
AB = buf[AB_OFF];
PC = buf[PC_OFF];
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);
}
}
/* ------------------------------------------------------------- */
/* implementation of the delete command */
extern p_tree remove_from_item_list();
do_delete(p)
p_tree p;
{
switch(p->t_oper) {
case OP_DELETE:
if (! p->t_args[0]) {
if (stop_reason) {
remove_from_item_list(stop_reason);
stop_reason = 0;
}
else {
error("no current stopping point");
}
}
else do_delete(p->t_args[0]);
break;
case OP_LINK:
do_delete(p->t_args[0]);
do_delete(p->t_args[1]);
break;
case OP_INTEGER:
p = remove_from_item_list((int) p->t_ival);
if (p) switch(p->t_oper) {
case OP_WHEN:
case OP_STOP:
setstop(p, M_CLRBP);
break;
case OP_TRACE:
settrace(p, M_CLRTRACE);
break;
case OP_DUMP:
free_dump(p);
}
freenode(p);
break;
default:
assert(0);
}
}
/* ------------------------------------------------------------- */
/* implementation of the print command */
do_print(p)
p_tree p;
{
char *buf = 0;
char *format = 0;
long size;
p_type tp;
switch(p->t_oper) {
case OP_PRINT:
if (p->t_args[0] == 0) {
p = print_command;
if (p == 0) {
error("no previous print command");
break;
}
}
else if (p != print_command) {
/* freenode(print_command); No, could be in when-list */
print_command = p;
}
/* fall through */
case OP_DISPLAY:
do_print(p->t_args[0]);
break;
case OP_LINK:
do_print(p->t_args[0]);
do_print(p->t_args[1]);
break;
default:
if (interrupted || ! eval_expr(p, &buf, &size, &tp)) return;
print_node(p, 0);
fputs(" = ", db_out);
if (p->t_oper == OP_FORMAT) {
format = p->t_args[1]->t_str;
}
print_val(tp, size, buf, 0, 0, format);
if (buf) free(buf);
fputs("\n", db_out);
break;
}
}
/* ------------------------------------------------------------- */
/* implementation of the set command */
do_set(p)
p_tree p;
{
char *buf = 0;
long size, size2;
p_type tp, tp2;
t_addr a;
if (interrupted || ! eval_desig(p->t_args[0], &a, &size, &tp) ||
! eval_expr(p->t_args[1], &buf, &size2, &tp2) ||
! convert(&buf, &size2, &tp2, tp, size)) {
if (buf) free(buf);
return;
}
if (interrupted) {
free(buf);
return;
}
set_bytes(size, buf, a);
free(buf);
}

88
util/grind/expr.c
View file

@ -241,7 +241,7 @@ eval_cond(p)
/* one routine for each unary operator */ /* one routine for each unary operator */
static int static int
do_not(p, pbuf, psize, ptp) not_op(p, pbuf, psize, ptp)
p_tree p; p_tree p;
char **pbuf; char **pbuf;
long *psize; long *psize;
@ -258,7 +258,7 @@ do_not(p, pbuf, psize, ptp)
} }
static int static int
do_bnot(p, pbuf, psize, ptp) bnot_op(p, pbuf, psize, ptp)
p_tree p; p_tree p;
char **pbuf; char **pbuf;
long *psize; long *psize;
@ -307,7 +307,7 @@ ptr_addr(p, paddr, psize, ptp)
} }
static int static int
do_deref(p, pbuf, psize, ptp) deref_op(p, pbuf, psize, ptp)
p_tree p; p_tree p;
char **pbuf; char **pbuf;
long *psize; long *psize;
@ -329,7 +329,7 @@ do_deref(p, pbuf, psize, ptp)
} }
static int static int
do_addr(p, pbuf, psize, ptp) addr_op(p, pbuf, psize, ptp)
p_tree p; p_tree p;
char **pbuf; char **pbuf;
long *psize; long *psize;
@ -349,7 +349,7 @@ do_addr(p, pbuf, psize, ptp)
} }
static int static int
do_unmin(p, pbuf, psize, ptp) unmin_op(p, pbuf, psize, ptp)
p_tree p; p_tree p;
char **pbuf; char **pbuf;
long *psize; long *psize;
@ -375,7 +375,7 @@ do_unmin(p, pbuf, psize, ptp)
} }
static int static int
do_unplus(p, pbuf, psize, ptp) unplus_op(p, pbuf, psize, ptp)
p_tree p; p_tree p;
char **pbuf; char **pbuf;
long *psize; long *psize;
@ -399,8 +399,8 @@ do_unplus(p, pbuf, psize, ptp)
static int (*un_op[])() = { static int (*un_op[])() = {
0, 0,
do_not, not_op,
do_deref, deref_op,
0, 0,
0, 0,
0, 0,
@ -409,8 +409,8 @@ static int (*un_op[])() = {
0, 0,
0, 0,
0, 0,
do_unplus, unplus_op,
do_unmin, unmin_op,
0, 0,
0, 0,
0, 0,
@ -422,11 +422,11 @@ static int (*un_op[])() = {
0, 0,
0, 0,
0, 0,
do_bnot, bnot_op,
0, 0,
0, 0,
0, 0,
do_addr addr_op
}; };
static p_type static p_type
@ -504,7 +504,7 @@ balance(tp1, tp2)
} }
static int static int
do_andor(p, pbuf, psize, ptp) andor_op(p, pbuf, psize, ptp)
p_tree p; p_tree p;
char **pbuf; char **pbuf;
long *psize; long *psize;
@ -535,7 +535,7 @@ do_andor(p, pbuf, psize, ptp)
} }
static int static int
do_arith(p, pbuf, psize, ptp) arith_op(p, pbuf, psize, ptp)
p_tree p; p_tree p;
char **pbuf; char **pbuf;
long *psize; long *psize;
@ -699,7 +699,7 @@ do_arith(p, pbuf, psize, ptp)
} }
static int static int
do_sft(p, pbuf, psize, ptp) sft_op(p, pbuf, psize, ptp)
p_tree p; p_tree p;
char **pbuf; char **pbuf;
long *psize; long *psize;
@ -747,7 +747,7 @@ do_sft(p, pbuf, psize, ptp)
} }
static int static int
do_cmp(p, pbuf, psize, ptp) cmp_op(p, pbuf, psize, ptp)
p_tree p; p_tree p;
char **pbuf; char **pbuf;
long *psize; long *psize;
@ -859,7 +859,7 @@ do_cmp(p, pbuf, psize, ptp)
} }
static int static int
do_in(p, pbuf, psize, ptp) in_op(p, pbuf, psize, ptp)
p_tree p; p_tree p;
char **pbuf; char **pbuf;
long *psize; long *psize;
@ -951,7 +951,7 @@ array_addr(p, paddr, psize, ptp)
} }
static int static int
do_array(p, pbuf, psize, ptp) array_op(p, pbuf, psize, ptp)
p_tree p; p_tree p;
char **pbuf; char **pbuf;
long *psize; long *psize;
@ -1009,7 +1009,7 @@ select_addr(p, paddr, psize, ptp)
} }
static int static int
do_select(p, pbuf, psize, ptp) select_op(p, pbuf, psize, ptp)
p_tree p; p_tree p;
char **pbuf; char **pbuf;
long *psize; long *psize;
@ -1030,7 +1030,7 @@ do_select(p, pbuf, psize, ptp)
} }
static int static int
do_derselect(p, pbuf, psize, ptp) derselect_op(p, pbuf, psize, ptp)
p_tree p; p_tree p;
char **pbuf; char **pbuf;
long *psize; long *psize;
@ -1054,31 +1054,31 @@ static int (*bin_op[])() = {
0, 0,
0, 0,
0, 0,
do_andor, andor_op,
do_andor, andor_op,
do_arith, arith_op,
do_arith, arith_op,
do_arith, arith_op,
do_arith, arith_op,
do_in, in_op,
do_array, array_op,
do_arith, arith_op,
do_arith, arith_op,
do_arith, arith_op,
do_cmp, cmp_op,
do_cmp, cmp_op,
do_cmp, cmp_op,
do_cmp, cmp_op,
do_cmp, cmp_op,
do_cmp, cmp_op,
do_select, select_op,
do_arith, arith_op,
do_arith, arith_op,
do_arith, arith_op,
0, 0,
do_derselect, derselect_op,
do_sft, sft_op,
do_sft, sft_op,
0 0
}; };

11
util/grind/idf.c
View file

@ -1,14 +1,7 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*
* Author: Ceriel J.H. Jacobs
*/
/* I N S T A N T I A T I O N O F I D F P A C K A G E */
/* $Header$ */ /* $Header$ */
/* Instantiation of idf package */
#include "position.h" #include "position.h"
#include "file.h" #include "file.h"
#include "idf.h" #include "idf.h"

11
util/grind/idf.h
View file

@ -1,14 +1,7 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*
* Author: Ceriel J.H. Jacobs
*/
/* U S E R D E C L A R E D P A R T O F I D F */
/* $Header$ */ /* $Header$ */
/* User-declared part of idf structure */
struct id_u { struct id_u {
int id_res; int id_res;
struct symbol *id_df; struct symbol *id_df;

19
util/grind/itemlist.cc
View file

@ -71,7 +71,7 @@ item_addr_actions(a, mess_type, may_stop)
&& (p->t_address == a || p->t_address == NO_ADDR)) { && (p->t_address == a || p->t_address == NO_ADDR)) {
switch(p->t_oper) { switch(p->t_oper) {
case OP_STOP: case OP_STOP:
if (mess_type != DB_SS && mess_type != OK) break; if (mess_type != M_DB_SS && mess_type != M_OK) break;
if (! p->t_args[1] || eval_cond(p->t_args[1])) { if (! p->t_args[1] || eval_cond(p->t_args[1])) {
if (! stop_reason) stop_reason = i->i_itemno; if (! stop_reason) stop_reason = i->i_itemno;
stopping = 1; stopping = 1;
@ -94,7 +94,7 @@ item_addr_actions(a, mess_type, may_stop)
&& (p->t_address == a || p->t_address == NO_ADDR)) { && (p->t_address == a || p->t_address == NO_ADDR)) {
switch(p->t_oper) { switch(p->t_oper) {
case OP_TRACE: case OP_TRACE:
if ((! stopping && mess_type != END_SS) if ((! stopping && mess_type != M_END_SS)
|| p->t_args[2] || ! may_stop) { || p->t_args[2] || ! may_stop) {
perform(p, a); perform(p, a);
} }
@ -154,14 +154,18 @@ remove_from_item_list(n)
int n; int n;
{ {
register p_item i = item_list.il_first, prev = 0; register p_item i = item_list.il_first, prev = 0;
p_tree p = 0; p_tree p;
while (i) { while (i) {
if (i->i_itemno == n) break; if (i->i_itemno == n) break;
prev = i; prev = i;
i = i->i_next; i = i->i_next;
} }
if (i) { if (! i) {
error("no item %d in current status", n);
return 0;
}
if (i->i_itemno == stop_reason) stop_reason = 0;
if (prev) { if (prev) {
prev->i_next = i->i_next; prev->i_next = i->i_next;
} }
@ -171,7 +175,6 @@ remove_from_item_list(n)
if (p->t_address == NO_ADDR if (p->t_address == NO_ADDR
&& (p->t_oper != OP_TRACE || ! p->t_args[0])) db_ss--; && (p->t_oper != OP_TRACE || ! p->t_args[0])) db_ss--;
free_item(i); free_item(i);
}
return p; return p;
} }
@ -215,10 +218,10 @@ able_item(n, kind)
switch(p->t_oper) { switch(p->t_oper) {
case OP_STOP: case OP_STOP:
case OP_WHEN: case OP_WHEN:
setstop(p, kind ? CLRBP : SETBP); setstop(p, kind ? M_CLRBP : M_SETBP);
break; break;
case OP_TRACE: case OP_TRACE:
settrace(p, kind ? CLRTRACE : SETTRACE); settrace(p, kind ? M_CLRTRACE : M_SETTRACE);
break; break;
} }
} }
@ -232,7 +235,7 @@ print_items()
} }
} }
do_items() perform_items()
{ {
register p_item i = item_list.il_first; register p_item i = item_list.il_first;

12
util/grind/main.c
View file

@ -1,3 +1,5 @@
/* $Header$ */
#include <stdio.h> #include <stdio.h>
#include <varargs.h> #include <varargs.h>
@ -66,7 +68,7 @@ main(argc, argv)
init_types(); init_types();
init_scope(); init_scope();
init_languages(); init_languages();
if (DbxRead(AckObj) && AObj == 0) AObj = AckObj; if (DbRead(AckObj) && AObj == 0) AObj = AckObj;
else if (AObj == 0) AObj = "a.out"; else if (AObj == 0) AObj = "a.out";
reserve(tkidf); reserve(tkidf);
reserve(shorts); reserve(shorts);
@ -75,7 +77,7 @@ main(argc, argv)
} }
prompt(); prompt();
Commands(); Commands();
if (eof_seen) fputc('\n', db_out); if (eof_seen) putc('\n', db_out);
exit(0); exit(0);
} }
@ -87,7 +89,7 @@ prompt()
} }
} }
/*VARARGS1*/ /*VARARGS*/
fatal(va_alist) fatal(va_alist)
va_dcl va_dcl
{ {
@ -107,7 +109,7 @@ fatal(va_alist)
extern int errorgiven; extern int errorgiven;
/*VARARGS1*/ /*VARARGS*/
error(va_alist) error(va_alist)
va_dcl va_dcl
{ {
@ -127,7 +129,7 @@ error(va_alist)
errorgiven = 1; errorgiven = 1;
} }
/*VARARGS1*/ /*VARARGS*/
warning(va_alist) warning(va_alist)
va_dcl va_dcl
{ {

48
util/grind/message.h
View file

@ -5,38 +5,38 @@
struct message_hdr { struct message_hdr {
int m_type; int m_type;
/* Possible values of m_type: */ /* Possible values of m_type: */
#define DB_RUN 020000 /* set for commands that cause child to run */ #define M_DB_RUN 020000 /* set for commands that cause child to run */
#define SETBP 0 /* set breakpoint at address in m_size */ #define M_SETBP 0 /* set breakpoint at address in m_size */
#define CLRBP 1 /* clear breakpoint at address in m_size */ #define M_CLRBP 1 /* clear breakpoint at address in m_size */
#define SETSS (2|DB_RUN) /* set single stepping, # of steps in m_size */ #define M_SETSS (2|M_DB_RUN) /* set single stepping, # of steps in m_size */
#define SETSSF (3|DB_RUN) /* set single stepping, counting calls as one step */ #define M_SETSSF (3|M_DB_RUN) /* set single stepping, counting calls as one step */
#define GETEMREGS 4 /* get EM registers, m_size contains level */ #define M_GETEMREGS 4 /* get EM registers, m_size contains level */
#define GETBYTES 5 /* get data; m_size contains size, m_buf contains address */ #define M_GETBYTES 5 /* get data; m_size contains size, m_buf contains address */
#define GETSTR 6 /* get string; m_buf contains address */ #define M_GETSTR 6 /* get string; m_buf contains address */
#define SETBYTES 7 /* set data; m_buf contains address, m_size contains size */ #define M_SETBYTES 7 /* set data; m_buf contains address, m_size contains size */
#define CALL 8 /* call function; #define M_CALL 8 /* call function;
m_size contains size of parameter buffer, m_size contains size of parameter buffer,
m_buf contains address + size of function result m_buf contains address + size of function result
*/ */
#define CONT (9|DB_RUN) /* continue */ #define M_CONT (9|M_DB_RUN) /* continue */
#define SETEMREGS 10 /* set EM registers, m_size contains level #define M_SETEMREGS 10 /* set EM registers, m_size contains level
Actually, only the program counter is set. Actually, only the program counter is set.
*/ */
#define DB_SS 040000 /* debugger wants single stepping (to be orred with #define M_DB_SS 040000 /* debugger wants single stepping (to be orred with
SETSS(F) or CONT SETSS(F) or CONT
*/ */
#define CLRSS 12 /* clear single stepping */ #define M_CLRSS 12 /* clear single stepping */
#define DUMP 13 /* dump command */ #define M_DUMP 13 /* dump command */
#define DGLOB 14 /* data area */ #define M_DGLOB 14 /* data area */
#define DSTACK 15 /* stack area */ #define M_DSTACK 15 /* stack area */
#define SETTRACE 16 /* start tracing; range in m_mes */ #define M_SETTRACE 16 /* start tracing; range in m_mes */
#define CLRTRACE 17 /* end tracing */ #define M_CLRTRACE 17 /* end tracing */
#define OK 50 /* answer of child to most messages */ #define M_OK 50 /* answer of child to most messages */
#define FAIL 51 /* answer of child when something goes wrong */ #define M_FAIL 51 /* answer of child when something goes wrong */
#define DATA 52 /* answer of child when data requested */ #define M_DATA 52 /* answer of child when data requested */
#define END_SS 53 /* when stopped because of user single stepping */ #define M_END_SS 53 /* when stopped because of user single stepping */
#define INTR 54 /* sent on interrupt */ #define M_INTR 54 /* sent on interrupt */
long m_size; /* size */ long m_size; /* size */
char m_buf[BUFLEN]; /* some of the data required included in message */ char m_buf[BUFLEN]; /* some of the data required included in message */
}; };

4
util/grind/print.c
View file

@ -224,7 +224,7 @@ print_val(tp, tp_sz, addr, compressed, indent, format)
break; break;
} }
if (i > 1) { if (i > 1) {
fputc(',', db_out); putc(',', db_out);
} }
fprintf(db_out, "\n%*c", i > 1 ? indent : indent - 4, ' '); fprintf(db_out, "\n%*c", i > 1 ? indent : indent - 4, ' ');
} }
@ -259,7 +259,7 @@ print_val(tp, tp_sz, addr, compressed, indent, format)
break; break;
} }
if (i > 1) { if (i > 1) {
fputc(',', db_out); putc(',', db_out);
} }
fprintf(db_out, "\n%*c", i > 1 ? indent : indent - 4, ' '); fprintf(db_out, "\n%*c", i > 1 ? indent : indent - 4, ' ');
} }

74
util/grind/run.c
View file

@ -192,8 +192,8 @@ start_child(p)
curr_stop = m.m_size; curr_stop = m.m_size;
CurrentScope = get_scope_from_addr(curr_stop); CurrentScope = get_scope_from_addr(curr_stop);
} }
do_items(); perform_items();
if (! restoring && ! item_addr_actions(curr_stop, OK, 1)) { if (! restoring && ! item_addr_actions(curr_stop, M_OK, 1)) {
send_cont(1); send_cont(1);
} }
else if (! restoring) { else if (! restoring) {
@ -354,7 +354,7 @@ could_send(m, stop_message)
error("no process"); error("no process");
return 0; return 0;
} }
if (m->m_type & DB_RUN) { if (m->m_type & M_DB_RUN) {
disable_intr = 0; disable_intr = 0;
stop_reason = 0; stop_reason = 0;
} }
@ -363,7 +363,7 @@ could_send(m, stop_message)
} }
disable_intr = 1; disable_intr = 1;
if ((interrupted || child_interrupted) && ! child_dead) { if ((interrupted || child_interrupted) && ! child_dead) {
while (child_interrupted && answer.m_type != INTR) { while (child_interrupted && answer.m_type != M_INTR) {
if (! ugetm(&answer)) { if (! ugetm(&answer)) {
child_dead = 1; child_dead = 1;
break; break;
@ -397,24 +397,24 @@ could_send(m, stop_message)
} }
a = answer.m_size; a = answer.m_size;
type = answer.m_type; type = answer.m_type;
if (m->m_type & DB_RUN) { if (m->m_type & M_DB_RUN) {
/* run command */ /* run command */
CurrentScope = get_scope_from_addr((t_addr) a); CurrentScope = get_scope_from_addr((t_addr) a);
if (! item_addr_actions(a, type, stop_message) && if (! item_addr_actions(a, type, stop_message) &&
( type == DB_SS || type == OK)) { ( type == M_DB_SS || type == M_OK)) {
/* no explicit breakpoints at this position. /* no explicit breakpoints at this position.
Also, child did not stop because of Also, child did not stop because of
SETSS or SETSSF, otherwise we would SETSS or SETSSF, otherwise we would
have gotten END_SS. have gotten END_SS.
So, continue. So, continue.
*/ */
if ((m->m_type & ~ DB_SS) != CONT) { if ((m->m_type & ~ M_DB_SS) != M_CONT) {
m->m_type = CONT | (m->m_type & DB_SS); m->m_type = M_CONT | (m->m_type & M_DB_SS);
} }
continue; continue;
} }
if (type != END_SS && single_stepping) { if (type != M_END_SS && single_stepping) {
m->m_type = CLRSS; m->m_type = M_CLRSS;
if (! uputm(m) || ! ugetm(&answer)) return 0; if (! uputm(m) || ! ugetm(&answer)) return 0;
} }
single_stepping = 0; single_stepping = 0;
@ -445,13 +445,13 @@ getbytes(size, from, to, kind)
} }
switch(answer.m_type) { switch(answer.m_type) {
case FAIL: case M_FAIL:
error("could not get value"); error("could not get value");
return 0; return 0;
case INTR: case M_INTR:
error("interrupted"); error("interrupted");
return 0; return 0;
case DATA: case M_DATA:
return ureceive(to, answer.m_size); return ureceive(to, answer.m_size);
default: default:
assert(0); assert(0);
@ -465,7 +465,7 @@ get_bytes(size, from, to)
t_addr from; t_addr from;
char *to; char *to;
{ {
return getbytes(size, from, to, GETBYTES); return getbytes(size, from, to, M_GETBYTES);
} }
int int
@ -474,7 +474,7 @@ get_string(size, from, to)
t_addr from; t_addr from;
char *to; char *to;
{ {
int retval = getbytes(size, from, to, GETSTR); int retval = getbytes(size, from, to, M_GETSTR);
to[(int)answer.m_size] = 0; to[(int)answer.m_size] = 0;
return retval; return retval;
@ -487,7 +487,7 @@ set_bytes(size, from, to)
{ {
struct message_hdr m; struct message_hdr m;
m.m_type = SETBYTES; m.m_type = M_SETBYTES;
m.m_size = size; m.m_size = size;
put_int(m.m_buf, pointer_size, (long) to); put_int(m.m_buf, pointer_size, (long) to);
@ -495,13 +495,13 @@ set_bytes(size, from, to)
return; return;
} }
switch(answer.m_type) { switch(answer.m_type) {
case FAIL: case M_FAIL:
error("could not handle this SET request"); error("could not handle this SET request");
break; break;
case INTR: case M_INTR:
error("interrupted"); error("interrupted");
break; break;
case OK: case M_OK:
break; break;
default: default:
assert(0); assert(0);
@ -515,18 +515,18 @@ get_dump(globmessage, globbuf, stackmessage, stackbuf)
{ {
struct message_hdr m; struct message_hdr m;
m.m_type = DUMP; m.m_type = M_DUMP;
if (! could_send(&m, 0)) { if (! could_send(&m, 0)) {
return 0; return 0;
} }
switch(answer.m_type) { switch(answer.m_type) {
case FAIL: case M_FAIL:
error("request for DUMP failed"); error("request for DUMP failed");
return 0; return 0;
case INTR: case M_INTR:
error("interrupted"); error("interrupted");
return 0; return 0;
case DGLOB: case M_DGLOB:
break; break;
default: default:
assert(0); assert(0);
@ -538,7 +538,7 @@ get_dump(globmessage, globbuf, stackmessage, stackbuf)
if (*globbuf) free(*globbuf); if (*globbuf) free(*globbuf);
return 0; return 0;
} }
assert(stackmessage->m_type == DSTACK); assert(stackmessage->m_type == M_DSTACK);
*stackbuf = malloc((unsigned) stackmessage->m_size); *stackbuf = malloc((unsigned) stackmessage->m_size);
if (! ureceive(*stackbuf, stackmessage->m_size)) { if (! ureceive(*stackbuf, stackmessage->m_size)) {
if (*globbuf) free(*globbuf); if (*globbuf) free(*globbuf);
@ -583,20 +583,20 @@ get_EM_regs(level)
static t_addr buf[5]; static t_addr buf[5];
register t_addr *to = &buf[0]; register t_addr *to = &buf[0];
m.m_type = GETEMREGS; m.m_type = M_GETEMREGS;
m.m_size = level; m.m_size = level;
if (! could_send(&m, 0)) { if (! could_send(&m, 0)) {
return 0; return 0;
} }
switch(answer.m_type) { switch(answer.m_type) {
case FAIL: case M_FAIL:
error("request for registers failed"); error("request for registers failed");
return 0; return 0;
case INTR: case M_INTR:
error("interrupted"); error("interrupted");
return 0; return 0;
case GETEMREGS: case M_GETEMREGS:
break; break;
default: default:
assert(0); assert(0);
@ -615,18 +615,18 @@ set_pc(PC)
{ {
struct message_hdr m; struct message_hdr m;
m.m_type = SETEMREGS; m.m_type = M_SETEMREGS;
m.m_size = 0; m.m_size = 0;
put_int(m.m_buf+PC_OFF*pointer_size, pointer_size, (long)PC); put_int(m.m_buf+PC_OFF*pointer_size, pointer_size, (long)PC);
if (! could_send(&m, 0)) return 0; if (! could_send(&m, 0)) return 0;
switch(answer.m_type) { switch(answer.m_type) {
case FAIL: case M_FAIL:
error("could not set PC to %lx", (long) PC); error("could not set PC to %lx", (long) PC);
return 0; return 0;
case INTR: case M_INTR:
error("interrupted"); error("interrupted");
return 0; return 0;
case OK: case M_OK:
return 1; return 1;
default: default:
assert(0); assert(0);
@ -640,19 +640,19 @@ send_cont(stop_message)
{ {
struct message_hdr m; struct message_hdr m;
m.m_type = (CONT | (db_ss ? DB_SS : 0)); m.m_type = (M_CONT | (db_ss ? M_DB_SS : 0));
m.m_size = 0; m.m_size = 0;
return could_send(&m, stop_message) && child_pid; return could_send(&m, stop_message) && child_pid;
} }
int int
do_single_step(type, count) singlestep(type, count)
int type; int type;
long count; long count;
{ {
struct message_hdr m; struct message_hdr m;
m.m_type = type | (db_ss ? DB_SS : 0); m.m_type = type | (db_ss ? M_DB_SS : 0);
m.m_size = count; m.m_size = count;
single_stepping = 1; single_stepping = 1;
if (could_send(&m, 1) && child_pid) return 1; if (could_send(&m, 1) && child_pid) return 1;
@ -669,7 +669,7 @@ set_or_clear_breakpoint(a, type)
m.m_type = type; m.m_type = type;
m.m_size = a; m.m_size = a;
if (debug) printf("%s breakpoint at 0x%lx\n", type == SETBP ? "setting" : "clearing", (long) a); if (debug) printf("%s breakpoint at 0x%lx\n", type == M_SETBP ? "setting" : "clearing", (long) a);
if (child_pid && ! could_send(&m, 0)) { if (child_pid && ! could_send(&m, 0)) {
} }
@ -686,7 +686,7 @@ set_or_clear_trace(start, end, type)
m.m_type = type; m.m_type = type;
put_int(m.m_buf, pointer_size, (long)start); put_int(m.m_buf, pointer_size, (long)start);
put_int(m.m_buf+pointer_size, pointer_size, (long)end); put_int(m.m_buf+pointer_size, pointer_size, (long)end);
if (debug) printf("%s trace at [0x%lx,0x%lx]\n", type == SETTRACE ? "setting" : "clearing", (long) start, (long) end); if (debug) printf("%s trace at [0x%lx,0x%lx]\n", type == M_SETTRACE ? "setting" : "clearing", (long) start, (long) end);
if (child_pid && ! could_send(&m, 0)) { if (child_pid && ! could_send(&m, 0)) {
return 0; return 0;
} }

4
util/grind/scope.cc
View file

@ -1,7 +1,7 @@
/* Scope mechanism */
/* $Header$ */ /* $Header$ */
/* Scope mechanism */
#include <assert.h> #include <assert.h>
#include <alloc.h> #include <alloc.h>
#include <out.h> #include <out.h>

4
util/grind/scope.h
View file

@ -1,7 +1,7 @@
/* scope structure */
/* $Header$ */ /* $Header$ */
/* scope structure */
typedef struct scope { typedef struct scope {
struct scope *sc_static_encl; /* linked list of enclosing scopes */ struct scope *sc_static_encl; /* linked list of enclosing scopes */
struct symbol *sc_symbs; /* symbols defined in this scope */ struct symbol *sc_symbs; /* symbols defined in this scope */

2
util/grind/sizes.h
View file

@ -1,3 +1,5 @@
/* $Header$ */
/* For the time being ... */ /* For the time being ... */
#define SZ_INT 4 #define SZ_INT 4

46
util/grind/symbol.c
View file

@ -154,7 +154,7 @@ def_scope(s)
/* Determine if the OP_SELECT tree indicated by 'p' could lead to scope 'sc'. /* Determine if the OP_SELECT tree indicated by 'p' could lead to scope 'sc'.
*/ */
static int int
consistent(p, sc) consistent(p, sc)
p_tree p; p_tree p;
p_scope sc; p_scope sc;
@ -298,7 +298,6 @@ pr_scopes(sc)
} }
} }
static
pr_sym(s) pr_sym(s)
p_symbol s; p_symbol s;
{ {
@ -339,49 +338,6 @@ pr_sym(s)
fprintf(db_out, "%s\n", s->sy_idf->id_text); fprintf(db_out, "%s\n", s->sy_idf->id_text);
} }
/* Print all identifications of p->t_args[0].
*/
do_find(p)
p_tree p;
{
register p_symbol s;
p_tree arg;
p = p->t_args[0];
switch(p->t_oper) {
case OP_NAME:
s = p->t_idf->id_def;
while (s) {
pr_sym(s);
s = s->sy_next;
}
break;
case OP_SELECT:
arg = p->t_args[1];
assert(arg->t_oper == OP_NAME);
s = arg->t_idf->id_def;
while (s) {
if (consistent(p, s->sy_scope)) {
pr_sym(s);
}
s = s->sy_next;
}
break;
default:
assert(0);
}
}
do_which(p)
p_tree p;
{
p_symbol sym = identify(p->t_args[0], 0xffff);
if ( sym) pr_sym(sym);
}
resolve_cross(tp) resolve_cross(tp)
p_type tp; p_type tp;
{ {

9
util/grind/tokenname.c
View file

@ -1,12 +1,3 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*
* Author: Ceriel J.H. Jacobs
*/
/* T O K E N D E F I N I T I O N S */
/* $Header$ */ /* $Header$ */
#include "tokenname.h" #include "tokenname.h"

9
util/grind/tokenname.h
View file

@ -1,12 +1,3 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*
* Author: Ceriel J.H. Jacobs
*/
/* T O K E N N A M E S T R U C T U R E */
/* $Header$ */ /* $Header$ */
struct tokenname { /* Used for defining the name of a struct tokenname { /* Used for defining the name of a

399
util/grind/tree.c
View file

@ -20,15 +20,9 @@
extern FILE *db_out; extern FILE *db_out;
t_lineno currline; t_lineno currline;
static t_lineno listline; t_lineno listline;
extern long pointer_size;
extern char *strrindex(); extern char *strrindex();
extern int interrupted; extern int interrupted;
extern int stop_reason;
p_tree print_command;
static int wsize = 10;
/*VARARGS1*/ /*VARARGS1*/
p_tree p_tree
@ -89,7 +83,7 @@ freenode(p)
free_tree(p); free_tree(p);
} }
static t_addr t_addr
get_addr_from_node(p) get_addr_from_node(p)
p_tree p; p_tree p;
{ {
@ -399,73 +393,6 @@ eval(p)
if (p && operators[p->t_oper].op_fun) (*operators[p->t_oper].op_fun)(p); if (p && operators[p->t_oper].op_fun) (*operators[p->t_oper].op_fun)(p);
} }
do_list(p)
p_tree p;
{
int l1, l2;
if (p->t_args[1]) {
l2 = p->t_args[1]->t_ival;
if (l2 >= 0) {
if (l2 == 0) l2 = 1;
wsize = l2;
}
}
else l2 = wsize;
if (! p->t_args[0]) {
l1 = listline;
if (! l1) {
listline = currline - (wsize/2);
l1 = listline;
}
}
else {
if (p->t_args[0]->t_oper == OP_INTEGER) {
l1 = p->t_args[0]->t_ival;
}
else {
t_addr a = get_addr_from_node(p->t_args[0]);
p_position pos;
if (a == ILL_ADDR) {
return;
}
pos = get_position_from_addr(a);
newfile(str2idf(pos->filename, 1));
l1 = pos->lineno - (l2 > 0 ? l2 : wsize)/2;
if (l1 < 1) l1 = 1;
}
}
if (listfile) {
if (l2 < 0) {
l2 = -l2;
if (l1 > l2) l2 = 1;
else l2 -= l1 - 1;
}
lines(listfile->sy_file, l1, l2);
listline = l1 + l2;
}
else error("no current file");
}
do_file(p)
p_tree p;
{
FILE *f;
if (p->t_args[0]) {
if ((f = fopen(p->t_args[0]->t_str, "r")) == NULL) {
error("could not open %s", p->t_args[0]->t_str);
return;
}
fclose(f);
newfile(p->t_args[0]->t_idf);
}
else if (listfile) fprintf(db_out, "%s\n", listfile->sy_idf->id_text);
else error("no current file");
}
newfile(id) newfile(id)
register struct idf *id; register struct idf *id;
{ {
@ -481,328 +408,6 @@ newfile(id)
find_language(strrindex(id->id_text, '.')); find_language(strrindex(id->id_text, '.'));
} }
setstop(p, kind)
p_tree p;
int kind;
{
t_addr a = get_addr_from_node(p->t_args[0]);
if (a == ILL_ADDR) return 0;
p->t_address = a;
if (a != NO_ADDR) {
if (! set_or_clear_breakpoint(a, kind)) {
return 0;
}
}
return 1;
}
do_stop(p)
p_tree p;
{
if (! setstop(p, SETBP)) {
return;
}
add_to_item_list(p);
}
settrace(p, kind)
p_tree p;
int kind;
{
t_addr a, e;
a = get_addr_from_node(p->t_args[0]);
if (a == NO_ADDR) return 1;
if (a == ILL_ADDR) return 0;
if (p->t_args[0]->t_oper == OP_AT) {
e = a;
p->t_address = a;
}
else {
p_scope sc = get_next_scope_from_addr(a+1);
if (sc) e = sc->sc_start - 1;
else e = 0xffffffff;
}
return set_or_clear_trace(a, e, kind);
}
do_trace(p)
p_tree p;
{
p->t_address = NO_ADDR;
if (! settrace(p, SETTRACE)) {
return;
}
add_to_item_list(p);
}
static
able(p, kind)
p_tree p;
int kind;
{
if (!p) {
if (stop_reason) {
able_item(stop_reason, kind);
}
else {
error("no current stopping point");
}
return;
}
switch(p->t_oper) {
case OP_LINK:
able(p->t_args[0], kind);
able(p->t_args[1], kind);
break;
case OP_INTEGER:
able_item((int)p->t_ival, kind);
break;
default:
assert(0);
}
}
do_enable(p)
p_tree p;
{
able(p->t_args[0], 0);
}
do_disable(p)
p_tree p;
{
able(p->t_args[0], 1);
}
do_continue(p)
p_tree p;
{
int count;
if (p) {
count = p->t_args[0]->t_ival;
if (p->t_args[1]) {
t_addr a = get_addr_from_position(&(p->t_args[1]->t_pos));
p_scope sc = get_scope_from_addr(a);
if (a == ILL_ADDR || base_scope(sc) != base_scope(CurrentScope)) {
error("cannot continue at line %d",
p->t_args[1]->t_lino);
return;
}
if (! set_pc(a)) {
return;
}
}
}
else count = 1;
while (count--) {
if (! send_cont(count==0)) {
break;
}
}
if (count > 0) {
fprintf(db_out, "Only %d breakpoints skipped\n",
p->t_args[0]->t_ival - count);
}
}
do_step(p)
p_tree p;
{
p = p->t_args[0];
if (! do_single_step(SETSS, p ? p->t_ival : 1L)) {
}
}
do_next(p)
p_tree p;
{
p = p->t_args[0];
if (! do_single_step(SETSSF, p? p->t_ival : 1L)) {
}
}
extern t_addr *get_EM_regs();
do_regs(p)
p_tree p;
{
t_addr *buf;
int n = 0;
p = p->t_args[0];
if (p) n = p->t_ival;
if (! (buf = get_EM_regs(n))) {
return;
}
fprintf(db_out, "EM registers %d levels back:\n", n);
fprintf(db_out, "\tLocalBase =\t0x%lx\n\tArgumentBase =\t0x%lx\n",
(long) buf[LB_OFF], (long) buf[AB_OFF]);
fprintf(db_out, "\tProgramCounter=\t0x%lx\n\tHeapPointer = \t0x%lx\n",
(long) buf[PC_OFF],
(long) buf[HP_OFF]);
fprintf(db_out, "\tStackPointer =\t0x%lx\n", (long) buf[SP_OFF]);
}
/*ARGSUSED*/
do_where(p)
p_tree p;
{
int i = 0;
unsigned int cnt;
unsigned int maxcnt = 0xffff;
p_scope sc;
t_addr *buf;
t_addr PC;
p = p->t_args[0];
if (p && p->t_ival < 0) {
for (;;) {
buf = get_EM_regs(i++);
if (! buf || ! buf[AB_OFF]) break;
PC = buf[PC_OFF];
sc = base_scope(get_scope_from_addr(PC));
if (! sc || sc->sc_start > PC) break;
if (interrupted) return;
}
i--;
maxcnt = - p->t_ival;
i -= maxcnt;
if (i < 0) i = 0;
}
else if (p) maxcnt = p->t_ival;
for (cnt = maxcnt; cnt != 0; cnt--) {
t_addr AB;
if (interrupted) return;
if (! (buf = get_EM_regs(i++))) break;
AB = buf[AB_OFF];
PC = buf[PC_OFF];
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);
}
}
extern p_tree remove_from_item_list();
do_delete(p)
p_tree p;
{
switch(p->t_oper) {
case OP_DELETE:
if (! p->t_args[0]) {
if (stop_reason) {
remove_from_item_list(stop_reason);
stop_reason = 0;
}
else {
error("no current stopping point");
}
}
else do_delete(p->t_args[0]);
break;
case OP_LINK:
do_delete(p->t_args[0]);
do_delete(p->t_args[1]);
break;
case OP_INTEGER:
p = remove_from_item_list((int) p->t_ival);
if (p) switch(p->t_oper) {
case OP_WHEN:
case OP_STOP:
setstop(p, CLRBP);
break;
case OP_TRACE:
settrace(p, CLRTRACE);
break;
case OP_DUMP:
free_dump(p);
}
freenode(p);
break;
default:
assert(0);
}
}
do_print(p)
p_tree p;
{
char *buf = 0;
char *format = 0;
long size;
p_type tp;
switch(p->t_oper) {
case OP_PRINT:
if (p->t_args[0] == 0) {
p = print_command;
if (p == 0) {
error("no previous print command");
break;
}
}
else if (p != print_command) {
/* freenode(print_command); No, could be in when-list */
print_command = p;
}
/* fall through */
case OP_DISPLAY:
do_print(p->t_args[0]);
break;
case OP_LINK:
do_print(p->t_args[0]);
do_print(p->t_args[1]);
break;
default:
if (interrupted || ! eval_expr(p, &buf, &size, &tp)) return;
print_node(p, 0);
fputs(" = ", db_out);
if (p->t_oper == OP_FORMAT) {
format = p->t_args[1]->t_str;
}
print_val(tp, size, buf, 0, 0, format);
if (buf) free(buf);
fputs("\n", db_out);
break;
}
}
do_set(p)
p_tree p;
{
char *buf = 0;
long size, size2;
p_type tp, tp2;
t_addr a;
if (interrupted || ! eval_desig(p->t_args[0], &a, &size, &tp) ||
! eval_expr(p->t_args[1], &buf, &size2, &tp2) ||
! convert(&buf, &size2, &tp2, tp, size)) {
if (buf) free(buf);
return;
}
if (interrupted) {
free(buf);
return;
}
set_bytes(size, buf, a);
free(buf);
}
perform(p, a) perform(p, a)
register p_tree p; register p_tree p;
t_addr a; t_addr a;