From bd18f6c521faf839cb2b2cd644ef353247082e52 Mon Sep 17 00:00:00 2001 From: ceriel Date: Wed, 12 Sep 1990 16:13:59 +0000 Subject: [PATCH] many changes --- util/grind/Amakefile | 1 + util/grind/char.ct | 2 +- util/grind/commands.g | 154 +------- util/grind/dbx_string.g | 11 +- util/grind/default.c | 340 ++++++++++++++++++ util/grind/expr.c | 757 +++++++++++++++++++++++++++++++++++++++- util/grind/expr.h | 28 ++ util/grind/langdep.cc | 3 + util/grind/langdep.h | 6 +- util/grind/list.c | 3 +- util/grind/modula-2.c | 144 +++++++- util/grind/print.c | 4 +- util/grind/tree.c | 34 +- util/grind/type.c | 14 +- util/grind/type.hh | 3 +- util/grind/value.c | 14 +- 16 files changed, 1327 insertions(+), 191 deletions(-) create mode 100644 util/grind/default.c create mode 100644 util/grind/expr.h diff --git a/util/grind/Amakefile b/util/grind/Amakefile index 09f3ae0b6..e90a8a977 100644 --- a/util/grind/Amakefile +++ b/util/grind/Amakefile @@ -61,6 +61,7 @@ CSRC = { value.c, type.c, rd.c, + default.c, modula-2.c } ; diff --git a/util/grind/char.ct b/util/grind/char.ct index 21a4fbabc..9682c3349 100644 --- a/util/grind/char.ct +++ b/util/grind/char.ct @@ -65,7 +65,7 @@ STSIMP:,<>{}:` % ISTOKEN % %C -1:-abcefiprstuvxAEFGLMPQSTVX,;:+=()* +1:-acefiprstuvxAEFGLMPQSTVX,;:+=()* %T char istoken[] = { %p %T}; diff --git a/util/grind/commands.g b/util/grind/commands.g index 11e90e236..32f782bd2 100644 --- a/util/grind/commands.g +++ b/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) diff --git a/util/grind/dbx_string.g b/util/grind/dbx_string.g index 38829851f..0c545e69f 100644 --- a/util/grind/dbx_string.g +++ b/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); } diff --git a/util/grind/default.c b/util/grind/default.c new file mode 100644 index 000000000..4f9a9e1ef --- /dev/null +++ b/util/grind/default.c @@ -0,0 +1,340 @@ +/* $Header$ */ + +/* Language dependant support; this one is default */ + +#include +#include + +#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; + } +} diff --git a/util/grind/expr.c b/util/grind/expr.c index fe786e529..a499b544d 100644 --- a/util/grind/expr.c +++ b/util/grind/expr.c @@ -1,14 +1,767 @@ /* $Header$ */ +#include +#include +#include + #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; } diff --git a/util/grind/expr.h b/util/grind/expr.h new file mode 100644 index 000000000..dea45775c --- /dev/null +++ b/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 diff --git a/util/grind/langdep.cc b/util/grind/langdep.cc index 930de6a66..2dc5253cd 100644 --- a/util/grind/langdep.cc +++ b/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; + } } diff --git a/util/grind/langdep.h b/util/grind/langdep.h index b6a379218..e641ce2c9 100644 --- a/util/grind/langdep.h +++ b/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(); diff --git a/util/grind/list.c b/util/grind/list.c index ee596843d..c1b4342ab 100644 --- a/util/grind/list.c +++ b/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); diff --git a/util/grind/modula-2.c b/util/grind/modula-2.c index b49491281..00ea429ff 100644 --- a/util/grind/modula-2.c +++ b/util/grind/modula-2.c @@ -3,19 +3,21 @@ /* Language dependant support; this one is for Modula-2 */ #include +#include +#include +#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; + } +} diff --git a/util/grind/print.c b/util/grind/print.c index dc8eaa44d..287dda77e 100644 --- a/util/grind/print.c +++ b/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, "", fld->fld_bitsize, fld->fld_type->ty_size); + fprintf(db_out, "", fld->fld_bitsize, sz); } else print_val(fld->fld_type, sz, addr+(fld->fld_pos>>3), compressed, indent); if (compressed && i > 1) { diff --git a/util/grind/tree.c b/util/grind/tree.c index 51771ff07..a034e7614 100644 --- a/util/grind/tree.c +++ b/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; } } diff --git a/util/grind/type.c b/util/grind/type.c index 111f1f4ae..85730a966 100644 --- a/util/grind/type.c +++ b/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 diff --git a/util/grind/type.hh b/util/grind/type.hh index 0ddc228c3..54816aa22 100644 --- a/util/grind/type.hh +++ b/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; diff --git a/util/grind/value.c b/util/grind/value.c index f9896e4aa..205b31d47 100644 --- a/util/grind/value.c +++ b/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; } -- 2.34.1