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

20
util/grind/c.c
View file

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

2
util/grind/char.ct
View file

@ -12,7 +12,7 @@ STIDF:a-zA-Z_
STSTR:"'
STDOT:.
STNUM:0-9
STSIMP:-,<>{}:`?\\
STSIMP:-,!<>{}:`?\\
%T#include "class.h"
%Tchar tkclass[] = {
%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$ */
/* As a starter, chars are divided into classes, according to which
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])
/* 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 STNL 1 /* newline character(s): update linenumber etc. */
#define STGARB 2 /* garbage ascii character: not allowed */
@ -33,8 +18,9 @@
#define STEOI 9 /* End-Of-Information mark */
#define STSIMP 10 /* this character can occur as token */
/* But occurring inside a token is not, so we need 1 bit for each
class. This is implemented as a collection of tables to speed up
/* But occurring inside a token is not an exclusive property,
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.
*/
#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); }
| WHICH qualified_name(p){ *p = mknode(OP_WHICH, *p); }
| able_command(p)
| '!' { shellescape(); }
|
]
;
@ -127,7 +128,7 @@ list_command(p_tree *p;)
:
LIST
[
| count(&t1)
| position(&t1)
| qualified_name(&t1)
]
[ ',' count(&t2)
@ -201,7 +202,7 @@ continue_command(p_tree *p;)
[ INTEGER { l = tok.ival; }
| { l = 1; }
]
position(&pos)?
[ AT position(&pos) ]?
{ *p = mknode(OP_CONT, mknode(OP_INTEGER, l), pos); }
;
@ -332,9 +333,9 @@ condition(p_tree *p;)
where(p_tree *p;)
:
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;)
@ -404,7 +405,6 @@ position(p_tree *p;)
char *str;
}
:
AT
[ STRING { str = tok.str; }
':'
| { if (! listfile) str = 0;
@ -597,4 +597,82 @@ init_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 */
static int
do_not(p, pbuf, psize, ptp)
not_op(p, pbuf, psize, ptp)
p_tree p;
char **pbuf;
long *psize;
@ -258,7 +258,7 @@ do_not(p, pbuf, psize, ptp)
}
static int
do_bnot(p, pbuf, psize, ptp)
bnot_op(p, pbuf, psize, ptp)
p_tree p;
char **pbuf;
long *psize;
@ -307,7 +307,7 @@ ptr_addr(p, paddr, psize, ptp)
}
static int
do_deref(p, pbuf, psize, ptp)
deref_op(p, pbuf, psize, ptp)
p_tree p;
char **pbuf;
long *psize;
@ -329,7 +329,7 @@ do_deref(p, pbuf, psize, ptp)
}
static int
do_addr(p, pbuf, psize, ptp)
addr_op(p, pbuf, psize, ptp)
p_tree p;
char **pbuf;
long *psize;
@ -349,7 +349,7 @@ do_addr(p, pbuf, psize, ptp)
}
static int
do_unmin(p, pbuf, psize, ptp)
unmin_op(p, pbuf, psize, ptp)
p_tree p;
char **pbuf;
long *psize;
@ -375,7 +375,7 @@ do_unmin(p, pbuf, psize, ptp)
}
static int
do_unplus(p, pbuf, psize, ptp)
unplus_op(p, pbuf, psize, ptp)
p_tree p;
char **pbuf;
long *psize;
@ -399,8 +399,8 @@ do_unplus(p, pbuf, psize, ptp)
static int (*un_op[])() = {
0,
do_not,
do_deref,
not_op,
deref_op,
0,
0,
0,
@ -409,8 +409,8 @@ static int (*un_op[])() = {
0,
0,
0,
do_unplus,
do_unmin,
unplus_op,
unmin_op,
0,
0,
0,
@ -422,11 +422,11 @@ static int (*un_op[])() = {
0,
0,
0,
do_bnot,
bnot_op,
0,
0,
0,
do_addr
addr_op
};
static p_type
@ -504,7 +504,7 @@ balance(tp1, tp2)
}
static int
do_andor(p, pbuf, psize, ptp)
andor_op(p, pbuf, psize, ptp)
p_tree p;
char **pbuf;
long *psize;
@ -535,7 +535,7 @@ do_andor(p, pbuf, psize, ptp)
}
static int
do_arith(p, pbuf, psize, ptp)
arith_op(p, pbuf, psize, ptp)
p_tree p;
char **pbuf;
long *psize;
@ -699,7 +699,7 @@ do_arith(p, pbuf, psize, ptp)
}
static int
do_sft(p, pbuf, psize, ptp)
sft_op(p, pbuf, psize, ptp)
p_tree p;
char **pbuf;
long *psize;
@ -747,7 +747,7 @@ do_sft(p, pbuf, psize, ptp)
}
static int
do_cmp(p, pbuf, psize, ptp)
cmp_op(p, pbuf, psize, ptp)
p_tree p;
char **pbuf;
long *psize;
@ -859,7 +859,7 @@ do_cmp(p, pbuf, psize, ptp)
}
static int
do_in(p, pbuf, psize, ptp)
in_op(p, pbuf, psize, ptp)
p_tree p;
char **pbuf;
long *psize;
@ -951,7 +951,7 @@ array_addr(p, paddr, psize, ptp)
}
static int
do_array(p, pbuf, psize, ptp)
array_op(p, pbuf, psize, ptp)
p_tree p;
char **pbuf;
long *psize;
@ -1009,7 +1009,7 @@ select_addr(p, paddr, psize, ptp)
}
static int
do_select(p, pbuf, psize, ptp)
select_op(p, pbuf, psize, ptp)
p_tree p;
char **pbuf;
long *psize;
@ -1030,7 +1030,7 @@ do_select(p, pbuf, psize, ptp)
}
static int
do_derselect(p, pbuf, psize, ptp)
derselect_op(p, pbuf, psize, ptp)
p_tree p;
char **pbuf;
long *psize;
@ -1054,31 +1054,31 @@ static int (*bin_op[])() = {
0,
0,
0,
do_andor,
do_andor,
do_arith,
do_arith,
do_arith,
do_arith,
do_in,
do_array,
do_arith,
do_arith,
do_arith,
do_cmp,
do_cmp,
do_cmp,
do_cmp,
do_cmp,
do_cmp,
do_select,
do_arith,
do_arith,
do_arith,
andor_op,
andor_op,
arith_op,
arith_op,
arith_op,
arith_op,
in_op,
array_op,
arith_op,
arith_op,
arith_op,
cmp_op,
cmp_op,
cmp_op,
cmp_op,
cmp_op,
cmp_op,
select_op,
arith_op,
arith_op,
arith_op,
0,
do_derselect,
do_sft,
do_sft,
derselect_op,
sft_op,
sft_op,
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$ */
/* Instantiation of idf package */
#include "position.h"
#include "file.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$ */
/* User-declared part of idf structure */
struct id_u {
int id_res;
struct symbol *id_df;

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

12
util/grind/main.c
View file

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

48
util/grind/message.h
View file

@ -5,38 +5,38 @@
struct message_hdr {
int m_type;
/* Possible values of m_type: */
#define DB_RUN 020000 /* set for commands that cause child to run */
#define SETBP 0 /* set breakpoint at address in m_size */
#define CLRBP 1 /* clear breakpoint at address in m_size */
#define SETSS (2|DB_RUN) /* set single stepping, # of steps in m_size */
#define SETSSF (3|DB_RUN) /* set single stepping, counting calls as one step */
#define GETEMREGS 4 /* get EM registers, m_size contains level */
#define GETBYTES 5 /* get data; m_size contains size, m_buf contains address */
#define GETSTR 6 /* get string; m_buf contains address */
#define SETBYTES 7 /* set data; m_buf contains address, m_size contains size */
#define CALL 8 /* call function;
#define M_DB_RUN 020000 /* set for commands that cause child to run */
#define M_SETBP 0 /* set breakpoint at address in m_size */
#define M_CLRBP 1 /* clear breakpoint at address in m_size */
#define M_SETSS (2|M_DB_RUN) /* set single stepping, # of steps in m_size */
#define M_SETSSF (3|M_DB_RUN) /* set single stepping, counting calls as one step */
#define M_GETEMREGS 4 /* get EM registers, m_size contains level */
#define M_GETBYTES 5 /* get data; m_size contains size, m_buf contains address */
#define M_GETSTR 6 /* get string; m_buf contains address */
#define M_SETBYTES 7 /* set data; m_buf contains address, m_size contains size */
#define M_CALL 8 /* call function;
m_size contains size of parameter buffer,
m_buf contains address + size of function result
*/
#define CONT (9|DB_RUN) /* continue */
#define SETEMREGS 10 /* set EM registers, m_size contains level
#define M_CONT (9|M_DB_RUN) /* continue */
#define M_SETEMREGS 10 /* set EM registers, m_size contains level
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
*/
#define CLRSS 12 /* clear single stepping */
#define DUMP 13 /* dump command */
#define DGLOB 14 /* data area */
#define DSTACK 15 /* stack area */
#define SETTRACE 16 /* start tracing; range in m_mes */
#define CLRTRACE 17 /* end tracing */
#define M_CLRSS 12 /* clear single stepping */
#define M_DUMP 13 /* dump command */
#define M_DGLOB 14 /* data area */
#define M_DSTACK 15 /* stack area */
#define M_SETTRACE 16 /* start tracing; range in m_mes */
#define M_CLRTRACE 17 /* end tracing */
#define OK 50 /* answer of child to most messages */
#define FAIL 51 /* answer of child when something goes wrong */
#define DATA 52 /* answer of child when data requested */
#define END_SS 53 /* when stopped because of user single stepping */
#define INTR 54 /* sent on interrupt */
#define M_OK 50 /* answer of child to most messages */
#define M_FAIL 51 /* answer of child when something goes wrong */
#define M_DATA 52 /* answer of child when data requested */
#define M_END_SS 53 /* when stopped because of user single stepping */
#define M_INTR 54 /* sent on interrupt */
long m_size; /* size */
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;
}
if (i > 1) {
fputc(',', db_out);
putc(',', db_out);
}
fprintf(db_out, "\n%*c", i > 1 ? indent : indent - 4, ' ');
}
@ -259,7 +259,7 @@ print_val(tp, tp_sz, addr, compressed, indent, format)
break;
}
if (i > 1) {
fputc(',', db_out);
putc(',', db_out);
}
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;
CurrentScope = get_scope_from_addr(curr_stop);
}
do_items();
if (! restoring && ! item_addr_actions(curr_stop, OK, 1)) {
perform_items();
if (! restoring && ! item_addr_actions(curr_stop, M_OK, 1)) {
send_cont(1);
}
else if (! restoring) {
@ -354,7 +354,7 @@ could_send(m, stop_message)
error("no process");
return 0;
}
if (m->m_type & DB_RUN) {
if (m->m_type & M_DB_RUN) {
disable_intr = 0;
stop_reason = 0;
}
@ -363,7 +363,7 @@ could_send(m, stop_message)
}
disable_intr = 1;
if ((interrupted || child_interrupted) && ! child_dead) {
while (child_interrupted && answer.m_type != INTR) {
while (child_interrupted && answer.m_type != M_INTR) {
if (! ugetm(&answer)) {
child_dead = 1;
break;
@ -397,24 +397,24 @@ could_send(m, stop_message)
}
a = answer.m_size;
type = answer.m_type;
if (m->m_type & DB_RUN) {
if (m->m_type & M_DB_RUN) {
/* run command */
CurrentScope = get_scope_from_addr((t_addr) a);
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.
Also, child did not stop because of
SETSS or SETSSF, otherwise we would
have gotten END_SS.
So, continue.
*/
if ((m->m_type & ~ DB_SS) != CONT) {
m->m_type = CONT | (m->m_type & DB_SS);
if ((m->m_type & ~ M_DB_SS) != M_CONT) {
m->m_type = M_CONT | (m->m_type & M_DB_SS);
}
continue;
}
if (type != END_SS && single_stepping) {
m->m_type = CLRSS;
if (type != M_END_SS && single_stepping) {
m->m_type = M_CLRSS;
if (! uputm(m) || ! ugetm(&answer)) return 0;
}
single_stepping = 0;
@ -445,13 +445,13 @@ getbytes(size, from, to, kind)
}
switch(answer.m_type) {
case FAIL:
case M_FAIL:
error("could not get value");
return 0;
case INTR:
case M_INTR:
error("interrupted");
return 0;
case DATA:
case M_DATA:
return ureceive(to, answer.m_size);
default:
assert(0);
@ -465,7 +465,7 @@ get_bytes(size, from, to)
t_addr from;
char *to;
{
return getbytes(size, from, to, GETBYTES);
return getbytes(size, from, to, M_GETBYTES);
}
int
@ -474,7 +474,7 @@ get_string(size, from, to)
t_addr from;
char *to;
{
int retval = getbytes(size, from, to, GETSTR);
int retval = getbytes(size, from, to, M_GETSTR);
to[(int)answer.m_size] = 0;
return retval;
@ -487,7 +487,7 @@ set_bytes(size, from, to)
{
struct message_hdr m;
m.m_type = SETBYTES;
m.m_type = M_SETBYTES;
m.m_size = size;
put_int(m.m_buf, pointer_size, (long) to);
@ -495,13 +495,13 @@ set_bytes(size, from, to)
return;
}
switch(answer.m_type) {
case FAIL:
case M_FAIL:
error("could not handle this SET request");
break;
case INTR:
case M_INTR:
error("interrupted");
break;
case OK:
case M_OK:
break;
default:
assert(0);
@ -515,18 +515,18 @@ get_dump(globmessage, globbuf, stackmessage, stackbuf)
{
struct message_hdr m;
m.m_type = DUMP;
m.m_type = M_DUMP;
if (! could_send(&m, 0)) {
return 0;
}
switch(answer.m_type) {
case FAIL:
case M_FAIL:
error("request for DUMP failed");
return 0;
case INTR:
case M_INTR:
error("interrupted");
return 0;
case DGLOB:
case M_DGLOB:
break;
default:
assert(0);
@ -538,7 +538,7 @@ get_dump(globmessage, globbuf, stackmessage, stackbuf)
if (*globbuf) free(*globbuf);
return 0;
}
assert(stackmessage->m_type == DSTACK);
assert(stackmessage->m_type == M_DSTACK);
*stackbuf = malloc((unsigned) stackmessage->m_size);
if (! ureceive(*stackbuf, stackmessage->m_size)) {
if (*globbuf) free(*globbuf);
@ -583,20 +583,20 @@ get_EM_regs(level)
static t_addr buf[5];
register t_addr *to = &buf[0];
m.m_type = GETEMREGS;
m.m_type = M_GETEMREGS;
m.m_size = level;
if (! could_send(&m, 0)) {
return 0;
}
switch(answer.m_type) {
case FAIL:
case M_FAIL:
error("request for registers failed");
return 0;
case INTR:
case M_INTR:
error("interrupted");
return 0;
case GETEMREGS:
case M_GETEMREGS:
break;
default:
assert(0);
@ -615,18 +615,18 @@ set_pc(PC)
{
struct message_hdr m;
m.m_type = SETEMREGS;
m.m_type = M_SETEMREGS;
m.m_size = 0;
put_int(m.m_buf+PC_OFF*pointer_size, pointer_size, (long)PC);
if (! could_send(&m, 0)) return 0;
switch(answer.m_type) {
case FAIL:
case M_FAIL:
error("could not set PC to %lx", (long) PC);
return 0;
case INTR:
case M_INTR:
error("interrupted");
return 0;
case OK:
case M_OK:
return 1;
default:
assert(0);
@ -640,19 +640,19 @@ send_cont(stop_message)
{
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;
return could_send(&m, stop_message) && child_pid;
}
int
do_single_step(type, count)
singlestep(type, count)
int type;
long count;
{
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;
single_stepping = 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_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)) {
}
@ -686,7 +686,7 @@ set_or_clear_trace(start, end, type)
m.m_type = type;
put_int(m.m_buf, pointer_size, (long)start);
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)) {
return 0;
}

4
util/grind/scope.cc
View file

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

4
util/grind/scope.h
View file

@ -1,7 +1,7 @@
/* scope structure */
/* $Header$ */
/* scope structure */
typedef struct scope {
struct scope *sc_static_encl; /* linked list of enclosing scopes */
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 ... */
#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'.
*/
static int
int
consistent(p, sc)
p_tree p;
p_scope sc;
@ -298,7 +298,6 @@ pr_scopes(sc)
}
}
static
pr_sym(s)
p_symbol s;
{
@ -339,49 +338,6 @@ pr_sym(s)
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)
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$ */
#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$ */
struct tokenname { /* Used for defining the name of a

399
util/grind/tree.c
View file

@ -20,15 +20,9 @@
extern FILE *db_out;
t_lineno currline;
static t_lineno listline;
extern long pointer_size;
t_lineno listline;
extern char *strrindex();
extern int interrupted;
extern int stop_reason;
p_tree print_command;
static int wsize = 10;
/*VARARGS1*/
p_tree
@ -89,7 +83,7 @@ freenode(p)
free_tree(p);
}
static t_addr
t_addr
get_addr_from_node(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);
}
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)
register struct idf *id;
{
@ -481,328 +408,6 @@ newfile(id)
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)
register p_tree p;
t_addr a;