recognize expressions

util/grind/Amakefile

@@ -75,6 +75,8 @@ HSRC = {
 	scope.h,
 	langdep.h,
 	sizes.h,
+	token.h,
+	expr.h,
 	rd.h
 } ;
 

util/grind/commands.g

@@ -14,28 +14,24 @@
 #include	"idf.h"
 #include	"symbol.h"
 #include	"tree.h"
+#include	"langdep.h"
+#include	"token.h"
 
 extern char	*Salloc();
 extern t_lineno	currline;
 extern FILE	*db_in;
 
 int		errorgiven;
-int		extended_charset = 0;
+static int	extended_charset = 0;
+static int	in_expression = 0;
 jmp_buf		jmpbuf;
 
 static int	init_del();
 static int	skip_to_eol();
 
-static struct token {
+struct token	tok, aside;
-  int	tokno;
-  long	ival;
-  char	*str;
-  double fval;
-  struct idf *idf;
-} tok, aside;
 
-#define TOK	tok.tokno
+#define prio(op)	((*(currlang->op_prio))(op))
-#define ASIDE	aside.tokno
 }
 %start Commands, commands;
 
@@ -160,7 +156,7 @@ trace_command(p_tree *p;)
   { p_tree whr = 0, cond = 0, exp = 0; }
 :
   TRACE
-  [ ON expression(&exp) ]?
+  [ ON expression(&exp, 1) ]?
   where(&whr)?
   condition(&cond)?	{ *p = mknode(OP_TRACE, whr, cond, exp); }
 ;
@@ -234,19 +230,19 @@ delete_command(p_tree *p;)
 
 print_command(p_tree *p;)
 :
-  PRINT expression(p)	{ *p = mknode(OP_PRINT, *p); 
+  PRINT expression(p, 1){ *p = mknode(OP_PRINT, *p); 
 			  p = &((*p)->t_args[0]);
 			}
   [ ','			{ *p = mknode(OP_LINK, *p, (p_tree) 0);
 			  p = &((*p)->t_args[1]);
 			}
-    expression(p)
+    expression(p, 1)
   ]*
 ;
 
 condition(p_tree *p;)
 :
-  IF expression(p)
+  IF expression(p, 1)
 ;
 
 where(p_tree *p;)
@@ -256,9 +252,57 @@ where(p_tree *p;)
   position(p)
 ;
 
-expression(p_tree *p;)
+expression(p_tree *p; int level;)
+  { int currprio, currop; }
+:			{ in_expression++; }
+  factor(p)
+  [ %while ((currprio = prio(currop = (int) tok.ival)) > level)
+	[ BIN_OP | PREF_OR_BIN_OP ] 
+			{ *p = mknode(OP_BINOP, *p, (p_tree) 0);
+			  (*p)->t_whichoper = currop;
+			}
+	expression(&((*p)->t_args[1]), currprio)
+  ]*
+			{ in_expression--; }
+;
+
+factor(p_tree *p;)
 :
-	qualified_name(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)
+|
+  PREF_OP		{ *p = mknode(OP_UNOP, (p_tree) 0);
+			  (*p)->t_whichoper = (int) tok.ival;
+			}
+  factor(&(*p)->t_args[0])
+;
+
+designator(p_tree *p;)
+:
+  qualified_name(p)
+  [
+	SEL_OP		{ *p = mknode(OP_BINOP, *p, (p_tree) 0);
+			  (*p)->t_whichoper = (int) tok.ival;
+			}
+	name(&(*p)->t_args[1])
+  |
+	'['		{ *p = mknode(OP_BINOP, *p, (p_tree) 0);
+			  (*p)->t_whichoper = '[';
+			}
+	expression(&(*p)->t_args[1], 1)
+	']'
+  |
+	POST_OP		{ *p = mknode(OP_UNOP, *p);
+			  (*p)->t_whichoper = (int) tok.ival;
+			}
+  ]*
 ;
 
 position(p_tree *p;)
@@ -357,10 +401,11 @@ LLlex()
   if (c == EOF) return c;
   switch(class(c)) {
   case STSTR:
-	TOK = get_string(c);
+	TOK = (*currlang->get_string)(c);
 	break;
   case STIDF:
-	TOK = get_name(c);
+	if (in_expression) TOK = (*currlang->get_name)(c);
+	else TOK = get_name(c);
 	break;
   case STDOT:
 	c = getc(db_in);
@@ -371,15 +416,20 @@ LLlex()
 	}
 	/* Fall through */
   case STNUM:
-	TOK = get_number(c);
+	TOK = (*currlang->get_number)(c);
 	break;
   case STNL:
-  case STSIMP:
 	TOK = c;
 	break;
+  case STSIMP:
+	if (! in_expression) {
+		TOK = c;
+		break;
+	}
+	/* Fall through */
   default:
-	error("illegal character '\\0%o'", c);
+	TOK = (*currlang->get_token)(c);
-	return LLlex();
+	break;
   }
   return TOK;
 }
@@ -450,7 +500,8 @@ quoted(ch)
 
 }
 
-int get_string(c)
+int 
+get_string(c)
   int	c;
 {
   register int ch;

util/grind/dbx_string.g

@@ -447,16 +447,24 @@ type(p_type *ptp; int *type_index;)
 ;
 
 structure_type(register p_type tp;)
-  { register struct fields *fldp; }
+  { register struct fields *fldp;
+    register p_symbol s;
+  }
 :
   integer_const(&(tp->ty_size))		/* size in bytes */
+			{ open_scope((p_symbol) 0, 0); }
   [			{ fldp = get_field_space(tp); }
 	name(&(fldp->fld_name))
+			{ s = NewSymbol(fldp->fld_name, CurrentScope, FIELD, currnam);
+			  s->sy_field = fldp;
+			}
 	type(&(fldp->fld_type), (int *) 0) ','
 	integer_const(&(fldp->fld_pos)) ','	/* offset in bits */
 	integer_const(&(fldp->fld_bitsize)) ';'	/* size in bits */
   ]*
-  ';'			{ end_field(tp); }
+  ';'			{ end_field(tp); 
+			  close_scope();
+			}
 ;
 
 enum_type(register p_type tp;)

util/grind/expr.c

@@ -3,6 +3,7 @@
 #include "position.h"
 #include "operator.h"
 #include "tree.h"
+#include "expr.h"
 
 int
 eval_cond(p)

util/grind/langdep.h

@@ -23,6 +23,11 @@ struct langdep {
   /* language dependant routines: */
   int	(*printstring)();
   long	(*arrayelsize)();
+  int	(*op_prio)();
+  int	(*get_string)();
+  int	(*get_name)();
+  int	(*get_number)();
+  int	(*get_token)();
 };
 
 extern struct langdep	*m2_dep, *currlang;

util/grind/main.c

@@ -30,7 +30,7 @@ main(argc, argv)
   while (p = strindex(progname, '/')) {
 	progname = p + 1;
   }
-  if (argv[1][0] == '-') {
+  if (argv[1] && argv[1][0] == '-') {
 	switch(argv[1][1]) {
 	case 'd':
 		debug++;

util/grind/modula-2.c

@@ -4,12 +4,27 @@
 
 #include <stdio.h>
 
+#include "class.h"
 #include "langdep.h"
+#include "Lpars.h"
+#include "idf.h"
+#include "token.h"
+#include "expr.h"
 
-extern FILE *db_out;
+extern FILE *db_out, *db_in;
+
+extern int
+	get_string();
+
+extern double
+	atof();
 
 static int
-	print_string();
+	print_string(),
+	get_number(),
+	get_name(),
+	get_token(),
+	op_prio();
 
 static long
 	array_elsize();
@@ -31,7 +46,12 @@ static struct langdep m2 = {
 	"}",
 
 	print_string,
-	array_elsize
+	array_elsize,
+	op_prio,
+	get_string,
+	get_name,
+	get_number,
+	get_token
 };
 
 struct langdep *m2_dep = &m2;
@@ -59,3 +79,295 @@ array_elsize(size)
   if (! (size % int_size)) return size;
   return ((size + int_size - 1) / int_size) * int_size;
 }
+
+static int
+op_prio(op)
+  int	op;
+{
+  /* ??? to be written ??? */
+  return 1;
+}
+
+static int
+get_number(ch)
+  register int	ch;
+{
+  /*	The problem arising with the "parsing" of a number
+	is that we don't know the base in advance so we
+	have to read the number with the help of a rather
+	complex finite automaton.
+  */
+  enum statetp {Oct,Hex,Dec,OctEndOrHex,End,Real};
+  register enum statetp state;
+  char buf[512+1];
+  register int base = 10;
+  register char *np = &buf[0];
+
+  *np++ = ch;
+  state = is_oct(ch) ? Oct : Dec;
+  ch = getc(db_in);
+  for (;;) {
+	switch(state) {
+	case Oct:
+		while (is_oct(ch))	{
+			if (np < &buf[512]) *np++ = ch;
+			ch = getc(db_in);
+		}
+		if (ch == 'B' || ch == 'C') {
+			state = OctEndOrHex;
+			break;
+		}
+		/* Fall Through */
+	case Dec:
+		base = 10;
+		while (is_dig(ch))	{
+			if (np < &buf[512]) {
+				*np++ = ch;
+			}
+			ch = getc(db_in);
+		}
+		if (is_hex(ch)) state = Hex;
+		else if (ch == '.') state = Real;
+		else {
+			state = End;
+			if (ch == 'H') base = 16;
+			else ungetc(ch, db_in);
+		}
+		break;
+
+	case Hex:
+		while (is_hex(ch))	{
+			if (np < &buf[512]) *np++ = ch;
+			ch = getc(db_in);
+		}
+		base = 16;
+		state = End;
+		if (ch != 'H') {
+			error("H expected after hex number");
+			ungetc(ch, db_in);
+		}
+		break;
+
+	case OctEndOrHex:
+		if (np < &buf[512]) *np++ = ch;
+		ch = getc(db_in);
+		if (ch == 'H') {
+			base = 16;
+			state = End;
+			break;
+		}
+		if (is_hex(ch)) {
+			state = Hex;
+			break;
+		}
+		ungetc(ch, db_in);
+		ch = *--np;
+		*np++ = '\0';
+		/* Fall through */
+		
+	case End:
+		*np = '\0';
+		if (np >= &buf[512]) {
+			tok.ival = 1;
+			error("constant too long");
+		}
+		else {
+			np = &buf[0];
+			while (*np == '0') np++;
+			tok.ival = 0;
+			while (*np) {
+				int c;
+
+				if (is_dig(*np)) {
+					c = *np++ - '0';
+				}
+				else {
+					c = *np++ - 'A' + 10;
+				}
+				tok.ival *= base;
+				tok.ival += c;
+			}
+		}
+		return INTEGER;
+	}
+	if (state == Real) break;
+  }
+
+  /* a real real constant */
+  if (np < &buf[512]) *np++ = '.';
+
+  while (is_dig(ch)) {
+	/* 	Fractional part
+	*/
+	if (np < &buf[512]) *np++ = ch;
+	ch = getc(db_in);
+  }
+
+  if (ch == 'E') {
+	/*	Scale factor
+	*/
+	if (np < &buf[512]) *np++ = ch;
+	ch = getc(db_in);
+	if (ch == '+' || ch == '-') {
+		/*	Signed scalefactor
+		*/
+		if (np < &buf[512]) *np++ = ch;
+		ch = getc(db_in);
+	}
+	if (is_dig(ch)) {
+		do {
+			if (np < &buf[512]) *np++ = ch;
+			ch = getc(db_in);
+		} while (is_dig(ch));
+	}
+	else {
+		error("bad scale factor");
+	}
+  }
+
+  *np++ = '\0';
+  ungetc(ch, db_in);
+
+  if (np >= &buf[512]) {
+	tok.fval = 0.0;
+	error("real constant too long");
+  }
+  else	tok.fval = atof(buf);
+  return REAL;
+}
+
+static int
+get_name(c)
+  register int	c;
+{
+  char	buf[512+1];
+  register char	*p = &buf[0];
+  register struct idf *id;
+
+  do {
+	if (p - buf < 512) *p++ = c;
+	c = getc(db_in);
+  } while (in_idf(c));
+  ungetc(c, db_in);
+  *p = 0;
+  /* now recognize AND, DIV, IN, MOD, NOT, OR */
+  switch(buf[0]) {
+  case 'A':
+	if (strcmp(buf, "AND") == 0) {
+		tok.ival = E_AND;
+		return BIN_OP;
+	}
+	break;
+  case 'D':
+	if (strcmp(buf, "DIV") == 0) {
+		tok.ival = E_DIV;
+		return BIN_OP;
+	}
+	break;
+  case 'I':
+	if (strcmp(buf, "IN") == 0) {
+		tok.ival = E_IN;
+		return BIN_OP;
+	}
+	break;
+  case 'M':
+	if (strcmp(buf, "MOD") == 0) {
+		tok.ival = E_MOD;
+		return BIN_OP;
+	}
+	break;
+  case 'N':
+	if (strcmp(buf, "NOT") == 0) {
+		tok.ival = E_NOT;
+		return PREF_OP;
+	}
+	break;
+  case 'O':
+	if (strcmp(buf, "OR") == 0) {
+		tok.ival = E_OR;
+		return BIN_OP;
+	}
+	break;
+  }
+  id = str2idf(buf, 1);
+  tok.idf = id;
+  tok.str = id->id_text;
+  return id->id_reserved ? id->id_reserved : NAME;
+}
+
+static int
+get_token(c)
+  register int	c;
+{
+  switch(c) {
+  case '(':
+  case ')':
+  case '[':
+  case ']':
+  case '`':
+  case '{':
+  case '}':
+  case ':':
+  case ',':
+	return c;
+
+  case '.':
+	tok.ival = E_SELECT;
+	return SEL_OP;
+  case '+':
+	tok.ival = E_PLUS;
+	return PREF_OR_BIN_OP;
+  case '-':
+	tok.ival = E_MIN;
+	return PREF_OR_BIN_OP;
+  case '*':
+	tok.ival = E_MUL;
+	return BIN_OP;
+  case '/':
+	tok.ival = E_DIV;
+	return BIN_OP;
+  case '&':
+	tok.ival = E_AND;
+	return BIN_OP;
+  case '|':
+	tok.ival = E_OR;
+	return BIN_OP;
+  case '=':
+	tok.ival = E_EQUAL;
+	return BIN_OP;
+  case '#':
+	tok.ival = E_NOTEQUAL;
+	return BIN_OP;
+  case '<':
+	c = getc(db_in);
+	if (c == '>') {
+		tok.ival = E_NOTEQUAL;
+		return BIN_OP;
+	}
+	if (c == '=') {
+		tok.ival = E_LTEQUAL;
+		return BIN_OP;
+	}
+	ungetc(c, db_in);
+	tok.ival = E_LT;
+	return BIN_OP;
+  case '>':
+	c = getc(db_in);
+	if (c == '=') {
+		tok.ival = E_GTEQUAL;
+		return BIN_OP;
+	}
+	ungetc(c, db_in);
+	tok.ival = E_GT;
+	return BIN_OP;
+  case '^':
+	tok.ival = E_DEREF;
+	return POST_OP;
+  case '~':
+	tok.ival = E_NOT;
+	return PREF_OP;
+  default:
+	error("illegal character 0%o", c);
+	return LLlex();
+  }
+}

util/grind/operators.ot

@@ -5,6 +5,8 @@ OP_RUN		1	start_child
 OP_INPUT	1	0
 OP_OUTPUT	1	0
 OP_INTEGER	0	0
+OP_REAL		0	0
+OP_STRING	0	0
 OP_NAME		0	0
 OP_AT		0	0
 OP_IN		1	0
@@ -22,3 +24,5 @@ OP_PRINT	1	do_print
 OP_DUMP		0	do_dump
 OP_RESTORE	0	do_restore
 OP_TRACE	3	do_trace
+OP_UNOP		1	0
+OP_BINOP	2	0

util/grind/print.c

@@ -99,11 +99,11 @@ print_params(tp, AB, static_link)
 			fprintf(db_out, currlang->addr_fmt, BUFTOA(p));
 		}
 		else {
-			print_val(par->par_type, q, 1, 0, param_bytes);
+			print_val(par->par_type, size, q, 1, 0);
 		}
 		free(q);
 	}
-	else print_val(par->par_type, p, 1, 0, param_bytes);
+	else print_val(par->par_type, par->par_type->ty_size, p, 1, 0);
 	if (i) fputs(", ", db_out);
 	p += param_size(par->par_type, par->par_kind);
 	par++;
@@ -111,29 +111,27 @@ print_params(tp, AB, static_link)
   free(param_bytes);
 }
 
-print_val(tp, addr, compressed, indent, AB)
+print_val(tp, tp_sz, addr, compressed, indent)
   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 */
-  char		*AB;		/* argument base for dynamic subranges */
 {
-  long sz;
   register int i;
   long elsize;
 
   if (indent == 0) indent = 4;
   switch(tp->ty_class) {
   case T_SUBRANGE:
-	print_val(tp->ty_base, addr, compressed, indent, AB);
+	print_val(tp->ty_base, tp->ty_size, addr, compressed, indent);
 	break;
   case T_ARRAY:
 	if (tp->ty_elements == char_type ||
 	    tp->ty_elements == uchar_type) {
-		print_val(string_type, addr, compressed, indent, AB);
+		print_val(string_type, tp_sz, addr, compressed, indent);
 		break;
 	}
-	if ((sz = tp->ty_size) == 0) sz = compute_size(tp, AB);
 	if (compressed) {
 		fprintf(db_out, currlang->open_array_display);
 	}
@@ -146,8 +144,8 @@ print_val(tp, addr, compressed, indent, AB)
 	}
 	indent += 4;
 	elsize = (*currlang->arrayelsize)(tp->ty_elements->ty_size);
-	for (i = sz/elsize; i; i--) {
+	for (i = tp_sz/elsize; i; i--) {
-		print_val(tp->ty_elements, addr, compressed, indent, AB);
+		print_val(tp->ty_elements, tp->ty_elements->ty_size, addr, compressed, indent);
 		addr += elsize;
 		if (compressed && i > 1) {
 			fprintf(db_out, ", ...");
@@ -176,13 +174,14 @@ print_val(tp, addr, compressed, indent, AB)
 	}
 	indent += 4;
 	for (i = tp->ty_nfields; i; i--, fld++) {
+		long sz = fld->fld_type->ty_size;
 		if (! compressed) fprintf(db_out, "%s = ", fld->fld_name);
-		if (fld->fld_bitsize != fld->fld_type->ty_size << 3) {
+		if (fld->fld_bitsize != sz << 3) {
 			/* apparently a bit field */
 			/* ??? */
 			fprintf(db_out, "<bitfield, %d, %d>", fld->fld_bitsize, fld->fld_type->ty_size);
 		}
-		else print_val(fld->fld_type, addr+(fld->fld_pos>>3), compressed, indent, AB);
+		else print_val(fld->fld_type, sz, addr+(fld->fld_pos>>3), compressed, indent);
 		if (compressed && i > 1) {
 			fprintf(db_out, ", ...");
 			break;
@@ -200,9 +199,9 @@ print_val(tp, addr, compressed, indent, AB)
 	fprintf(db_out, "<union>");
 	break;
   case T_ENUM:
-	print_literal(tp,  tp->ty_size == 1 
+	print_literal(tp,  tp_sz == 1 
 			   ? (*addr & 0xFF)
-			   : tp->ty_size == 2
+			   : tp_sz == 2
 			      ? (BUFTOS(addr) & 0xFFFF)
 			      : (int) BUFTOL(addr));
 	break;
@@ -281,16 +280,16 @@ print_val(tp, addr, compressed, indent, AB)
 	break;
 	}
   case T_UNSIGNED:
-	print_unsigned(tp, tp->ty_size == 1 
+	print_unsigned(tp, tp_sz == 1 
 				? (*addr & 0xFF)
-				: tp->ty_size == 2
+				: tp_sz == 2
 			  	    ? (BUFTOS(addr) & 0xFFFF)
 			  	    : BUFTOL(addr));
 	break;
   case T_INTEGER:
-	print_integer(tp, tp->ty_size == 1 
+	print_integer(tp, tp_sz == 1 
 				? *addr
-				: tp->ty_size == 2
+				: tp_sz == 2
 			  	    ? BUFTOS(addr)
 			  	    : BUFTOL(addr));
 	break;
@@ -308,13 +307,12 @@ print_sym(sym)
   p_symbol	sym;
 {
   char		*buf;
-  char		*AB;
+  long		size;
 
-  if (get_value(sym, &buf, &AB)) {
+  if (get_value(sym, &buf, &size)) {
 	fputs(" = ", db_out);
-	print_val(sym->sy_type, buf, 0, 0, AB);
+	print_val(sym->sy_type, size, buf, 0, 0);
 	if (buf) free(buf);
-	if (AB) free(AB);
 	fputs("\n", db_out);
 	return 1;
   }

util/grind/symbol.hh

@@ -31,7 +31,7 @@ typedef struct symbol {
 #define REGVAR		0x0080
 #define LOCVAR		0x0100
 #define VARPAR		0x0200
-/* #define SYMENTRY	0x0400	/* a non-dbx entry */
+#define FIELD		0x0400
 #define FILESYM		0x0800	/* a filename */
 #define FILELINK	0x1000	/* a filename without its suffix */
   struct idf	*sy_idf;	/* reference back to its idf structure */
@@ -42,12 +42,14 @@ typedef struct symbol {
 /*	struct outname syv_onam;	/* for non-dbx entries */
 	struct file *syv_file;		/* for FILESYM */
 	struct symbol *syv_fllink;	/* for FILELINK */
+	struct fields *syv_field;
   }	sy_v;
 #define sy_const	sy_v.syv_const
 #define sy_name		sy_v.syv_name
 #define sy_onam		sy_v.syv_onam
 #define sy_file		sy_v.syv_file
 #define sy_filelink	sy_v.syv_fllink
+#define sy_field	sy_v.syv_field
 } t_symbol, *p_symbol;
 
 /* ALLOCDEF "symbol" 50 */

util/grind/token.h

@@ -0,0 +1,16 @@
+/* $Header$ */
+
+/* token structure for lexical analyzer */
+
+struct token {
+  int	tokno;
+  long	ival;
+  char	*str;
+  double fval;
+  struct idf *idf;
+};
+
+extern struct token	tok, aside;
+
+#define TOK	tok.tokno
+#define ASIDE	aside.tokno

util/grind/tokenname.c

@@ -29,6 +29,11 @@ struct tokenname tkspec[] =	{	/* the names of the special tokens */
 	{INTEGER, "number"},
 	{REAL, "real"},
 	{CHAR, "char"},
+	{BIN_OP, "<operator>"},
+	{PREF_OR_BIN_OP, "<operator>"},
+	{PREF_OP, "<operator>"},
+	{POST_OP, "<operator>"},
+	{SEL_OP, "<operator>"},
 	{0, ""}
 };
 #endif

util/grind/tree.c

@@ -44,6 +44,12 @@ mknode(va_alist)
 	case OP_INTEGER:
 		p->t_ival = va_arg(ap, long);
 		break;
+	case OP_STRING:
+		p->t_sval = va_arg(ap, char *);
+		break;
+	case OP_REAL:
+		p->t_fval = va_arg(ap, double);
+		break;
 	case OP_AT:
 		p->t_lino = va_arg(ap, long);
 		p->t_filename = va_arg(ap, char *);
@@ -74,23 +80,10 @@ freenode(p)
   register int na, i;
 
   if (! p) return;
-  switch(p->t_oper) {
+  na = nargs(p->t_oper);
-  case OP_NAME:
+  assert(na <= MAXARGS);
-  case OP_INTEGER:
+  for (i = 0; i < na; i++) {
-  case OP_AT:
+	freenode(p->t_args[i]);
-  case OP_CONT:
-  case OP_NEXT:
-  case OP_STEP:
-  case OP_REGS:
-  case OP_DELETE:
-	break;
-  default:
-	na = nargs(p->t_oper);
-	assert(na <= MAXARGS);
-	for (i = 0; i < na; i++) {
-		freenode(p->t_args[i]);
-	}
-	break;
   }
   free_tree(p);
 }
@@ -219,6 +212,12 @@ print_node(p, top_level)
   case OP_INTEGER:
 	fprintf(db_out, "%d", p->t_ival);
 	break;
+  case OP_STRING:
+	fprintf(db_out, "%s", p->t_sval);
+	break;
+  case OP_REAL:
+	fprintf(db_out, "%.14g", p->t_fval);
+	break;
   }
   if (top_level) fputs("\n", db_out);
 }
@@ -548,7 +547,7 @@ do_print(p)
 	break;
   case OP_NAME:
   case OP_SELECT:
-	sym = identify(p, VAR|REGVAR|LOCVAR|VARPAR);
+	sym = identify(p, VAR|REGVAR|LOCVAR|VARPAR|CONST);
 	if (! sym) return;
 	print_node(p, 0);
 	if (! print_sym(sym)) {

util/grind/tree.hh

@@ -3,11 +3,14 @@
 #define MAXARGS	3
 
 typedef struct tree {
-  int	t_oper;		/* operator */
+  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;
+	double tt_fval;
 	struct {
 		struct idf *tt_idf;
 		char *tt_str;
@@ -17,6 +20,8 @@ typedef struct tree {
 	t_position tt_pos;
   } t_xxxx;
 #define t_ival	t_xxxx.tt_ival
+#define t_sval	t_xxxx.tt_sval
+#define t_fval	t_xxxx.tt_fval
 #define t_idf	t_xxxx.tt_x.tt_idf
 #define t_str	t_xxxx.tt_x.tt_str
 #define t_sc	t_xxxx.tt_x.tt_scope

util/grind/value.c

@@ -12,20 +12,21 @@ int stack_offset;		/* for up and down commands */
 
 extern long pointer_size;
 extern t_addr *get_EM_regs();
+extern char *memcpy();
 
 /* Get the value of the symbol indicated by sym.
    Return 0 on failure,
 	  1 on success.
-   On success, 'buf' contains the value, and 'AB' may contain the parameters
+   On success, 'buf' contains the value, and 'size' contains the size.
-   of the procedure invocation containing sym.
+   For 'buf', storage is allocated by Malloc; this storage must
-   For both of these, storage is allocated by Malloc; this storage must
    be freed by caller (I don't like this any more than you do, but caller
    does not know sizes).
 */
 int
-get_value(sym, buf, AB)
+get_value(sym, buf, psize)
   register p_symbol	sym;
-  char	**buf, **AB;
+  char	**buf;
+  long	*psize;
 {
   p_type	tp = sym->sy_type;
   long		size = tp->ty_size;
@@ -33,9 +34,9 @@ get_value(sym, buf, AB)
   t_addr	*EM_regs;
   int		i;
   p_scope	sc, symsc;
+  char		*AB;
 
   *buf = 0;
-  *AB = 0;
   switch(sym->sy_class) {
   case VAR:
 	/* exists if child exists; nm_value contains addres */
@@ -44,7 +45,40 @@ get_value(sym, buf, AB)
 		retval = 1;
 	}
 	break;
-
+  case CONST:
+	*buf = Malloc((unsigned) tp->ty_size);
+	switch(tp->ty_class) {
+	case T_REAL:
+		if (tp->ty_size != sizeof(double)) {
+			*((float *) *buf) = sym->sy_const.co_rval;
+		}
+		else	*((double *) *buf) = sym->sy_const.co_rval;
+		break;
+	case T_INTEGER:
+	case T_SUBRANGE:
+	case T_UNSIGNED:
+	case T_ENUM:
+		if (tp->ty_size == 1) {
+			*((char *) *buf) = sym->sy_const.co_ival;
+		}
+		else if (tp->ty_size == 2) {
+			*((short *) *buf) = sym->sy_const.co_ival;
+		}
+		else {
+			*((long *) *buf) = sym->sy_const.co_ival;
+		}
+		break;
+	case T_SET:
+		memcpy(*buf, sym->sy_const.co_setval, (int) tp->ty_size);
+		break;
+	case T_STRING:
+		memcpy(*buf, sym->sy_const.co_sval, (int) tp->ty_size);
+		break;
+	default:
+		fatal("strange constant");
+	}
+	retval = 1;
+	break;
   case VARPAR:
   case LOCVAR:
 	/* first find the stack frame in which it resides */
@@ -97,28 +131,29 @@ get_value(sym, buf, AB)
 
 		size = proctype->ty_nbparams;
 		if (has_static_link(sc)) size += pointer_size;
-		*AB = Malloc((unsigned) size);
+		AB = Malloc((unsigned) size);
-		if (! get_bytes(size, EM_regs[AB_OFF], *AB)) {
+		if (! get_bytes(size, EM_regs[AB_OFF], AB)) {
 			break;
 		}
 		if ((size = tp->ty_size) == 0) {
-			size = compute_size(tp, *AB);
+			size = compute_size(tp, AB);
 		}
 	}
 	*buf = Malloc((unsigned) size);
+	*psize = size;
 	if (get_bytes(size,
-		      (t_addr) BUFTOA(*AB+sym->sy_name.nm_value),
+		      (t_addr) BUFTOA(AB+sym->sy_name.nm_value),
 		      *buf)) {
 		retval = 1;
 	}
+	free(AB);
 	break;
   }
 
   if (retval == 0) {
 	if (*buf) free(*buf);
-	if (*AB) free(*AB);
 	*buf = 0;
-	*AB = 0;
+	*psize = 0;
   }
 
   return retval;