register char *np = &buf[1];
/* allow a '-' to be added */
+ buf[0] = '-';
*np++ = ch;
LoadChar(ch);
COBJ = LLlex.o LLmessage.o char.o error.o main.o \
symbol2str.o tokenname.o idf.o input.o type.o def.o \
scope.o misc.o enter.o defmodule.o typequiv.o node.o \
- cstoper.o
+ cstoper.o chk_expr.o
OBJ = $(COBJ) $(LOBJ) Lpars.o
GENFILES= tokenfile.c \
program.c declar.c expression.c statement.c \
clean:
rm -f $(OBJ) $(GENFILES) LLfiles
+lint: LLfiles lintlist
+ lint $(INCLUDES) `cat lintlist`
+
tokenfile.g: tokenname.c make.tokfile
make.tokfile <tokenname.c >tokenfile.g
LLmessage.o: LLlex.h Lpars.h idf.h
char.o: class.h
error.o: LLlex.h f_info.h input.h main.h node.h
-main.o: LLlex.h Lpars.h debug.h def.h f_info.h idf.h input.h main.h scope.h standards.h type.h
+main.o: LLlex.h Lpars.h debug.h def.h f_info.h idf.h input.h scope.h standards.h tokenname.h type.h
symbol2str.o: Lpars.h
tokenname.o: Lpars.h idf.h tokenname.h
idf.o: idf.h
input.o: f_info.h input.h
type.o: LLlex.h Lpars.h def.h def_sizes.h idf.h node.h type.h
def.o: LLlex.h Lpars.h debug.h def.h idf.h main.h node.h scope.h type.h
-scope.o: LLlex.h debug.h def.h idf.h main.h scope.h type.h
-misc.o: LLlex.h f_info.h idf.h misc.h
+scope.o: LLlex.h debug.h def.h idf.h node.h scope.h type.h
+misc.o: LLlex.h f_info.h idf.h misc.h node.h
enter.o: LLlex.h def.h idf.h node.h scope.h type.h
-defmodule.o: LLlex.h def.h f_info.h idf.h input.h scope.h
+defmodule.o: LLlex.h debug.h def.h f_info.h idf.h input.h scope.h
typequiv.o: Lpars.h def.h type.h
-node.o: LLlex.h debug.h def.h main.h node.h type.h
-cstoper.o: Lpars.h def_sizes.h idf.h node.h type.h
+node.o: LLlex.h debug.h def.h node.h type.h
+cstoper.o: LLlex.h Lpars.h def_sizes.h idf.h node.h type.h
+chk_expr.o: LLlex.h Lpars.h def.h idf.h node.h scope.h type.h
tokenfile.o: Lpars.h
program.o: LLlex.h Lpars.h debug.h def.h idf.h main.h node.h scope.h type.h
declar.o: LLlex.h Lpars.h def.h idf.h misc.h node.h scope.h type.h
-expression.o: LLlex.h Lpars.h debug.h def.h idf.h main.h node.h scope.h
+expression.o: LLlex.h Lpars.h const.h debug.h def.h idf.h node.h scope.h type.h
statement.o: LLlex.h Lpars.h node.h
Lpars.o: Lpars.h
--- /dev/null
+/* E X P R E S S I O N C H E C K I N G */
+
+static char *RcsId = "$Header$";
+
+/* Check expressions, and try to evaluate them as far as possible.
+*/
+#include <em_arith.h>
+#include <em_label.h>
+#include <assert.h>
+#include "idf.h"
+#include "type.h"
+#include "def.h"
+#include "LLlex.h"
+#include "node.h"
+#include "Lpars.h"
+#include "scope.h"
+
+int
+chk_expr(expp, const)
+ register struct node *expp;
+{
+ /* Check the expression indicated by expp for semantic errors,
+ identify identifiers used in it, replace constants by
+ their value.
+ */
+
+ switch(expp->nd_class) {
+ case Oper:
+ return chk_expr(expp->nd_left, const) &&
+ chk_expr(expp->nd_right, const) &&
+ chk_oper(expp, const);
+ case Uoper:
+ return chk_expr(expp->nd_right, const) &&
+ chk_uoper(expp, const);
+ case Value:
+ switch(expp->nd_symb) {
+ case REAL:
+ case STRING:
+ case INTEGER:
+ return 1;
+ default:
+ assert(0);
+ }
+ break;
+ case Xset:
+ return chk_set(expp, const);
+ case Name:
+ return chk_name(expp, const);
+ case Call:
+ return chk_call(expp, const);
+ case Link:
+ return chk_name(expp, const);
+ }
+ /*NOTREACHED*/
+}
+
+int
+chk_set(expp, const)
+ register struct node *expp;
+{
+ /* ??? */
+ return 1;
+}
+
+int
+chk_call(expp, const)
+ register struct node *expp;
+{
+ /* ??? */
+ return 1;
+}
+
+struct def *
+findname(expp)
+ register struct node *expp;
+{
+ /* Find the name indicated by "expp", starting from the current
+ scope.
+ */
+ register struct def *df;
+ struct def *lookfor();
+ register struct node *nd;
+ int scope;
+ int module;
+
+ if (expp->nd_class == Name) {
+ return lookfor(expp, CurrentScope, 1);
+ }
+ assert(expp->nd_class == Link && expp->nd_symb == '.');
+ assert(expp->nd_left->nd_class == Name);
+ df = lookfor(expp->nd_left, CurrentScope, 1);
+ if (df->df_kind == D_ERROR) return df;
+ nd = expp;
+ while (nd->nd_class == Link) {
+ struct node *nd1;
+
+ if (!(scope = has_selectors(df))) {
+ node_error(nd, "identifier \"%s\" has no selectors",
+ df->df_idf->id_text);
+ return ill_df;
+ }
+ nd = nd->nd_right;
+ if (nd->nd_class == Name) nd1 = nd;
+ else nd1 = nd->nd_left;
+ module = (df->df_kind == D_MODULE);
+ df = lookup(nd1->nd_IDF, scope);
+ if (!df) {
+ id_not_declared(nd1);
+ return ill_df;
+ }
+ if (module && !(df->df_flags&(D_EXPORTED|D_QEXPORTED))) {
+node_error(nd1, "identifier \"%s\" not exprted from qualifying module",
+df->df_idf->id_text);
+ }
+ }
+ return df;
+}
+
+int
+chk_name(expp, const)
+ register struct node *expp;
+{
+ register struct def *df;
+ int retval = 1;
+
+ df = findname(expp);
+ if (df->df_kind == D_ERROR) {
+ retval = 0;
+ }
+ expp->nd_type = df->df_type;
+ if (df->df_kind == D_ENUM || df->df_kind == D_CONST) {
+ if (expp->nd_left) FreeNode(expp->nd_left);
+ if (expp->nd_right) FreeNode(expp->nd_right);
+ if (df->df_kind == D_ENUM) {
+ expp->nd_left = expp->nd_right = 0;
+ expp->nd_class = Value;
+ expp->nd_INT = df->enm_val;
+ expp->nd_symb = INTEGER;
+ }
+ else if (df->df_kind == D_CONST) {
+ *expp = *(df->con_const);
+ }
+ }
+ else if (const) {
+ node_error(expp, "constant expected");
+ retval = 0;
+ }
+ return retval;
+}
+
+int
+chk_oper(expp, const)
+ register struct node *expp;
+{
+ /* Check a binary operation. If "const" is set, also check
+ that it is constant.
+ The code is ugly !
+ */
+ register struct type *tpl = expp->nd_left->nd_type;
+ register struct type *tpr = expp->nd_right->nd_type;
+ char *symbol2str();
+ int errval = 1;
+
+ if (tpl == intorcard_type) {
+ if (tpr == int_type || tpr == card_type) {
+ expp->nd_left->nd_type = tpl = tpr;
+ }
+ }
+ if (tpr == intorcard_type) {
+ if (tpl == int_type || tpl == card_type) {
+ expp->nd_right->nd_type = tpr = tpl;
+ }
+ }
+
+ if (expp->nd_symb == IN) {
+ /* Handle this one specially */
+ expp->nd_type == bool_type;
+ if (tpr->tp_fund != SET) {
+node_error(expp, "RHS of IN operator not a SET type");
+ return 0;
+ }
+ if (!TstCompat(tpl, tpr->next)) {
+node_error(expp, "IN operator: type of LHS not compatible with element type of RHS");
+ return 0;
+ }
+ return 1;
+ }
+
+ if (tpl->tp_fund == SUBRANGE) tpl = tpl->next;
+ expp->nd_type = tpl;
+
+ if (!TstCompat(tpl, tpr)) {
+node_error(expp, "Incompatible types for operator \"%s\"", symbol2str(expp->nd_symb));
+ return 0;
+ }
+
+ switch(expp->nd_symb) {
+ case '+':
+ case '-':
+ case '*':
+ switch(tpl->tp_fund) {
+ case INTEGER:
+ case INTORCARD:
+ case CARDINAL:
+ case LONGINT:
+ case SET:
+ if (expp->nd_left->nd_class == Value &&
+ expp->nd_right->nd_class == Value) {
+ cstbin(expp);
+ }
+ return 1;
+ case REAL:
+ case LONGREAL:
+ if (const) {
+ errval = 2;
+ break;
+ }
+ return 1;
+ }
+ break;
+ case '/':
+ switch(tpl->tp_fund) {
+ case SET:
+ if (expp->nd_left->nd_class == Value &&
+ expp->nd_right->nd_class == Value) {
+ cstbin(expp);
+ }
+ return 1;
+ case REAL:
+ case LONGREAL:
+ if (const) {
+ errval = 2;
+ break;
+ }
+ return 1;
+ }
+ break;
+ case DIV:
+ case MOD:
+ switch(tpl->tp_fund) {
+ case INTEGER:
+ case INTORCARD:
+ case CARDINAL:
+ case LONGINT:
+ if (expp->nd_left->nd_class == Value &&
+ expp->nd_right->nd_class == Value) {
+ cstbin(expp);
+ }
+ return 1;
+ }
+ break;
+ case OR:
+ case AND:
+ if (tpl == bool_type) {
+ if (expp->nd_left->nd_class == Value &&
+ expp->nd_right->nd_class == Value) {
+ cstbin(expp);
+ }
+ return 1;
+ }
+ errval = 3;
+ break;
+ case '=':
+ case '#':
+ case GREATEREQUAL:
+ case LESSEQUAL:
+ case '<':
+ case '>':
+ switch(tpl->tp_fund) {
+ case SET:
+ if (expp->nd_symb == '<' || expp->nd_symb == '>') {
+ break;
+ }
+ case INTEGER:
+ case INTORCARD:
+ case LONGINT:
+ case CARDINAL:
+ case ENUMERATION: /* includes boolean */
+ case CHAR:
+ if (expp->nd_left->nd_class == Value &&
+ expp->nd_right->nd_class == Value) {
+ cstbin(expp);
+ }
+ return 1;
+ case POINTER:
+ if (!(expp->nd_symb == '=' || expp->nd_symb == '#')) {
+ break;
+ }
+ /* Fall through */
+ case REAL:
+ case LONGREAL:
+ if (const) {
+ errval = 2;
+ break;
+ }
+ return 1;
+ }
+ default:
+ assert(0);
+ }
+ switch(errval) {
+ case 1:
+ node_error(expp,"Operator \"%s\": illegal operand type(s)", symbol2str(expp->nd_symb));
+ break;
+ case 2:
+ node_error(expp, "Expression not constant");
+ break;
+ case 3:
+ node_error(expp, "BOOLEAN type(s) expected");
+ break;
+ }
+ return 0;
+}
+
+int
+chk_uoper(expp, const)
+ register struct node *expp;
+{
+ /* Check an unary operation. If "const" is set, also check that
+ it can be evaluated compile-time.
+ */
+ register struct type *tpr = expp->nd_right->nd_type;
+
+ if (tpr->tp_fund == SUBRANGE) tpr = tpr->next;
+ expp->nd_type = tpr;
+
+ switch(expp->nd_symb) {
+ case '+':
+ switch(tpr->tp_fund) {
+ case INTEGER:
+ case LONGINT:
+ case REAL:
+ case LONGREAL:
+ case CARDINAL:
+ case INTORCARD:
+ expp->nd_token = expp->nd_right->nd_token;
+ FreeNode(expp->nd_right);
+ expp->nd_right = 0;
+ return 1;
+ }
+ break;
+ case '-':
+ switch(tpr->tp_fund) {
+ case INTEGER:
+ case LONGINT:
+ case INTORCARD:
+ if (expp->nd_right->nd_class == Value) {
+ cstunary(expp);
+ }
+ return 1;
+ case REAL:
+ case LONGREAL:
+ if (expp->nd_right->nd_class == Value) {
+ expp->nd_token = expp->nd_right->nd_token;
+ if (*(expp->nd_REL) == '-') {
+ expp->nd_REL++;
+ }
+ else expp->nd_REL--;
+ FreeNode(expp->nd_right);
+ expp->nd_right = 0;
+ }
+ return 1;
+ }
+ break;
+ case NOT:
+ if (tpr == bool_type) {
+ if (expp->nd_right->nd_class == Value) {
+ cstunary(expp);
+ }
+ return 1;
+ }
+ break;
+ default:
+ assert(0);
+ }
+ node_error(expp, "Illegal operand for unary operator \"%s\"",
+ symbol2str(expp->nd_symb));
+ return 0;
+}
arith max_unsigned; /* maximum unsigned on target machine */
arith max_longint; /* maximum longint on target machine */
-cstunary(expp, oper)
+cstunary(expp)
register struct node *expp;
{
- /* The unary operation oper is performed on the constant
- expression expp, and the result restored in expp.
+ /* The unary operation in "expp" is performed on the constant
+ expression below it, and the result restored in expp.
*/
- arith o1 = expp->nd_INT;
+ arith o1 = expp->nd_right->nd_INT;
- switch(oper) {
+ switch(expp->nd_symb) {
case '+':
- return;
+ break;
case '-':
o1 = -o1;
break;
default:
assert(0);
}
+ expp->nd_class = Value;
+ expp->nd_token = expp->nd_right->nd_token;
expp->nd_INT = o1;
cut_size(expp);
+ FreeNode(expp->nd_right);
+ expp->nd_right = 0;
}
-cstbin(expp, oper, expr)
- register struct node *expp, *expr;
+cstbin(expp)
+ register struct node *expp;
{
- /* The binary operation oper is performed on the constant
- expressions expp and expr, and the result restored in
+ /* The binary operation in "expp" is performed on the constant
+ expressions below it, and the result restored in
expp.
*/
- arith o1 = expp->nd_INT;
- arith o2 = expr->nd_INT;
+ arith o1 = expp->nd_left->nd_INT;
+ arith o2 = expp->nd_right->nd_INT;
int uns = expp->nd_type != int_type;
- assert(expp->nd_class == Value && expr->nd_class == Value);
- switch (oper) {
- case IN:
- /* ??? */
+ assert(expp->nd_class == Oper);
+ if (expp->nd_right->nd_type->tp_fund == SET) {
+ cstset(expp);
return;
+ }
+ switch (expp->nd_symb) {
case '*':
- if (expp->nd_type->tp_fund == SET) {
- /* ??? */
- return;
- }
o1 *= o2;
break;
- case '/':
- assert(expp->nd_type->tp_fund == SET);
- /* ??? */
- return;
case DIV:
if (o2 == 0) {
- node_error(expr, "division by 0");
+ node_error(expp, "division by 0");
return;
}
if (uns) {
break;
case MOD:
if (o2 == 0) {
- node_error(expr, "modulo by 0");
+ node_error(expp, "modulo by 0");
return;
}
if (uns) {
o1 %= o2;
break;
case '+':
- if (expp->nd_type->tp_fund == SET) {
- /* ??? */
- return;
- }
o1 += o2;
break;
case '-':
- if (expp->nd_type->tp_fund == SET) {
- /* ??? */
- return;
- }
o1 -= o2;
break;
case '<':
o1 = o1 > o2;
break;
case LESSEQUAL:
- if (expp->nd_type->tp_fund == SET) {
- /* ??? */
- return;
- }
if (uns) {
o1 = (o1 & mach_long_sign ?
(o2 & mach_long_sign ? o1 <= o2 : 0) :
o1 = o1 <= o2;
break;
case GREATEREQUAL:
- if (expp->nd_type->tp_fund == SET) {
- /* ??? */
- return;
- }
if (uns) {
o1 = (o1 & mach_long_sign ?
(o2 & mach_long_sign ? o1 >= o2 : 1) :
o1 = o1 >= o2;
break;
case '=':
- if (expp->nd_type->tp_fund == SET) {
- /* ??? */
- return;
- }
o1 = o1 == o2;
break;
case '#':
- if (expp->nd_type->tp_fund == SET) {
- /* ??? */
- return;
- }
o1 = o1 != o2;
break;
case AND:
default:
assert(0);
}
+ expp->nd_class = Value;
+ expp->nd_token = expp->nd_right->nd_token;
expp->nd_INT = o1;
cut_size(expp);
+ FreeNode(expp->nd_left);
+ FreeNode(expp->nd_right);
+ expp->nd_left = expp->nd_right = 0;
+}
+
+cstset(expp)
+ register struct node *expp;
+{
+ switch(expp->nd_symb) {
+ case IN:
+ case '+':
+ case '-':
+ case '*':
+ case '/':
+ case GREATEREQUAL:
+ case LESSEQUAL:
+ case '=':
+ case '#':
+ /* ??? */
+ break;
+ default:
+ assert(0);
+ }
}
cut_size(expr)
#include <em_arith.h>
#include <em_label.h>
+#include <alloc.h>
#include <assert.h>
#include "idf.h"
#include "LLlex.h"
if (doparams) {
EnterIdList(FPList, D_VARIABLE, VARp, tp, CurrentScope);
}
- *ppr = ParamList(FPList, tp);
+ *ppr = ParamList(FPList, tp, VARp);
FreeNode(FPList);
}
;
tp->tp_fund != POINTER) {
error("Opaque type \"%s\" is not a pointer type", df->df_idf->id_text);
}
-
+
}
;
SimpleType(struct type **ptp;)
{
struct def *df;
- struct type *tp;
} :
qualident(D_TYPE | D_HTYPE, &df, "type", (struct node **) 0)
[
/* nothing */
+ { *ptp = df->df_type; }
|
SubrangeType(ptp)
/* The subrange type is given a base type by the
qualident (this is new modula-2).
*/
{
- chk_basesubrange(*ptp, tp);
+ chk_basesubrange(*ptp, df->df_type);
}
]
|
{
/* For the time being: */
tp = int_type;
- tp = construct_type(SUBRANGE, tp, (arith) 0);
+ tp = construct_type(SUBRANGE, tp);
*ptp = tp;
}
;
} :
SET OF SimpleType(&tp)
{
- *ptp = construct_type(SET, tp, (arith) 0 /* ???? */);
+ *ptp = construct_type(SET, tp);
}
;
struct type *tp;
struct def *df;
struct def *lookfor();
+ struct node *nd;
} :
POINTER TO
[ %if ( (df = lookup(dot.TOK_IDF, CurrentScope->sc_scope)))
}
else tp = df->df_type;
}
- | %if (df = lookfor(dot.TOK_IDF, CurrentScope, 0),
- df->df_kind == D_MODULE)
+ | %if ( nd = new_node(), nd->nd_token = dot,
+ df = lookfor(nd, CurrentScope, 0), free_node(nd),
+ df->df_kind == D_MODULE)
type(&tp)
|
IDENT
}:
IDENT { id = dot.TOK_IDF; }
'=' ConstExpression(&nd){ df = define(id, CurrentScope, D_CONST);
- /* ???? */
+ df->con_const = nd;
}
;
};
struct constant {
- arith co_const; /* result of a constant expression */
-#define con_const df_value.df_variable.con_const
+ struct node *co_const; /* result of a constant expression */
+#define con_const df_value.df_constant.co_const
};
struct enumval {
#include <em_arith.h>
#include <em_label.h>
#include <assert.h>
+#include "main.h"
#include "Lpars.h"
#include "def.h"
#include "type.h"
#include "idf.h"
-#include "main.h"
#include "scope.h"
#include "LLlex.h"
#include "node.h"
struct def *
define(id, scope, kind)
register struct idf *id;
- struct scope *scope;
+ register struct scope *scope;
{
/* Declare an identifier in a scope, but first check if it
already has been defined. If so, error message.
*/
register struct def *df;
- register struct scope *sc;
DO_DEBUG(5, debug("Defining identifier \"%s\" in scope %d", id->id_text, scope->sc_scope));
df = lookup(id, scope->sc_scope);
identifiers defined in this module.
*/
register struct def *df;
- register struct idf *id = 0;
int scope;
int kind;
int imp_kind;
#define FROM_ENCLOSING 1
struct def *lookfor(), *GetDefinitionModule();
- if (idn) id = idn->nd_IDF;
kind = D_IMPORT;
scope = enclosing(CurrentScope)->sc_scope;
- if (!id) imp_kind = FROM_ENCLOSING;
+ if (!idn) imp_kind = FROM_ENCLOSING;
else {
imp_kind = FROM_MODULE;
- if (local) df = lookfor(id, enclosing(CurrentScope), 1);
- else df = GetDefinitionModule(id);
+ if (local) df = lookfor(idn, enclosing(CurrentScope), 1);
+ else df = GetDefinitionModule(idn->nd_IDF);
if (df->df_kind != D_MODULE) {
/* enter all "ids" with type D_ERROR */
kind = D_ERROR;
if (df->df_kind != D_ERROR) {
-node_error(idn, "identifier \"%s\" does not represent a module", id->id_text);
+node_error(idn, "identifier \"%s\" does not represent a module", idn->nd_IDF->id_text);
}
}
else scope = df->mod_scope;
}
else {
if (local) {
- df = lookfor(ids->nd_IDF,
- enclosing(CurrentScope), 0);
+ df = lookfor(ids, enclosing(CurrentScope), 0);
} else df = GetDefinitionModule(ids->nd_IDF);
if (df->df_kind == D_ERROR) {
node_error(ids, "identifier \"%s\" not visible in enclosing scope",
ids->nd_IDF->id_text);
}
}
+ DO_DEBUG(2, debug("importing \"%s\", kind %d", ids->nd_IDF->id_text, df->df_kind));
define(ids->nd_IDF, CurrentScope, kind)->imp_def = df;
if (df->df_kind == D_TYPE &&
df->df_type->tp_fund == ENUMERATION) {
exprt_literals(df, toscope)
register struct def *df;
- register struct scope *toscope;
+ struct scope *toscope;
{
/* A list of enumeration literals is exported. This is implemented
as an import from the scope "toscope".
*/
+ DO_DEBUG(2, debug("enumeration import:"));
while (df) {
+ DO_DEBUG(2, debug(df->df_idf->id_text));
define(df->df_idf, toscope, D_IMPORT)->imp_def = df;
df = df->enm_next;
}
#include "def.h"
#include "LLlex.h"
#include "f_info.h"
+#include "debug.h"
+
+#ifdef DEBUG
+long sys_filesize();
+#endif
GetFile(name)
char *name;
fatal("Could'nt find a DEFINITION MODULE for \"%s\"", name);
}
LineNumber = 1;
+ DO_DEBUG(1, debug("File %s : %ld characters", FileName, sys_filesize(FileName)));
}
struct def *
struct def *
lookfor(id, scope, give_error)
- struct idf *id;
+ struct node *id;
struct scope *scope;
{
/* Look for an identifier in the visibility range started by
register struct scope *sc = scope;
while (sc) {
- df = lookup(id, sc->sc_scope);
+ df = lookup(id->nd_IDF, sc->sc_scope);
if (df) return df;
sc = nextvisible(sc);
}
if (give_error) id_not_declared(id);
- return define(id, scope, D_ERROR);
+ return define(id->nd_IDF, scope, D_ERROR);
}
#include <alloc.h>
#include <em_arith.h>
#include <em_label.h>
-#include "main.h"
#include "LLlex.h"
#include "idf.h"
#include "def.h"
qualident(int types; struct def **pdf; char *str; struct node **p;)
{
- int scope;
- int module;
register struct def *df;
- struct def *lookfor();
register struct node **pnd;
struct node *nd;
+ struct def *findname();
} :
- IDENT { if (types) {
- df = lookfor(dot.TOK_IDF, CurrentScope, 1);
- *pdf = df;
- if (df->df_kind == D_ERROR) types = 0;
- }
- nd = MkNode(Value, NULLNODE, NULLNODE, &dot);
+ IDENT { nd = MkNode(Name, NULLNODE, NULLNODE, &dot);
pnd = &nd;
}
[
- { if (types &&!(scope = has_selectors(df))) {
- types = 0;
- *pdf = ill_df;
- }
- }
/* selector */
'.' { *pnd = MkNode(Link,*pnd,NULLNODE,&dot);
pnd = &(*pnd)->nd_right;
}
IDENT
- { *pnd = MkNode(Value,NULLNODE,NULLNODE,&dot);
- if (types) {
- module = (df->df_kind == D_MODULE);
- df = lookup(dot.TOK_IDF, scope);
- if (!df) {
- types = 0;
- df = ill_df;
- id_not_declared(dot.TOK_IDF);
- }
- else
- if (module &&
- !(df->df_flags&(D_EXPORTED|D_QEXPORTED))) {
- error("identifier \"%s\" not exported from qualifying module", dot.TOK_IDF->id_text);
- }
- }
- }
+ { *pnd = MkNode(Name,NULLNODE,NULLNODE,&dot); }
]*
- { if (types && !(types & df->df_kind)) {
- error("identifier \"%s\" is not a %s",
+ { if (types) {
+ *pdf = df = findname(nd);
+ if (df->df_kind != D_ERROR &&
+ !(types & df->df_kind)) {
+ error("identifier \"%s\" is not a %s",
df->df_idf->id_text, str);
+ }
}
if (!p) FreeNode(nd);
else *p = nd;
{ DO_DEBUG(3,
( debug("Constant expression:"),
PrNode(*pnd)));
+ (void) chk_expr(*pnd, 1);
}
;
'(' expression(p) ')'
|
NOT { *p = MkNode(Uoper, NULLNODE, NULLNODE, &dot); }
- factor(&((*p)->nd_left))
+ factor(&((*p)->nd_right))
;
bare_set(struct node **pnd;)
} :
'{' {
dot.tk_symb = SET;
- *pnd = nd = MkNode(Link, NULLNODE, NULLNODE, &dot);
+ *pnd = nd = MkNode(Xset, NULLNODE, NULLNODE, &dot);
nd->nd_type = bitset_type;
}
[
visible_designator_tail(pnd)
[
/* selector */
- '.' { *pnd = MkNode(Oper, *pnd, NULLNODE, &dot); }
+ '.' { *pnd = MkNode(Link, *pnd, NULLNODE, &dot); }
IDENT { (*pnd)->nd_right =
- MkNode(Value, NULLNODE, NULLNODE, &dot);
+ MkNode(Name, NULLNODE, NULLNODE, &dot);
}
|
visible_designator_tail(pnd)
#include "idf.h"
#include "LLlex.h"
#include "Lpars.h"
-#include "main.h"
#include "debug.h"
#include "type.h"
#include "def.h"
#include "scope.h"
#include "standards.h"
+#include "tokenname.h"
char options[128];
int DefinitionModule;
add_standards()
{
register struct def *df;
- register struct type *tp;
struct def *Enter();
(void) Enter("ABS", D_STDFUNC, NULLTYPE, S_ABS);
0);
df = Enter("BITSET", D_TYPE, bitset_type, 0);
df = Enter("FALSE", D_ENUM, bool_type, 0);
- df->df_value.df_enum.en_val = 0;
- df->df_value.df_enum.en_next = Enter("TRUE", D_ENUM, bool_type, 0);
- df = df->df_value.df_enum.en_next;
- df->df_value.df_enum.en_val = 1;
- df->df_value.df_enum.en_next = 0;
+ df->enm_val = 0;
+ df->enm_next = Enter("TRUE", D_ENUM, bool_type, 0);
+ df = df->enm_next;
+ df->enm_val = 1;
+ df->enm_next = 0;
}
init_DEFPATH()
#include "misc.h"
#include "LLlex.h"
#include "idf.h"
+#include "node.h"
match_id(id1, id2)
struct idf *id1, *id2;
}
id_not_declared(id)
- struct idf *id;
+ struct node *id;
{
/* The identifier "id" is not declared. If it is not generated,
give an error message
*/
- if (!is_anon_idf(id)) {
- error("identifier \"%s\" not declared", id->id_text);
+ if (!is_anon_idf(id->nd_IDF)) {
+ node_error(id,
+ "identifier \"%s\" not declared", id->nd_IDF->id_text);
}
}
#define nd_left next
struct node *nd_right;
int nd_class; /* kind of node */
-#define Value 1 /* idf or constant */
+#define Value 1 /* constant */
#define Oper 2 /* binary operator */
#define Uoper 3 /* unary operator */
#define Call 4 /* cast or procedure - or function call */
-#define Link 5
+#define Name 5 /* a qualident */
+#define Set 6 /* a set constant */
+#define Xset 7 /* a set */
+#define Def 8 /* an identified name */
+#define Link 11
struct type *nd_type; /* type of this node */
union {
- struct token ndu_token;
- char *ndu_set; /* Pointer to a set constant */
+ struct token ndu_token; /* (Value, Oper, Uoper, Call, Name,
+ Link)
+ */
+ arith *ndu_set; /* pointer to a set constant (Set) */
+ struct def *ndu_def; /* pointer to definition structure for
+ identified name (Def)
+ */
} nd_val;
#define nd_token nd_val.ndu_token
#define nd_set nd_val.ndu_set
+#define nd_def nd_val.ndu_def
#define nd_symb nd_token.tk_symb
#define nd_lineno nd_token.tk_lineno
#define nd_filename nd_token.tk_filename
#include <em_arith.h>
#include <alloc.h>
#include <system.h>
-#include "main.h"
#include "def.h"
#include "type.h"
#include "LLlex.h"
#include <alloc.h>
#include <em_arith.h>
#include <em_label.h>
-#include "idf.h"
#include "main.h"
+#include "idf.h"
#include "LLlex.h"
#include "scope.h"
#include "def.h"
definition
{
struct def *df;
- struct type *tp;
} :
CONST [ ConstantDeclaration ';' ]*
|
TYPE
[ IDENT { df = define(dot.TOK_IDF, CurrentScope, D_TYPE); }
- [ '=' type(&tp)
+ [ '=' type(&(df->df_type))
| /* empty */
/*
Here, the exported type has a hidden implementation.
#include "scope.h"
#include "type.h"
#include "def.h"
-#include "main.h"
+#include "node.h"
#include "debug.h"
static int maxscope; /* maximum assigned scope number */
register struct scope *sc1;
sc->sc_scope = scope == 0 ? ++maxscope : scope;
- sc->sc_forw = 0; sc->sc_def = 0;
+ sc->sc_forw = 0;
+ sc->sc_def = 0;
assert(scopetype == OPENSCOPE || scopetype == CLOSEDSCOPE);
DO_DEBUG(1, debug("Opening a %s scope",
scopetype == OPENSCOPE ? "open" : "closed"));
if (scopetype == CLOSEDSCOPE) {
sc1 = new_scope();
sc1->sc_scope = 0; /* Pervasive scope nr */
- sc1->sc_forw = 0; sc1->sc_def = 0;
+ sc1->sc_forw = 0;
+ sc1->sc_def = 0;
sc1->next = CurrentScope;
}
sc->next = sc1;
CurrentScope = sc;
}
-static rem_forwards();
-
-close_scope()
-{
- register struct scope *sc = CurrentScope;
-
- assert(sc != 0);
- DO_DEBUG(1, debug("Closing a scope"));
- if (sc->sc_forw) rem_forwards(sc->sc_forw);
- if (sc->next && (sc->next->sc_scope == 0)) {
- struct scope *sc1 = sc;
-
- sc = sc->next;
- free_scope(sc1);
- }
- CurrentScope = sc->next;
- free_scope(sc);
-}
-
init_scope()
{
register struct scope *sc = new_scope();
struct forwards {
struct forwards *next;
- struct token fo_tok;
+ struct node fo_tok;
struct type **fo_ptyp;
};
*/
register struct forwards *f = new_forwards();
- f->fo_tok = *tk;
+ f->fo_tok.nd_token = *tk;
f->fo_ptyp = ptp;
f->next = CurrentScope->sc_forw;
CurrentScope->sc_forw = f;
}
+close_scope()
+{
+ register struct scope *sc = CurrentScope;
+
+ assert(sc != 0);
+ DO_DEBUG(1, debug("Closing a scope"));
+ if (sc->sc_forw) rem_forwards(sc->sc_forw);
+ if (sc->next && (sc->next->sc_scope == 0)) {
+ struct scope *sc1 = sc;
+
+ sc = sc->next;
+ free_scope(sc1);
+ }
+ CurrentScope = sc->next;
+ free_scope(sc);
+}
+
static
rem_forwards(fo)
struct forwards *fo;
/* When closing a scope, all forward references must be resolved
*/
register struct forwards *f;
- struct token savetok;
register struct def *df;
struct def *lookfor();
- savetok = dot;
while (f = fo) {
- dot = f->fo_tok;
- df = lookfor(dot.TOK_IDF, CurrentScope, 1);
+ df = lookfor(&(f->fo_tok), CurrentScope, 1);
if (!(df->df_kind & (D_TYPE | D_HTYPE | D_ERROR))) {
- error("identifier \"%s\" not a type",
+ node_error(&(f->fo_tok), "identifier \"%s\" not a type",
df->df_idf->id_text);
}
*(f->fo_ptyp) = df->df_type;
fo = f->next;
free_forwards(f);
}
- dot = savetok;
}
|| tp1 == intorcard_type
|| tp1->tp_fund == POINTER
)
- );
+ )
+ ;
}
public / ack.git / commitdiff