Some new commands and improvements

util/grind/c.c

@@ -31,7 +31,8 @@ static int
 	get_token(),
 	print_op(),
 	unop_prio(),
-	binop_prio();
+	binop_prio(),
+	fix_bin_to_pref();
 
 static long
 	array_elsize();
@@ -62,7 +63,8 @@ static struct langdep c = {
 	get_name,
 	get_number,
 	get_token,
-	print_op
+	print_op,
+	fix_bin_to_pref
 };
 
 struct langdep *c_dep = &c;
@@ -270,12 +272,11 @@ get_token(c)
 	c = getc(db_in);
 	if (c == '&') {
 		tok.ival = E_AND;
+		return BIN_OP;
 	}
-	else {
 	ungetc(c, db_in);
 	tok.ival = E_BAND;
-	}
+	return PREF_OR_BIN_OP;
-	return BIN_OP;
   case '^':
 	tok.ival = E_BXOR;
 	return BIN_OP;
@@ -428,7 +429,6 @@ print_op(p)
 		print_node(p->t_args[0], 0);
 		break;
 	case E_DEREF:
-	case E_MUL:
 		fputs("*", db_out);
 		print_node(p->t_args[0], 0);
 		break;
@@ -436,6 +436,10 @@ print_op(p)
 		fputs("~", db_out);
 		print_node(p->t_args[0], 0);
 		break;
+	case E_ADDR:
+		fputs("&", db_out);
+		print_node(p->t_args[0], 0);
+		break;
 	}
 	break;
   case OP_BINOP:
@@ -521,3 +525,17 @@ print_op(p)
 	break;
   }
 }
+
+static int
+fix_bin_to_pref(p)
+  p_tree	p;
+{
+  switch(p->t_whichoper) {
+  case E_MUL:
+	p->t_whichoper = E_DEREF;
+	break;
+  case E_BAND:
+	p->t_whichoper = E_ADDR;
+	break;
+  }
+}

util/grind/commands.g

@@ -94,17 +94,29 @@ command_line(p_tree *p;)
 | step_command(p)
 | next_command(p)
 | regs_command(p)
-| WHERE			{ *p = mknode(OP_WHERE); }
+| where_command(p)
 | STATUS		{ *p = mknode(OP_STATUS); }
 | DUMP			{ *p = mknode(OP_DUMP); }
 | RESTORE INTEGER	{ *p = mknode(OP_RESTORE, tok.ival); }
 | delete_command(p)
 | print_command(p)
+| display_command(p)
 | trace_command(p)
 | set_command(p)
+| FIND qualified_name(p){ *p = mknode(OP_FIND, *p); }
+| WHICH qualified_name(p){ *p = mknode(OP_WHICH, *p); }
 |			{ *p = 0; }
 ;
 
+where_command(p_tree *p;)
+  { long l; }
+:
+  WHERE
+  [ INTEGER		{ l = tok.ival; }
+  |			{ l = 0x7fffffff; }
+  ]			{ *p = mknode(OP_WHERE, l); }
+;
+
 list_command(p_tree *p;)
   { p_tree t1 = 0, t2 = 0; }
 :
@@ -233,9 +245,19 @@ delete_command(p_tree *p;)
 
 print_command(p_tree *p;)
 :
-  PRINT expression(p, 1){ *p = mknode(OP_PRINT, *p); 
+  PRINT expression_list(p)
-			  p = &((*p)->t_args[0]);
+			{ *p = mknode(OP_PRINT, *p); }
-			}
+;
+
+display_command(p_tree *p;)
+:
+  DISPLAY expression_list(p)
+			{ *p = mknode(OP_DISPLAY, *p); }
+;
+
+expression_list(p_tree *p;)
+:
+  expression(p, 1)
   [ ','			{ *p = mknode(OP_LINK, *p, (p_tree) 0);
 			  p = &((*p)->t_args[1]);
 			}
@@ -291,7 +313,9 @@ factor(p_tree *p;)
   			{ *p = mknode(OP_UNOP, (p_tree) 0);
 			  (*p)->t_whichoper = (int) tok.ival;
 			}
-  [ PREF_OP | PREF_OR_BIN_OP ]
+  [ PREF_OP 
+  | PREF_OR_BIN_OP 	{ (*currlang->fix_bin_to_pref)(*p); }
+  ]
   expression(&(*p)->t_args[0], unprio((*p)->t_whichoper))
 ;
 
@@ -394,6 +418,9 @@ name(p_tree *p;)
   | ON
   | SET
   | TO
+  | FIND
+  | DISPLAY
+  | WHICH
   ]			{ *p = mknode(OP_NAME, tok.idf, tok.str); }
 ;
 

util/grind/dbx_string.g

@@ -56,6 +56,7 @@ debugger_string
   | /* type name */
 			{ s = NewSymbol(str, CurrentScope, TYPE, currnam); }
 	't' type_name(&(s->sy_type))
+			{ if (! s->sy_type->ty_sym) s->sy_type->ty_sym = s; }
 
   | /* tag name (only C?) */
 			{ s = NewSymbol(str, CurrentScope, TAG, currnam); }
@@ -76,7 +77,7 @@ debugger_string
 			}
 
   | /* external procedure */
-			{ s = NewSymbol(str, PervasiveScope, PROC, currnam); }
+			{ s = NewSymbol(str, FileScope, PROC, currnam); }
 	'P' routine(s)
 
   | /* private procedure */
@@ -84,7 +85,7 @@ debugger_string
 	'Q' routine(s)
 
   | /* external function */
-			{ s = NewSymbol(str, PervasiveScope, FUNCTION, currnam); }
+			{ s = NewSymbol(str, FileScope, FUNCTION, currnam); }
 	'F' function(s)
 
   | /* private function */
@@ -96,10 +97,10 @@ debugger_string
 				   the type information anyway for other
 				   types.
 				*/
-			{ s = Lookup(findidf(str), PervasiveScope, VAR);
+			{ s = Lookup(findidf(str), FileScope, VAR);
 			  if (s) {
 				tmp = s->sy_type;
-			  } else s = NewSymbol(str, PervasiveScope, VAR, currnam);
+			  } else s = NewSymbol(str, FileScope, VAR, currnam);
 			}
 	'G' type(&(s->sy_type), (int *) 0)
 			{ if (tmp) s->sy_type = tmp; } 

util/grind/expr.c

@@ -307,6 +307,23 @@ do_deref(p, pbuf, psize, ptp)
   return 0;
 }
 
+static int
+do_addr(p, pbuf, psize, ptp)
+  p_tree	p;
+  char		**pbuf;
+  long		*psize;
+  p_type	*ptp;
+{
+  t_addr addr;
+
+  if (eval_desig(p->t_args[0], &addr, psize, ptp)) {
+	*pbuf = Malloc((unsigned) pointer_size);
+	put_int(*pbuf, pointer_size, (long) addr);
+	return 1;
+  }
+  return 0;
+}
+
 static int
 do_unmin(p, pbuf, psize, ptp)
   p_tree	p;
@@ -370,7 +387,7 @@ static int (*un_op[])() = {
   0,
   do_unplus,
   do_unmin,
-  do_deref,
+  0,
   0,
   0,
   0,
@@ -383,7 +400,9 @@ static int (*un_op[])() = {
   0,
   do_bnot,
   0,
-  0
+  0,
+  0,
+  do_addr
 };
 
 static p_type
@@ -961,8 +980,10 @@ static int (*bin_op[])() = {
   do_arith,
   do_arith,
   0,
+  0,
   do_sft,
-  do_sft
+  do_sft,
+  0
 };
 
 int

util/grind/expr.h

@@ -33,3 +33,4 @@
 #define E_DERSELECT 25		/* -> in C */
 #define E_LSFT	26
 #define E_RSFT	27
+#define E_ADDR	28

util/grind/file.hh

@@ -13,6 +13,7 @@
 
 typedef struct file {
 	struct symbol	*f_sym;
+	struct symbol	*f_base;
 	char		*f_fullname;	/* name including directory */
 	struct scope	*f_scope;	/* reference to scope of this file */
 	t_lineno	f_nlines;	/* number of lines in file */

util/grind/itemlist.cc

@@ -65,6 +65,7 @@ item_addr_actions(a)
 			    eval_cond(p->t_args[1])) stopping = 1;
 			break;
 		case OP_DUMP:
+		case OP_DISPLAY:
 			break;
 		default:
 			assert(0);
@@ -75,6 +76,18 @@ item_addr_actions(a)
   return stopping;
 }
 
+handle_displays()
+{
+  register p_item i = item_list.il_first;
+
+  while (i) {
+	register p_tree p = i->i_node;
+
+	if (p->t_oper == OP_DISPLAY) do_print(p);
+	i = i->i_next;
+  }
+}
+
 add_to_item_list(p)
   p_tree	p;
 {

util/grind/langdep.cc

@@ -40,6 +40,10 @@ find_language(suff)
 {
   register struct langlist *p = list;
 
+  if (! suff) {
+	currlang = c_dep;
+	return;
+  }
   while (p) {
 	currlang = p->l_lang;
 	if (! strcmp(p->l_suff, suff)) break;

util/grind/langdep.h

@@ -33,6 +33,7 @@ struct langdep {
   int	(*get_number)();
   int	(*get_token)();
   int	(*printop)();
+  int	(*fix_bin_to_pref)();
 };
 
 extern struct langdep	*m2_dep, *c_dep, *currlang;

util/grind/modula-2.c

@@ -30,7 +30,8 @@ static int
 	get_string(),
 	print_op(),
 	binop_prio(),
-	unop_prio();
+	unop_prio(),
+	fix_bin_to_pref();
 
 static long
 	array_elsize();
@@ -61,7 +62,8 @@ static struct langdep m2 = {
 	get_name,
 	get_number,
 	get_token,
-	print_op
+	print_op,
+	fix_bin_to_pref
 };
 
 struct langdep *m2_dep = &m2;
@@ -537,3 +539,9 @@ print_op(p)
 	break;
   }
 }
+
+static int
+fix_bin_to_pref()
+{
+  /* No problems of this kind in Modula-2 */
+}

util/grind/operators.ot

@@ -25,5 +25,8 @@ OP_PRINT	1	do_print
 OP_DUMP		0	do_dump
 OP_RESTORE	0	do_restore
 OP_TRACE	3	do_trace
+OP_FIND		1	do_find
+OP_DISPLAY	1	add_to_item_list
+OP_WHICH	1	do_which
 OP_UNOP		1	0
 OP_BINOP	2	0

util/grind/print.c

@@ -124,7 +124,7 @@ 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->ty_size, addr, compressed, indent);
+	print_val(tp->ty_base, tp_sz, addr, compressed, indent);
 	break;
   case T_ARRAY:
 	if (tp->ty_elements == char_type ||

util/grind/run.c

@@ -349,7 +349,10 @@ could_send(m, stop_message)
 			}
 			single_stepping = 0;
 		}
-		if (stop_message) stopped("stopped", a);
+		if (stop_message) {
+			stopped("stopped", a);
+			handle_displays();
+		}
 		return 1;
 	}
 	return 0;

util/grind/symbol.c

@@ -2,6 +2,7 @@
 
 /* Symbol handling */
 
+#include	<stdio.h>
 #include	<alloc.h>
 #include	<out.h>
 #include	<stb.h>
@@ -18,6 +19,8 @@
 
 p_symbol	currfile;
 
+extern FILE	*db_out;
+
 p_symbol
 NewSymbol(s, scope, class, nam)
   char	*s;
@@ -120,10 +123,29 @@ add_file(s)
 			 (struct outname *) 0);
 	*p = c;
 	sym1->sy_filelink = sym;
+	sym->sy_file->f_base = sym1;
   }
   return sym;
 }
 
+p_scope
+def_scope(s)
+  p_symbol	s;
+{
+  switch(s->sy_class) {
+  case FILELINK:
+	s = s->sy_filelink;
+	/* fall through */
+  case FILESYM:
+	return s->sy_file->f_scope;
+  case PROC:
+  case FUNCTION:
+  case MODULE:
+	return s->sy_name.nm_scope;
+  }
+  return 0;
+}
+
 /* Determine if the OP_SELECT tree indicated by 'p' could lead to scope 'sc'.
 */
 static int
@@ -133,23 +155,35 @@ consistent(p, sc)
 {
   p_tree	arg;
   p_symbol	sym;
+  p_scope	target_sc;
 
   assert(p->t_oper == OP_SELECT);
-  sc = sc->sc_static_encl;
-  if (!sc) return 0;
 
   p = p->t_args[0];
 
   switch(p->t_oper) {
   case OP_NAME:
-	sym = Lookfromscope(p->t_idf, FILELINK|FILESYM|PROC|FUNCTION|MODULE, sc);
+	sym = Lookfromscope(p->t_idf, FILELINK|FILESYM|PROC|FUNCTION|MODULE, sc->sc_static_encl);
-	return sym != 0;
+	if (sym) {
+		target_sc = def_scope(sym);
+		while (sc && sc != target_sc) {
+			sc = sc->sc_static_encl;
+		}
+		return sc != 0;
+	}
+	return 0;
 
   case OP_SELECT:
 	arg = p->t_args[1];
-	sym = Lookfromscope(arg->t_idf, FILELINK|FILESYM|PROC|FUNCTION|MODULE, sc);
+	sym = Lookfromscope(arg->t_idf, FILELINK|FILESYM|PROC|FUNCTION|MODULE, sc->sc_static_encl);
-	if (sym == 0) return 0;
+	if (sym) {
-	return consistent(p, sym->sy_scope);
+		target_sc = def_scope(sym);
+		while (sc && sc != target_sc) {
+			sc = sc->sc_static_encl;
+		}
+		return sc != 0 && consistent(p, sym->sy_scope);
+	}
+	return 0;
 
   default:
 	assert(0);
@@ -224,3 +258,106 @@ identify(p, class_set)
   }
   return sym;
 }
+
+static
+pr_scopes(sc)
+  p_scope	sc;
+{
+  while (sc && ! sc->sc_definedby) {
+	sc = sc->sc_static_encl;
+  }
+  if (sc) {
+	pr_scopes(sc->sc_static_encl);
+	if (sc->sc_definedby->sy_class == FILESYM &&
+	    sc->sc_definedby->sy_file->f_base) {
+		fprintf(db_out, "%s`", sc->sc_definedby->sy_file->f_base->sy_idf->id_text);
+	}
+	else fprintf(db_out, "%s`", sc->sc_definedby->sy_idf->id_text);
+  }
+}
+
+static
+pr_sym(s)
+  p_symbol	s;
+{
+  switch(s->sy_class) {
+  case CONST:
+	fprintf(db_out, "Constant:\t");
+	break;
+  case TYPE:
+	fprintf(db_out, "Type:\t\t");
+	break;
+  case TAG:
+	fprintf(db_out, "Tag:\t\t");
+	break;
+  case MODULE:
+	fprintf(db_out, "Module:\t\t");
+	break;
+  case PROC:
+  case FUNCTION:
+	fprintf(db_out, "Routine:\t");
+	break;
+  case VAR:
+  case REGVAR:
+  case LOCVAR:
+  case VARPAR:
+	fprintf(db_out, "Variable:\t");
+	break;
+  case FIELD:
+	fprintf(db_out, "Field:\t\t");
+	break;
+  case FILESYM:
+  case FILELINK:
+	fprintf(db_out, "File:\t\t");
+	break;
+  default:
+	assert(0);
+  }
+  pr_scopes(s->sy_scope);
+  fprintf(db_out, "%s\n", s->sy_idf->id_text);
+}
+
+/* Print all identifications of p->t_args[0].
+*/
+do_find(p)
+  p_tree	p;
+{
+  p_symbol	sym = 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;
+	sym = 0;
+	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);
+}

util/grind/tokenname.c

@@ -62,6 +62,9 @@ struct tokenname tkidf[] =	{	/* names of the identifier tokens */
 	{TRACE, "trace"},
 	{SET, "set"},
 	{TO, "to"},
+	{FIND, "find"},
+	{DISPLAY, "display"},
+	{WHICH, "which"},
 	{-1, "quit"},
 	{0, ""}
 };

util/grind/tree.c

@@ -43,9 +43,6 @@ mknode(va_alist)
 		p->t_idf = va_arg(ap, struct idf *);
 		p->t_str = va_arg(ap, char *);
 		break;
-	case OP_INTEGER:
-		p->t_ival = va_arg(ap, long);
-		break;
 	case OP_STRING:
 		p->t_sval = va_arg(ap, char *);
 		break;
@@ -56,11 +53,13 @@ mknode(va_alist)
 		p->t_lino = va_arg(ap, long);
 		p->t_filename = va_arg(ap, char *);
 		break;
+	case OP_INTEGER:
 	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);
 		break;
 	default:
@@ -124,6 +123,10 @@ print_node(p, top_level)
 	fputs("print ", 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_FILE:
 	fputs("file ", db_out);
 	print_node(p->t_args[0], 0);
@@ -134,17 +137,25 @@ print_node(p, top_level)
 	fputs(" to ", db_out);
 	print_node(p->t_args[1], 0);
 	break;
+  case OP_FIND:
+	fputs("find ", db_out);
+	print_node(p->t_args[0], 0);
+	break;
+  case OP_WHICH:
+	fputs("which ", db_out);
+	print_node(p->t_args[0], 0);
+	break;
   case OP_DELETE:
-	fprintf(db_out, "delete %d", p->t_ival);
+	fprintf(db_out, "delete %ld", p->t_ival);
 	break;
   case OP_REGS:
-	fprintf(db_out, "regs %d", p->t_ival);
+	fprintf(db_out, "regs %ld", p->t_ival);
 	break;
   case OP_NEXT:
-	fprintf(db_out, "next %d", p->t_ival);
+	fprintf(db_out, "next %ld", p->t_ival);
 	break;
   case OP_STEP:
-	fprintf(db_out, "step %d", p->t_ival);
+	fprintf(db_out, "step %ld", p->t_ival);
 	break;
   case OP_STATUS:
 	fputs("status", db_out);
@@ -154,15 +165,16 @@ print_node(p, top_level)
 	print_position(p->t_address, 1);
 	break;
   case OP_RESTORE:
-	fprintf(db_out, "restore %d", p->t_ival);
+	fprintf(db_out, "restore %ld", p->t_ival);
 	break;
   case OP_WHERE:
 	fputs("where", db_out);
+	if (p->t_ival != 0x7fffffff) fprintf(" %ld", p->t_ival);
 	break;
   case OP_CONT:
 	fputs("cont", db_out);
 	if (p->t_args[0]) {
-		fprintf(db_out, " %d", p->t_args[0]->t_ival);
+		fprintf(db_out, " %ld", p->t_args[0]->t_ival);
 	}
 	if (p->t_args[1]) {
 		fputs(" ", db_out);
@@ -274,6 +286,7 @@ in_status(com)
   case OP_WHEN:
   case OP_TRACE:
   case OP_DUMP:
+  case OP_DISPLAY:
 	return 1;
   }
   return 0;
@@ -487,8 +500,9 @@ do_where(p)
   p_tree	p;
 {
   int i = 0;
+  unsigned int cnt;
 
-  for (;;) {
+  for (cnt = p->t_ival; cnt != 0; cnt--) {
 	t_addr AB;
 	t_addr PC;
 	p_scope sc;
@@ -568,6 +582,7 @@ do_print(p)
 
   switch(p->t_oper) {
   case OP_PRINT:
+  case OP_DISPLAY:
 	do_print(p->t_args[0]);
 	break;
   case OP_LINK:

util/grind/type.hh

@@ -42,6 +42,7 @@ typedef struct type {
   short		ty_flags;
 #define T_CROSS		0x0001
   long		ty_size;
+  struct symbol	*ty_sym;
   union {
      /* cross references */
      char	    *typ_tag;