Added some C support

util/grind/Amakefile

@@ -62,7 +62,8 @@ CSRC = {
 	type.c,
 	rd.c,
 	default.c,
-	modula-2.c
+	modula-2.c,
+	c.c
 } ;
 
 HSRC = {

util/grind/c.c

@@ -0,0 +1,425 @@
+/* $Header$ */
+
+/* Language dependant support; this one is for C */
+
+#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 c = {
+	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 *c_dep = &c;
+
+static int
+print_string(s, len)
+  char	*s;
+  int	len;
+{
+  register char	*str = s;
+  int delim = '\'';
+
+  while (*str) {
+	if (*str++ == '\'') delim = '"';
+  }
+  fprintf(db_out, "%c%.*s%c", delim, len, 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;
+{
+  switch(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 '[':
+  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 PREF_OR_BIN_OP;
+  case '/':
+	tok.ival = E_ZDIV;
+	return BIN_OP;
+  case '%':
+	tok.ival = E_ZMOD;
+	return BIN_OP;
+  case '&':
+	c = getc(db_in);
+	if (c == '&') {
+		tok.ival = E_AND;
+	}
+	else {
+		ungetc(c, db_in);
+		tok.ival = E_BAND;
+	}
+	return BIN_OP;
+  case '^':
+	tok.ival = E_BXOR;
+	return BIN_OP;
+  case '|':
+	c = getc(db_in);
+	if (c == '|') {
+		tok.ival = E_OR;
+	}
+	else {
+		ungetc(c, db_in);
+		tok.ival = E_BOR;
+	}
+	return BIN_OP;
+  case '=':
+	c = getc(db_in);
+	if (c == '=') {
+	}
+	else {
+		ungetc(c, db_in);
+		warning("== assumed");
+	}
+	tok.ival = E_EQUAL;
+	return BIN_OP;
+  case '<':
+	c = getc(db_in);
+	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 '!':
+	c = getc(db_in);
+	if (c == '=') {
+		tok.ival = E_NOTEQUAL;
+		return BIN_OP;
+	}
+	ungetc(c, db_in);
+	tok.ival = E_NOT;
+	return PREF_OP;
+  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:
+	case E_MUL:
+		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_BAND:
+		fputs("&", db_out);
+		break;
+	case E_OR:
+		fputs("||", db_out);
+		break;
+	case E_BOR:
+		fputs("|", db_out);
+		break;
+	case E_BXOR:
+		fputs("^", db_out);
+		break;
+	case E_ZDIV:
+		fputs("/", db_out);
+		break;
+	case E_ZMOD:
+		fputs("%", 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;
+  }
+}

util/grind/default.c

@@ -65,8 +65,9 @@ static struct langdep def = {
 struct langdep *def_dep = &def;
 
 static int
-print_string(s)
+print_string(s, len)
   char	*s;
+  int	len;
 {
   register char	*str = s;
   int delim = '\'';
@@ -74,7 +75,7 @@ print_string(s)
   while (*str) {
 	if (*str++ == '\'') delim = '"';
   }
-  fprintf(db_out, "%c%s%c", delim, s, delim);
+  fprintf(db_out, "%c%.*s%c", delim, len, s, delim);
 }
 
 extern long	int_size;

util/grind/expr.c

@@ -15,19 +15,27 @@
 extern FILE	*db_out;
 
 static long
-get_int(buf, size)
+get_int(buf, size, class)
   char	*buf;
   long	size;
 {
+  long l;
+
   switch((int)size) {
   case 1:
-	return *buf & 0xFF;
+	l = *buf;
+	if (class == T_INTEGER && l >= 0x7F) l -= 256;
+	else if (class != T_INTEGER && l < 0) l += 256;
+	break;
   case 2:
-	return *((short *) buf) & 0xFFFF;
+	l = *((short *) buf);
+	if (class == T_INTEGER && l >= 0x7FFF) l -= 65536;
+	else if (class != T_INTEGER && l < 0) l += 65536;
+	break;
   default:
-	return *((long *) buf);
+	l = *((long *) buf);
   }
-  /* NOTREACHED */
+  return l;
 }
 
 static double
@@ -101,7 +109,7 @@ convert(pbuf, psize, ptp, tp)
   case T_UNSIGNED:
   case T_POINTER:
   case T_ENUM:
-	l = get_int(*pbuf, *psize);
+	l = get_int(*pbuf, *psize, (*ptp)->ty_class);
 	if (tp == bool_type) l = l != 0;
 	switch(tp->ty_class) {
   	case T_SUBRANGE:
@@ -166,9 +174,9 @@ eval_cond(p)
 
   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);
+		val = get_int(buf, size, T_UNSIGNED);
 		if (buf) free(buf);
-		return (int) val;
+		return (int) (val != 0);
 	}
 	if (buf) free(buf);
   }
@@ -184,7 +192,7 @@ do_not(p, pbuf, psize, 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));
+	put_int(*pbuf, *psize, (long) !get_int(*pbuf, *psize, T_UNSIGNED));
 	return 1;
   }
   return 0;
@@ -233,7 +241,7 @@ do_unmin(p, pbuf, psize, ptp)
   	case T_INTEGER:
   	case T_ENUM:
   	case T_UNSIGNED:
-		put_int(*pbuf, *psize, -get_int(*pbuf, *psize));
+		put_int(*pbuf, *psize, -get_int(*pbuf, *psize, (*ptp)->ty_class));
 		return 1;
   	case T_REAL:
 		put_real(*pbuf, *psize, -get_real(*pbuf, *psize));
@@ -283,6 +291,9 @@ static int (*un_op[])() = {
   0,
   do_unplus,
   do_unmin,
+  do_deref,
+  0,
+  0,
   0,
   0,
   0,
@@ -383,8 +394,8 @@ do_andor(p, 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);
+	l1 = get_int(*pbuf, *psize, T_UNSIGNED);
-	l2 = get_int(buf, size);
+	l2 = get_int(buf, size, T_UNSIGNED);
 	put_int(*pbuf,
 		*psize,
 		p->t_whichoper == E_AND 
@@ -419,11 +430,20 @@ do_arith(p, pbuf, psize, ptp)
 	case T_INTEGER:
 	case T_ENUM:
 	case T_UNSIGNED:
-		l1 = get_int(*pbuf, *psize);
+		l1 = get_int(*pbuf, *psize, balance_tp->ty_class);
-		l2 = get_int(buf, size);
+		l2 = get_int(buf, size, balance_tp->ty_class);
 		free(buf);
 		buf = 0;
 		switch(p->t_whichoper) {
+		case E_BAND:
+			l1 &= l2;
+			break;
+		case E_BOR:
+			l1 |= l2;
+			break;
+		case E_BXOR:
+			l1 ^= l2;
+			break;
 		case E_PLUS:
 			l1 += l2;
 			break;
@@ -540,8 +560,8 @@ do_cmp(p, pbuf, psize, ptp)
 	case T_ENUM:
 	case T_UNSIGNED:
 	case T_POINTER:
-		l1 = get_int(*pbuf, *psize);
+		l1 = get_int(*pbuf, *psize, balance_tp->ty_class);
-		l2 = get_int(buf, size);
+		l2 = get_int(buf, size, balance_tp->ty_class);
 		free(buf);
 		buf = 0;
 		switch(p->t_whichoper) {
@@ -636,8 +656,30 @@ do_in(p, pbuf, psize, ptp)
   char		*buf = 0;
   long		size;
   p_type	tp;
+  int		sft = int_size == 2 ? 4 : 5;
 
-  error("IN not implemented"); 	/* ??? */
+  if (eval_expr(p->t_args[0], pbuf, psize, ptp) &&
+      eval_expr(p->t_args[1], &buf, &size, &tp)) {
+	if (tp->ty_class != T_SET) {
+		error("right-hand side of IN not a set");
+		free(buf);
+		return 0;
+	}
+	if (! convert(pbuf, psize, ptp, tp->ty_setbase)) {
+		free(buf);
+		return 0;
+	}
+	l = get_int(*pbuf, *psize, (*ptp)->ty_class) - tp->ty_setlow;
+	l = l >= 0 
+	    && l <= (size << 3) 
+	    && (((int *) buf)[(int)(l>>sft)] & (1 << (l & ((1 << sft)-1))));
+	free(buf);
+	*pbuf = Realloc(*pbuf, (unsigned) int_size);
+	*psize = int_size;
+	*ptp = currlang->has_bool_type ? bool_type : int_type;
+	put_int(*pbuf, *psize, l);
+	return 1;
+  }
   return 0;
 }
 
@@ -694,7 +736,10 @@ static int (*bin_op[])() = {
   do_cmp,
   do_cmp,
   do_cmp,
-  do_select
+  do_select,
+  do_arith,
+  do_arith,
+  do_arith
 };
 
 int

util/grind/expr.h

@@ -26,3 +26,6 @@
 #define E_LT	18
 #define E_GT	19
 #define E_SELECT 20
+#define E_BAND	21		/* bitwise and */
+#define E_BOR	22		/* bitwise or */
+#define E_BXOR	23

util/grind/langdep.cc

@@ -31,6 +31,7 @@ int
 init_languages()
 {
   add_language(".mod", m2_dep);
+  add_language(".c", c_dep);
 }
 
 int

util/grind/langdep.h

@@ -34,7 +34,7 @@ struct langdep {
   int	(*printop)();
 };
 
-extern struct langdep	*m2_dep, *def_dep, *currlang;
+extern struct langdep	*m2_dep, *def_dep, *c_dep, *currlang;
 
 extern int find_language();
 

util/grind/list.c

@@ -84,7 +84,6 @@ lines(file, l1, l2)
 		error("could not open %s", file->f_sym->sy_idf->id_text);
 		return;
 	}
-	printf("filedesc = %d\n", fileno(f));
 	last_file = file;
 	last_f = f;
 	if (! file->f_linepos) {

util/grind/main.c

@@ -110,6 +110,23 @@ error(va_alist)
   errorgiven = 1;
 }
 
+/*VARARGS1*/
+warning(va_alist)
+  va_dcl
+{
+  va_list ap;
+  char *fmt;
+
+  va_start(ap);
+  {
+	fmt = va_arg(ap, char *);
+	fprintf(stderr, "%s: ", progname);
+	vfprintf(stderr, fmt, ap);
+	fprintf(stderr, "\n");
+  }
+  va_end(ap);
+}
+
 rd_fatal()
 {
   fatal("read error in %s", AckObj);

util/grind/modula-2.c

@@ -64,8 +64,9 @@ static struct langdep m2 = {
 struct langdep *m2_dep = &m2;
 
 static int
-print_string(s)
+print_string(s, len)
   char	*s;
+  int	len;
 {
   register char	*str = s;
   int delim = '\'';
@@ -73,7 +74,7 @@ print_string(s)
   while (*str) {
 	if (*str++ == '\'') delim = '"';
   }
-  fprintf(db_out, "%c%s%c", delim, s, delim);
+  fprintf(db_out, "%c%.*s%c", delim, len, s, delim);
 }
 
 extern long	int_size;

util/grind/print.c

@@ -294,7 +294,7 @@ print_val(tp, tp_sz, addr, compressed, indent)
 			  	    : BUFTOL(addr));
 	break;
   case T_STRING:
-	(*currlang->printstring)(addr);
+	(*currlang->printstring)(addr, (int) tp_sz);
 	break;
   default:
 	assert(0);

util/grind/tree.c

@@ -214,7 +214,7 @@ print_node(p, top_level)
 	fprintf(db_out, currlang->decint_fmt, p->t_ival);
 	break;
   case OP_STRING:
-	(*currlang->printstring)(p->t_sval);
+	(*currlang->printstring)(p->t_sval, strlen(p->t_sval));
 	break;
   case OP_REAL:
 	fprintf(db_out, currlang->real_fmt, p->t_fval);