Ver código fonte

many changes

ceriel 34 anos atrás
pai
commit
bd18f6c521

+ 1 - 0
util/grind/Amakefile

@@ -61,6 +61,7 @@ CSRC = {
 	value.c,
 	type.c,
 	rd.c,
+	default.c,
 	modula-2.c
 } ;
 

+ 1 - 1
util/grind/char.ct

@@ -65,7 +65,7 @@ STSIMP:,<>{}:`
 %	ISTOKEN
 %
 %C
-1:-abcefiprstuvxAEFGLMPQSTVX,;:+=()*
+1:-acefiprstuvxAEFGLMPQSTVX,;:+=()*
 %T char istoken[] = {
 %p
 %T};

+ 5 - 149
util/grind/commands.g

@@ -16,6 +16,7 @@
 #include	"tree.h"
 #include	"langdep.h"
 #include	"token.h"
+#include	"expr.h"
 
 extern char	*Salloc();
 extern t_lineno	currline;
@@ -278,10 +279,11 @@ factor(p_tree *p;)
 |
   designator(p)
 |
-  PREF_OP		{ *p = mknode(OP_UNOP, (p_tree) 0);
+  			{ *p = mknode(OP_UNOP, (p_tree) 0);
 			  (*p)->t_whichoper = (int) tok.ival;
 			}
-  factor(&(*p)->t_args[0])
+  [ PREF_OP | PREF_OR_BIN_OP ]
+  expression(&(*p)->t_args[0], prio((*p)->t_whichoper))
 ;
 
 designator(p_tree *p;)
@@ -294,7 +296,7 @@ designator(p_tree *p;)
 	name(&(*p)->t_args[1])
   |
 	'['		{ *p = mknode(OP_BINOP, *p, (p_tree) 0);
-			  (*p)->t_whichoper = '[';
+			  (*p)->t_whichoper = E_ARRAY;
 			}
 	expression(&(*p)->t_args[1], 1)
 	']'
@@ -407,14 +409,6 @@ LLlex()
 	if (in_expression) TOK = (*currlang->get_name)(c);
 	else TOK = get_name(c);
 	break;
-  case STDOT:
-	c = getc(db_in);
-	if (c == EOF || class(c) != STNUM) {
-		ungetc(c,db_in);
-		TOK = '.';
-		break;
-	}
-	/* Fall through */
   case STNUM:
 	TOK = (*currlang->get_number)(c);
 	break;
@@ -459,144 +453,6 @@ get_name(c)
   return id->id_reserved ? id->id_reserved : NAME;
 }
 
-static int
-quoted(ch)
-  int	ch;
-{
-  /*	quoted() replaces an escaped character sequence by the
-	character meant.
-  */
-  /* first char after backslash already in ch */
-  if (!is_oct(ch)) {		/* a quoted char */
-	switch (ch) {
-	case 'n':
-		ch = '\n';
-		break;
-	case 't':
-		ch = '\t';
-		break;
-	case 'b':
-		ch = '\b';
-		break;
-	case 'r':
-		ch = '\r';
-		break;
-	case 'f':
-		ch = '\f';
-		break;
-	}
-  }
-  else {				/* a quoted octal */
-	register int oct = 0, cnt = 0;
-
-	do {
-		oct = oct*8 + (ch-'0');
-		ch = getc(db_in);
-	} while (is_oct(ch) && ++cnt < 3);
-	ungetc(ch, db_in);
-	ch = oct;
-  }
-  return ch&0377;
-
-}
-
-int 
-get_string(c)
-  int	c;
-{
-  register int ch;
-  char buf[512];
-  register int len = 0;
-
-  while (ch = getc(db_in), ch != c) {
-	if (ch == '\n') {
-		error("newline in string");
-		break;
-	}
-	if (ch == '\\') {
-		ch = getc(db_in);
-		ch = quoted(ch);
-	}
-	buf[len++] = ch;
-  }
-  buf[len++] = 0;
-  tok.str = Salloc(buf, (unsigned) len);
-  return STRING;
-}
-
-static int
-val_in_base(c, base)
-  register int c;
-{
-  return is_dig(c) 
-	? c - '0'
-	: base != 16
-	  ? -1
-	  : is_hex(c)
-	    ? (c - 'a' + 10) & 017
-	    : -1;
-}
-
-int
-get_number(c)
-  register int	c;
-{
-  char buf[512+1];
-  register int base = 10;
-  register char *p = &buf[0];
-  register long val = 0;
-  register int val_c;
-
-  if (c == '0') {
-	/* check if next char is an 'x' or an 'X' */
-	c = getc(db_in);
-	if (c == 'x' || c == 'X') {
-		base = 16;
-		c = getc(db_in);
-	}
-	else	base = 8;
-  }
-  while (val_c = val_in_base(c, base), val_c >= 0) {
-	val = val * base + val_c;
-	if (p - buf < 512) *p++ = c;
-	c = getc(db_in);
-  }
-  if (base == 16 || !((c == '.' || c == 'e' || c == 'E'))) {
-	ungetc(c, db_in);
-	tok.ival = val;
-	return INTEGER;
-  }
-  if (c == '.') {
-	if (p - buf < 512) *p++ = c;
-	c = getc(db_in);
-  }
-  while (is_dig(c)) {
-	if (p - buf < 512) *p++ = c;
-	c = getc(db_in);
-  }
-  if (c == 'e' || c == 'E') {
-	if (p - buf < 512) *p++ = c;
-	c = getc(db_in);
-	if (c == '+' || c == '-') {
-		if (p - buf < 512) *p++ = c;
-		c = getc(db_in);
-	}
-	if (! is_dig(c)) {
-		error("malformed floating constant");
-	}
-	while (is_dig(c)) {
-		if (p - buf < 512) *p++ = c;
-		c = getc(db_in);
-	}
-  }
-  ungetc(c, db_in);
-  *p++ = 0;
-  if (p == &buf[512+1]) {
-	error("floating point constant too long");
-  }
-  return REAL;
-}
-
 extern char * symbol2str();
 
 LLmessage(t)

+ 8 - 3
util/grind/dbx_string.g

@@ -156,8 +156,10 @@ const_name(p_symbol cst;)
 :
   '='
   [
+/*
 	'b' integer_const(&(cst->sy_const.co_ival))	/* boolean */
-  |
+/*  |
+*/
 	'c' integer_const(&(cst->sy_const.co_ival))	/* character */
 				{ cst->sy_type = char_type; }
   |
@@ -470,14 +472,17 @@ structure_type(register p_type tp;)
 enum_type(register p_type tp;)
   { register struct literal *litp;
     long maxval = 0;
+    register p_symbol s;
   }
 :
-  [			{ litp = get_literal_space(tp);
-			}
+  [			{ litp = get_literal_space(tp); }
 	name(&(litp->lit_name))
 	integer_const(&(litp->lit_val)) ',' 
 			{ if (maxval < litp->lit_val) maxval = litp->lit_val;
 			  AllowName = 1;
+			  s = NewSymbol(litp->lit_name, CurrentScope, CONST, (struct outname *) 0);
+			  s->sy_const.co_ival = litp->lit_val;
+			  s->sy_type = tp;
 			}
   ]*
   ';'			{ end_literal(tp, maxval); }

+ 340 - 0
util/grind/default.c

@@ -0,0 +1,340 @@
+/* $Header$ */
+
+/* Language dependant support; this one is default */
+
+#include <stdio.h>
+#include <alloc.h>
+
+#include "position.h"
+#include "class.h"
+#include "langdep.h"
+#include "Lpars.h"
+#include "idf.h"
+#include "token.h"
+#include "expr.h"
+#include "tree.h"
+#include "operator.h"
+
+extern FILE *db_out, *db_in;
+
+extern int
+	get_name();
+
+extern double
+	atof();
+
+static int
+	print_string(),
+	get_number(),
+	get_string(),
+	get_token(),
+	print_op(),
+	op_prio();
+
+static long
+	array_elsize();
+
+static struct langdep def = {
+	0,
+
+	"%ld",
+	"0%lo",
+	"0x%lX",
+	"%lu",
+	"0x%lX",
+	"%g",
+	"'\\%o'",
+
+	"[",
+	"]",
+	"(",
+	")",
+	"{",
+	"}",
+
+	print_string,
+	array_elsize,
+	op_prio,
+	get_string,
+	get_name,
+	get_number,
+	get_token,
+	print_op
+};
+
+struct langdep *def_dep = &def;
+
+static int
+print_string(s)
+  char	*s;
+{
+  register char	*str = s;
+  int delim = '\'';
+
+  while (*str) {
+	if (*str++ == '\'') delim = '"';
+  }
+  fprintf(db_out, "%c%s%c", delim, s, delim);
+}
+
+extern long	int_size;
+
+static long
+array_elsize(size)
+  long	size;
+{
+  if (! (int_size % size)) return size;
+  if (! (size % int_size)) return size;
+  return ((size + int_size - 1) / int_size) * int_size;
+}
+
+/*ARGSUSED*/
+static int
+op_prio(op)
+  int	op;
+{
+  return 1;
+}
+
+static int
+val_in_base(c, base)
+  register int c;
+{
+  return is_dig(c) 
+	? c - '0'
+	: base != 16
+	  ? -1
+	  : is_hex(c)
+	    ? (c - 'a' + 10) & 017
+	    : -1;
+}
+
+static int
+get_number(c)
+  register int	c;
+{
+  char buf[512+1];
+  register int base = 10;
+  register char *p = &buf[0];
+  register long val = 0;
+  register int val_c;
+
+  if (c == '0') {
+	/* check if next char is an 'x' or an 'X' */
+	c = getc(db_in);
+	if (c == 'x' || c == 'X') {
+		base = 16;
+		c = getc(db_in);
+	}
+	else	base = 8;
+  }
+  while (val_c = val_in_base(c, base), val_c >= 0) {
+	val = val * base + val_c;
+	if (p - buf < 512) *p++ = c;
+	c = getc(db_in);
+  }
+  if (base == 16 || !((c == '.' || c == 'e' || c == 'E'))) {
+	ungetc(c, db_in);
+	tok.ival = val;
+	return INTEGER;
+  }
+  if (c == '.') {
+	if (p - buf < 512) *p++ = c;
+	c = getc(db_in);
+  }
+  while (is_dig(c)) {
+	if (p - buf < 512) *p++ = c;
+	c = getc(db_in);
+  }
+  if (c == 'e' || c == 'E') {
+	if (p - buf < 512) *p++ = c;
+	c = getc(db_in);
+	if (c == '+' || c == '-') {
+		if (p - buf < 512) *p++ = c;
+		c = getc(db_in);
+	}
+	if (! is_dig(c)) {
+		error("malformed floating constant");
+	}
+	while (is_dig(c)) {
+		if (p - buf < 512) *p++ = c;
+		c = getc(db_in);
+	}
+  }
+  ungetc(c, db_in);
+  *p++ = 0;
+  if (p == &buf[512+1]) {
+	error("floating point constant too long");
+  }
+  tok.fval = atof(buf);
+  return REAL;
+}
+
+static int
+get_token(c)
+  register int	c;
+{
+  switch(c) {
+  case '`':
+  case ':':
+  case ',':
+	return c;
+  case '.':
+	return get_number(c);
+  default:
+	error("illegal character 0%o", c);
+	return LLlex();
+  }
+}
+
+static int
+quoted(ch)
+  int	ch;
+{
+  /*	quoted() replaces an escaped character sequence by the
+	character meant.
+  */
+  /* first char after backslash already in ch */
+  if (!is_oct(ch)) {		/* a quoted char */
+	switch (ch) {
+	case 'n':
+		ch = '\n';
+		break;
+	case 't':
+		ch = '\t';
+		break;
+	case 'b':
+		ch = '\b';
+		break;
+	case 'r':
+		ch = '\r';
+		break;
+	case 'f':
+		ch = '\f';
+		break;
+	}
+  }
+  else {				/* a quoted octal */
+	register int oct = 0, cnt = 0;
+
+	do {
+		oct = oct*8 + (ch-'0');
+		ch = getc(db_in);
+	} while (is_oct(ch) && ++cnt < 3);
+	ungetc(ch, db_in);
+	ch = oct;
+  }
+  return ch&0377;
+
+}
+
+static int 
+get_string(c)
+  int	c;
+{
+  register int ch;
+  char buf[512];
+  register int len = 0;
+
+  while (ch = getc(db_in), ch != c) {
+	if (ch == '\n') {
+		error("newline in string");
+		break;
+	}
+	if (ch == '\\') {
+		ch = getc(db_in);
+		ch = quoted(ch);
+	}
+	buf[len++] = ch;
+  }
+  buf[len++] = 0;
+  tok.str = Salloc(buf, (unsigned) len);
+  return STRING;
+}
+
+static int
+print_op(p)
+  p_tree	p;
+{
+  switch(p->t_oper) {
+  case OP_UNOP:
+  	switch(p->t_whichoper) {
+	case E_MIN:
+		fputs("-", db_out);
+		print_node(p->t_args[0], 0);
+		break;
+	case E_PLUS:
+		fputs("+", db_out);
+		print_node(p->t_args[0], 0);
+		break;
+	case E_NOT:
+		fputs("~", db_out);
+		print_node(p->t_args[0], 0);
+		break;
+	case E_DEREF:
+		fputs("*", db_out);
+		print_node(p->t_args[0], 0);
+		break;
+	}
+	break;
+  case OP_BINOP:
+	fputs("(", db_out);
+	print_node(p->t_args[0], 0);
+	switch(p->t_whichoper) {
+	case E_AND:
+		fputs("&&", db_out);
+		break;
+	case E_OR:
+		fputs("||", db_out);
+		break;
+	case E_ZDIV:
+		fputs("/", db_out);
+		break;
+	case E_ZMOD:
+		fputs("%", db_out);
+		break;
+	case E_DIV:
+		fputs(" div ", db_out);
+		break;
+	case E_MOD:
+		fputs(" mod ", db_out);
+		break;
+	case E_IN:
+		fputs(" in ", db_out);
+		break;
+	case E_PLUS:
+		fputs("+", db_out);
+		break;
+	case E_MIN:
+		fputs("-", db_out);
+		break;
+	case E_MUL:
+		fputs("*", db_out);
+		break;
+	case E_EQUAL:
+		fputs("==", db_out);
+		break;
+	case E_NOTEQUAL:
+		fputs("!=", db_out);
+		break;
+	case E_LTEQUAL:
+		fputs("<=", db_out);
+		break;
+	case E_GTEQUAL:
+		fputs(">=", db_out);
+		break;
+	case E_LT:
+		fputs("<", db_out);
+		break;
+	case E_GT:
+		fputs(">", db_out);
+		break;
+	case E_SELECT:
+		fputs(".", db_out);
+		break;
+	}
+	print_node(p->t_args[1], 0);
+	fputs(")", db_out);
+	break;
+  }
+}

+ 755 - 2
util/grind/expr.c

@@ -1,14 +1,767 @@
 /* $Header$ */
 
+#include <stdio.h>
+#include <alloc.h>
+#include <assert.h>
+
 #include "position.h"
 #include "operator.h"
 #include "tree.h"
 #include "expr.h"
+#include "symbol.h"
+#include "type.h"
+#include "langdep.h"
+
+extern FILE	*db_out;
+
+static long
+get_int(buf, size)
+  char	*buf;
+  long	size;
+{
+  switch((int)size) {
+  case 1:
+	return *buf & 0xFF;
+  case 2:
+	return *((short *) buf) & 0xFFFF;
+  default:
+	return *((long *) buf);
+  }
+  /* NOTREACHED */
+}
+
+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;
+  long	size;
+  long	value;
+{
+  switch((int)size) {
+  case 1:
+	*buf = value;
+	break;
+  case 2:
+	*((short *) buf) = value;
+	break;
+  default:
+	*((long *) buf) = value;
+	break;
+  }
+  /* NOTREACHED */
+}
+
+static
+put_real(buf, size, value)
+  char	*buf;
+  long	size;
+  double value;
+{
+  switch((int)size) {
+  case sizeof(float):
+	*((float *) buf) = value;
+	break;
+  default:
+	*((double *) buf) = value;
+	break;
+  }
+  /* NOTREACHED */
+}
+
+static int
+convert(pbuf, psize, ptp, tp)
+  char	**pbuf;
+  long	*psize;
+  p_type *ptp;
+  p_type tp;
+{
+  long	l;
+  double d;
+
+  if (*ptp == tp) return 1;
+  if (tp->ty_size > *psize) {
+	*pbuf = Realloc(*pbuf, (unsigned int) tp->ty_size);
+  }
+  if ((*ptp)->ty_class == T_SUBRANGE) *ptp = (*ptp)->ty_base;
+  switch((*ptp)->ty_class) {
+  case T_INTEGER:
+  case T_UNSIGNED:
+  case T_POINTER:
+  case T_ENUM:
+	l = get_int(*pbuf, *psize);
+	if (tp == bool_type) l = l != 0;
+	switch(tp->ty_class) {
+  	case T_SUBRANGE:
+  	case T_INTEGER:
+  	case T_UNSIGNED:
+  	case T_POINTER:
+  	case T_ENUM:
+		put_int(*pbuf, tp->ty_size, l);
+		*psize = tp->ty_size;
+		*ptp = tp;
+		return 1;
+	case T_REAL:
+		put_real(*pbuf,
+			 tp->ty_size,
+			 (*ptp)->ty_class == T_INTEGER 
+				? (double) l
+				: (double) (unsigned long) l);
+		*psize = tp->ty_size;
+		*ptp = tp;
+		return 1;
+	default:
+		break;
+	}
+	break;
+  case T_REAL:
+	d = get_real(*pbuf, *psize);
+	switch(tp->ty_class) {
+  	case T_ENUM:
+  	case T_SUBRANGE:
+  	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;
+		*ptp = tp;
+		return 1;
+	case T_REAL:
+		put_real(*pbuf, tp->ty_size, d);
+		*psize = tp->ty_size;
+		*ptp = tp;
+		return 1;
+	default:
+		break;
+	}
+	break;
+  default:
+	break;
+  }
+  error("illegal conversion");
+  return 0;
+}
 
 int
 eval_cond(p)
   p_tree	p;
 {
-  /* to be written !!! */
-  return 1;
+  char	*buf;
+  long	size;
+  p_type tp;
+  long val;
+
+  if (eval_expr(p, &buf, &size, &tp)) {
+	if (convert(&buf, &size, &tp, currlang->has_bool_type ? bool_type : int_type)) {
+		val = get_int(buf, size);
+		if (buf) free(buf);
+		return (int) val;
+	}
+	if (buf) free(buf);
+  }
+  return 0;
+}
+
+static int
+do_not(p, pbuf, psize, ptp)
+  p_tree	p;
+  char		**pbuf;
+  long		*psize;
+  p_type	*ptp;
+{
+  if (eval_expr(p->t_args[0], pbuf, psize, ptp) &&
+      convert(pbuf, psize, ptp, currlang->has_bool_type ? bool_type : int_type)) {
+	put_int(*pbuf, *psize, (long) !get_int(*pbuf, *psize));
+	return 1;
+  }
+  return 0;
+}
+
+static int
+do_deref(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_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;
+		}
+		return 1;
+  	default:
+		error("illegal operand of DEREF");
+		break;
+	}
+  }
+  return 0;
+}
+
+static int
+do_unmin(p, pbuf, psize, ptp)
+  p_tree	p;
+  char		**pbuf;
+  long		*psize;
+  p_type	*ptp;
+{
+  if (eval_expr(p->t_args[0], pbuf, psize, ptp)) {
+  	switch((*ptp)->ty_class) {
+  	case T_SUBRANGE:
+  	case T_INTEGER:
+  	case T_ENUM:
+  	case T_UNSIGNED:
+		put_int(*pbuf, *psize, -get_int(*pbuf, *psize));
+		return 1;
+  	case T_REAL:
+		put_real(*pbuf, *psize, -get_real(*pbuf, *psize));
+		return 1;
+  	default:
+		error("illegal operand of unary -");
+		break;
+	}
+  }
+  return 0;
+}
+
+static int
+do_unplus(p, pbuf, psize, ptp)
+  p_tree	p;
+  char		**pbuf;
+  long		*psize;
+  p_type	*ptp;
+{
+  if (eval_expr(p->t_args[0], pbuf, psize, ptp)) {
+  	switch((*ptp)->ty_class) {
+  	case T_SUBRANGE:
+  	case T_INTEGER:
+  	case T_ENUM:
+  	case T_UNSIGNED:
+  	case T_REAL:
+		return 1;
+  	default:
+		error("illegal operand of unary +");
+		break;
+  	}
+  }
+  return 0;
+}
+
+static int (*un_op[])() = {
+  0,
+  do_not,
+  do_deref,
+  0,
+  0,
+  0,
+  0,
+  0,
+  0,
+  0,
+  0,
+  do_unplus,
+  do_unmin,
+  0,
+  0,
+  0,
+  0,
+  0,
+  0,
+  0,
+  0
+};
+
+static p_type
+balance(tp1, tp2)
+  p_type	tp1, tp2;
+{
+
+  if (tp1->ty_class == T_SUBRANGE) tp1 = tp1->ty_base;
+  if (tp2->ty_class == T_SUBRANGE) tp2 = tp2->ty_base;
+  if (tp1 == tp2) return tp2;
+  if (tp2->ty_class == T_REAL) {
+  	p_type tmp = tp1; tp1 = tp2; tp2 = tmp;
+  }
+  if (tp1->ty_class == T_REAL) {
+	switch(tp2->ty_class) {
+	case T_INTEGER:
+	case T_UNSIGNED:
+	case T_ENUM:
+		return tp1;
+	case T_REAL:
+		return tp1->ty_size > tp2->ty_size ? tp1 : tp2;
+	default:
+		error("illegal type combination");
+		return 0;
+	}
+  }
+  if (tp2->ty_class == T_POINTER) {
+  	p_type tmp = tp1; tp1 = tp2; tp2 = tmp;
+  }
+  if (tp1->ty_class == T_POINTER) {
+	switch(tp2->ty_class) {
+	case T_INTEGER:
+	case T_UNSIGNED:
+	case T_POINTER:
+	case T_ENUM:
+		return tp1;
+	default:
+		error("illegal type combination");
+		return 0;
+	}
+  }
+  if (tp2->ty_class == T_UNSIGNED) {
+  	p_type tmp = tp1; tp1 = tp2; tp2 = tmp;
+  }
+  if (tp1->ty_class == T_UNSIGNED) {
+	switch(tp2->ty_class) {
+	case T_INTEGER:
+	case T_UNSIGNED:
+		if (tp1->ty_size >= tp2->ty_size) return tp1;
+		return tp2;
+	case T_ENUM:
+		return tp1;
+	default:
+		error("illegal type combination");
+		return 0;
+	}
+  }
+  if (tp2->ty_class == T_INTEGER) {
+  	p_type tmp = tp1; tp1 = tp2; tp2 = tmp;
+  }
+  if (tp1->ty_class == T_INTEGER) {
+	switch(tp2->ty_class) {
+	case T_INTEGER:
+		if (tp1->ty_size >= tp2->ty_size) return tp1;
+		return tp2;
+	case T_ENUM:
+		return tp1;
+	default:
+		error("illegal type combination");
+		return 0;
+	}
+  }
+  error("illegal type combination");
+  return 0;
+}
+
+static int
+do_andor(p, pbuf, psize, ptp)
+  p_tree	p;
+  char		**pbuf;
+  long		*psize;
+  p_type	*ptp;
+{
+  long		l1, l2;
+  char		*buf;
+  long		size;
+  p_type	tp;
+
+  if (eval_expr(p->t_args[0], pbuf, psize, ptp) &&
+      convert(pbuf, psize, ptp, currlang->has_bool_type ? bool_type : int_type) &&
+      eval_expr(p->t_args[1], &buf, &size, &tp) &&
+      convert(&buf, &size, &tp, currlang->has_bool_type ? bool_type : int_type)) {
+	l1 = get_int(*pbuf, *psize);
+	l2 = get_int(buf, size);
+	put_int(*pbuf,
+		*psize,
+		p->t_whichoper == E_AND 
+			? (long)(l1 && l2) 
+			: (long)(l1 || l2));
+	free(buf);
+	return 1;
+  }
+  free(buf);
+  return 0;
+}
+
+static int
+do_arith(p, pbuf, psize, ptp)
+  p_tree	p;
+  char		**pbuf;
+  long		*psize;
+  p_type	*ptp;
+{
+  long		l1, l2;
+  double	d1, d2;
+  char		*buf = 0;
+  long		size;
+  p_type	tp, balance_tp;
+
+  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)) {
+	switch(balance_tp->ty_class) {
+	case T_INTEGER:
+	case T_ENUM:
+	case T_UNSIGNED:
+		l1 = get_int(*pbuf, *psize);
+		l2 = get_int(buf, size);
+		free(buf);
+		buf = 0;
+		switch(p->t_whichoper) {
+		case E_PLUS:
+			l1 += l2;
+			break;
+		case E_MIN:
+			l1 -= l2;
+			break;
+		case E_MUL:
+			l1 *= l2;
+			break;
+		case E_DIV:
+		case E_ZDIV:
+			if (! l2) {
+				error("division by 0");
+				return 0;
+			}
+			if (balance_tp->ty_class == T_INTEGER) {
+				if ((l1 < 0) != (l2 < 0)) {
+					if (l1 < 0) l1 = - l1;
+					else l2 = -l2;
+					if (p->t_whichoper == E_DIV) {
+					    l1 = -((l1+l2-1)/l2);
+					}
+					else {
+					    l1 = -(l1/l2);
+					}
+				}
+				else l1 /= l2;
+			}
+			else l1 = (unsigned long) l1 /
+				  (unsigned long) l2;
+			break;
+		case E_MOD:
+		case E_ZMOD:
+			if (! l2) {
+				error("modulo by 0");
+				return 0;
+			}
+			if (balance_tp->ty_class == T_INTEGER) {
+				if ((l1 < 0) != (l2 < 0)) {
+					if (l1 < 0) l1 = - l1;
+					else l2 = -l2;
+					if (p->t_whichoper == E_MOD) {
+					    l1 = ((l1+l2-1)/l2)*l2 - l1;
+					}
+					else {
+					    l1 = (l1/l2)*l2 - l1;
+					}
+				}
+				else l1 %= l2;
+			}
+			else l1 = (unsigned long) l1 %
+				  (unsigned long) l2;
+			break;
+		}
+		put_int(*pbuf, *psize, l1);
+		break;
+	case T_REAL:
+		d1 = get_real(*pbuf, *psize);
+		d2 = get_real(buf, size);
+		free(buf);
+		buf = 0;
+		switch(p->t_whichoper) {
+		case E_DIV:
+		case E_ZDIV:
+			if (d2 == 0.0) {
+				error("division by 0.0");
+				return 0;
+			}
+			d1 /= d2;
+			break;
+		case E_PLUS:
+			d1 += d2;
+			break;
+		case E_MIN:
+			d1 -= d2;
+			break;
+		case E_MUL:
+			d1 *= d2;
+			break;
+		}
+		put_real(*pbuf, *psize, d1);
+		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;
+  char		**pbuf;
+  long		*psize;
+  p_type	*ptp;
+{
+  long		l1, l2;
+  double	d1, d2;
+  char		*buf = 0;
+  long		size;
+  p_type	tp, balance_tp;
+
+  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)) {
+	switch(balance_tp->ty_class) {
+	case T_INTEGER:
+	case T_ENUM:
+	case T_UNSIGNED:
+	case T_POINTER:
+		l1 = get_int(*pbuf, *psize);
+		l2 = get_int(buf, size);
+		free(buf);
+		buf = 0;
+		switch(p->t_whichoper) {
+		case E_EQUAL:
+			l1 = l1 == l2;
+			break;
+		case E_NOTEQUAL:
+			l1 = l1 != l2;
+			break;
+		case E_LTEQUAL:
+			if (balance_tp->ty_class == T_INTEGER) {
+				l1 = l1 <= l2;
+			}
+			else	l1 = (unsigned long) l1 <=
+				     (unsigned long) l2;
+			break;
+		case E_LT:
+			if (balance_tp->ty_class == T_INTEGER) {
+				l1 = l1 < l2;
+			}
+			else	l1 = (unsigned long) l1 <
+				     (unsigned long) l2;
+			break;
+		case E_GTEQUAL:
+			if (balance_tp->ty_class == T_INTEGER) {
+				l1 = l1 >= l2;
+			}
+			else	l1 = (unsigned long) l1 >=
+				     (unsigned long) l2;
+			break;
+		case E_GT:
+			if (balance_tp->ty_class == T_INTEGER) {
+				l1 = l1 > l2;
+			}
+			else	l1 = (unsigned long) l1 >
+				     (unsigned long) l2;
+			break;
+		}
+		break;
+	case T_REAL:
+		d1 = get_real(*pbuf, *psize);
+		d2 = get_real(buf, size);
+		free(buf);
+		buf = 0;
+		switch(p->t_whichoper) {
+		case E_EQUAL:
+			l1 = d1 == d2;
+			break;
+		case E_NOTEQUAL:
+			l1 = d1 != d2;
+			break;
+		case E_LTEQUAL:
+			l1 = d1 <= d2;
+			break;
+		case E_LT:
+			l1 = d1 < d2;
+			break;
+		case E_GTEQUAL:
+			l1 = d1 >= d2;
+			break;
+		case E_GT:
+			l1 = d1 > d2;
+			break;
+		}
+		break;
+	}
+	if (*psize < int_size) {
+		*psize = int_size;
+		free(*pbuf);
+		*pbuf = Malloc((unsigned int) int_size);
+	}
+	else	*psize = int_size;
+	if (currlang->has_bool_type) {
+		*ptp = bool_type;
+	}
+	else	*ptp = int_type;
+	put_int(*pbuf, *psize, l1);
+	return 1;
+  }
+  if (buf) free(buf);
+  return 0;
+}
+
+static int
+do_in(p, pbuf, psize, ptp)
+  p_tree	p;
+  char		**pbuf;
+  long		*psize;
+  p_type	*ptp;
+{
+  long		l;
+  char		*buf = 0;
+  long		size;
+  p_type	tp;
+
+  error("IN not implemented"); 	/* ??? */
+  return 0;
+}
+
+static int
+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;
+
+  error("[ not implemented"); 	/* ??? */
+  return 0;
+}
+
+static int
+do_select(p, pbuf, psize, ptp)
+  p_tree	p;
+  char		**pbuf;
+  long		*psize;
+  p_type	*ptp;
+{
+  long		l;
+  char		*buf = 0;
+  long		size;
+  p_type	tp;
+
+  error("SELECT not implemented"); 	/* ??? */
+  return 0;
+}
+
+static int (*bin_op[])() = {
+  0,
+  0,
+  0,
+  do_andor,
+  do_andor,
+  do_arith,
+  do_arith,
+  do_arith,
+  do_arith,
+  do_in,
+  do_array,
+  do_arith,
+  do_arith,
+  do_arith,
+  do_cmp,
+  do_cmp,
+  do_cmp,
+  do_cmp,
+  do_cmp,
+  do_cmp,
+  do_select
+};
+
+int
+eval_expr(p, pbuf, psize, ptp)
+  p_tree	p;
+  char		**pbuf;
+  long		*psize;
+  p_type	*ptp;
+{
+  register p_symbol	sym;
+  int	retval = 0;
+
+  switch(p->t_oper) {
+  case OP_NAME:
+  case OP_SELECT:
+	sym = identify(p, VAR|REGVAR|LOCVAR|VARPAR|CONST);
+	if (! sym) return 0;
+	if (! get_value(sym, pbuf, psize)) {
+		print_node(p, 0);
+		fputs(" currently not available\n", db_out);
+		break;
+	}
+	*ptp = sym->sy_type;
+	retval = 1;
+	break;
+
+  case OP_INTEGER:
+	*pbuf = Malloc(sizeof(long));
+	*psize = sizeof(long);
+	*ptp = long_type;
+	*((long *) (*pbuf)) = p->t_ival;
+	retval = 1;
+	break;
+
+  case OP_REAL:
+	*pbuf = Malloc(sizeof(double));
+	*psize = sizeof(double);
+	*ptp = double_type;
+	*((double *) (*pbuf)) = p->t_fval;
+	retval = 1;
+	break;
+
+  case OP_STRING:
+	*pbuf = Malloc(sizeof(char *));
+	*psize = sizeof(char *);
+	*ptp = string_type;
+	*((char **) (*pbuf)) = p->t_sval;
+	retval = 1;
+	break;
+
+  case OP_UNOP:
+	retval = (*un_op[p->t_whichoper])(p, pbuf, psize, ptp);
+	break;
+
+  case OP_BINOP:
+	retval = (*bin_op[p->t_whichoper])(p, pbuf, psize, ptp);
+	break;
+  default:
+	assert(0);
+	break;
+  }
+  if (! retval) {
+	if (*pbuf) {
+		free(*pbuf);
+		*pbuf = 0;
+	}
+	*psize = 0;
+  }
+  return retval;
 }

+ 28 - 0
util/grind/expr.h

@@ -0,0 +1,28 @@
+/* $Header$ */
+
+/* expression operators. Do not change values, as they are used as
+   indices into arrays.
+*/
+
+#define E_NOT	1
+#define E_DEREF	2
+#define E_AND	3
+#define E_OR	4
+#define E_DIV	5		/* equal to truncated quotient */
+#define E_MOD	6		/* x = (x E_DIV y) * y + x E_MOD y,
+				   0 <= (x E_MOD y) < y
+				*/
+#define E_ZDIV	7		/* quotient rounded to 0 */
+#define E_ZMOD	8		/* remainder of E_ZDIV */
+#define E_IN	9		/* set membership */
+#define E_ARRAY	10
+#define E_PLUS	11
+#define E_MIN	12
+#define E_MUL	13
+#define E_EQUAL	14
+#define E_NOTEQUAL 15
+#define E_LTEQUAL 16
+#define E_GTEQUAL 17
+#define E_LT	18
+#define E_GT	19
+#define E_SELECT 20

+ 3 - 0
util/grind/langdep.cc

@@ -44,4 +44,7 @@ find_language(suff)
 	if (! strcmp(p->l_suff, suff)) break;
 	p = p->l_next;
   }
+  if (! currlang) {
+	currlang = def_dep;
+  }
 }

+ 5 - 1
util/grind/langdep.h

@@ -3,6 +3,9 @@
 /* language-dependent routines and formats, together in one structure: */
 
 struct langdep {
+  /* language info: */
+  int	has_bool_type;		/* set if language has a boolean type */
+
   /* formats (for fprintf): */
   char	*decint_fmt;		/* decimal ints (format for long) */
   char	*octint_fmt;		/* octal ints (format for long) */
@@ -28,9 +31,10 @@ struct langdep {
   int	(*get_name)();
   int	(*get_number)();
   int	(*get_token)();
+  int	(*printop)();
 };
 
-extern struct langdep	*m2_dep, *currlang;
+extern struct langdep	*m2_dep, *def_dep, *currlang;
 
 extern int find_language();
 

+ 2 - 1
util/grind/list.c

@@ -12,6 +12,7 @@ static	line_positions();
 extern char	*dirs[];
 extern FILE	*fopen();
 extern FILE	*db_out;
+extern t_lineno	currline;
 #define	window_size	21
 
 static int
@@ -103,7 +104,7 @@ lines(file, l1, l2)
   for (n = l1; n <= l2; n++) {
 	register int	c;
 
-	fprintf(db_out, "%6d  ", n);
+	fprintf(db_out, "%c%5d\t", n == currline ? '>' : ' ', n);
 	do {
 		c = getc(f);
 		if (c != EOF) putc(c, db_out);

+ 139 - 5
util/grind/modula-2.c

@@ -3,19 +3,21 @@
 /* Language dependant support; this one is for Modula-2 */
 
 #include <stdio.h>
+#include <alloc.h>
+#include <assert.h>
 
+#include "position.h"
 #include "class.h"
 #include "langdep.h"
 #include "Lpars.h"
 #include "idf.h"
 #include "token.h"
 #include "expr.h"
+#include "tree.h"
+#include "operator.h"
 
 extern FILE *db_out, *db_in;
 
-extern int
-	get_string();
-
 extern double
 	atof();
 
@@ -24,12 +26,16 @@ static int
 	get_number(),
 	get_name(),
 	get_token(),
+	get_string(),
+	print_op(),
 	op_prio();
 
 static long
 	array_elsize();
 
 static struct langdep m2 = {
+	1,
+
 	"%ld",
 	"%loB",
 	"%lXH",
@@ -51,7 +57,8 @@ static struct langdep m2 = {
 	get_string,
 	get_name,
 	get_number,
-	get_token
+	get_token,
+	print_op
 };
 
 struct langdep *m2_dep = &m2;
@@ -84,7 +91,33 @@ static int
 op_prio(op)
   int	op;
 {
-  /* ??? to be written ??? */
+  switch(op) {
+  case E_NOT:
+  	return 5;
+
+  case E_SELECT:
+	return 9;
+
+  case E_AND:
+  case E_MUL:
+  case E_DIV:
+  case E_MOD:
+	return 4;
+
+  case E_PLUS:
+  case E_MIN:
+  case E_OR:
+	return 3;
+
+  case E_IN:
+  case E_EQUAL:
+  case E_NOTEQUAL:
+  case E_LTEQUAL:
+  case E_GTEQUAL:
+  case E_LT:
+  case E_GT:
+	return 2;
+  }
   return 1;
 }
 
@@ -371,3 +404,104 @@ get_token(c)
 	return LLlex();
   }
 }
+
+static int 
+get_string(c)
+  int	c;
+{
+  register int ch;
+  char buf[512];
+  register int len = 0;
+
+  while (ch = getc(db_in), ch != c) {
+	if (ch == '\n') {
+		error("newline in string");
+		break;
+	}
+	buf[len++] = ch;
+  }
+  buf[len++] = 0;
+  tok.str = Salloc(buf, (unsigned) len);
+  return STRING;
+}
+
+static int
+print_op(p)
+  p_tree	p;
+{
+  switch(p->t_oper) {
+  case OP_UNOP:
+  	switch(p->t_whichoper) {
+	case E_MIN:
+		fputs("-", db_out);
+		print_node(p->t_args[0], 0);
+		break;
+	case E_PLUS:
+		fputs("+", db_out);
+		print_node(p->t_args[0], 0);
+		break;
+	case E_NOT:
+		fputs("~", db_out);
+		print_node(p->t_args[0], 0);
+		break;
+	case E_DEREF:
+		print_node(p->t_args[0], 0);
+		fputs("^", db_out);
+		break;
+	}
+	break;
+  case OP_BINOP:
+	fputs("(", db_out);
+	print_node(p->t_args[0], 0);
+	switch(p->t_whichoper) {
+	case E_AND:
+		fputs("&", db_out);
+		break;
+	case E_OR:
+		fputs("|", db_out);
+		break;
+	case E_DIV:
+		fputs("/", db_out);
+		break;
+	case E_MOD:
+		fputs(" MOD ", db_out);
+		break;
+	case E_IN:
+		fputs(" IN ", db_out);
+		break;
+	case E_PLUS:
+		fputs("+", db_out);
+		break;
+	case E_MIN:
+		fputs("-", db_out);
+		break;
+	case E_MUL:
+		fputs("*", db_out);
+		break;
+	case E_EQUAL:
+		fputs("=", db_out);
+		break;
+	case E_NOTEQUAL:
+		fputs("#", db_out);
+		break;
+	case E_LTEQUAL:
+		fputs("<=", db_out);
+		break;
+	case E_GTEQUAL:
+		fputs(">=", db_out);
+		break;
+	case E_LT:
+		fputs("<", db_out);
+		break;
+	case E_GT:
+		fputs(">", db_out);
+		break;
+	case E_SELECT:
+		fputs(".", db_out);
+		break;
+	}
+	print_node(p->t_args[1], 0);
+	fputs(")", db_out);
+	break;
+  }
+}

+ 2 - 2
util/grind/print.c

@@ -176,10 +176,10 @@ print_val(tp, tp_sz, addr, compressed, indent)
 	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 != sz << 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);
+			fprintf(db_out, "<bitfield, %d, %ld>", fld->fld_bitsize, sz);
 		}
 		else print_val(fld->fld_type, sz, addr+(fld->fld_pos>>3), compressed, indent);
 		if (compressed && i > 1) {

+ 20 - 14
util/grind/tree.c

@@ -15,6 +15,7 @@
 #include	"scope.h"
 #include	"symbol.h"
 #include	"langdep.h"
+#include	"type.h"
 
 extern FILE	*db_out;
 extern t_lineno	currline;
@@ -210,13 +211,17 @@ print_node(p, top_level)
 	fputs(p->t_str, db_out);
 	break;
   case OP_INTEGER:
-	fprintf(db_out, "%d", p->t_ival);
+	fprintf(db_out, currlang->decint_fmt, p->t_ival);
 	break;
   case OP_STRING:
-	fprintf(db_out, "%s", p->t_sval);
+	(*currlang->printstring)(p->t_sval);
 	break;
   case OP_REAL:
-	fprintf(db_out, "%.14g", p->t_fval);
+	fprintf(db_out, currlang->real_fmt, p->t_fval);
+	break;
+  case OP_UNOP:
+  case OP_BINOP:
+	(*currlang->printop)(p);
 	break;
   }
   if (top_level) fputs("\n", db_out);
@@ -263,8 +268,8 @@ do_list(p)
 {
   if (currfile) {
 	lines(currfile->sy_file,
-	      p->t_args[0] ? (int) p->t_args[0]->t_ival : (int) currline,
-	      p->t_args[1] ? (int) p->t_args[1]->t_ival : (int) currline+9);
+	      p->t_args[0] ? (int) p->t_args[0]->t_ival : (int) currline-4,
+	      p->t_args[1] ? (int) p->t_args[1]->t_ival : (int) currline+5);
 	currline = p->t_args[1] ? p->t_args[1]->t_ival + 1 : currline + 10;
   }
   else fprintf(db_out, "no current file\n");
@@ -535,7 +540,9 @@ do_delete(p)
 do_print(p)
   p_tree	p;
 {
-  p_symbol sym;
+  char	*buf;
+  long	size;
+  p_type tp;
 
   switch(p->t_oper) {
   case OP_PRINT:
@@ -545,15 +552,14 @@ do_print(p)
 	do_print(p->t_args[0]);
 	do_print(p->t_args[1]);
 	break;
-  case OP_NAME:
-  case OP_SELECT:
-	sym = identify(p, VAR|REGVAR|LOCVAR|VARPAR|CONST);
-	if (! sym) return;
+  default:
+	if (! eval_expr(p, &buf, &size, &tp)) return;
 	print_node(p, 0);
-	if (! print_sym(sym)) {
-		fputs(" currently not available\n", db_out);
-		break;
-	}
+	fputs(" = ", db_out);
+	print_val(tp, size, buf, 0, 0);
+	if (buf) free(buf);
+	fputs("\n", db_out);
+	break;
   }
 }
 

+ 9 - 5
util/grind/type.c

@@ -12,7 +12,7 @@
 #include "message.h"
 #include "langdep.h"
 
-p_type	int_type, char_type, short_type, long_type;
+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;
@@ -49,7 +49,7 @@ struct integer_types {
 };
 
 static struct integer_types i_types[4];
-static struct integer_types u_types[5];
+static struct integer_types u_types[4];
 
 #define ufit(n, nb)	Xfit(n, nb, ubounds)
 #define ifit(n, nb)	Xfit(n, nb, ibounds)
@@ -76,10 +76,14 @@ subrange_type(A, base_index, c1, c2, result_index)
 			return void_type;
 		}
 
-		/* c1 = 0 and c2 = 127 -> char ??? */
-		if (c1 == 0 && c2 == 127) {
+		if ((c1 == 0 || c1 == -128) && c2 == 127) {
 			return char_type;
 		}
+
+		if (c1 == 0 && c2 == 255) {
+			return uchar_type;
+		}
+
 		itself = 1;
 	}
   }
@@ -242,7 +246,6 @@ init_types()
   u_types[0].maxval = max_uns[(int)int_size]; u_types[0].type = uint_type;
   u_types[1].maxval = max_uns[(int)short_size]; u_types[1].type = ushort_type;
   u_types[2].maxval = max_uns[(int)long_size]; u_types[2].type = ulong_type;
-  u_types[3].maxval = max_uns[1]; u_types[3].type = uchar_type;
 }
 
 /*
@@ -323,6 +326,7 @@ end_literal(tp, maxval)
   if (ufit(maxval, 1)) tp->ty_size = 1;
   else if (ufit(maxval, (int)short_size)) tp->ty_size = short_size;
   else tp->ty_size = int_size;
+  if (! bool_type) bool_type = tp;
 }
 
 long

+ 2 - 1
util/grind/type.hh

@@ -112,7 +112,8 @@ extern long
 	param_size(),
 	compute_size();
 
-extern p_type	char_type, uchar_type,
+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;
 

+ 7 - 7
util/grind/value.c

@@ -46,10 +46,10 @@ get_value(sym, buf, psize)
 	}
 	break;
   case CONST:
-	*buf = Malloc((unsigned) tp->ty_size);
+	*buf = Malloc((unsigned) size);
 	switch(tp->ty_class) {
 	case T_REAL:
-		if (tp->ty_size != sizeof(double)) {
+		if (size != sizeof(double)) {
 			*((float *) *buf) = sym->sy_const.co_rval;
 		}
 		else	*((double *) *buf) = sym->sy_const.co_rval;
@@ -58,10 +58,10 @@ get_value(sym, buf, psize)
 	case T_SUBRANGE:
 	case T_UNSIGNED:
 	case T_ENUM:
-		if (tp->ty_size == 1) {
+		if (size == 1) {
 			*((char *) *buf) = sym->sy_const.co_ival;
 		}
-		else if (tp->ty_size == 2) {
+		else if (size == 2) {
 			*((short *) *buf) = sym->sy_const.co_ival;
 		}
 		else {
@@ -69,10 +69,10 @@ get_value(sym, buf, psize)
 		}
 		break;
 	case T_SET:
-		memcpy(*buf, sym->sy_const.co_setval, (int) tp->ty_size);
+		memcpy(*buf, sym->sy_const.co_setval, (int) size);
 		break;
 	case T_STRING:
-		memcpy(*buf, sym->sy_const.co_sval, (int) tp->ty_size);
+		memcpy(*buf, sym->sy_const.co_sval, (int) size);
 		break;
 	default:
 		fatal("strange constant");
@@ -140,7 +140,6 @@ get_value(sym, buf, psize)
 		}
 	}
 	*buf = Malloc((unsigned) size);
-	*psize = size;
 	if (get_bytes(size,
 		      (t_addr) BUFTOA(AB+sym->sy_name.nm_value),
 		      *buf)) {
@@ -155,6 +154,7 @@ get_value(sym, buf, psize)
 	*buf = 0;
 	*psize = 0;
   }
+  else *psize = size;
 
   return retval;
 }