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-12 16:13:59 +00:00
parent 74f3d91777
commit bd18f6c521
16 changed files with 1327 additions and 191 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
util/grind/Amakefile
View file

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

2
util/grind/char.ct
View file

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

154
util/grind/commands.g
View file

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

11
util/grind/dbx_string.g
View file

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

340
util/grind/default.c Normal file
View file

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

757
util/grind/expr.c
View file

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

28
util/grind/expr.h Normal file
View file

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

3
util/grind/langdep.cc
View file

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

6
util/grind/langdep.h
View file

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

3
util/grind/list.c
View file

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

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

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

4
util/grind/print.c
View file

@ -176,10 +176,10 @@ print_val(tp, tp_sz, addr, compressed, indent)
for (i = tp->ty_nfields; i; i--, fld++) {
long sz = fld->fld_type->ty_size;
if (! compressed) fprintf(db_out, "%s = ", fld->fld_name);
if (fld->fld_bitsize != sz << 3) {
if (fld->fld_bitsize < sz << 3) {
/* apparently a bit field */
/* ??? */
fprintf(db_out, "<bitfield, %d, %d>", fld->fld_bitsize, fld->fld_type->ty_size);
fprintf(db_out, "<bitfield, %d, %ld>", fld->fld_bitsize, sz);
}
else print_val(fld->fld_type, sz, addr+(fld->fld_pos>>3), compressed, indent);
if (compressed && i > 1) {

34
util/grind/tree.c
View file

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

14
util/grind/type.c
View file

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

3
util/grind/type.hh
View file

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

14
util/grind/value.c
View file

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