Too many changes and fixes to mention them all here

util/grind/Amakefile

@@ -61,6 +61,7 @@ CSRC = {
 	value.c,
 	type.c,
 	rd.c,
+	help.c,
 	modula-2.c,
 	c.c
 } ;
@@ -101,7 +102,7 @@ LIBRARIES = {
 	$EMHOME/modules/lib/libsystem.a
 } ;
 
-DBFLAGS = { -g, -DDEBUG } ;
+DBFLAGS = { -O, -DDEBUG } ;
 PROFFLAGS = { } ;
 
 LDFLAGS = {

util/grind/c.c

@@ -57,8 +57,8 @@ static struct langdep c = {
 	print_string,
 	print_char,
 	array_elsize,
-	unop_prio,
 	binop_prio,
+	unop_prio,
 	get_string,
 	get_name,
 	get_number,
@@ -69,11 +69,46 @@ static struct langdep c = {
 
 struct langdep *c_dep = &c;
 
+static int
+printchar(c, esc)
+  int	c;
+{
+  switch(c) {
+  case '\n':
+	fputs("\\n", db_out);
+	break;
+  case '\t':
+	fputs("\\t", db_out);
+	break;
+  case '\b':
+	fputs("\\b", db_out);
+	break;
+  case '\r':
+	fputs("\\r", db_out);
+	break;
+  case '\f':
+	fputs("\\f", db_out);
+	break;
+  case '\\':
+	fputs("\\\\", db_out);
+	break;
+  case '\'':
+  case '"':
+	fprintf(db_out, c == esc ? "\\%c" : "%c", c);
+	break;
+  default:
+  	fprintf(db_out, (c >= 040 && c < 0177) ? "%c" : "\\%03o", c);
+	break;
+  }
+}
+
 static int
 print_char(c)
   int	c;
 {
-  fprintf(db_out, (c >= 040 && c < 0177) ? "'%c'" : "'\\0%o'", c);
+  fputc('\'', db_out);
+  printchar(c, '\'');
+  fputc('\'', db_out);
 }
 
 static int
@@ -82,12 +117,10 @@ print_string(s, len)
   int	len;
 {
   register char	*str = s;
-  int delim = '\'';
 
-  while (*str) {
+  fputc('"', db_out);
-	if (*str++ == '\'') delim = '"';
+  while (*str && len-- > 0) printchar(*str++, '"');
-  }
+  fputc('"', db_out);
-  fprintf(db_out, "%c%.*s%c", delim, len, s, delim);
 }
 
 extern long	int_size;
@@ -110,7 +143,6 @@ unop_prio(op)
   case E_BNOT:
   case E_MIN:
   case E_DEREF:
-  case E_SELECT:
   case E_PLUS:
   case E_ADDR:
 	return 12;
@@ -153,6 +185,11 @@ binop_prio(op)
   case E_MOD:
   case E_ZMOD:
 	return 11;
+  case E_ARRAY:
+  case E_SELECT:
+	return 12;
+  case E_DERSELECT:
+	return 13;
   }
   return 1;
 }
@@ -236,15 +273,19 @@ get_token(c)
   register int	c;
 {
   switch(c) {
+  case '[':
+	tok.ival = E_ARRAY;
+	/* fall through */
   case '(':
   case ')':
-  case '[':
   case ']':
   case '`':
   case ':':
   case ',':
+  case '}':
+  case '{':
+  case '\\':
 	return c;
-
   case '.':
 	tok.ival = E_SELECT;
 	return SEL_OP;
@@ -340,7 +381,7 @@ get_token(c)
 	tok.ival = E_BNOT;
 	return PREF_OP;
   default:
-	error("illegal character 0%o", c);
+	error((c >= 040 && c < 0177) ? "%s'%c'" : "%s'\\0%o'", "illegal character ", c);
 	return LLlex();
   }
 }
@@ -397,6 +438,7 @@ get_string(c)
   while (ch = getc(db_in), ch != c) {
 	if (ch == '\n') {
 		error("newline in string");
+		ungetc(ch, db_in);
 		break;
 	}
 	if (ch == '\\') {
@@ -406,6 +448,15 @@ get_string(c)
 	buf[len++] = ch;
   }
   buf[len++] = 0;
+  if (c == '\'') {
+	long val = 0;
+	ch = 0;
+	while (buf[ch] != 0) {
+		val = (val << 8) + (buf[ch++] & 0377);
+	}
+	tok.ival = val;
+	return INTEGER;
+  }
   tok.str = Salloc(buf, (unsigned) len);
   return STRING;
 }
@@ -418,28 +469,34 @@ print_op(p)
   case OP_UNOP:
   	switch(p->t_whichoper) {
 	case E_MIN:
-		fputs("-", db_out);
+		fputs("-(", db_out);
 		print_node(p->t_args[0], 0);
+		fputc(')', db_out);
 		break;
 	case E_PLUS:
-		fputs("+", db_out);
+		fputs("+(", db_out);
 		print_node(p->t_args[0], 0);
+		fputc(')', db_out);
 		break;
 	case E_NOT:
-		fputs("!", db_out);
+		fputs("!(", db_out);
 		print_node(p->t_args[0], 0);
+		fputc(')', db_out);
 		break;
 	case E_DEREF:
-		fputs("*", db_out);
+		fputs("*(", db_out);
 		print_node(p->t_args[0], 0);
+		fputc(')', db_out);
 		break;
 	case E_BNOT:
-		fputs("~", db_out);
+		fputs("~(", db_out);
 		print_node(p->t_args[0], 0);
+		fputc(')', db_out);
 		break;
 	case E_ADDR:
-		fputs("&", db_out);
+		fputs("&(", db_out);
 		print_node(p->t_args[0], 0);
+		fputc(')', db_out);
 		break;
 	}
 	break;

util/grind/char.ct

@@ -8,11 +8,11 @@
 %iSTGARB
 STSKIP: \t\013\014\015
 STNL:;\012
-STIDF:a-zA-Z_$
+STIDF:a-zA-Z_
 STSTR:"'
 STDOT:.
 STNUM:0-9
-STSIMP:,<>{}:`
+STSIMP:-,<>{}:`?\\
 %T#include "class.h"
 %Tchar tkclass[] = {
 %p

util/grind/commands.g

@@ -4,7 +4,6 @@
 {
 #include	<stdio.h>
 #include	<alloc.h>
-#include	<setjmp.h>
 #include	<signal.h>
 
 #include	"ops.h"
@@ -19,15 +18,17 @@
 #include	"expr.h"
 
 extern char	*Salloc();
+extern char	*strindex();
 extern FILE	*db_in;
+extern int	disable_intr;
+extern p_tree	run_command, print_command;
 
-int		errorgiven;
+int		errorgiven = 0;
+int		child_interrupted = 0;
+int		interrupted = 0;
+int		eof_seen = 0;
 static int	extended_charset = 0;
 static int	in_expression = 0;
-jmp_buf		jmpbuf;
-
-static int	init_del();
-static int	skip_to_eol();
 
 struct token	tok, aside;
 
@@ -40,50 +41,51 @@ struct token	tok, aside;
 
 commands
   { p_tree com, lastcom = 0;
+    int give_prompt;
   }
 :
-			{ if (! setjmp(jmpbuf)) {
-				init_del();
-			  }
-			  else {
-				skip_to_eol();
-				goto prmpt;
-			  }
-			}
   [ %persistent command_line(&com)
+    [	'\n'		{ give_prompt = 1; }
+    |	%default ';'	{ give_prompt = 0; }
+    ]
 			{ if (com) {
 				if (errorgiven) {
 					freenode(com);
 					com = 0;
 				}
-				if (lastcom && !in_status(lastcom) &&
+				if (lastcom) {
-				    lastcom != run_command) {
 					freenode(lastcom);
 					lastcom = 0;
 				}
 
 				if (com) {
+					eval(com);
 			  		if (repeatable(com)) {
 						lastcom = com;
 					}
-					eval(com);
+					else if (! in_status(com) &&
-					if (! repeatable(com) &&
+					        com != run_command &&
-					    ! in_status(com) &&
+						com != print_command) {
-					    com != run_command) {
 						freenode(com);
 					}
 				}
-			  } else if (lastcom && ! errorgiven) eval(lastcom);
+			  } else if (lastcom && ! errorgiven) {
+				eval(lastcom);
+			  }
+			  if (give_prompt) {
+			  	errorgiven = 0;
+				interrupted = 0;
+				prompt();
+			  }
 			}
-    [	'\n' 		{ prmpt: prompt(); }
-    |	';'
-    ]			{ errorgiven = 0; }
   ]*
 			{ signal_child(SIGKILL); }
 ;
 
 command_line(p_tree *p;)
 :
+			{ *p = 0; }
+[
   list_command(p)
 | file_command(p)
 | run_command(p)
@@ -102,9 +104,12 @@ command_line(p_tree *p;)
 | display_command(p)
 | trace_command(p)
 | set_command(p)
+| help_command(p)
 | FIND qualified_name(p){ *p = mknode(OP_FIND, *p); }
 | WHICH qualified_name(p){ *p = mknode(OP_WHICH, *p); }
-|			{ *p = 0; }
+| able_command(p)
+|
+]
 ;
 
 where_command(p_tree *p;)
@@ -112,6 +117,7 @@ where_command(p_tree *p;)
 :
   WHERE
   [ INTEGER		{ l = tok.ival; }
+  | '-' INTEGER		{ l = - tok.ival; }
   |			{ l = 0x7fffffff; }
   ]			{ *p = mknode(OP_WHERE, l); }
 ;
@@ -121,12 +127,17 @@ list_command(p_tree *p;)
 :
   LIST
   [
-  | lin_num(&t1)
+  | count(&t1)
-    [ ',' lin_num(&t2)
-    |			{ t2 = mknode(OP_INTEGER, t1->t_ival); }
-    ]
   | qualified_name(&t1)
-  ]			{ *p = mknode(OP_LIST, t1, t2); }
+  ]
+  [ ',' count(&t2)
+  | '-' 
+    [	count(&t2)	{ t2->t_ival = - t2->t_ival; }
+    |			{ t2 = mknode(OP_INTEGER, -100000000L); }
+    ]
+  |
+  ]
+			{ *p = mknode(OP_LIST, t1, t2); }
 ;
 
 file_command(p_tree *p;)
@@ -139,13 +150,20 @@ file_command(p_tree *p;)
 			}
 ;
 
+help_command(p_tree *p;)
+:
+  [ HELP | '?' ]
+  [			{ *p = mknode(OP_HELP, (struct idf *) 0, (char *) 0); }
+  | name(p)		{ (*p)->t_oper = OP_HELP; }
+  | '?'			{ *p = mknode(OP_HELP, str2idf("help",0), (char *) 0); }
+  ]
+;
+
 run_command(p_tree *p;)
 :
-  RUN			{ extended_charset = 1; *p = 0; }
+  RUN			{ extended_charset = 1; }
   args(p)		{ *p = mknode(OP_RUN, *p);
 			  extended_charset = 0;
-			  freenode(run_command);
-			  run_command = *p;
 			}
 | RERUN			{ if (! run_command) {
 				error("no run command given yet");
@@ -171,7 +189,7 @@ trace_command(p_tree *p;)
   { p_tree whr = 0, cond = 0, exp = 0; }
 :
   TRACE
-  [ ON expression(&exp, 1) ]?
+  [ ON expression(&exp, 0) ]?
   where(&whr)?
   condition(&cond)?	{ *p = mknode(OP_TRACE, whr, cond, exp); }
 ;
@@ -195,9 +213,11 @@ when_command(p_tree *p;)
   condition(&cond)?
   '{' 
   command_line(p)
-  [ ';'			{ *p = mknode(OP_LINK, *p, (p_tree) 0);
+  [ ';'			{ if (*p) {
+				*p = mknode(OP_LINK, *p, (p_tree) 0);
 			  	p = &((*p)->t_args[1]);
 			  }
+			}
     command_line(p)
   ]*
   '}'
@@ -206,6 +226,9 @@ when_command(p_tree *p;)
 				freenode(*p);
 				*p = 0;
 			  }
+			  else if (! *p) {
+				error("no commands given");
+			  }
 			  else *p = mknode(OP_WHEN, whr, cond, *p);
 			}
 ;
@@ -239,41 +262,81 @@ regs_command(p_tree *p;)
 
 delete_command(p_tree *p;)
 :
-  DELETE
+  DELETE count_list(p)	{ *p = mknode(OP_DELETE, *p); }
-  INTEGER		{ *p = mknode(OP_DELETE, tok.ival); }
 ;
 
 print_command(p_tree *p;)
 :
-  PRINT expression_list(p)
+  PRINT 
+  [ format_expression_list(p)
 			{ *p = mknode(OP_PRINT, *p); }
+  |
+			{ *p = mknode(OP_PRINT, (p_tree) 0); }
+  ]
 ;
 
 display_command(p_tree *p;)
 :
-  DISPLAY expression_list(p)
+  DISPLAY format_expression_list(p)
 			{ *p = mknode(OP_DISPLAY, *p); }
 ;
 
-expression_list(p_tree *p;)
+format_expression_list(p_tree *p;)
 :
-  expression(p, 1)
+  format_expression(p)
   [ ','			{ *p = mknode(OP_LINK, *p, (p_tree) 0);
 			  p = &((*p)->t_args[1]);
 			}
-    expression(p, 1)
+    format_expression(p)
   ]*
 ;
 
+format_expression(p_tree *p;)
+  { p_tree	p1; }
+:
+  expression(p, 0)
+  [ '\\' 
+	[ name(&p1)	{ register char *c = p1->t_str;
+			  while (*c) {
+				if (! strindex("doshcax", *c)) {
+					error("illegal format: %c", *c);
+					break;
+				}
+				c++;
+			  }
+			  *p = mknode(OP_FORMAT, *p, p1);
+			}
+	|
+	]
+  |
+  ]
+;
+
 set_command(p_tree *p;)
 :
-  SET expression(p, 1)	{ *p = mknode(OP_SET, *p, (p_tree) 0); }
+  SET expression(p, 0)	{ *p = mknode(OP_SET, *p, (p_tree) 0); }
-  TO expression(&((*p)->t_args[1]), 1)
+  TO expression(&((*p)->t_args[1]), 0)
+;
+
+able_command(p_tree *p;)
+:
+  [ ENABLE 		{ *p = mknode(OP_ENABLE, (p_tree) 0); }
+  | DISABLE 		{ *p = mknode(OP_DISABLE, (p_tree) 0); }
+  ]
+  count_list(&(*p)->t_args[0])
+;
+
+count_list(p_tree *p;)
+:
+  count(p)
+  [ ','			{ *p = mknode(OP_LIST, *p, (p_tree) 0); }
+    count(&(*p)->t_args[1])
+  ]*
 ;
 
 condition(p_tree *p;)
 :
-  IF expression(p, 1)
+  IF expression(p, 0)
 ;
 
 where(p_tree *p;)
@@ -293,36 +356,7 @@ expression(p_tree *p; int level;)
 			  (*p)->t_whichoper = currop;
 			}
 	expression(&((*p)->t_args[1]), currprio)
-			{ adjust_oper(p); }
+  |
-  ]*
-			{ in_expression--; }
-;
-
-factor(p_tree *p;)
-:
-  '(' expression(p, 1) ')'
-|
-  INTEGER		{ *p = mknode(OP_INTEGER, tok.ival); }
-|
-  REAL			{ *p = mknode(OP_REAL, tok.fval); }
-|
-  STRING		{ *p = mknode(OP_STRING, tok.str); }
-|
-  designator(p)
-|
-  			{ *p = mknode(OP_UNOP, (p_tree) 0);
-			  (*p)->t_whichoper = (int) tok.ival;
-			}
-  [ PREF_OP 
-  | PREF_OR_BIN_OP 	{ (*currlang->fix_bin_to_pref)(*p); }
-  ]
-  expression(&(*p)->t_args[0], unprio((*p)->t_whichoper))
-;
-
-designator(p_tree *p;)
-:
-  qualified_name(p)
-  [
 	SEL_OP		{ *p = mknode(OP_BINOP, *p, (p_tree) 0);
 			  (*p)->t_whichoper = (int) tok.ival;
 			}
@@ -331,9 +365,43 @@ designator(p_tree *p;)
 	'['		{ *p = mknode(OP_BINOP, *p, (p_tree) 0);
 			  (*p)->t_whichoper = E_ARRAY;
 			}
-	expression(&(*p)->t_args[1], 1)
+	expression(&(*p)->t_args[1], 0)
+	[	','	{ *p = mknode(OP_BINOP, *p, (p_tree) 0);
+			  (*p)->t_whichoper = E_ARRAY;
+			}
+		expression(&(*p)->t_args[1], 0)
+	]*
 	']'
+  ]*
+			{ in_expression--; }
+;
+
+factor(p_tree *p;)
+:
+  [
+  	%default EXPRESSION	/* lexical analyzer will never return this token */
+			{ *p = mknode(OP_INTEGER, 0L); }
   |
+  	'(' expression(p, 0) ')'
+  |
+  	INTEGER		{ *p = mknode(OP_INTEGER, tok.ival); }
+  |
+  	REAL		{ *p = mknode(OP_REAL, tok.fval); }
+  |
+  	STRING		{ *p = mknode(OP_STRING, tok.str); }
+  |
+  	qualified_name(p)
+  |
+  			{ *p = mknode(OP_UNOP, (p_tree) 0);
+			  (*p)->t_whichoper = (int) tok.ival;
+			}
+  	[ PREF_OP 
+  	| PREF_OR_BIN_OP
+			{ (*currlang->fix_bin_to_pref)(*p); }
+  	]
+  	expression(&(*p)->t_args[0], unprio((*p)->t_whichoper))
+  ]
+  [ %while(1)
 	POST_OP		{ *p = mknode(OP_UNOP, *p);
 			  (*p)->t_whichoper = (int) tok.ival;
 			}
@@ -352,7 +420,7 @@ position(p_tree *p;)
 			  else str = listfile->sy_idf->id_text;
 			}
   ]
-  lin_num(&lin)		{ *p = mknode(OP_AT, lin->t_ival, str);
+  count(&lin)		{ *p = mknode(OP_AT, lin->t_ival, str);
 			  freenode(lin);
 			}
 ;
@@ -379,7 +447,7 @@ arg(p_tree *p;)
   '<' name(p)		{ (*p)->t_oper = OP_INPUT; }
 ;
 
-lin_num(p_tree *p;)
+count(p_tree *p;)
 :
   INTEGER		{ *p = mknode(OP_INTEGER, tok.ival); }
 ;
@@ -403,7 +471,7 @@ name(p_tree *p;)
   | AT
   | IN
   | IF
-  | NAME
+  | %default NAME
   | CONT
   | STEP
   | NEXT
@@ -421,6 +489,9 @@ name(p_tree *p;)
   | FIND
   | DISPLAY
   | WHICH
+  | HELP
+  | DISABLE
+  | ENABLE
   ]			{ *p = mknode(OP_NAME, tok.idf, tok.str); }
 ;
 
@@ -438,7 +509,10 @@ LLlex()
   do {
 	c = getc(db_in);
   } while (c != EOF && class(c) == STSKIP);
-  if (c == EOF) return c;
+  if (c == EOF) {
+	eof_seen = 1;
+	return c;
+  }
   if (extended_charset && in_ext(c)) {
 	TOK = get_name(c);
 	return TOK;
@@ -483,7 +557,7 @@ get_name(c)
 	c = getc(db_in);
   } while ((extended_charset && in_ext(c)) || in_idf(c));
   ungetc(c, db_in);
-  *p = 0;
+  *p++ = 0;
   if (extended_charset) {
 	tok.idf = 0;
 	tok.str = Salloc(buf, (unsigned) (p - buf));
@@ -520,20 +594,16 @@ static int
 catch_del()
 {
   signal(SIGINT, catch_del);
+  if (! disable_intr) {
   	signal_child(SIGEMT);
-  longjmp(jmpbuf, 1);
+  	child_interrupted = 1;
+  }
+  interrupted = 1;
 }
 
-static int
+int
 init_del()
 {
   signal(SIGINT, catch_del);
 }
-
-static int
-skip_to_eol()
-{
-  while (TOK != '\n' && TOK > 0) LLlex();
-  wait_for_child("interrupted");
-}
 }

util/grind/dbx_string.g

@@ -56,8 +56,13 @@ debugger_string
   | /* 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_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' tag_name(s)
@@ -225,7 +230,7 @@ type_name(p_type *t; p_symbol sy;)
 	type(t, type_index, sy)
 				{ p = tp_lookup(type_index);
 				  if (*p && *p != incomplete_type) {
-					if (!((*p)->ty_flags & T_CROSS))
+					if ((*p)->ty_class != T_CROSS)
 						error("Redefining (%d,%d) %d",
 						  type_index[0],
 						  type_index[1],
@@ -264,7 +269,7 @@ tag_name(p_symbol t;)
   type(&(t->sy_type), type_index, t)
 				{ p = tp_lookup(type_index);
 				  if (*p && *p != incomplete_type) {
-					if (!((*p)->ty_flags & T_CROSS))
+					if ((*p)->ty_class != T_CROSS)
 						error("Redefining (%d,%d) %d",
 						  type_index[0],
 						  type_index[1],
@@ -275,6 +280,11 @@ tag_name(p_symbol t;)
 				  }
 				  if (t->sy_type) *p = t->sy_type; 
 				  if (*p == 0) *p = incomplete_type;
+			  	  if (t->sy_type &&
+				      t->sy_type->ty_class == T_ENUM &&
+			              currnam->on_desc != 0) {
+					t->sy_type->ty_size = currnam->on_desc;
+			  	  }
 				}
 ;
 
@@ -348,14 +358,15 @@ type(p_type *ptp; int *type_index; p_symbol sy;)
   	]
 			{ AllowName = 1; }
   	name(&str)
-			{ sy = Lookfromscope(str2idf(str,0),CurrentScope,TAG);
+			{ sy = Lookfromscope(str2idf(str,0),TAG,CurrentScope);
-			  if (sy && sy->sy_type->ty_class == tclass) {
+			  if (sy && 
+			      (sy->sy_type->ty_class == tclass ||
+			       sy->sy_type->ty_class == T_CROSS)) {
 				tp = sy->sy_type;
 			  }
 			  else {
 				tp = new_type();
-				tp->ty_flags = T_CROSS;
+				tp->ty_class = T_CROSS;
-				tp->ty_class = tclass;
 				tp->ty_tag = str;
 				sy = NewSymbol(str, CurrentScope, TAG, (struct outname *) 0);
 			  }

util/grind/dbxread.c

@@ -38,11 +38,11 @@ DbxRead(f)
 
   /* Open file, read header, and check magic word */
   if (! rd_open(f)) {
-  	fatal("%s: not an ACK object file", f);
+  	fatal("%s: could not open", f);
   }
   rd_ohead(&h);
   if (BADMAGIC(h) && h.oh_magic != O_CONVERTED) {
-  	fatal("%s: not an ACK object file", f);
+  	fatal("%s: not an object file", f);
   }
 
   /* Allocate space for name table and read it */

util/grind/expr.c

@@ -229,10 +229,10 @@ eval_cond(p)
   if (eval_expr(p, &buf, &size, &tp)) {
 	if (convert(&buf, &size, &tp, target_tp, target_tp->ty_size)) {
 		val = get_int(buf, size, T_UNSIGNED);
-		if (buf) free(buf);
+		free(buf);
 		return (int) (val != 0);
 	}
-	if (buf) free(buf);
+	free(buf);
   }
   return 0;
 }
@@ -298,6 +298,7 @@ ptr_addr(p, paddr, psize, ptp)
 		return 1;
   	default:
 		error("illegal operand of DEREF");
+		free(buf);
 		break;
 	}
   }
@@ -318,6 +319,9 @@ do_deref(p, pbuf, psize, ptp)
 	malloc_succeeded(*pbuf);
 	if (! get_bytes(*psize, addr, *pbuf)) {
 		error("could not get value");
+		free(*pbuf);
+		*pbuf = 0;
+		return 0;
 	}
 	return 1;
   }
@@ -337,6 +341,8 @@ do_addr(p, pbuf, psize, ptp)
 	*pbuf = malloc((unsigned) pointer_size);
 	malloc_succeeded(*pbuf);
 	put_int(*pbuf, pointer_size, (long) addr);
+	address_type->ty_ptrto = *ptp;
+	*ptp = address_type;
 	return 1;
   }
   return 0;
@@ -505,7 +511,7 @@ do_andor(p, pbuf, psize, ptp)
   p_type	*ptp;
 {
   long		l1, l2;
-  char		*buf;
+  char		*buf = 0;
   long		size;
   p_type	tp;
   p_type	target_tp = currlang->has_bool_type ? bool_type : int_type;
@@ -524,7 +530,7 @@ do_andor(p, pbuf, psize, ptp)
 	free(buf);
 	return 1;
   }
-  free(buf);
+  if (buf) free(buf);
   return 0;
 }
 
@@ -541,9 +547,44 @@ do_arith(p, pbuf, psize, ptp)
   long		size;
   p_type	tp, balance_tp;
 
-  if (eval_expr(p->t_args[0], pbuf, psize, ptp) &&
+  if (!(eval_expr(p->t_args[0], pbuf, psize, ptp) &&
-      eval_expr(p->t_args[1], &buf, &size, &tp) &&
+        eval_expr(p->t_args[1], &buf, &size, &tp))) {
-      (balance_tp = balance(*ptp, tp)) &&
+	return 0;
+  }
+  if ((*ptp)->ty_class == T_POINTER) {
+	if (currlang != c_dep ||
+	    (p->t_whichoper != E_PLUS && p->t_whichoper != E_MIN)) {
+		error("illegal operand type(s)");
+		free(buf);
+		return 0;
+	}
+	l1 = get_int(*pbuf, *psize, T_UNSIGNED);
+	if (tp->ty_class == T_POINTER) {
+		if (p->t_whichoper != E_MIN) {
+			error("illegal operand type(s)");
+			free(buf);
+			return 0;
+		}
+		l2 = get_int(buf, size, T_UNSIGNED);
+		free(buf);
+		*pbuf = Realloc(*pbuf, (unsigned) long_size);
+		put_int(*pbuf, long_size, (l1 - l2)/(*ptp)->ty_ptrto->ty_size);
+		*ptp = long_type;
+		return 1;
+	}
+	if (! convert(&buf, &size, &tp, long_type, long_size)) {
+		free(buf);
+		return 0;
+	}
+	l2 = get_int(buf, size, T_INTEGER) * (*ptp)->ty_ptrto->ty_size;
+	free(buf);
+	buf = 0;
+	if (p->t_whichoper == E_PLUS) l1 += l2;
+	else l1 -= l2;
+	put_int(*pbuf, *psize, l1);
+	return 1;
+  }
+  if ((balance_tp = balance(*ptp, tp)) &&
       convert(pbuf, psize, ptp, balance_tp, balance_tp->ty_size) &&
       convert(&buf, &size, &tp, balance_tp, balance_tp->ty_size)) {
 	switch(balance_tp->ty_class) {
@@ -795,6 +836,10 @@ do_cmp(p, pbuf, psize, ptp)
 			break;
 		}
 		break;
+	default:
+		error("illegal operand type(s)");
+		free(buf);
+		return 0;
 	}
 	if (*psize < int_size) {
 		*psize = int_size;
@@ -976,6 +1021,9 @@ do_select(p, pbuf, psize, ptp)
 	*pbuf = malloc((unsigned int) *psize);
 	malloc_succeeded(*pbuf);
 	if (! get_bytes(*psize, a, *pbuf)) {
+		error("could not get value");
+		free(*pbuf);
+		*pbuf = 0;
 		return 0;
 	}
 	return 1;
@@ -983,6 +1031,27 @@ do_select(p, pbuf, psize, ptp)
   return 0;
 }
 
+static int
+do_derselect(p, pbuf, psize, ptp)
+  p_tree	p;
+  char		**pbuf;
+  long		*psize;
+  p_type	*ptp;
+{
+  int	retval;
+  t_tree	t;
+
+  t.t_oper = OP_UNOP;
+  t.t_whichoper = E_DEREF;
+  t.t_args[0] = p->t_args[0];
+  p->t_args[0] = &t;
+  p->t_whichoper = E_SELECT;
+  retval = eval_expr(p, pbuf, psize, ptp);
+  p->t_args[0] = t.t_args[0];
+  p->t_whichoper = E_DERSELECT;
+  return retval;
+}
+
 static int (*bin_op[])() = {
   0,
   0,
@@ -1009,7 +1078,7 @@ static int (*bin_op[])() = {
   do_arith,
   do_arith,
   0,
-  0,
+  do_derselect,
   do_sft,
   do_sft,
   0
@@ -1025,7 +1094,12 @@ eval_expr(p, pbuf, psize, ptp)
   register p_symbol	sym;
   int		retval = 0;
 
+  *pbuf = 0;
+
   switch(p->t_oper) {
+  case OP_FORMAT:
+	if (eval_expr(p->t_args[0], pbuf, psize, ptp)) retval = 1;
+	break;
   case OP_NAME:
   case OP_SELECT:
 	sym = identify(p, VAR|REGVAR|LOCVAR|VARPAR|CONST);
@@ -1148,7 +1222,7 @@ eval_desig(p, paddr, psize, ptp)
 	}
 	break;
   default:
-	assert(0);
+	error("illegal designator");
 	break;
   }
   if (! retval) {

util/grind/grind.1

@@ -1,5 +1,5 @@
 .\" $Header$
-.TH GRIND 1ACK
+.TH GRIND 1
 .SH NAME
 grind \- source-level debugger for ACK
 .SH SYNOPSIS
@@ -21,15 +21,15 @@ available on many Unix systems. However, some
 .B grind
 commands are not available in
 .IR dbx ,
-some more
+some
 .I dbx
 commands are not available in
 .BR grind ,
-and some things are just plain different.
+and some things are just different.
 .LP
 .I <object file>
 is an object file, produced by
-.IR ack (1ACK)
+.IR ack (1)
 with the
 .B \-g
 option to include a symbol table.
@@ -40,7 +40,7 @@ is specified, "a.out" is used.
 .LP
 For some machines, the debugger does not recognize the object file
 format. For these machines, the result of the
-.IR led (6ACK)
+.IR led (6)
 program must be saved and offered to
 .BR grind .
 .SH USAGE
@@ -164,10 +164,10 @@ when the
 is reached, and then when
 .I condition
 becomes true.
-If no position is given, stop when
+If no position is given, do this when
 .I condition
 becomes true.
-If no condition is given, stop when
+If no condition is given, do this when
 .I position
 is reached.
 Either a position or a condition (or both) must be given.
@@ -273,6 +273,9 @@ If the types do not match,
 tries to apply conversions.
 .TP
 \fBwhere\fP [ \fIn\fP ]
+.ti -0.5i
+\fBw\fP [ \fIn\fP ]
+.br
 List all, or the top
 .IR n ,
 active functions on the stack.
@@ -302,13 +305,11 @@ the first statement of
 Exit
 .BR grind .
 .LP
-Some commands can be repeated by entering an empty command line: step,
+Some commands can be repeated without arguments by entering an empty command line:
-next, print, list, status, cont.
+step, next, list, cont.
-.SH ENVIRONMENT
-P.M.
 .SH SEE ALSO
-.IR ack (1ACK).
+.IR ack (1).
-.IR led (6ACK).
+.IR led (6).
 .SH REMARKS
 .LP
 .B Grind

util/grind/itemlist.cc

@@ -7,6 +7,7 @@
 #include "position.h"
 #include "tree.h"
 #include "operator.h"
+#include "message.h"
 
 extern FILE	*db_out;
 extern int	db_ss;
@@ -14,6 +15,8 @@ extern int	db_ss;
 typedef struct item {
   struct item	*i_next;
   struct tree	*i_node;
+  int		i_disabled;
+  int		i_itemno;
 } t_item, *p_item;
 
 /* STATICALLOCDEF "item" 10 */
@@ -25,7 +28,7 @@ struct itemlist {
 
 static struct itemlist	item_list;
 
-int
+static int
 in_item_list(p)
   p_tree	p;
 {
@@ -38,8 +41,17 @@ in_item_list(p)
   return 0;
 }
 
+static
+pr_item(i)
+  p_item	i;
+{
+  fprintf(db_out, "(%d)\t", i->i_itemno);
+  print_node(i->i_node, 0);
+  fputs(i->i_disabled ? " (disabled)\n": "\n", db_out);
+}
+
 int
-item_addr_actions(a)
+item_addr_actions(a, mess_type)
   t_addr	a;
 {
   /* Perform actions associated with position 'a', and return 1 if we must stop
@@ -51,16 +63,14 @@ item_addr_actions(a)
   while (i) {
 	register p_tree	p = i->i_node;
 
-	if (p->t_address == a || p->t_address == NO_ADDR) {
+	if (! i->i_disabled && (p->t_address == a || p->t_address == NO_ADDR)) {
 		switch(p->t_oper) {
 		case OP_TRACE:
 		case OP_WHEN:
-			if (! p->t_args[1] ||
-			    eval_cond(p->t_args[1])) {
 			perform(p, a);
-			}
 			break;
 		case OP_STOP:
+			if (mess_type != DB_SS && mess_type != OK) break;
 			if (! p->t_args[1] ||
 			    eval_cond(p->t_args[1])) stopping = 1;
 			break;
@@ -83,7 +93,7 @@ handle_displays()
   while (i) {
 	register p_tree p = i->i_node;
 
-	if (p->t_oper == OP_DISPLAY) do_print(p);
+	if (! i->i_disabled && p->t_oper == OP_DISPLAY) do_print(p);
 	i = i->i_next;
   }
 }
@@ -105,9 +115,9 @@ add_to_item_list(p)
   else {
 	item_list.il_last->i_next = i;
   }
-  p->t_itemno = ++item_list.il_count;
+  i->i_itemno = ++item_list.il_count;
   item_list.il_last = i;
-  pr_item(p);
+  pr_item(i);
   return 1;
 }
 
@@ -119,7 +129,7 @@ remove_from_item_list(n)
   p_tree	p = 0;
 
   while (i) {
-	if (i->i_node->t_itemno == n) break;
+	if (i->i_itemno == n) break;
 	prev = i;
 	i = i->i_next;
   }
@@ -144,33 +154,61 @@ get_from_item_list(n)
   register p_item i = item_list.il_first;
 
   while (i) {
-	if (i->i_node->t_itemno == n) return i->i_node;
+	if (i->i_itemno == n) return i->i_node;
 	i = i->i_next;
   }
   return 0;
 }
 
+able_item(n, kind)
+  int	n;
+{
+  register p_item i = item_list.il_first;
+  register p_tree p;
+
+  while (i) {
+	if (i->i_itemno == n) break;
+	i = i->i_next;
+  }
+  if (! i) {
+	error("no item %d in current status", n);
+	return;
+  }
+  p = i->i_node;
+  if (i->i_disabled == kind) {
+	warning("item %d already %sabled", n, kind ? "dis" : "en");
+	return;
+  }
+  if (p->t_address == NO_ADDR &&
+      (p->t_oper != OP_TRACE || ! p->t_args[0])) {
+	db_ss += kind == 1 ? (-1) : 1;
+  }
+  i->i_disabled = kind;
+  switch(p->t_oper) {
+  case OP_STOP:
+  case OP_WHEN:
+	setstop(p, kind ? CLRBP : SETBP);
+	break;
+  case OP_TRACE:
+	settrace(p, kind ? CLRTRACE : SETTRACE);
+	break;
+  }
+}
+
 print_items()
 {
   register p_item i = item_list.il_first;
 
   for (; i; i = i->i_next) {
-	pr_item(i->i_node);
+	pr_item(i);
   }
 }
 
-pr_item(p)
-  p_tree	p;
-{
-  fprintf(db_out, "(%d)\t", p->t_itemno);
-  print_node(p, 1);
-}
-
 do_items()
 {
   register p_item i = item_list.il_first;
 
   for (; i; i = i->i_next) {
-	if (i->i_node->t_oper != OP_DUMP) eval(i->i_node);
+	if (! i->i_disabled && i->i_node->t_oper != OP_DUMP) eval(i->i_node);
   }
 }

util/grind/list.c

@@ -13,6 +13,7 @@ extern char	*dirs[];
 extern FILE	*fopen();
 extern FILE	*db_out;
 extern t_lineno	currline;
+extern int	interrupted;
 
 static int
 mk_filnm(dir, file, newname)
@@ -81,16 +82,14 @@ lines(file, l1, l2)
   else f = last_f;
 
   if (l1 < 1) l1 = 1;
-  if (l2 > file->f_nlines) l2 = file->f_nlines;
+  if (l1 > file->f_nlines) l1 = file->f_nlines;
-  if (l1 > l2) {
+  if (l1+l2-1 > file->f_nlines) l2 = file->f_nlines - l1 + 1;
-	error("%s has only %d lines", file->f_sym->sy_idf->id_text, file->f_nlines);
-	return;
-  }
 
   fseek(f, *(file->f_linepos+(l1-1)), 0);
-  for (n = l1; n <= l2; n++) {
+  for (n = l1; n < l1 + l2; n++) {
 	register int	c;
 
+	if (interrupted) return;
 	fprintf(db_out, "%c%5d\t", currfile && file == currfile->sy_file && n == currline ? '>' : ' ', n);
 	do {
 		c = getc(f);

util/grind/main.c

@@ -9,7 +9,7 @@
 #include "Lpars.h"
 
 static char	*usage = "Usage: %s [<ack.out>] [<a.out>]";
-static char	*progname;
+char		*progname;
 char		*AckObj;
 char		*AObj;
 char		*dirs[] = { "", 0 };
@@ -18,6 +18,7 @@ FILE		*db_in;
 int		debug;
 extern struct tokenname tkidf[];
 extern char	*strindex();
+extern int	eof_seen;
 
 static struct tokenname shorts[] = {
 	{LIST, "l"},
@@ -28,6 +29,7 @@ static struct tokenname shorts[] = {
 	{PRINT, "p"},
 	{RESTORE, "r"},
 	{TRACE, "t"},
+	{WHERE, "w"},
 	{ 0, 0}
 };
 
@@ -39,6 +41,7 @@ main(argc, argv)
   db_out = stdout;
   db_in = stdin;
   progname = argv[0];
+  init_del();
   while (p = strindex(progname, '/')) {
 	progname = p + 1;
   }
@@ -66,20 +69,19 @@ main(argc, argv)
   else if (AObj == 0) AObj = "a.out";
   reserve(tkidf);
   reserve(shorts);
-  if (currfile) CurrentScope = currfile->sy_file->f_scope;
   if (! init_run()) {
 	fatal("something wrong with file descriptors");
   }
   prompt();
   Commands();
-  fputc( '\n', db_out);
+  if (eof_seen) fputc('\n', db_out);
   exit(0);
 }
 
 prompt()
 {
   if (isatty(fileno(db_in))) {
-	fprintf(db_out, "%s -> ", progname);
+	fprintf(db_out, "-> ");
 	fflush(db_out);
   }
 }
@@ -94,12 +96,11 @@ fatal(va_alist)
   va_start(ap);
   {
 	fmt = va_arg(ap, char *);
-	fprintf(stderr, "%s: ", progname);
+	fprintf(db_out, "%s: ", progname);
-	vfprintf(stderr, fmt, ap);
+	vfprintf(db_out, fmt, ap);
-	fprintf(stderr, "\n");
+	fprintf(db_out, "\n");
   }
   va_end(ap);
-  abort();
   exit(1);
 }
 
@@ -115,9 +116,9 @@ error(va_alist)
   va_start(ap);
   {
 	fmt = va_arg(ap, char *);
-	fprintf(stderr, "%s: ", progname);
+	fprintf(db_out, "%s: ", progname);
-	vfprintf(stderr, fmt, ap);
+	vfprintf(db_out, fmt, ap);
-	fprintf(stderr, "\n");
+	fprintf(db_out, "\n");
   }
   va_end(ap);
   errorgiven = 1;
@@ -133,9 +134,9 @@ warning(va_alist)
   va_start(ap);
   {
 	fmt = va_arg(ap, char *);
-	fprintf(stderr, "%s: ", progname);
+	fprintf(db_out, "%s: ", progname);
-	vfprintf(stderr, fmt, ap);
+	vfprintf(db_out, fmt, ap);
-	fprintf(stderr, "\n");
+	fprintf(db_out, "\n");
   }
   va_end(ap);
 }

util/grind/message.h

@@ -36,6 +36,7 @@ struct message_hdr {
 #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 */
   long	m_size;		/* size */
   char	m_buf[BUFLEN];	/* some of the data required included in message */
 };

util/grind/modula-2.c

@@ -110,8 +110,6 @@ unop_prio(op)
   case E_MIN:
   case E_PLUS:
 	return 3;
-  case E_SELECT:
-	return 9;
   }
   return 1;
 }
@@ -121,6 +119,10 @@ binop_prio(op)
   int	op;
 {
   switch(op) {
+  case E_SELECT:
+	return 9;
+  case E_ARRAY:
+	return 5;
   case E_AND:
   case E_MUL:
   case E_DIV:
@@ -357,15 +359,18 @@ get_token(c)
   register int	c;
 {
   switch(c) {
+  case '[':
+	tok.ival = E_ARRAY;
+	/* fall through */
   case '(':
   case ')':
-  case '[':
   case ']':
   case '`':
   case '{':
   case '}':
   case ':':
   case ',':
+  case '\\':
 	return c;
 
   case '.':
@@ -424,7 +429,7 @@ get_token(c)
 	tok.ival = E_NOT;
 	return PREF_OP;
   default:
-	error("illegal character 0%o", c);
+	error((c >= 040 && c < 0177) ? "%s'%c'" : "%s'\\0%o'", "illegal character ", c);
 	return LLlex();
   }
 }
@@ -440,6 +445,7 @@ get_string(c)
   while (ch = getc(db_in), ch != c) {
 	if (ch == '\n') {
 		error("newline in string");
+		ungetc(ch, db_in);
 		break;
 	}
 	buf[len++] = ch;

util/grind/operators.ot

@@ -10,6 +10,7 @@ OP_STRING	0	0
 OP_NAME		0	0
 OP_AT		0	0
 OP_IN		1	0
+OP_HELP		0	do_help
 OP_STOP		2	do_stop
 OP_WHEN		3	do_stop
 OP_CONT		2	do_continue
@@ -17,8 +18,8 @@ OP_STEP		0	do_step
 OP_NEXT		0	do_next
 OP_REGS		0	do_regs
 OP_WHERE	0	do_where
-OP_STATUS	0	do_status
+OP_STATUS	0	print_items
-OP_DELETE	0	do_delete
+OP_DELETE	1	do_delete
 OP_SELECT	2	0
 OP_SET		2	do_set
 OP_PRINT	1	do_print
@@ -30,3 +31,6 @@ OP_DISPLAY	1	add_to_item_list
 OP_WHICH	1	do_which
 OP_UNOP		1	0
 OP_BINOP	2	0
+OP_FORMAT	2	0
+OP_DISABLE	1	do_disable
+OP_ENABLE	1	do_enable

util/grind/position.c

@@ -127,9 +127,11 @@ add_position_addr(filename, n)
 	map->f_start = n;
   }
   else map = lastmap;
+  if (map) {
   	map->f_end = n;
   	setnext_outname(n, map->f_line_addr[HASH(n->on_desc)]);
   	map->f_line_addr[HASH(n->on_desc)] = n;
+  }
 }
 
 /* extern p_position print_position(t_addr a, int print_function);

util/grind/print.c

@@ -15,46 +15,99 @@
 
 extern FILE *db_out;
 extern long float_size, pointer_size, int_size;
+extern char *strindex();
 
 static
-print_literal(tp, v)
+print_unsigned(tp, v, format)
   p_type	tp;
   long		v;
+  register char	*format;
+{
+  while (format && *format) {
+	if (strindex("cdohx", *format)) break;
+	format++;
+  }
+  switch(format == 0 ? 0 : *format) {
+  default:
+	if (tp != uchar_type) {
+  		fprintf(db_out, currlang->uns_fmt, v);
+		break;
+	}
+	/* fall through */
+  case 'c':
+	(*currlang->printchar)((int) v);
+	break;
+  case 'd':
+  	fprintf(db_out, currlang->decint_fmt, v);
+	break;
+  case 'o':
+  	fprintf(db_out, currlang->octint_fmt, v);
+	break;
+  case 'x':
+  case 'h':
+  	fprintf(db_out, currlang->hexint_fmt, v);
+	break;
+  }
+}
+
+static
+print_literal(tp, v, compressed, format)
+  p_type	tp;
+  long		v;
+  int		compressed;
+  char		*format;
 {
   register struct literal *lit = tp->ty_literals;
   register int i;
 
+  if (format) {
+	print_unsigned(tp, v, format);
+	return;
+  }
   for (i = tp->ty_nenums; i; i--, lit++) {
 	if (lit->lit_val == v) {
-		fprintf(db_out, lit->lit_name);
+		fputs(lit->lit_name, db_out);
 		break;
 	}
   }
   if (! i) {
-	fprintf(db_out, "unknown enumeration value %d", v);
+	fprintf(db_out,
+		compressed ? "?%ld?" : "unknown enumeration value %ld",
+		v);
   }
 }
 
 static
-print_unsigned(tp, v)
+print_integer(tp, v, format)
   p_type	tp;
   long		v;
+  register char	*format;
 {
-  if (tp == uchar_type) {
+  while (format && *format) {
-	(*currlang->printchar)((int) v);
+	if (strindex("cdohx", *format)) break;
+	format++;
   }
-  else	fprintf(db_out, currlang->uns_fmt, v);
+  switch(format == 0 ? 0 : *format) {
-}
+  default:
-
+	if (tp != char_type) {
-static
+  		fprintf(db_out, currlang->decint_fmt, v);
-print_integer(tp, v)
+		break;
-  p_type	tp;
+	}
-  long		v;
+	/* fall through */
-{
+  case 'c':
-  if (tp == char_type) {
+	(*currlang->printchar)((int) v);
-	(*currlang->printchar)((int) v);
+	break;
+  case 'd':
+  	fprintf(db_out, currlang->decint_fmt, v);
+	break;
+  case 'o':
+  	fprintf(db_out, currlang->octint_fmt, v);
+	break;
+  case 'x':
+  case 'h':
+  	fprintf(db_out, currlang->hexint_fmt, v);
+	break;
   }
-  else	fprintf(db_out, currlang->decint_fmt, v);
 }
 
 print_params(tp, AB, static_link)
@@ -83,7 +136,6 @@ print_params(tp, AB, static_link)
   }
   if (static_link) p += pointer_size;
   if (! get_bytes(size, AB, param_bytes)) {
-	error("no debuggee");
 	free(param_bytes);
 	return;
   }
@@ -110,11 +162,11 @@ print_params(tp, AB, static_link)
 			fprintf(db_out, currlang->addr_fmt, (long) addr);
 		}
 		else {
-			print_val(par->par_type, size, q, 1, 0);
+			print_val(par->par_type, size, q, 1, 0, (char *)0);
 		}
 		free(q);
 	}
-	else print_val(par->par_type, par->par_type->ty_size, p, 1, 0);
+	else print_val(par->par_type, par->par_type->ty_size, p, 1, 0, (char *)0);
 	if (i) fputs(", ", db_out);
 	p += param_size(par->par_type, par->par_kind);
 	par++;
@@ -122,12 +174,13 @@ print_params(tp, AB, static_link)
   free(param_bytes);
 }
 
-print_val(tp, tp_sz, addr, compressed, indent)
+print_val(tp, tp_sz, addr, compressed, indent, format)
   p_type	tp;		/* type of value to be printed */
   long		tp_sz;		/* size of object to be printed */
   char		*addr;		/* address to get value from */
   int		compressed;	/* for parameter lists */
   int		indent;		/* indentation */
+  register char	*format;	/* format given or 0 */
 {
   register int i;
   long elsize;
@@ -135,12 +188,13 @@ print_val(tp, tp_sz, addr, compressed, indent)
   if (indent == 0) indent = 4;
   switch(tp->ty_class) {
   case T_SUBRANGE:
-	print_val(tp->ty_base, tp_sz, addr, compressed, indent);
+	print_val(tp->ty_base, tp_sz, addr, compressed, indent, format);
 	break;
   case T_ARRAY:
-	if (tp->ty_elements == char_type ||
+	if ((!format || strindex(format, 'a') == 0) &&
-	    tp->ty_elements == uchar_type) {
+	    (tp->ty_elements == char_type ||
-		print_val(string_type, tp_sz, addr, compressed, indent);
+	     tp->ty_elements == uchar_type)) {
+		print_val(string_type, tp_sz, addr, compressed, indent, format);
 		break;
 	}
 	if (compressed) {
@@ -156,7 +210,7 @@ print_val(tp, tp_sz, addr, compressed, indent)
 	indent += 4;
 	elsize = (*currlang->arrayelsize)(tp->ty_elements->ty_size);
 	for (i = tp_sz/elsize; i; i--) {
-		print_val(tp->ty_elements, tp->ty_elements->ty_size, addr, compressed, indent);
+		print_val(tp->ty_elements, tp->ty_elements->ty_size, addr, compressed, indent, format);
 		addr += elsize;
 		if (compressed && i > 1) {
 			fprintf(db_out, ", ...");
@@ -192,7 +246,7 @@ print_val(tp, tp_sz, addr, compressed, indent)
 			/* ??? */
 			fprintf(db_out, "<bitfield, %d, %ld>", fld->fld_bitsize, sz);
 		}
-		else print_val(fld->fld_type, sz, addr+(fld->fld_pos>>3), compressed, indent);
+		else print_val(fld->fld_type, sz, addr+(fld->fld_pos>>3), compressed, indent, format);
 		if (compressed && i > 1) {
 			fprintf(db_out, ", ...");
 			break;
@@ -210,7 +264,7 @@ print_val(tp, tp_sz, addr, compressed, indent)
 	fprintf(db_out, "<union>");
 	break;
   case T_ENUM:
-	print_literal(tp, get_int(addr, tp_sz, T_ENUM));
+	print_literal(tp, get_int(addr, tp_sz, T_ENUM), compressed, format);
 	break;
   case T_PROCEDURE: {
 	register p_scope sc = get_scope_from_addr((t_addr) get_int(addr, pointer_size, T_UNSIGNED));
@@ -220,8 +274,21 @@ print_val(tp, tp_sz, addr, compressed, indent)
 		break;
 	}
 	}
-	/* Fall through */
+	fprintf(db_out, currlang->addr_fmt, get_int(addr, pointer_size, T_UNSIGNED));
+	break;
   case T_POINTER:
+	if (format && strindex(format,'s') &&
+	    (tp->ty_ptrto == char_type || tp->ty_ptrto == uchar_type)) {
+		t_addr a = get_int(addr, tp_sz, T_UNSIGNED);
+		char *naddr = malloc(512);
+
+		if (naddr && get_string(511L, a, naddr)) {
+			print_val(string_type, 512L, naddr, 0, indent, format);
+			free(naddr);
+			break;
+		}
+		if (naddr) free(naddr);
+	}
 	fprintf(db_out, currlang->addr_fmt, get_int(addr, pointer_size, T_UNSIGNED));
 	break;
   case T_FILE:
@@ -259,13 +326,13 @@ print_val(tp, tp_sz, addr, compressed, indent)
 			}
 			switch(base->ty_class) {
 			case T_INTEGER:
-				print_integer(base, val+i);
+				print_integer(base, val+i, format);
 				break;
 			case T_UNSIGNED:
-				print_unsigned(base, val+i);
+				print_unsigned(base, val+i, format);
 				break;
 			case T_ENUM:
-				print_literal(base, val+i);
+				print_literal(base, val+i, compressed, format);
 				break;
 			default:
 				assert(0);
@@ -283,10 +350,10 @@ print_val(tp, tp_sz, addr, compressed, indent)
 	fprintf(db_out, currlang->real_fmt, get_real(addr, tp->ty_size));
 	break;
   case T_UNSIGNED:
-	print_unsigned(tp, get_int(addr, tp_sz, T_UNSIGNED));
+	print_unsigned(tp, get_int(addr, tp_sz, T_UNSIGNED), format);
 	break;
   case T_INTEGER:
-	print_integer(tp, get_int(addr, tp_sz, T_INTEGER));
+	print_integer(tp, get_int(addr, tp_sz, T_INTEGER), format);
 	break;
   case T_STRING:
 	(*currlang->printstring)(addr, (int) tp_sz);

util/grind/run.c

@@ -27,20 +27,25 @@ extern char	*AObj;
 extern FILE	*db_out;
 extern int	debug;
 extern long	pointer_size;
+extern char	*progname;
+extern int	child_interrupted;
+extern int	interrupted;
 
 static int	child_pid;		/* process id of child */
 static int	to_child, from_child;	/* file descriptors for communication */
 static int	child_status;
 static int	restoring;
 static int	fild1[2], fild2[2];	/* pipe file descriptors */
+int		disable_intr = 1;
 
 int		db_ss;
-t_lineno	currline, listline;
+t_lineno	currline;
 
 static int	catch_sigpipe();
 static int	stopped();
 static int	uputm(), ugetm();
 static t_addr	curr_stop;
+p_tree		run_command;
 
 int
 init_run()
@@ -57,9 +62,13 @@ init_run()
   }
   to_child = fild1[1];
   from_child = fild2[0];
+  child_pid = 0;
+  if (currfile) CurrentScope = currfile->sy_file->f_scope;
   return 1;
 }
 
+extern int errno;
+
 int
 start_child(p)
   p_tree	p;
@@ -76,6 +85,10 @@ start_child(p)
 			    allowed one child
 			 */
 
+  if (p != run_command) {
+	freenode(run_command);
+	run_command = p;
+  }
   /* first check arguments and redirections and build argument list */
   while (pt) {
   	switch(pt->t_oper) {
@@ -133,7 +146,7 @@ start_child(p)
 		close(0);
 		if ((fd = open(in_redirect, 0)) < 0 ||
 		    (fd != 0 && dup2(fd, 0) < 0)) {
-			error("could not open input file");
+			perror(progname);
 			exit(1);
 		}
 		if (fd != 0) {
@@ -142,10 +155,11 @@ start_child(p)
 	}
 	if (out_redirect) {
 		int fd;
+
 		close(1);
-		if ((fd = creat(in_redirect, 0666)) < 0 ||
+		if ((fd = creat(out_redirect, 0666)) < 0 ||
 		    (fd != 1 && dup2(fd, 1) < 0)) {
-			error("could not open output file");
+			perror(progname);
 			exit(1);
 		}
 		if (fd != 1) {
@@ -165,32 +179,23 @@ start_child(p)
 
   pipe(fild1);		/* to occupy file descriptors */
   signal(SIGPIPE, catch_sigpipe);
-  if (! wait_for_child((char *) 0)) {
+  {
+	struct message_hdr m;
+
+  	if (! ugetm(&m)) {
 		error("child not responding");
+		init_run();
 		return 0;
 	}
+	curr_stop = m.m_size;
+	CurrentScope = get_scope_from_addr(curr_stop);
+  }
   do_items();
-  if (! restoring && ! item_addr_actions(curr_stop)) {
+  if (! restoring && ! item_addr_actions(curr_stop, OK)) {
 	send_cont(1);
   }
   else if (! restoring) {
 	stopped("stopped", curr_stop);
-	handle_displays();
-  }
-  return 1;
-}
-
-int
-wait_for_child(s)
-  char	*s;		/* to pass on to 'stopped' */
-{
-  struct message_hdr m;
-
-  if (child_pid) {
-  	if (ugetm(&m)) {
-		return stopped(s, (t_addr) m.m_size);
-  	}
-  	return 0;
   }
   return 1;
 }
@@ -212,7 +217,6 @@ catch_sigpipe()
   child_pid = 0;
 }
 
-
 static int
 ureceive(p, c)
   char	*p;
@@ -252,6 +256,7 @@ usend(p, c)
 {
   int	i;
 
+  if (! child_pid) return 0;
   while (c >= 0x1000) {
 	i = write(to_child, p, 0x1000);
 	if (i < 0) return 0;
@@ -299,11 +304,12 @@ stopped(s, a)
 {
   p_position pos;
 
-  if (s) {
+  if (s && a) {
 	fprintf(db_out, "%s ", s);
 	pos = print_position(a, 1);
 	fputs("\n", db_out);
 	list_position(pos);
+	handle_displays();
   }
   curr_stop = a;
   return 1;
@@ -315,16 +321,37 @@ could_send(m, stop_message)
 {
   int	type;
   t_addr a;
+  static int level = 0;
+
+  level++;
   for (;;) {
   	if (child_pid) {
-		if (! uputm(m) ||
+		int child_dead = 0;
-		    ! ugetm(&answer)) {
+		if (m->m_type & DB_RUN) disable_intr = 0;
-			if (child_pid) {
+		if (!child_interrupted && (! uputm(m) || ! ugetm(&answer))) {
-				error("something wrong!");
+			child_dead = 1;
+		}
+		disable_intr = 1;
+		if ((interrupted || child_interrupted) && ! child_dead) {
+			while (child_interrupted && answer.m_type != INTR) {
+				if (! ugetm(&answer)) {
+					child_dead = 1;
+					break;
+				}
+			}
+			if (interrupted && ! child_dead) {
+				level--;
+				if (! level) {
+					child_interrupted = 0;
+					CurrentScope = get_scope_from_addr((t_addr) answer.m_size);
+					interrupted = 0;
+					stopped("interrupted", (t_addr) answer.m_size);
+				}
 				return 1;
 			}
+		}
+		if (child_dead) {
 			wait(&child_status);
-			init_run();
 			if (child_status & 0177) {
 				fprintf(db_out,
 					"child died with signal %d\n",
@@ -335,6 +362,8 @@ could_send(m, stop_message)
 					"child terminated, exit status %d\n",
 					child_status >> 8);
 			}
+			init_run();
+			level--;
 			return 1;
 		}
 		a = answer.m_size;
@@ -342,7 +371,7 @@ could_send(m, stop_message)
 		if (m->m_type & DB_RUN) {
 			/* run command */
 			CurrentScope = get_scope_from_addr((t_addr) a);
-		    	if (! item_addr_actions(a) &&
+		    	if (! item_addr_actions(a, type) &&
 		            ( type == DB_SS || type == OK)) {
 				/* no explicit breakpoints at this position.
 				   Also, child did not stop because of
@@ -363,38 +392,61 @@ could_send(m, stop_message)
 		}
 		if (stop_message) {
 			stopped("stopped", a);
-			handle_displays();
 		}
-		return 1;
+		level--;
+		return type;
 	}
+	level--;
 	return 0;
   }
   /*NOTREACHED*/
 }
 
+static int
+getbytes(size, from, to, kind)
+  long	size;
+  t_addr from;
+  char	*to;
+{
+  struct message_hdr	m;
+
+  m.m_type = kind;
+  m.m_size = size;
+  put_int(m.m_buf, pointer_size, (long)from);
+
+  if (! could_send(&m, 0)) {
+	error("no process");
+	return 0;
+  }
+
+  if (answer.m_type == FAIL || answer.m_type == INTR) {
+	return 0;
+  }
+
+  assert(answer.m_type == DATA);
+
+  return ureceive(to, answer.m_size);
+}
+
 int
 get_bytes(size, from, to)
   long	size;
   t_addr from;
   char	*to;
 {
-  struct message_hdr	m;
+  return getbytes(size, from, to, GETBYTES);
+}
 
-  m.m_type = GETBYTES;
+int
-  m.m_size = size;
+get_string(size, from, to)
-  put_int(m.m_buf, pointer_size, (long)from);
+  long	size;
+  t_addr from;
+  char	*to;
+{
+  int retval = getbytes(size, from, to, GETSTR);
 
-  if (! could_send(&m, 0)) {
+  to[(int)answer.m_size] = 0;
-	return 0;
+  return retval;
-  }
-
-  if (answer.m_type == FAIL) {
-	return 0;
-  }
-
-  assert(answer.m_type == DATA && answer.m_size == m.m_size);
-
-  return ureceive(to, answer.m_size);
 }
 
 int
@@ -409,8 +461,7 @@ set_bytes(size, from, to)
   m.m_size = size;
   put_int(m.m_buf, pointer_size, (long) to);
 
-  return uputm(&m)
+  return uputm(&m) && usend(from, size)
-	 && usend(from, size)
 	 && ugetm(&m)
 	 && m.m_type != FAIL;
 }
@@ -424,16 +475,16 @@ get_dump(globmessage, globbuf, stackmessage, stackbuf)
 
   m.m_type = DUMP;
   if (! could_send(&m, 0)) {
-	error("no debuggee");
+	error("no process");
 	return 0;
   }
-  if (answer.m_type == FAIL) return 0;
+  if (answer.m_type == FAIL || answer.m_type == INTR) return 0;
   assert(answer.m_type == DGLOB);
   *globmessage = answer;
   *globbuf = malloc((unsigned) answer.m_size);
   if (! ureceive(*globbuf, answer.m_size) || ! ugetm(stackmessage)) {
 	if (*globbuf) free(*globbuf);
-	error("no debuggee");
+	error("no process");
 	return 0;
   }
   assert(stackmessage->m_type == DSTACK);
@@ -441,7 +492,7 @@ get_dump(globmessage, globbuf, stackmessage, stackbuf)
   if (! ureceive(*stackbuf, stackmessage->m_size)) {
 	if (*globbuf) free(*globbuf);
 	if (*stackbuf) free(*stackbuf);
-	error("no debuggee");
+	error("no process");
 	return 0;
   }
   put_int(globmessage->m_buf+SP_OFF*pointer_size, pointer_size,
@@ -461,17 +512,17 @@ put_dump(globmessage, globbuf, stackmessage, stackbuf)
   char *globbuf, *stackbuf;
 {
   struct message_hdr m;
+  int retval;
 
   if (! child_pid) {
 	restoring = 1;
 	start_child(run_command);
 	restoring = 0;
   }
-  return	uputm(globmessage) &&
+  retval =	uputm(globmessage) && usend(globbuf, globmessage->m_size) &&
-		usend(globbuf, globmessage->m_size) &&
+		uputm(stackmessage) && usend(stackbuf, stackmessage->m_size) &&
-		uputm(stackmessage) &&
-		usend(stackbuf, stackmessage->m_size) &&
 		ugetm(&m) && stopped("restored", m.m_size);
+  return retval;
 }
 
 t_addr *
@@ -486,9 +537,10 @@ get_EM_regs(level)
   m.m_size = level;
 
   if (! could_send(&m, 0)) {
+	error("no process");
 	return 0;
   }
-  if (answer.m_type == FAIL) return 0;
+  if (answer.m_type == FAIL || answer.m_type == INTR) return 0;
   *to++ = (t_addr) get_int(answer.m_buf, pointer_size, T_UNSIGNED);
   *to++ = (t_addr) get_int(answer.m_buf+pointer_size, pointer_size, T_UNSIGNED);
   *to++ = (t_addr) get_int(answer.m_buf+2*pointer_size, pointer_size, T_UNSIGNED);
@@ -506,7 +558,7 @@ set_pc(PC)
   m.m_type = SETEMREGS;
   m.m_size = 0;
   put_int(m.m_buf+PC_OFF*pointer_size, pointer_size, (long)PC);
-  return could_send(&m, 0) && answer.m_type != FAIL;
+  return could_send(&m, 0) && answer.m_type != FAIL && answer.m_type != INTR;
 }
 
 int
@@ -530,7 +582,7 @@ do_single_step(type, count)
   m.m_type = type | (db_ss ? DB_SS : 0);
   m.m_size = count;
   single_stepping = 1;
-  if (could_send(&m, 1) && answer.m_type != FAIL) {
+  if (could_send(&m, 1) && answer.m_type != FAIL && answer.m_type != INTR) {
 	return 1;
   }
   single_stepping = 0;
@@ -549,7 +601,8 @@ 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 (! could_send(&m, 0)) { }
+  if (! could_send(&m, 0)) {
+  }
 
   return 1;
 }
@@ -565,7 +618,8 @@ set_or_clear_trace(start, end, 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 (! could_send(&m, 0)) { }
+  if (! could_send(&m, 0)) {
+  }
 
   return 1;
 }

util/grind/symbol.c

@@ -117,11 +117,12 @@ add_file(s)
 	p_symbol sym1;
 
 	*p = 0;
-	sym1 = NewSymbol(Salloc(s, (unsigned) strlen(s)+1),
+	s = Salloc(s, (unsigned) strlen(s)+1);
+	*p = c;
+	sym1 = NewSymbol(s,
 		  	 PervasiveScope,
 		 	 FILELINK,
 			 (struct outname *) 0);
-	*p = c;
 	sym1->sy_filelink = sym;
 	sym->sy_file->f_base = sym1;
   }
@@ -171,11 +172,14 @@ consistent(p, sc)
 #define CLASS	(FILELINK|FILESYM|PROC|FUNCTION|MODULE|TYPE|VAR|REGVAR|LOCVAR|VARPAR)
 	sym = Lookfromscope(p->t_idf, CLASS, sc->sc_static_encl);
 	if (sym) {
+		int precise = 1;
+
 		target_sc = def_scope(sym);
 		while (sc && sc != target_sc) {
+			precise = 0;
 			sc = sc->sc_static_encl;
 		}
-		return sc != 0;
+		return sc == 0 ? 0 : precise + 1 ;
 	}
 	return 0;
 
@@ -183,11 +187,16 @@ consistent(p, sc)
 	arg = p->t_args[1];
 	sym = Lookfromscope(arg->t_idf, CLASS, sc->sc_static_encl);
 	if (sym) {
+		int precise = 1;
+
 		target_sc = def_scope(sym);
 		while (sc && sc != target_sc) {
+			precise = 0;
 			sc = sc->sc_static_encl;
 		}
-		return sc != 0 && consistent(p, sym->sy_scope);
+		if (sc == 0) return 0;
+		if (precise) return consistent(p, sym->sy_scope);
+		return consistent(p, sym->sy_scope) != 0;
 	}
 	return 0;
 
@@ -205,9 +214,10 @@ identify(p, class_set)
   p_tree	p;
   int		class_set;
 {
-  p_symbol	sym = 0;
+  p_symbol	sym = 0, sym1 = 0;
   register p_symbol s;
   p_tree	arg;
+  int precise = 0;
 
   switch(p->t_oper) {
   case OP_NAME:
@@ -243,19 +253,26 @@ identify(p, class_set)
 	arg = p->t_args[1];
 	assert(arg->t_oper == OP_NAME);
 	s = arg->t_idf->id_def;
-	sym = 0;
 	while (s) {
-		if ((s->sy_class & class_set) && consistent(p, s->sy_scope)) {
+		int temp;
-			if (sym) {
+		if ((s->sy_class & class_set) &&
-				error("could not identify \"%s\"", arg->t_str);
+		    (temp = consistent(p, s->sy_scope))) {
-				sym = 0;
+			if (temp > precise) {
-			}
 				sym = s;
+				precise = temp;
+				sym1 = 0;
+			}
+			else if (sym && temp == precise) sym1 = s;
 		}
 		s = s->sy_next;
 	}
+	if (sym && sym1) {
+		error("could not identify \"%s\"", arg->t_str);
+		return 0;
+	}
 	if (!sym && !s) {
 		error("could not find \"%s\"", arg->t_str);
+		return 0;
 	}
 	break;
 

util/grind/tokenname.c

@@ -27,6 +27,7 @@ struct tokenname tkspec[] =	{	/* the names of the special tokens */
 	{NAME, "name"},
 	{STRING, "string"},
 	{INTEGER, "number"},
+	{EXPRESSION, "<expression>"},
 	{REAL, "real"},
 	{CHAR, "char"},
 	{BIN_OP, "<operator>"},
@@ -65,6 +66,9 @@ struct tokenname tkidf[] =	{	/* names of the identifier tokens */
 	{FIND, "find"},
 	{DISPLAY, "display"},
 	{WHICH, "which"},
+	{HELP, "help"},
+	{DISABLE,"disable"},
+	{ENABLE,"enable"},
 	{-1, "quit"},
 	{0, ""}
 };

util/grind/tree.c

@@ -19,12 +19,15 @@
 #include	"expr.h"
 
 extern FILE	*db_out;
-extern t_lineno	currline, listline;
+extern t_lineno	currline;
+static t_lineno	listline;
 extern long	pointer_size;
 extern char	*strrindex();
+extern int	interrupted;
 
-p_tree		run_command;
+p_tree		print_command;
 
+static int	wsize = 10;
 
 /*VARARGS1*/
 p_tree
@@ -41,6 +44,7 @@ mknode(va_alist)
 	p->t_oper = va_arg(ap, int);
 	switch(p->t_oper) {
 	case OP_NAME:
+	case OP_HELP:
 		p->t_idf = va_arg(ap, struct idf *);
 		p->t_str = va_arg(ap, char *);
 		break;
@@ -58,7 +62,6 @@ mknode(va_alist)
 	case OP_NEXT:
 	case OP_STEP:
 	case OP_REGS:
-	case OP_DELETE:
 	case OP_RESTORE:
 	case OP_WHERE:
 		p->t_ival = va_arg(ap, long);
@@ -76,21 +79,6 @@ mknode(va_alist)
   return p;
 }
 
-adjust_oper(pp)
-  p_tree	*pp;
-{
-  register p_tree	p = *pp, p1;
-
-  switch(p->t_whichoper) {
-  case E_DERSELECT:
-	p1 = mknode(OP_UNOP, p->t_args[0]);
-	p1->t_whichoper = E_DEREF;
-	p->t_args[0] = p1;
-	p->t_whichoper = E_SELECT;
-	break;
-  }
-}
-
 freenode(p)
   register p_tree	p;
 {
@@ -164,19 +152,40 @@ print_node(p, top_level)
 	if (p->t_args[0]) {
 		print_node(p->t_args[0], 0);
 		if (p->t_args[1]) {
+			if (p->t_args[1]->t_ival >= 0) {
 				fputs(", ", db_out);
 				print_node(p->t_args[1], 0);
 			}
+			else  {
+				if (p->t_args[1]->t_ival < -100000000) {
+					fputs("-", db_out);
+				}
+				else print_node(p->t_args[1], 0);
+			}
+		}
 	}
 	break;
   case OP_PRINT:
 	fputs("print ", db_out);
 	print_node(p->t_args[0], 0);
 	break;
+  case OP_ENABLE:
+	fputs("enable ", db_out);
+	print_node(p->t_args[0], 0);
+	break;
+  case OP_DISABLE:
+	fputs("disable ", db_out);
+	print_node(p->t_args[0], 0);
+	break;
   case OP_DISPLAY:
 	fputs("display ", db_out);
 	print_node(p->t_args[0], 0);
 	break;
+  case OP_LINK:
+	print_node(p->t_args[0], 0);
+	fputs(", ", db_out);
+	print_node(p->t_args[1], 0);
+	break;
   case OP_FILE:
 	fputs("file ", db_out);
 	print_node(p->t_args[0], 0);
@@ -196,7 +205,8 @@ print_node(p, top_level)
 	print_node(p->t_args[0], 0);
 	break;
   case OP_DELETE:
-	fprintf(db_out, "delete %ld", p->t_ival);
+	fputs("delete ", db_out);
+	print_node(p->t_args[0], 0);
 	break;
   case OP_REGS:
 	fprintf(db_out, "regs %ld", p->t_ival);
@@ -221,6 +231,10 @@ print_node(p, top_level)
 	fputs("where", db_out);
 	if (p->t_ival != 0x7fffffff) fprintf(db_out, " %ld", p->t_ival);
 	break;
+  case OP_HELP:
+	fputs("help", db_out);
+	if (p->t_str != 0) fprintf(db_out, " %s", p->t_str);
+	break;
   case OP_CONT:
 	fputs("cont", db_out);
 	if (p->t_args[0]) {
@@ -303,6 +317,11 @@ print_node(p, top_level)
   case OP_REAL:
 	fprintf(db_out, currlang->real_fmt, p->t_fval);
 	break;
+  case OP_FORMAT:
+	print_node(p->t_args[0], 0);
+	fputs("\\", db_out);
+	print_node(p->t_args[1], 0);
+	break;
   case OP_UNOP:
   case OP_BINOP:
 	(*currlang->printop)(p);
@@ -317,11 +336,19 @@ repeatable(com)
 {
   switch(com->t_oper) {
   case OP_CONT:
+	com->t_args[0]->t_ival = 1;
+	freenode(com->t_args[1]);
+	com->t_args[1] = 0;
+	return 1;
   case OP_NEXT:
   case OP_STEP:
+	com->t_ival = 1;
+	return 1;
   case OP_LIST:
-  case OP_STATUS:
+	freenode(com->t_args[0]);
-  case OP_PRINT:
+	com->t_args[0] = 0;
+	freenode(com->t_args[1]);
+	com->t_args[1] = 0;
 	return 1;
   }
   return 0;
@@ -345,7 +372,7 @@ in_status(com)
 eval(p)
   p_tree	p;
 {
-  if (p) (*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)
@@ -353,15 +380,25 @@ do_list(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;
-	l2 = listline + 9;
+	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;
-		assert(p->t_args[1] != 0);
-		l2 = p->t_args[1]->t_ival;
 	}
 	else {
   		t_addr	a = get_addr_from_node(p->t_args[0]);
@@ -372,16 +409,20 @@ do_list(p)
 		}
 		pos = get_position_from_addr(a);
   		newfile(str2idf(pos->filename, 1));
-		l1 = pos->lineno - 5;
+		l1 = pos->lineno - (l2 > 0 ? l2 : wsize)/2;
 		if (l1 < 1) l1 = 1;
-		l2 = l1+9;
 	}
   }
   if (listfile) {
-	lines(listfile->sy_file, l1, l2);
+	if (l2 < 0) {
-	listline = l2+1;
+		l2 = -l2;
+		if (l1 > l2) l2 = 1;
+		else l2 -= l1 - 1;
 	}
-  else fprintf(db_out, "no current file\n");
+	lines(listfile->sy_file, l1, l2);
+	listline = l1 + l2;
+  }
+  else error("no current file");
 }
 
 do_file(p)
@@ -391,7 +432,7 @@ do_file(p)
 	newfile(p->t_args[0]->t_idf);
   }
   else if (listfile) fprintf(db_out, "%s\n", listfile->sy_idf->id_text);
-  else fprintf(db_out, "no current file\n");
+  else error("no current file");
 }
 
 newfile(id)
@@ -409,34 +450,42 @@ newfile(id)
   find_language(strrindex(id->id_text, '.'));
 }
 
-do_stop(p)
+setstop(p, kind)
   p_tree	p;
+  int		kind;
 {
   t_addr	a = get_addr_from_node(p->t_args[0]);
 
-  if (a == ILL_ADDR) {
+  if (a == ILL_ADDR) return 0;
-	return;
-  }
 
   p->t_address = a;
-  add_to_item_list(p);
   if (a != NO_ADDR) {
-	if (! set_or_clear_breakpoint(a, SETBP)) {
+	if (! set_or_clear_breakpoint(a, kind)) {
-		error("could not set breakpoint");
+		error("could not %s breakpoint", kind == SETBP ? "set" : "clear");
+		return 0;
 	}
   }
+  return 1;
 }
 
-do_trace(p)
+do_stop(p)
   p_tree	p;
 {
-  t_addr a;
+  if (! setstop(p, SETBP)) {
-  t_addr e;
+	return;
+  }
+  add_to_item_list(p);
+}
+
+settrace(p, kind)
+  p_tree	p;
+  int		kind;
+{
+  t_addr	a, e;
 
-  p->t_address = NO_ADDR;
-  if (p->t_args[0]) {
   a = get_addr_from_node(p->t_args[0]);
-	if (a == ILL_ADDR) return;
+  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;
@@ -447,17 +496,56 @@ do_trace(p)
 	if (sc) e = sc->sc_start - 1;
 	else e = 0xffffffff;
   }
-	if (! set_or_clear_trace(a, e, SETTRACE)) {
+  if (! set_or_clear_trace(a, e, kind)) {
-		error("could not set trace");
+	error("could not %s trace", kind == SETTRACE ? "set" : "clear");
+	return 0;
   }
+  return 1;
+}
+
+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;
+{
+  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;
+  }
+}
+
+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;
+  int first_time = 1;
 
   if (p) {
 	count = p->t_args[0]->t_ival;
@@ -476,9 +564,10 @@ do_continue(p)
   else count = 1;
   while (count--) {
 	if (! send_cont(count==0)) {
-		error("no debuggee");
+		if (first_time) error("no process");
 		break;
 	}
+	first_time = 0;
   }
 }
 
@@ -486,7 +575,7 @@ do_step(p)
   p_tree	p;
 {
   if (! do_single_step(SETSS, p->t_ival)) {
-	error("no debuggee");
+	if (! interrupted) error("no process");
   }
 }
 
@@ -495,7 +584,7 @@ do_next(p)
 {
 
   if (! do_single_step(SETSSF, p->t_ival)) {
-	error("no debuggee");
+	if (! interrupted) error("no process");
   }
 }
 
@@ -508,7 +597,7 @@ do_regs(p)
   int		n = p->t_ival;
 
   if (! (buf = get_EM_regs(n))) {
-	error("no debuggee");
+	if (! interrupted) error("no process");
 	return;
   }
   fprintf(db_out, "EM registers %d levels back:\n", n);
@@ -526,17 +615,30 @@ do_where(p)
 {
   int i = 0;
   unsigned int cnt;
-
+  unsigned int maxcnt = p->t_ival;
-  for (cnt = p->t_ival; cnt != 0; cnt--) {
-	t_addr AB;
-	t_addr PC;
   p_scope sc;
   t_addr *buf;
+  t_addr PC;
 
-	if (! (buf = get_EM_regs(i++))) {
+  if (p->t_ival < 0) {
-		error("no debuggee");
+	for (;;) {
-		return;
+		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;
+  }
+  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;
@@ -550,63 +652,60 @@ do_where(p)
   }
 }
 
-/*ARGSUSED*/
-do_status(p)
-  p_tree	p;
-{
-  print_items();
-}
-
 extern p_tree	remove_from_item_list();
 
 do_delete(p)
   p_tree	p;
 {
+  switch(p->t_oper) {
+  case OP_DELETE:
+	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: {
+  	case OP_STOP:
-	t_addr a = get_addr_from_node(p->t_args[0]);
+		setstop(p, CLRBP);
-
-	if (a != ILL_ADDR && a != NO_ADDR) {
-		set_or_clear_breakpoint(a, CLRBP);
-	}
 		break;
-	}
+  	case OP_TRACE:
-  case OP_TRACE: {
+		settrace(p, CLRTRACE);
-	t_addr a = get_addr_from_node(p->t_args[0]);
-	
-	if (a != ILL_ADDR && a != NO_ADDR) {
-		t_addr e;
-		if (p->t_args[0]->t_oper == OP_AT) {
-			e = a;
-		}
-		else {
-			p_scope sc = get_next_scope_from_addr(a+1);
-
-			if (sc) e = sc->sc_start - 1;
-			else e = 0xffffffff;
-		}
-		set_or_clear_trace(a, e, CLRTRACE);
-	}
 		break;
-	}
   	case OP_DUMP:
 		free_dump(p);
   	}
   	freenode(p);
+	break;
+  }
 }
 
 do_print(p)
   p_tree	p;
 {
-  char	*buf;
+  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);
+		print_command = p;
+	}
+	/* fall through */
   case OP_DISPLAY:
 	do_print(p->t_args[0]);
 	break;
@@ -615,10 +714,13 @@ do_print(p)
 	do_print(p->t_args[1]);
 	break;
   default:
-	if (! eval_expr(p, &buf, &size, &tp)) return;
+	if (interrupted || ! eval_expr(p, &buf, &size, &tp)) return;
 	print_node(p, 0);
 	fputs(" = ", db_out);
-	print_val(tp, size, buf, 0, 0);
+	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;
@@ -633,13 +735,17 @@ do_set(p)
   p_type tp, tp2;
   t_addr a;
 
-  if (! eval_desig(p->t_args[0], &a, &size, &tp) ||
+  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;
+  }
   if (! set_bytes(size, buf, a)) {
 	error("could not handle this SET request");
   }
@@ -652,11 +758,14 @@ perform(p, a)
 {
   switch(p->t_oper) {
   case OP_WHEN:
+	if (p->t_args[1] && ! eval_cond(p->t_args[1])) break;
 	p = p->t_args[2];
 	while (p->t_oper == OP_LINK) {
+		if (interrupted) return;
 		eval(p->t_args[0]);
 		p = p->t_args[1];
 	}
+	if (interrupted) return;
 	eval(p);
 	break;
   case OP_TRACE:
@@ -667,6 +776,8 @@ perform(p, a)
 			break;
 		}
 	}
+	if (interrupted) return;
+	if (p->t_args[1] && ! eval_cond(p->t_args[1])) break;
 	list_position(get_position_from_addr(a));
 	if (p->t_args[2]) do_print(p->t_args[2]);
 	break;
@@ -681,6 +792,6 @@ list_position(pos)
   newfile(str2idf(pos->filename, 1));
   currfile = listfile;
   currline = pos->lineno;
-  listline = currline-5;
+  lines(currfile->sy_file, (int)currline, (int)1);
-  lines(currfile->sy_file, (int)currline, (int)currline);
+  listline = 0;
 }

util/grind/tree.hh

@@ -6,7 +6,6 @@ typedef struct tree {
   short	t_oper;		/* tree operator */
   short t_whichoper;	/* expression operator */
   t_addr t_address;	/* some operators use an address */
-  int	t_itemno;	/* item number in status list */
   union {
 	long tt_ival;
 	char *tt_sval;
@@ -34,4 +33,3 @@ typedef struct tree {
 /* ALLOCDEF "tree" 100 */
 
 extern p_tree	mknode();
-extern p_tree	run_command;

util/grind/type.c

@@ -17,7 +17,7 @@ p_type	int_type, char_type, short_type, long_type, bool_type;
 p_type	uint_type, uchar_type, ushort_type, ulong_type;
 p_type	void_type, incomplete_type;
 p_type	float_type, double_type;
-p_type	string_type;
+p_type	string_type, address_type;
 
 long	int_size = SZ_INT,
 	char_size = 1,
@@ -255,6 +255,7 @@ init_types()
   ushort_type = basic_type(T_UNSIGNED, short_size);
   uchar_type = basic_type(T_UNSIGNED, char_size);
   string_type = basic_type(T_STRING, 0L);
+  address_type = basic_type(T_POINTER, pointer_size);
   void_type = basic_type(T_VOID, 0L);
   incomplete_type = basic_type(T_INCOMPLETE, 0L);
   float_type = basic_type(T_REAL, float_size);

util/grind/type.hh

@@ -38,9 +38,8 @@ typedef struct type {
 #define T_VOID		12
 #define T_UNSIGNED	13
 #define T_STRING	14	/* only for string constants ... */
+#define T_CROSS		15	/* cross reference to type */
 #define T_INCOMPLETE   100
-  short		ty_flags;
-#define T_CROSS		0x0001
   long		ty_size;
   struct symbol	*ty_sym;
   union {
@@ -117,7 +116,7 @@ extern long
 	compute_size();
 
 extern p_type	char_type, uchar_type, bool_type, int_type,
-		long_type, double_type, string_type;
+		long_type, double_type, string_type, address_type;
 extern p_type	void_type, incomplete_type;
 extern long	int_size, pointer_size, long_size, double_size;