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 = {
-	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
 } ;

+ 10 - 10
util/grind/c.c

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

+ 1 - 1
util/grind/char.ct

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

+ 83 - 5
util/grind/commands.g

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

+ 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$ */
 
+/* Instantiation of idf package */
+
 #include	"position.h"
 #include	"file.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$ */
 
+/* User-declared part of idf structure */
+
 struct id_u {
 	int id_res;
 	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)) {
 		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;
 

+ 7 - 5
util/grind/main.c

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

+ 24 - 24
util/grind/message.h

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

+ 2 - 2
util/grind/print.c

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

+ 37 - 37
util/grind/run.c

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

+ 2 - 2
util/grind/scope.cc

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

+ 2 - 2
util/grind/scope.h

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

@@ -1,3 +1,5 @@
+/* $Header$ */
+
 /* For the time being ... */
 
 #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'.
 */
-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;
 {

+ 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$ */
 
 #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$ */
 
 struct tokenname	{	/*	Used for defining the name of a

+ 2 - 397
util/grind/tree.c

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