Browse Source

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

ceriel 34 years ago
parent
commit
9da96274ae

+ 3 - 5
util/grind/Amakefile

@@ -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
 } ;
 } ;

+ 10 - 10
util/grind/c.c

@@ -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;

+ 1 - 1
util/grind/char.ct

@@ -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

+ 3 - 17
util/grind/class.h

@@ -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
-	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.
 	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])

+ 83 - 5
util/grind/commands.g

@@ -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 - 0
util/grind/db_symtab.g

@@ -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 - 0
util/grind/do_comm.c

@@ -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);
+}
+

+ 44 - 44
util/grind/expr.c

@@ -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,
-  do_deref,
+  not_op,
+  deref_op,
   0,
   0,
   0,
   0,
   0,
   0,
@@ -409,8 +409,8 @@ static int (*un_op[])() = {
   0,
   0,
   0,
   0,
   0,
   0,
-  do_unplus,
-  do_unmin,
+  unplus_op,
+  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,
-  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,
   0,
-  do_derselect,
-  do_sft,
-  do_sft,
+  derselect_op,
+  sft_op,
+  sft_op,
   0
   0
 };
 };
 
 

+ 2 - 9
util/grind/idf.c

@@ -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"

+ 2 - 9
util/grind/idf.h

@@ -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 - 16
util/grind/itemlist.cc

@@ -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,24 +154,27 @@ 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 (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;
   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;
 
 

+ 7 - 5
util/grind/main.c

@@ -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
 {
 {

+ 24 - 24
util/grind/message.h

@@ -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	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_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	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.
 			   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 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 */
   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 */
 };
 };

+ 2 - 2
util/grind/print.c

@@ -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, ' ');
 	}
 	}

+ 37 - 37
util/grind/run.c

@@ -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();
-  if (! restoring && ! item_addr_actions(curr_stop, OK, 1)) {
+  perform_items();
+  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) {
-				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;
 			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;
 			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;
   }
   }

+ 2 - 2
util/grind/scope.cc

@@ -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>

+ 2 - 2
util/grind/scope.h

@@ -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 - 0
util/grind/sizes.h

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

+ 1 - 45
util/grind/symbol.c

@@ -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;
 {
 {

+ 0 - 9
util/grind/tokenname.c

@@ -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"

+ 0 - 9
util/grind/tokenname.h

@@ -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

+ 2 - 397
util/grind/tree.c

@@ -20,15 +20,9 @@
 
 
 extern FILE	*db_out;
 extern FILE	*db_out;
 t_lineno	currline;
 t_lineno	currline;
-static t_lineno	listline;
-extern long	pointer_size;
+t_lineno	listline;
 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;