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 #include #include @@ -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,6 +68,28 @@ get_int(buf, size, class) return l; } +static +put_int(buf, size, value) + char *buf; + long size; + long value; +{ + switch((int)size) { + case sizeof(char): + *buf = value; + break; + case sizeof(short): + *((short *) buf) = value; + break; + default: + *((long *) buf) = value; + break; + } + /*NOTREACHED*/ +} + +/* buffer to real and vice versa routines */ + static double get_real(buf, size) char *buf; @@ -52,26 +104,6 @@ get_real(buf, size) /*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; @@ -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,14 +230,64 @@ 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; } return 0; } +static int +do_bnot(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_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: + *ptp = (*ptp)->ty_ptrto; + *psize = (*ptp)->ty_size; + *paddr = get_int(buf, pointer_size, T_UNSIGNED); + free(buf); + return 1; + default: + error("illegal operand of DEREF"); + break; + } + } + return 0; +} + static int do_deref(p, pbuf, psize, ptp) p_tree p; @@ -205,25 +295,14 @@ do_deref(p, pbuf, psize, ptp) long *psize; p_type *ptp; { - char *addr; + t_addr 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; + 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; } @@ -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,7 +826,94 @@ 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_array(p, pbuf, psize, ptp) + p_tree p; + char **pbuf; + long *psize; + p_type *ptp; +{ + 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; } @@ -706,12 +924,14 @@ do_select(p, pbuf, psize, ptp) long *psize; p_type *ptp; { - long l; - char *buf = 0; - long size; - p_type tp; - - error("SELECT not implemented"); /* ??? */ + 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 +#include #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); + 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; } } - *buf = Malloc((unsigned) size); - if (get_bytes(size, - (t_addr) BUFTOA(AB+sym->sy_name.nm_value), - *buf)) { - retval = 1; - } - free(AB); break; }