d0p1/ack
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

many changes

Browse source
This commit is contained in:
ceriel 1990-09-19 14:31:12 +00:00
parent 641a446f01
commit 1feeb94dbf
18 changed files with 730 additions and 207 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
util/grind/Amakefile
View file

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

114
util/grind/c.c
View file

@ -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);

17
util/grind/commands.g
View file

@ -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); }
;

435
util/grind/expr.c
View file

@ -1,5 +1,33 @@
/* $Header$ */
/* This file contains the expression evaluator. It exports four routines:
- int eval_cond(p_tree p)
This routine evaluates the conditional expression indicated by p
and returns 1 if it evaluates to TRUE, or 0 if it could not be
evaluated for some reason or if it evalutes to FALSE.
If the expression cannot be evaluated, an error message is given.
- int eval_desig(p_tree p, t_addr *pbuf, long **psize, p_type *ptp)
This routine evaluates the expression indicated by p, which should
result in a designator. The result of the expression is an address
which is to be found in *pbuf. *psize will contain the size of the
designated object, and *ptp its type.
If the expression cannot be evaluated or does not result in a
designator, 0 is returned and an error message is given.
Otherwise, 1 is returned.
- int eval_expr(p_tree p, char **pbuf, long **psize, p_type *ptp)
This routine evaluates the expression indicated by p.
The result of the expression is left in *pbuf.
*psize will contain the size of the value, and *ptp its type.
If the expression cannot be evaluated, 0 is returned and an error
message is given. Otherwise, 1 is returned.
- int convert(char **pbuf, long *psize, p_type *ptp, p_type tp, long size)
This routine tries to convert the value in pbuf of size psize
and type ptp to type tp with size size. It returns 0 if this fails,
while producing an error message. Otherwise, it returns 1 and
the resulting value, type and size are left in pbuf, ptp, and
psize, respectively.
*/
#include <stdio.h>
#include <alloc.h>
#include <assert.h>
@ -14,6 +42,8 @@
extern FILE *db_out;
/* buffer to integer and vice versa routines */
static long
get_int(buf, size, class)
char *buf;
@ -22,12 +52,12 @@ get_int(buf, size, class)
long l;
switch((int)size) {
case 1:
case sizeof(char):
l = *buf;
if (class == T_INTEGER && l >= 0x7F) l -= 256;
else if (class != T_INTEGER && l < 0) l += 256;
break;
case 2:
case sizeof(short):
l = *((short *) buf);
if (class == T_INTEGER && l >= 0x7FFF) l -= 65536;
else if (class != T_INTEGER && l < 0) l += 65536;
@ -38,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;
}

4
util/grind/expr.h
View file

@ -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

2
util/grind/langdep.cc
View file

@ -46,6 +46,6 @@ find_language(suff)
p = p->l_next;
}
if (! currlang) {
currlang = def_dep;
currlang = c_dep;
}
}

7
util/grind/langdep.h
View file

@ -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();

49
util/grind/modula-2.c
View file

@ -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);

1
util/grind/operators.ot
View file

@ -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

21
util/grind/print.c
View file

@ -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;
}

30
util/grind/run.c
View file

@ -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;

15
util/grind/symbol.c
View file

@ -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);

9
util/grind/symbol.hh
View file

@ -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;

2
util/grind/tokenname.c
View file

@ -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, ""}
};

45
util/grind/tree.c
View file

@ -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;

21
util/grind/type.c
View file

@ -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;
}

5
util/grind/type.hh
View file

@ -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;

159
util/grind/value.c
View file

@ -1,12 +1,14 @@
/* $Header$ */
#include <alloc.h>
#include <assert.h>
#include "position.h"
#include "scope.h"
#include "symbol.h"
#include "type.h"
#include "message.h"
#include "langdep.h"
int stack_offset; /* for up and down commands */
@ -14,70 +16,27 @@ extern long pointer_size;
extern t_addr *get_EM_regs();
extern char *memcpy();
/* Get the value of the symbol indicated by sym.
/* Get the address of the object indicated by sym.
Return 0 on failure,
1 on success.
On success, 'buf' contains the value, and 'size' contains the size.
For 'buf', storage is allocated by Malloc; this storage must
be freed by caller (I don't like this any more than you do, but caller
does not know sizes).
address on success.
*psize will contain size of object.
*/
int
get_value(sym, buf, psize)
t_addr
get_addr(sym, psize)
register p_symbol sym;
char **buf;
long *psize;
long *psize;
{
p_type tp = sym->sy_type;
long size = tp->ty_size;
int retval = 0;
t_addr *EM_regs;
int i;
p_scope sc, symsc;
char *AB;
*buf = 0;
*psize = size;
switch(sym->sy_class) {
case VAR:
/* exists if child exists; nm_value contains addres */
*buf = Malloc((unsigned) size);
if (get_bytes(size, (t_addr) sym->sy_name.nm_value, *buf)) {
retval = 1;
}
break;
case CONST:
*buf = Malloc((unsigned) size);
switch(tp->ty_class) {
case T_REAL:
if (size != sizeof(double)) {
*((float *) *buf) = sym->sy_const.co_rval;
}
else *((double *) *buf) = sym->sy_const.co_rval;
break;
case T_INTEGER:
case T_SUBRANGE:
case T_UNSIGNED:
case T_ENUM:
if (size == 1) {
*((char *) *buf) = sym->sy_const.co_ival;
}
else if (size == 2) {
*((short *) *buf) = sym->sy_const.co_ival;
}
else {
*((long *) *buf) = sym->sy_const.co_ival;
}
break;
case T_SET:
memcpy(*buf, sym->sy_const.co_setval, (int) size);
break;
case T_STRING:
memcpy(*buf, sym->sy_const.co_sval, (int) size);
break;
default:
fatal("strange constant");
}
retval = 1;
return (t_addr) sym->sy_name.nm_value;
break;
case VARPAR:
case LOCVAR:
@ -110,17 +69,8 @@ get_value(sym, buf, psize)
if (sym->sy_class == LOCVAR) {
/* Either local variable or value parameter */
*buf = Malloc((unsigned) size);
if (get_bytes(size,
EM_regs[sym->sy_name.nm_value < 0
? LB_OFF
: AB_OFF
] +
(t_addr) sym->sy_name.nm_value,
*buf)) {
retval = 1;
}
break;
return EM_regs[sym->sy_name.nm_value < 0 ? LB_OFF : AB_OFF] +
(t_addr) sym->sy_name.nm_value;
}
/* If we get here, we have a var parameter. Get the parameters
@ -128,6 +78,8 @@ get_value(sym, buf, psize)
*/
{
p_type proctype = sc->sc_definedby->sy_type;
t_addr a;
char *AB;
size = proctype->ty_nbparams;
if (has_static_link(sc)) size += pointer_size;
@ -137,15 +89,84 @@ get_value(sym, buf, psize)
}
if ((size = tp->ty_size) == 0) {
size = compute_size(tp, AB);
*psize = size;
}
a = (t_addr) BUFTOA(AB+sym->sy_name.nm_value);
free(AB);
return a;
}
default:
break;
}
return 0;
}
/* Get the value of the symbol indicated by sym.
Return 0 on failure,
1 on success.
On success, 'buf' contains the value, and 'size' contains the size.
For 'buf', storage is allocated by Malloc; this storage must
be freed by caller (I don't like this any more than you do, but caller
does not know sizes).
*/
int
get_value(sym, buf, psize)
register p_symbol sym;
char **buf;
long *psize;
{
p_type tp = sym->sy_type;
int retval = 0;
t_addr a;
long size = tp->ty_size;
*buf = 0;
switch(sym->sy_class) {
case CONST:
*buf = Malloc((unsigned) size);
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;
}