value.c,
type.c,
rd.c,
+ default.c,
modula-2.c
} ;
% ISTOKEN
%
%C
-1:-abcefiprstuvxAEFGLMPQSTVX,;:+=()*
+1:-acefiprstuvxAEFGLMPQSTVX,;:+=()*
%T char istoken[] = {
%p
%T};
#include "tree.h"
#include "langdep.h"
#include "token.h"
+#include "expr.h"
extern char *Salloc();
extern t_lineno currline;
|
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;)
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)
']'
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;
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)
:
'='
[
+/*
'b' integer_const(&(cst->sy_const.co_ival)) /* boolean */
- |
+/* |
+*/
'c' integer_const(&(cst->sy_const.co_ival)) /* character */
{ cst->sy_type = char_type; }
|
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); }
--- /dev/null
+/* $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;
+ }
+}
/* $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;
}
--- /dev/null
+/* $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
if (! strcmp(p->l_suff, suff)) break;
p = p->l_next;
}
+ if (! currlang) {
+ currlang = def_dep;
+ }
}
/* 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) */
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();
extern char *dirs[];
extern FILE *fopen();
extern FILE *db_out;
+extern t_lineno currline;
#define window_size 21
static int
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);
/* 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();
get_number(),
get_name(),
get_token(),
+ get_string(),
+ print_op(),
op_prio();
static long
array_elsize();
static struct langdep m2 = {
+ 1,
+
"%ld",
"%loB",
"%lXH",
get_string,
get_name,
get_number,
- get_token
+ get_token,
+ print_op
};
struct langdep *m2_dep = &m2;
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;
}
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;
+ }
+}
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) {
#include "scope.h"
#include "symbol.h"
#include "langdep.h"
+#include "type.h"
extern FILE *db_out;
extern t_lineno currline;
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);
{
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");
do_print(p)
p_tree p;
{
- p_symbol sym;
+ char *buf;
+ long size;
+ p_type tp;
switch(p->t_oper) {
case OP_PRINT:
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;
}
}
#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;
};
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)
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;
}
}
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;
}
/*
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
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;
}
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;
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 {
}
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");
}
}
*buf = Malloc((unsigned) size);
- *psize = size;
if (get_bytes(size,
(t_addr) BUFTOA(AB+sym->sy_name.nm_value),
*buf)) {
*buf = 0;
*psize = 0;
}
+ else *psize = size;
return retval;
}
public / ack.git / commitdiff