From: ceriel <none@none>
Date: Wed, 19 Sep 1990 14:31:12 +0000 (+0000)
Subject: many changes
X-Git-Tag: release-5-5~1535
X-Git-Url: https://git.ndcode.org/public/gitweb.cgi?a=commitdiff_plain;h=1feeb94dbf63915fa5e324fd9feca2c71e1b2ff3;p=ack.git

many changes
---

diff --git a/util/grind/Amakefile b/util/grind/Amakefile
index 941d48e6b..f1e5df0bf 100644
--- a/util/grind/Amakefile
+++ b/util/grind/Amakefile
@@ -61,7 +61,6 @@ CSRC = {
 	value.c,
 	type.c,
 	rd.c,
-	default.c,
 	modula-2.c,
 	c.c
 } ;
diff --git a/util/grind/c.c b/util/grind/c.c
index 59f1ed54e..284671f29 100644
--- a/util/grind/c.c
+++ b/util/grind/c.c
@@ -25,11 +25,13 @@ extern double
 
 static int
 	print_string(),
+	print_char(),
 	get_number(),
 	get_string(),
 	get_token(),
 	print_op(),
-	op_prio();
+	unop_prio(),
+	binop_prio();
 
 static long
 	array_elsize();
@@ -43,7 +45,6 @@ static struct langdep c = {
 	"%lu",
 	"0x%lX",
 	"%g",
-	"'\\%o'",
 
 	"{",
 	"}",
@@ -53,8 +54,10 @@ static struct langdep c = {
 	"}",
 
 	print_string,
+	print_char,
 	array_elsize,
-	op_prio,
+	unop_prio,
+	binop_prio,
 	get_string,
 	get_name,
 	get_number,
@@ -64,6 +67,13 @@ static struct langdep c = {
 
 struct langdep *c_dep = &c;
 
+static int
+print_char(c)
+  int	c;
+{
+  fprintf(db_out, (c >= 040 && c < 0177) ? "'%c'" : "'\\0%o'", c);
+}
+
 static int
 print_string(s, len)
   char	*s;
@@ -89,12 +99,57 @@ array_elsize(size)
   return ((size + int_size - 1) / int_size) * int_size;
 }
 
-/*ARGSUSED*/
 static int
-op_prio(op)
+unop_prio(op)
   int	op;
 {
   switch(op) {
+  case E_NOT:
+  case E_BNOT:
+  case E_MIN:
+  case E_MUL:
+  case E_SELECT:
+  case E_PLUS:
+	return 12;
+  }
+  return 1;
+}
+
+static int
+binop_prio(op)
+  int	op;
+{
+  switch(op) {
+  case E_OR:
+	return 2;
+  case E_AND:
+	return 3;
+  case E_BOR:
+	return 4;
+  case E_BXOR:
+	return 5;
+  case E_BAND:
+	return 6;
+  case E_EQUAL:
+  case E_NOTEQUAL:
+	return 7;
+  case E_LT:
+  case E_LTEQUAL:
+  case E_GT:
+  case E_GTEQUAL:
+	return 8;
+  case E_LSFT:
+  case E_RSFT:
+	return 9;
+  case E_MIN:
+  case E_PLUS:
+	return 10;
+  case E_MUL:
+  case E_DIV:
+  case E_ZDIV:
+  case E_MOD:
+  case E_ZMOD:
+	return 11;
   }
   return 1;
 }
@@ -194,6 +249,12 @@ get_token(c)
 	tok.ival = E_PLUS;
 	return PREF_OR_BIN_OP;
   case '-':
+	c = getc(db_in);
+	if (c == '>') {
+		tok.ival = E_DERSELECT;
+		return BIN_OP;
+	}
+	ungetc(c, db_in);
 	tok.ival = E_MIN;
 	return PREF_OR_BIN_OP;
   case '*':
@@ -244,6 +305,10 @@ get_token(c)
 		tok.ival = E_LTEQUAL;
 		return BIN_OP;
 	}
+	if (c == '<') {
+		tok.ival = E_LSFT;
+		return BIN_OP;
+	}
 	ungetc(c, db_in);
 	tok.ival = E_LT;
 	return BIN_OP;
@@ -253,6 +318,10 @@ get_token(c)
 		tok.ival = E_GTEQUAL;
 		return BIN_OP;
 	}
+	if (c == '>') {
+		tok.ival = E_RSFT;
+		return BIN_OP;
+	}
 	ungetc(c, db_in);
 	tok.ival = E_GT;
 	return BIN_OP;
@@ -265,6 +334,9 @@ get_token(c)
 	ungetc(c, db_in);
 	tok.ival = E_NOT;
 	return PREF_OP;
+  case '~':
+	tok.ival = E_BNOT;
+	return PREF_OP;
   default:
 	error("illegal character 0%o", c);
 	return LLlex();
@@ -360,12 +432,41 @@ print_op(p)
 		fputs("*", db_out);
 		print_node(p->t_args[0], 0);
 		break;
+	case E_BNOT:
+		fputs("~", db_out);
+		print_node(p->t_args[0], 0);
+		break;
 	}
 	break;
   case OP_BINOP:
+	if (p->t_whichoper == E_ARRAY) {
+		print_node(p->t_args[0], 0);
+		fputs("[", db_out);
+		print_node(p->t_args[1], 0);
+		fputs("]", db_out);
+		break;
+	}
+	if (p->t_whichoper == E_DERSELECT) {
+		print_node(p->t_args[0], 0);
+		fputs("->", db_out);
+		print_node(p->t_args[1], 0);
+		break;
+	}
+	if (p->t_whichoper == E_SELECT) {
+		print_node(p->t_args[0], 0);
+		fputs(".", db_out);
+		print_node(p->t_args[1], 0);
+		break;
+	}
 	fputs("(", db_out);
 	print_node(p->t_args[0], 0);
 	switch(p->t_whichoper) {
+	case E_LSFT:
+		fputs("<<", db_out);
+		break;
+	case E_RSFT:
+		fputs(">>", db_out);
+		break;
 	case E_AND:
 		fputs("&&", db_out);
 		break;
@@ -414,9 +515,6 @@ print_op(p)
 	case E_GT:
 		fputs(">", db_out);
 		break;
-	case E_SELECT:
-		fputs(".", db_out);
-		break;
 	}
 	print_node(p->t_args[1], 0);
 	fputs(")", db_out);
diff --git a/util/grind/commands.g b/util/grind/commands.g
index 32f782bd2..378e1ab59 100644
--- a/util/grind/commands.g
+++ b/util/grind/commands.g
@@ -32,7 +32,8 @@ static int	skip_to_eol();
 
 struct token	tok, aside;
 
-#define prio(op)	((*(currlang->op_prio))(op))
+#define binprio(op)	((*(currlang->binop_prio))(op))
+#define unprio(op)	((*(currlang->unop_prio))(op))
 }
 %start Commands, commands;
 
@@ -100,6 +101,7 @@ command_line(p_tree *p;)
 | delete_command(p)
 | print_command(p)
 | trace_command(p)
+| set_command(p)
 |			{ *p = 0; }
 ;
 
@@ -241,6 +243,12 @@ print_command(p_tree *p;)
   ]*
 ;
 
+set_command(p_tree *p;)
+:
+  SET expression(p, 1)	{ *p = mknode(OP_SET, *p, (p_tree) 0); }
+  TO expression(&((*p)->t_args[1]), 1)
+;
+
 condition(p_tree *p;)
 :
   IF expression(p, 1)
@@ -257,12 +265,13 @@ expression(p_tree *p; int level;)
   { int currprio, currop; }
 :			{ in_expression++; }
   factor(p)
-  [ %while ((currprio = prio(currop = (int) tok.ival)) > level)
+  [ %while ((currprio = binprio(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)
+			{ adjust_oper(p); }
   ]*
 			{ in_expression--; }
 ;
@@ -283,7 +292,7 @@ factor(p_tree *p;)
 			  (*p)->t_whichoper = (int) tok.ival;
 			}
   [ PREF_OP | PREF_OR_BIN_OP ]
-  expression(&(*p)->t_args[0], prio((*p)->t_whichoper))
+  expression(&(*p)->t_args[0], unprio((*p)->t_whichoper))
 ;
 
 designator(p_tree *p;)
@@ -383,6 +392,8 @@ name(p_tree *p;)
   | RESTORE
   | TRACE
   | ON
+  | SET
+  | TO
   ]			{ *p = mknode(OP_NAME, tok.idf, tok.str); }
 ;
 
diff --git a/util/grind/expr.c b/util/grind/expr.c
index 006849bd7..80290f857 100644
--- a/util/grind/expr.c
+++ b/util/grind/expr.c
@@ -1,5 +1,33 @@
 /* $Header$ */
 
+/* This file contains the expression evaluator. It exports four routines:
+   - int eval_cond(p_tree p)
+	This routine evaluates the conditional expression indicated by p
+	and returns 1 if it evaluates to TRUE, or 0 if it could not be
+	evaluated for some reason or if it evalutes to FALSE.
+	If the expression cannot be evaluated, an error message is given.
+   - int eval_desig(p_tree p, t_addr *pbuf, long **psize, p_type *ptp)
+	This routine evaluates the expression indicated by p, which should
+	result in a designator. The result of the expression is an address
+	which is to be found in *pbuf. *psize will contain the size of the
+	designated object, and *ptp its type.
+	If the expression cannot be evaluated or does not result in a
+	designator, 0 is returned and an error message is given.
+	Otherwise, 1 is returned.
+   - int eval_expr(p_tree p, char **pbuf, long **psize, p_type *ptp)
+	This routine evaluates the expression indicated by p.
+	The result of the expression is left in *pbuf.
+	*psize will contain the size of the value, and *ptp its type.
+	If the expression cannot be evaluated, 0 is returned and an error
+	message is given.  Otherwise, 1 is returned.
+   - int convert(char **pbuf, long *psize, p_type *ptp, p_type tp, long size)
+	This routine tries to convert the value in pbuf of size psize
+	and type ptp to type tp with size size. It returns 0 if this fails,
+	while producing an error message. Otherwise, it returns 1 and
+	the resulting value, type and size are left in pbuf, ptp, and
+	psize, respectively.
+*/
+
 #include <stdio.h>
 #include <alloc.h>
 #include <assert.h>
@@ -14,6 +42,8 @@
 
 extern FILE	*db_out;
 
+/* buffer to integer and vice versa routines */
+
 static long
 get_int(buf, size, class)
   char	*buf;
@@ -22,12 +52,12 @@ get_int(buf, size, class)
   long l;
 
   switch((int)size) {
-  case 1:
+  case sizeof(char):
 	l = *buf;
 	if (class == T_INTEGER && l >= 0x7F) l -= 256;
 	else if (class != T_INTEGER && l < 0) l += 256;
 	break;
-  case 2:
+  case sizeof(short):
 	l = *((short *) buf);
 	if (class == T_INTEGER && l >= 0x7FFF) l -= 65536;
 	else if (class != T_INTEGER && l < 0) l += 65536;
@@ -38,20 +68,6 @@ get_int(buf, size, class)
   return l;
 }
 
-static double
-get_real(buf, size)
-  char	*buf;
-  long	size;
-{
-  switch((int) size) {
-  case sizeof(float):
-	return *((float *) buf);
-  default:
-	return *((double *) buf);
-  }
-  /*NOTREACHED*/
-}
-
 static
 put_int(buf, size, value)
   char	*buf;
@@ -59,17 +75,33 @@ put_int(buf, size, value)
   long	value;
 {
   switch((int)size) {
-  case 1:
+  case sizeof(char):
 	*buf = value;
 	break;
-  case 2:
+  case sizeof(short):
 	*((short *) buf) = value;
 	break;
   default:
 	*((long *) buf) = value;
 	break;
   }
-  /* NOTREACHED */
+  /*NOTREACHED*/
+}
+
+/* buffer to real and vice versa routines */
+
+static double
+get_real(buf, size)
+  char	*buf;
+  long	size;
+{
+  switch((int) size) {
+  case sizeof(float):
+	return *((float *) buf);
+  default:
+	return *((double *) buf);
+  }
+  /*NOTREACHED*/
 }
 
 static
@@ -89,19 +121,24 @@ put_real(buf, size, value)
   /* NOTREACHED */
 }
 
-static int
-convert(pbuf, psize, ptp, tp)
+int
+convert(pbuf, psize, ptp, tp, size)
   char	**pbuf;
   long	*psize;
   p_type *ptp;
   p_type tp;
+  long size;
 {
+  /* Convert the value in pbuf, of size psize and type ptp, to type
+     tp and leave the resulting value in pbuf, the resulting size
+     in psize, and the resulting type in ptp.
+  */
   long	l;
   double d;
 
   if (*ptp == tp) return 1;
-  if (tp->ty_size > *psize) {
-	*pbuf = Realloc(*pbuf, (unsigned int) tp->ty_size);
+  if (size > *psize) {
+	*pbuf = Realloc(*pbuf, (unsigned int) size);
   }
   if ((*ptp)->ty_class == T_SUBRANGE) *ptp = (*ptp)->ty_base;
   switch((*ptp)->ty_class) {
@@ -117,17 +154,17 @@ convert(pbuf, psize, ptp, tp)
   	case T_UNSIGNED:
   	case T_POINTER:
   	case T_ENUM:
-		put_int(*pbuf, tp->ty_size, l);
-		*psize = tp->ty_size;
+		put_int(*pbuf, size, l);
+		*psize = size;
 		*ptp = tp;
 		return 1;
 	case T_REAL:
 		put_real(*pbuf,
-			 tp->ty_size,
+			 size,
 			 (*ptp)->ty_class == T_INTEGER 
 				? (double) l
 				: (double) (unsigned long) l);
-		*psize = tp->ty_size;
+		*psize = size;
 		*ptp = tp;
 		return 1;
 	default:
@@ -142,14 +179,14 @@ convert(pbuf, psize, ptp, tp)
   	case T_INTEGER:
   	case T_UNSIGNED:
   	case T_POINTER:
-		if (tp == bool_type) put_int(*pbuf, tp->ty_size, (long) (d != 0));
-		else put_int(*pbuf, tp->ty_size, (long) d);
-		*psize = tp->ty_size;
+		if (tp == bool_type) put_int(*pbuf, size, (long) (d != 0));
+		else put_int(*pbuf, size, (long) d);
+		*psize = size;
 		*ptp = tp;
 		return 1;
 	case T_REAL:
-		put_real(*pbuf, tp->ty_size, d);
-		*psize = tp->ty_size;
+		put_real(*pbuf, size, d);
+		*psize = size;
 		*ptp = tp;
 		return 1;
 	default:
@@ -171,9 +208,10 @@ eval_cond(p)
   long	size;
   p_type tp;
   long val;
+  p_type target_tp = currlang->has_bool_type ? bool_type : int_type;
 
   if (eval_expr(p, &buf, &size, &tp)) {
-	if (convert(&buf, &size, &tp, currlang->has_bool_type ? bool_type : int_type)) {
+	if (convert(&buf, &size, &tp, target_tp, target_tp->ty_size)) {
 		val = get_int(buf, size, T_UNSIGNED);
 		if (buf) free(buf);
 		return (int) (val != 0);
@@ -183,6 +221,8 @@ eval_cond(p)
   return 0;
 }
 
+/* one routine for each unary operator */
+
 static int
 do_not(p, pbuf, psize, ptp)
   p_tree	p;
@@ -190,8 +230,10 @@ do_not(p, pbuf, psize, ptp)
   long		*psize;
   p_type	*ptp;
 {
+  p_type target_tp = currlang->has_bool_type ? bool_type : int_type;
+
   if (eval_expr(p->t_args[0], pbuf, psize, ptp) &&
-      convert(pbuf, psize, ptp, currlang->has_bool_type ? bool_type : int_type)) {
+      convert(pbuf, psize, ptp, target_tp, target_tp->ty_size)) {
 	put_int(*pbuf, *psize, (long) !get_int(*pbuf, *psize, T_UNSIGNED));
 	return 1;
   }
@@ -199,26 +241,44 @@ do_not(p, pbuf, psize, ptp)
 }
 
 static int
-do_deref(p, pbuf, psize, ptp)
+do_bnot(p, pbuf, psize, ptp)
   p_tree	p;
   char		**pbuf;
   long		*psize;
   p_type	*ptp;
 {
-  char	*addr;
-
   if (eval_expr(p->t_args[0], pbuf, psize, ptp)) {
+	switch((*ptp)->ty_class) {
+	case T_INTEGER:
+	case T_ENUM:
+	case T_UNSIGNED:
+	case T_SUBRANGE:
+		put_int(*pbuf, *psize, ~get_int(*pbuf, *psize, T_UNSIGNED));
+		return 1;
+	default:
+		error("illegal operand type(s)");
+		break;
+	}
+  }
+  return 0;
+}
+
+static int
+ptr_addr(p, paddr, psize, ptp)
+  p_tree	p;
+  t_addr	*paddr;
+  long		*psize;
+  p_type	*ptp;
+{
+  char	*buf;
+
+  if (eval_expr(p->t_args[0], &buf, psize, ptp)) {
 	switch((*ptp)->ty_class) {
 	case T_POINTER:
-		addr = *((char **) (*pbuf));
-		free(*pbuf);
 		*ptp = (*ptp)->ty_ptrto;
 		*psize = (*ptp)->ty_size;
-		*pbuf = Malloc((unsigned) (*ptp)->ty_size);
-		if (! get_bytes(*psize, (t_addr) addr, *pbuf)) {
-			error("could not get value");
-			break;
-		}
+		*paddr = get_int(buf, pointer_size, T_UNSIGNED);
+		free(buf);
 		return 1;
   	default:
 		error("illegal operand of DEREF");
@@ -228,6 +288,25 @@ do_deref(p, pbuf, psize, ptp)
   return 0;
 }
 
+static int
+do_deref(p, pbuf, psize, ptp)
+  p_tree	p;
+  char		**pbuf;
+  long		*psize;
+  p_type	*ptp;
+{
+  t_addr addr;
+
+  if (ptr_addr(p, &addr, psize, ptp)) {
+	*pbuf = Malloc((unsigned) *psize);
+	if (! get_bytes(*psize, addr, *pbuf)) {
+		error("could not get value");
+	}
+	return 1;
+  }
+  return 0;
+}
+
 static int
 do_unmin(p, pbuf, psize, ptp)
   p_tree	p;
@@ -301,6 +380,9 @@ static int (*un_op[])() = {
   0,
   0,
   0,
+  0,
+  do_bnot,
+  0,
   0
 };
 
@@ -389,11 +471,12 @@ do_andor(p, pbuf, psize, ptp)
   char		*buf;
   long		size;
   p_type	tp;
+  p_type	target_tp = currlang->has_bool_type ? bool_type : int_type;
 
   if (eval_expr(p->t_args[0], pbuf, psize, ptp) &&
-      convert(pbuf, psize, ptp, currlang->has_bool_type ? bool_type : int_type) &&
+      convert(pbuf, psize, ptp, target_tp, target_tp->ty_size) &&
       eval_expr(p->t_args[1], &buf, &size, &tp) &&
-      convert(&buf, &size, &tp, currlang->has_bool_type ? bool_type : int_type)) {
+      convert(&buf, &size, &tp, target_tp, target_tp->ty_size)) {
 	l1 = get_int(*pbuf, *psize, T_UNSIGNED);
 	l2 = get_int(buf, size, T_UNSIGNED);
 	put_int(*pbuf,
@@ -424,8 +507,8 @@ do_arith(p, pbuf, psize, ptp)
   if (eval_expr(p->t_args[0], pbuf, psize, ptp) &&
       eval_expr(p->t_args[1], &buf, &size, &tp) &&
       (balance_tp = balance(*ptp, tp)) &&
-      convert(pbuf, psize, ptp, balance_tp) &&
-      convert(&buf, &size, &tp, balance_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) {
 	case T_INTEGER:
 	case T_ENUM:
@@ -537,6 +620,54 @@ do_arith(p, pbuf, psize, ptp)
   return 0;
 }
 
+static int
+do_sft(p, pbuf, psize, ptp)
+  p_tree	p;
+  char		**pbuf;
+  long		*psize;
+  p_type	*ptp;
+{
+  long		l1, l2;
+  char		*buf = 0;
+  long		size;
+  p_type	tp;
+
+  if (eval_expr(p->t_args[0], pbuf, psize, ptp) &&
+      eval_expr(p->t_args[1], &buf, &size, &tp) &&
+      convert(&buf, &size, &tp, int_type, int_size)) {
+	tp = *ptp;
+	if (tp->ty_class == T_SUBRANGE) {
+		tp = tp->ty_base;
+	}
+	switch(tp->ty_class) {
+	case T_INTEGER:
+	case T_ENUM:
+	case T_UNSIGNED:
+		l1 = get_int(*pbuf, *psize, tp->ty_class);
+		l2 = get_int(buf, size, T_INTEGER);
+		free(buf);
+		buf = 0;
+		switch(p->t_whichoper) {
+		case E_LSFT:
+			l1 <<= (int) l2;
+			break;
+		case E_RSFT:
+			if (tp->ty_class == T_INTEGER) l1 >>= (int) l2;
+			else l1 = (unsigned long) l1 >> (int) l2;
+			break;
+		}
+		break;
+	default:
+		error("illegal operand type(s)");
+		free(buf);
+		return 0;
+	}
+	return 1;
+  }
+  if (buf) free(buf);
+  return 0;
+}
+
 static int
 do_cmp(p, pbuf, psize, ptp)
   p_tree	p;
@@ -553,8 +684,8 @@ do_cmp(p, pbuf, psize, ptp)
   if (eval_expr(p->t_args[0], pbuf, psize, ptp) &&
       eval_expr(p->t_args[1], &buf, &size, &tp) &&
       (balance_tp = balance(*ptp, tp)) &&
-      convert(pbuf, psize, ptp, balance_tp) &&
-      convert(&buf, &size, &tp, balance_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) {
 	case T_INTEGER:
 	case T_ENUM:
@@ -665,7 +796,7 @@ do_in(p, pbuf, psize, ptp)
 		free(buf);
 		return 0;
 	}
-	if (! convert(pbuf, psize, ptp, tp->ty_setbase)) {
+	if (! convert(pbuf, psize, ptp, tp->ty_setbase, int_size)) {
 		free(buf);
 		return 0;
 	}
@@ -684,9 +815,9 @@ do_in(p, pbuf, psize, ptp)
 }
 
 static int
-do_array(p, pbuf, psize, ptp)
+array_addr(p, paddr, psize, ptp)
   p_tree	p;
-  char		**pbuf;
+  t_addr	*paddr;
   long		*psize;
   p_type	*ptp;
 {
@@ -695,23 +826,112 @@ do_array(p, pbuf, psize, ptp)
   long		size;
   p_type	tp;
 
-  error("[ not implemented"); 	/* ??? */
+  if (eval_desig(p->t_args[0], paddr, psize, ptp) &&
+      eval_expr(p->t_args[1], &buf, &size, &tp)) {
+	if ((*ptp)->ty_class != T_ARRAY && (*ptp)->ty_class != T_POINTER) {
+		error("illegal left-hand side of [");
+		free(buf);
+		return 0;
+	}
+	if (! convert(&buf, &size, &tp, int_type, int_size)) {
+		free(buf);
+		return 0;
+	}
+	l = get_int(buf, size, T_INTEGER);
+	free(buf);
+	buf = 0;
+	if ((*ptp)->ty_class == T_ARRAY) {
+	    	if (l < (*ptp)->ty_lb || l > (*ptp)->ty_hb) {
+			error("array bound error");
+			return 0;
+		}
+		l -= (*ptp)->ty_lb;
+		*ptp = (*ptp)->ty_elements;
+		l *= (*currlang->arrayelsize)((*ptp)->ty_size);
+	}
+	else {
+		*ptp = (*ptp)->ty_ptrto;
+		l *= (*ptp)->ty_size;
+	}
+	*psize = (*ptp)->ty_size;
+	*paddr += l;
+	return 1;
+  }
   return 0;
 }
 
 static int
-do_select(p, pbuf, psize, ptp)
+do_array(p, pbuf, psize, ptp)
   p_tree	p;
   char		**pbuf;
   long		*psize;
   p_type	*ptp;
 {
-  long		l;
-  char		*buf = 0;
-  long		size;
-  p_type	tp;
+  t_addr	a;
+
+  if (array_addr(p, &a, psize, ptp)) {
+	*pbuf = Malloc((unsigned int) *psize);
+	if (! get_bytes(*psize, a, *pbuf)) {
+		return 0;
+	}
+	return 1;
+  }
+  return 0;
+}
+
+static int
+select_addr(p, paddr, psize, ptp)
+  p_tree	p;
+  t_addr	*paddr;
+  long		*psize;
+  p_type	*ptp;
+{
+  register p_type	tp;
+  register struct fields *f;
+  register int		nf;
+
+  if (eval_desig(p->t_args[0], paddr, psize, ptp)) {
+	tp = *ptp;
+	if (tp->ty_class != T_STRUCT && tp->ty_class != T_UNION) {
+		error("SELECT on non-struct");
+		return 0;
+	}
+	if (p->t_args[1]->t_oper != OP_NAME) {
+		error("right-hand side of SELECT not a name");
+		return 0;
+	}
+	for (nf = tp->ty_nfields, f = tp->ty_fields; nf; nf--, f++) {
+		if (! strcmp(f->fld_name, p->t_args[1]->t_str)) break;
+	}
+	if (! nf) {
+		error("'%s' not found", p->t_args[1]->t_str);
+		return 0;
+	}
+	
+	/* ??? this needs some work for bitfields ??? */
+	*paddr += f->fld_pos>>3;
+	*psize = f->fld_bitsize >> 3;
+	*ptp = f->fld_type;
+	return 1;
+  }
+  return 0;
+}
 
-  error("SELECT not implemented"); 	/* ??? */
+static int
+do_select(p, pbuf, psize, ptp)
+  p_tree	p;
+  char		**pbuf;
+  long		*psize;
+  p_type	*ptp;
+{
+  t_addr	a;
+  if (select_addr(p, &a, psize, ptp)) {
+	*pbuf = Malloc((unsigned int) *psize);
+	if (! get_bytes(*psize, a, *pbuf)) {
+		return 0;
+	}
+	return 1;
+  }
   return 0;
 }
 
@@ -739,7 +959,10 @@ static int (*bin_op[])() = {
   do_select,
   do_arith,
   do_arith,
-  do_arith
+  do_arith,
+  0,
+  do_sft,
+  do_sft
 };
 
 int
@@ -810,3 +1033,73 @@ eval_expr(p, pbuf, psize, ptp)
   }
   return retval;
 }
+
+extern t_addr	get_addr();
+
+int
+eval_desig(p, paddr, psize, ptp)
+  p_tree	p;
+  t_addr	*paddr;
+  long		*psize;
+  p_type	*ptp;
+{
+  register p_symbol	sym;
+  int	retval = 0;
+  t_addr a;
+
+  switch(p->t_oper) {
+  case OP_NAME:
+  case OP_SELECT:
+	sym = identify(p, VAR|REGVAR|LOCVAR|VARPAR);
+	if (! sym) return 0;
+	if (! (a = get_addr(sym, psize))) {
+		print_node(p, 0);
+		fputs(" currently not available\n", db_out);
+		break;
+	}
+	*paddr = a;
+	*ptp = sym->sy_type;
+	retval = 1;
+	break;
+
+  case OP_UNOP:
+	switch(p->t_whichoper) {
+	case E_DEREF:
+		if (ptr_addr(p, paddr, psize, ptp)) {
+			retval = 1;
+		}
+		break;
+	default:
+		print_node(p, 0);
+		fputs(" not a designator\n", db_out);
+		break;
+	}
+	break;
+
+  case OP_BINOP:
+	switch(p->t_whichoper) {
+	case E_ARRAY:
+		if (array_addr(p, paddr, psize, ptp)) {
+			retval = 1;
+		}
+		break;
+	case E_SELECT:
+		if (select_addr(p, paddr, psize, ptp)) {
+			retval = 1;
+		}
+		break;
+	default:
+		print_node(p, 0);
+		fputs(" not a designator\n", db_out);
+		break;
+	}
+	break;
+  default:
+	assert(0);
+	break;
+  }
+  if (! retval) {
+	*psize = 0;
+  }
+  return retval;
+}
diff --git a/util/grind/expr.h b/util/grind/expr.h
index 2d81ef74c..00f77019b 100644
--- a/util/grind/expr.h
+++ b/util/grind/expr.h
@@ -29,3 +29,7 @@
 #define E_BAND	21		/* bitwise and */
 #define E_BOR	22		/* bitwise or */
 #define E_BXOR	23
+#define E_BNOT	24
+#define E_DERSELECT 25		/* -> in C */
+#define E_LSFT	26
+#define E_RSFT	27
diff --git a/util/grind/langdep.cc b/util/grind/langdep.cc
index 8680fdc59..cf897026c 100644
--- a/util/grind/langdep.cc
+++ b/util/grind/langdep.cc
@@ -46,6 +46,6 @@ find_language(suff)
 	p = p->l_next;
   }
   if (! currlang) {
-	currlang = def_dep;
+	currlang = c_dep;
   }
 }
diff --git a/util/grind/langdep.h b/util/grind/langdep.h
index 03f6ce6c2..9a0dfff0a 100644
--- a/util/grind/langdep.h
+++ b/util/grind/langdep.h
@@ -13,7 +13,6 @@ struct langdep {
   char	*uns_fmt;		/* unsigneds (format for long) */
   char	*addr_fmt;		/* address (format for long) */
   char	*real_fmt;		/* real (format for double) */
-  char	*char_fmt;		/* character (format for int) */
 
   /* display openers and closers: */
   char	*open_array_display;
@@ -25,8 +24,10 @@ struct langdep {
 
   /* language dependant routines: */
   int	(*printstring)();
+  int	(*printchar)();
   long	(*arrayelsize)();
-  int	(*op_prio)();
+  int	(*binop_prio)();
+  int	(*unop_prio)();
   int	(*get_string)();
   int	(*get_name)();
   int	(*get_number)();
@@ -34,7 +35,7 @@ struct langdep {
   int	(*printop)();
 };
 
-extern struct langdep	*m2_dep, *def_dep, *c_dep, *currlang;
+extern struct langdep	*m2_dep, *c_dep, *currlang;
 
 extern int find_language();
 
diff --git a/util/grind/modula-2.c b/util/grind/modula-2.c
index caed8535b..b8ff45ca3 100644
--- a/util/grind/modula-2.c
+++ b/util/grind/modula-2.c
@@ -23,12 +23,14 @@ extern double
 
 static int
 	print_string(),
+	print_char(),
 	get_number(),
 	get_name(),
 	get_token(),
 	get_string(),
 	print_op(),
-	op_prio();
+	binop_prio(),
+	unop_prio();
 
 static long
 	array_elsize();
@@ -41,8 +43,7 @@ static struct langdep m2 = {
 	"%lXH",
 	"%lu",
 	"%lXH",
-	"%g",
-	"%oC",
+	"%G",
 
 	"[",
 	"]",
@@ -52,8 +53,10 @@ static struct langdep m2 = {
 	"}",
 
 	print_string,
+	print_char,
 	array_elsize,
-	op_prio,
+	binop_prio,
+	unop_prio,
 	get_string,
 	get_name,
 	get_number,
@@ -63,6 +66,13 @@ static struct langdep m2 = {
 
 struct langdep *m2_dep = &m2;
 
+static int
+print_char(c)
+  int	c;
+{
+  fprintf(db_out, (c >= 040 && c < 0177) ? "'%c'" : "%oC", c);
+}
+
 static int
 print_string(s, len)
   char	*s;
@@ -89,16 +99,26 @@ array_elsize(size)
 }
 
 static int
-op_prio(op)
+unop_prio(op)
   int	op;
 {
   switch(op) {
   case E_NOT:
   	return 5;
-
+  case E_MIN:
+  case E_PLUS:
+	return 3;
   case E_SELECT:
 	return 9;
+  }
+  return 1;
+}
 
+static int
+binop_prio(op)
+  int	op;
+{
+  switch(op) {
   case E_AND:
   case E_MUL:
   case E_DIV:
@@ -230,6 +250,7 @@ get_number(ch)
   /* a real real constant */
   if (np < &buf[512]) *np++ = '.';
 
+  ch = getc(db_in);
   while (is_dig(ch)) {
 	/* 	Fractional part
 	*/
@@ -452,6 +473,19 @@ print_op(p)
 	}
 	break;
   case OP_BINOP:
+	if (p->t_whichoper == E_ARRAY) {
+		print_node(p->t_args[0], 0);
+		fputs("[", db_out);
+		print_node(p->t_args[1], 0);
+		fputs("]", db_out);
+		break;
+	}
+	if (p->t_whichoper == E_SELECT) {
+		print_node(p->t_args[0], 0);
+		fputs(".", db_out);
+		print_node(p->t_args[1], 0);
+		break;
+	}
 	fputs("(", db_out);
 	print_node(p->t_args[0], 0);
 	switch(p->t_whichoper) {
@@ -497,9 +531,6 @@ print_op(p)
 	case E_GT:
 		fputs(">", db_out);
 		break;
-	case E_SELECT:
-		fputs(".", db_out);
-		break;
 	}
 	print_node(p->t_args[1], 0);
 	fputs(")", db_out);
diff --git a/util/grind/operators.ot b/util/grind/operators.ot
index 48a611dd8..43dd3d380 100644
--- a/util/grind/operators.ot
+++ b/util/grind/operators.ot
@@ -20,6 +20,7 @@ OP_WHERE	0	do_where
 OP_STATUS	0	do_status
 OP_DELETE	0	do_delete
 OP_SELECT	2	0
+OP_SET		2	do_set
 OP_PRINT	1	do_print
 OP_DUMP		0	do_dump
 OP_RESTORE	0	do_restore
diff --git a/util/grind/print.c b/util/grind/print.c
index 320e0d362..e26d4a03c 100644
--- a/util/grind/print.c
+++ b/util/grind/print.c
@@ -40,7 +40,7 @@ print_unsigned(tp, v)
   long		v;
 {
   if (tp == uchar_type) {
-	fprintf(db_out, currlang->char_fmt, (int) v);
+	(*currlang->printchar)((int) v);
   }
   else	fprintf(db_out, currlang->uns_fmt, v);
 }
@@ -51,7 +51,7 @@ print_integer(tp, v)
   long		v;
 {
   if (tp == char_type) {
-	fprintf(db_out, currlang->char_fmt, (int) v);
+	(*currlang->printchar)((int) v);
   }
   else	fprintf(db_out, currlang->decint_fmt, v);
 }
@@ -301,20 +301,3 @@ print_val(tp, tp_sz, addr, compressed, indent)
 	break;
   }
 }
-
-int
-print_sym(sym)
-  p_symbol	sym;
-{
-  char		*buf;
-  long		size;
-
-  if (get_value(sym, &buf, &size)) {
-	fputs(" = ", db_out);
-	print_val(sym->sy_type, size, buf, 0, 0);
-	if (buf) free(buf);
-	fputs("\n", db_out);
-	return 1;
-  }
-  return 0;
-}
diff --git a/util/grind/run.c b/util/grind/run.c
index 2ae582edb..9011e8f8b 100644
--- a/util/grind/run.c
+++ b/util/grind/run.c
@@ -373,11 +373,33 @@ get_bytes(size, from, to)
 	return 0;
   }
 
+  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
+set_bytes(size, from, to)
+  long	size;
+  char	*from;
+  t_addr to;
+{
+  struct message_hdr	m;
+
+  m.m_type = SETBYTES;
+  m.m_size = size;
+  ATOBUF(m.m_buf, (char *) to);
+
+  return uputm(&m)
+	 && usend(from, size)
+	 && ugetm(&m)
+	 && m.m_type != FAIL;
+}
+
 int
 get_dump(globmessage, globbuf, stackmessage, stackbuf)
   struct message_hdr *globmessage, *stackmessage;
@@ -389,6 +411,7 @@ get_dump(globmessage, globbuf, stackmessage, stackbuf)
   if (! could_send(&m, 0)) {
 	return 0;
   }
+  if (answer.m_type == FAIL) return 0;
   assert(answer.m_type == DGLOB);
   *globmessage = answer;
   *globbuf = Malloc((unsigned) answer.m_size);
@@ -441,6 +464,7 @@ get_EM_regs(level)
   if (! could_send(&m, 0)) {
 	return 0;
   }
+  if (answer.m_type == FAIL) return 0;
   *to++ = (t_addr) BUFTOA(answer.m_buf);
   *to++ = (t_addr) BUFTOA(answer.m_buf+pointer_size);
   *to++ = (t_addr) BUFTOA(answer.m_buf+2*pointer_size);
@@ -458,7 +482,7 @@ set_pc(PC)
   m.m_type = SETEMREGS;
   m.m_size = 0;
   ATOBUF(m.m_buf+PC_OFF*pointer_size, (char *)PC);
-  return could_send(&m, 0);
+  return could_send(&m, 0) && answer.m_type != FAIL;
 }
 
 int
@@ -469,7 +493,7 @@ send_cont(stop_message)
 
   m.m_type = (CONT | (db_ss ? DB_SS : 0));
   m.m_size = 0;
-  return could_send(&m, stop_message);
+  return could_send(&m, stop_message) && answer.m_type != FAIL;
 }
 
 int
@@ -482,7 +506,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)) {
+  if (could_send(&m, 1) && answer.m_type != FAIL) {
 	return 1;
   }
   single_stepping = 0;
diff --git a/util/grind/symbol.c b/util/grind/symbol.c
index 57704e21c..fc7536e18 100644
--- a/util/grind/symbol.c
+++ b/util/grind/symbol.c
@@ -94,17 +94,6 @@ Lookfromscope(id, class, sc)
   return (p_symbol) 0;
 }
 
-/* Lookup a definition for 'id' with class in the 'class' bitset,
-   starting in scope 'CurrentScope' and also looking in enclosing scopes.
-*/
-p_symbol
-Lookfor(id, class)
-  register struct idf *id;
-  int	class;
-{
-  return Lookfromscope(id, class, CurrentScope);
-}
-
 extern char *strrindex();
 
 p_symbol
@@ -153,12 +142,12 @@ consistent(p, sc)
 
   switch(p->t_oper) {
   case OP_NAME:
-	sym = Lookfromscope(p->t_idf, FILELINK|FILESYM|PROC|MODULE, sc);
+	sym = Lookfromscope(p->t_idf, FILELINK|FILESYM|PROC|FUNCTION|MODULE, sc);
 	return sym != 0;
 
   case OP_SELECT:
 	arg = p->t_args[1];
-	sym = Lookfromscope(arg->t_idf, FILELINK|FILESYM|PROC|MODULE, sc);
+	sym = Lookfromscope(arg->t_idf, FILELINK|FILESYM|PROC|FUNCTION|MODULE, sc);
 	if (sym == 0) return 0;
 	return consistent(p, sym->sy_scope);
 
diff --git a/util/grind/symbol.hh b/util/grind/symbol.hh
index 582bad16e..6ca2d2cc4 100644
--- a/util/grind/symbol.hh
+++ b/util/grind/symbol.hh
@@ -1,5 +1,6 @@
-/* $Header$
-   Symbol table data structure.
+/* $Header$ */
+
+/* Symbol table data structure.
    Each identifier structure refers to a list of possible meanings of this
    identifier. Each of these meanings is represented by a "symbol" structure.
 */
@@ -39,14 +40,12 @@ typedef struct symbol {
   union {
 	t_const	syv_const;	/* CONST */
 	t_name	syv_name;
-/*	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
@@ -54,7 +53,7 @@ typedef struct symbol {
 
 /* ALLOCDEF "symbol" 50 */
 
-extern p_symbol	NewSymbol(), Lookup(), Lookfor(), Lookfromscope(), add_file();
+extern p_symbol	NewSymbol(), Lookup(), Lookfromscope(), add_file();
 extern p_symbol identify();
 
 extern p_symbol	currfile;
diff --git a/util/grind/tokenname.c b/util/grind/tokenname.c
index 704dd8853..80eb38f2b 100644
--- a/util/grind/tokenname.c
+++ b/util/grind/tokenname.c
@@ -60,6 +60,8 @@ struct tokenname tkidf[] =	{	/* names of the identifier tokens */
 	{DUMP, "dump"},
 	{RESTORE, "restore"},
 	{TRACE, "trace"},
+	{SET, "set"},
+	{TO, "to"},
 	{-1, "quit"},
 	{0, ""}
 };
diff --git a/util/grind/tree.c b/util/grind/tree.c
index f533d4bc6..d9eff97c0 100644
--- a/util/grind/tree.c
+++ b/util/grind/tree.c
@@ -16,6 +16,7 @@
 #include	"symbol.h"
 #include	"langdep.h"
 #include	"type.h"
+#include	"expr.h"
 
 extern FILE	*db_out;
 extern t_lineno	currline;
@@ -75,6 +76,21 @@ 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;
 {
@@ -112,6 +128,12 @@ print_node(p, top_level)
 	fputs("file ", db_out);
 	print_node(p->t_args[0], 0);
 	break;
+  case OP_SET:
+	fputs("set ", db_out);
+	print_node(p->t_args[0], 0);
+	fputs(" to ", db_out);
+	print_node(p->t_args[1], 0);
+	break;
   case OP_DELETE:
 	fprintf(db_out, "delete %d", p->t_ival);
 	break;
@@ -332,7 +354,7 @@ get_pos(p)
 
   case OP_NAME:
   case OP_SELECT:
-	sym = identify(p, PROC|MODULE);
+	sym = identify(p, FUNCTION|PROC|MODULE);
 	if (! sym) {
 		break;
 	}
@@ -563,6 +585,27 @@ do_print(p)
   }
 }
 
+do_set(p)
+  p_tree	p;
+{
+  char	*buf = 0;
+  long	size, size2;
+  p_type tp, tp2;
+  t_addr a;
+
+  if (! 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 (! set_bytes(size, buf, a)) {
+	error("could not handle this SET request");
+  }
+  free(buf);
+}
+
 perform(p, a)
   register p_tree	p;
   t_addr		a;
diff --git a/util/grind/type.c b/util/grind/type.c
index 85730a966..b43b40951 100644
--- a/util/grind/type.c
+++ b/util/grind/type.c
@@ -177,6 +177,25 @@ array_type(bound_type, el_type)
 
   tp->ty_class = T_ARRAY;
   tp->ty_index = bound_type;
+  switch(bound_type->ty_class) {
+  case T_SUBRANGE:
+	if (bound_type->ty_A) break;
+	tp->ty_lb = bound_type->ty_low;
+	tp->ty_hb = bound_type->ty_up;
+	break;
+  case T_ENUM:
+	tp->ty_lb = 0;
+	tp->ty_hb = bound_type->ty_nenums-1;
+	break;
+  case T_UNSIGNED:
+	tp->ty_lb = 0;
+	tp->ty_hb = bound_type->ty_size == 1 ? 255 : 65535L;
+	break;
+  case T_INTEGER:
+	tp->ty_lb = bound_type->ty_size == 1 ? -128 : -32768;
+	tp->ty_hb = bound_type->ty_size == 1 ? 127 : 32767;
+	break;
+  }
   tp->ty_elements = el_type;
   tp->ty_size = (*currlang->arrayelsize)(el_type->ty_size) * nel(bound_type);
   return tp;
@@ -384,8 +403,10 @@ compute_size(tp, AB)
   if (tp->ty_index->ty_A & 1) {
 	low = BUFTOI(AB+tp->ty_index->ty_low);
   } else low = tp->ty_index->ty_low;
+  tp->ty_lb = low;
   if (tp->ty_index->ty_A & 2) {
 	high = BUFTOI(AB+tp->ty_index->ty_up);
   } else high = tp->ty_index->ty_up;
+  tp->ty_hb = high;
   return (high - low + 1) * tp->ty_elements->ty_size;
 }
diff --git a/util/grind/type.hh b/util/grind/type.hh
index 54816aa22..ef14cb8a0 100644
--- a/util/grind/type.hh
+++ b/util/grind/type.hh
@@ -63,9 +63,12 @@ typedef struct type {
 #define ty_fileof	ty_v.typ_ptrto
      /* arrays: */
      struct {
+	long typ_lb, typ_hb;
 	struct type *typ_index;
 	struct type *typ_elements;
      } ty_array;
+#define ty_lb		ty_v.ty_array.typ_lb
+#define ty_hb		ty_v.ty_array.typ_hb
 #define ty_index	ty_v.ty_array.typ_index
 #define ty_elements	ty_v.ty_array.typ_elements
      /* subranges: */
@@ -115,5 +118,5 @@ extern long
 extern p_type	char_type, uchar_type, bool_type, int_type,
 		long_type, double_type, string_type;
 extern p_type	void_type, incomplete_type;
-extern long	int_size;
+extern long	int_size, pointer_size;
 
diff --git a/util/grind/value.c b/util/grind/value.c
index 205b31d47..a02df91c5 100644
--- a/util/grind/value.c
+++ b/util/grind/value.c
@@ -1,12 +1,14 @@
 /* $Header$ */
 
 #include <alloc.h>
+#include <assert.h>
 
 #include "position.h"
 #include "scope.h"
 #include "symbol.h"
 #include "type.h"
 #include "message.h"
+#include "langdep.h"
 
 int stack_offset;		/* for up and down commands */
 
@@ -14,70 +16,27 @@ extern long pointer_size;
 extern t_addr *get_EM_regs();
 extern char *memcpy();
 
-/* Get the value of the symbol indicated by sym.
+/* Get the address of the object indicated by sym.
    Return 0 on failure,
-	  1 on success.
-   On success, 'buf' contains the value, and 'size' contains the size.
-   For 'buf', 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).
+	  address on success.
+   *psize will contain size of object.
 */
-int
-get_value(sym, buf, psize)
+t_addr
+get_addr(sym, psize)
   register p_symbol	sym;
-  char	**buf;
-  long	*psize;
+  long			*psize;
 {
   p_type	tp = sym->sy_type;
   long		size = tp->ty_size;
-  int		retval = 0;
   t_addr	*EM_regs;
   int		i;
   p_scope	sc, symsc;
-  char		*AB;
 
-  *buf = 0;
+  *psize = size;
   switch(sym->sy_class) {
   case VAR:
 	/* exists if child exists; nm_value contains addres */
-	*buf = Malloc((unsigned) size);
-	if (get_bytes(size, (t_addr) sym->sy_name.nm_value, *buf)) {
-		retval = 1;
-	}
-	break;
-  case CONST:
-	*buf = Malloc((unsigned) size);
-	switch(tp->ty_class) {
-	case T_REAL:
-		if (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 (size == 1) {
-			*((char *) *buf) = sym->sy_const.co_ival;
-		}
-		else if (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) size);
-		break;
-	case T_STRING:
-		memcpy(*buf, sym->sy_const.co_sval, (int) size);
-		break;
-	default:
-		fatal("strange constant");
-	}
-	retval = 1;
+	return (t_addr) sym->sy_name.nm_value;
 	break;
   case VARPAR:
   case LOCVAR:
@@ -110,17 +69,8 @@ get_value(sym, buf, psize)
 
 	if (sym->sy_class == LOCVAR) {
 		/* Either local variable or value parameter */
-		*buf = Malloc((unsigned) size);
-		if (get_bytes(size,
-			      EM_regs[sym->sy_name.nm_value < 0 
-					? LB_OFF 
-					: AB_OFF
-				     ] +
-				  (t_addr) sym->sy_name.nm_value,
-			      *buf)) {
-			retval = 1;
-		}
-		break;
+		return EM_regs[sym->sy_name.nm_value < 0 ? LB_OFF : AB_OFF] +
+				  (t_addr) sym->sy_name.nm_value;
 	}
 
 	/* If we get here, we have a var parameter. Get the parameters
@@ -128,6 +78,8 @@ get_value(sym, buf, psize)
 	*/
 	{
 		p_type proctype = sc->sc_definedby->sy_type;
+		t_addr a;
+		char *AB;
 
 		size = proctype->ty_nbparams;
 		if (has_static_link(sc)) size += pointer_size;
@@ -137,15 +89,84 @@ get_value(sym, buf, psize)
 		}
 		if ((size = tp->ty_size) == 0) {
 			size = compute_size(tp, AB);
+			*psize = size;
 		}
+		a = (t_addr) BUFTOA(AB+sym->sy_name.nm_value);
+		free(AB);
+		return a;
 	}
+  default:
+	break;
+  }
+  return 0;
+}
+
+/* Get the value of the symbol indicated by sym.
+   Return 0 on failure,
+	  1 on success.
+   On success, 'buf' contains the value, and 'size' contains the size.
+   For 'buf', 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, psize)
+  register p_symbol	sym;
+  char	**buf;
+  long	*psize;
+{
+  p_type	tp = sym->sy_type;
+  int		retval = 0;
+  t_addr	a;
+  long		size = tp->ty_size;
+
+  *buf = 0;
+  switch(sym->sy_class) {
+  case CONST:
 	*buf = Malloc((unsigned) size);
-	if (get_bytes(size,
-		      (t_addr) BUFTOA(AB+sym->sy_name.nm_value),
-		      *buf)) {
-		retval = 1;
+	switch(tp->ty_class) {
+	case T_REAL:
+		if (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 (size == sizeof(char)) {
+			*((char *) *buf) = sym->sy_const.co_ival;
+		}
+		else if (size == sizeof(short)) {
+			*((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) size);
+		break;
+	case T_STRING:
+		memcpy(*buf, sym->sy_const.co_sval, (int) size);
+		break;
+	default:
+		fatal("strange constant");
+	}
+	retval = 1;
+	break;
+  case VAR:
+  case VARPAR:
+  case LOCVAR:
+	a = get_addr(sym, psize);
+	if (a) {
+		size = *psize;
+		*buf = Malloc((unsigned) size);
+		if (get_bytes(size, a, *buf)) {
+			retval = 1;
+		}
 	}
-	free(AB);
 	break;
   }