# make modula-2 "compiler"
# $Header$
+EMDIR = /usr/em
+MHDIR = $(EMDIR)/modules/h
+PKGDIR = $(EMDIR)/modules/pkg
+LIBDIR = $(EMDIR)/modules/lib
+LLGEN = $(EMDIR)/util/LLgen/src/LLgen
-HDIR = ../../em/h
-PKGDIR = ../../em/pkg
-LIBDIR = ../../em/lib
-
-INCLUDES = -I$(HDIR) -I/usr/em/h -I$(PKGDIR) -I/user1/erikb/em/h
+INCLUDES = -I$(MHDIR) -I$(EMDIR)/h -I$(PKGDIR)
LSRC = tokenfile.g program.g declar.g expression.g statement.g
CC = cc
-GEN = /usr/em/util/LLgen/src/LLgen
-GENOPTIONS = -d
+LLGENOPTIONS = -d
PROFILE =
CFLAGS = $(PROFILE) $(INCLUDES) -DSTATIC=
LINTFLAGS = -DSTATIC= -DNORCSID
GENGFILES= tokenfile.g
GENHFILES= errout.h\
idfsize.h numsize.h strsize.h target_sizes.h debug.h\
- inputtype.h maxset.h ndir.h density.h
+ inputtype.h maxset.h ndir.h density.h\
+ def.h type.h Lpars.h node.h
#
GENFILES = $(GENGFILES) $(GENCFILES) $(GENHFILES)
all:
make main
LLfiles: $(LSRC)
- $(GEN) $(GENOPTIONS) $(LSRC)
+ $(LLGEN) $(LLGENOPTIONS) $(LSRC)
@touch LLfiles
hfiles: Parameters make.hfiles
touch hfiles
main: $(OBJ) Makefile
- $(CC) $(LFLAGS) $(OBJ) /user1/erikb/em/lib/libem_mes.a /user1/erikb/em/lib/libeme.a $(LIBDIR)/libcomp.a $(LIBDIR)/malloc.o /user1/erikb/em/lib/libprint.a /user1/erikb/em/lib/libstr.a /user1/erikb/em/lib/libsystem.a -o main
+ $(CC) $(LFLAGS) $(OBJ) $(LIBDIR)/libem_mes.a $(LIBDIR)/libeme.a $(LIBDIR)/input.a $(LIBDIR)/assert.a $(LIBDIR)/alloc.a $(LIBDIR)/malloc.o $(LIBDIR)/libprint.a $(LIBDIR)/libstr.a $(LIBDIR)/libsystem.a -o main
size main
clean:
#include <em_label.h>
#include <em_arith.h>
+#include <em_code.h>
#include <alloc.h>
#include <assert.h>
#include <em_arith.h>
#include <em_label.h>
+#include <em_code.h>
#include <assert.h>
#include "type.h"
/* The unary operation in "expp" is performed on the constant
expression below it, and the result restored in expp.
*/
- arith o1 = expp->nd_right->nd_INT;
+ register arith o1 = expp->nd_right->nd_INT;
switch(expp->nd_symb) {
case '+':
break;
+
case '-':
o1 = -o1;
if (expp->nd_type->tp_fund == T_INTORCARD) {
expp->nd_type = int_type;
}
break;
+
case NOT:
case '~':
o1 = !o1;
break;
+
default:
crash("(cstunary)");
}
+
expp->nd_class = Value;
expp->nd_token = expp->nd_right->nd_token;
expp->nd_INT = o1;
expressions below it, and the result restored in
expp.
*/
- arith o1 = expp->nd_left->nd_INT;
- arith o2 = expp->nd_right->nd_INT;
+ register arith o1 = expp->nd_left->nd_INT;
+ register arith o2 = expp->nd_right->nd_INT;
int uns = expp->nd_type != int_type;
assert(expp->nd_class == Oper);
break;
case '<':
- if (uns) {
- o1 = (o1 & mach_long_sign ?
- (o2 & mach_long_sign ? o1 < o2 : 0) :
- (o2 & mach_long_sign ? 1 : o1 < o2)
- );
+ { arith tmp = o1;
+
+ o1 = o2;
+ o2 = tmp;
}
- else
- o1 = (o1 < o2);
- break;
+ /* Fall through */
case '>':
if (uns) {
else
o1 = (o1 > o2);
break;
+
case LESSEQUAL:
- if (uns) {
- o1 = (o1 & mach_long_sign ?
- (o2 & mach_long_sign ? o1 <= o2 : 0) :
- (o2 & mach_long_sign ? 1 : o1 <= o2)
- );
+ { arith tmp = o1;
+
+ o1 = o2;
+ o2 = tmp;
}
- else
- o1 = (o1 <= o2);
- break;
+ /* Fall through */
+
case GREATEREQUAL:
if (uns) {
o1 = (o1 & mach_long_sign ?
else
o1 = (o1 >= o2);
break;
+
case '=':
o1 = (o1 == o2);
break;
+
case '#':
o1 = (o1 != o2);
break;
+
case AND:
case '&':
o1 = (o1 && o2);
break;
+
case OR:
o1 = (o1 || o2);
break;
+
default:
crash("(cstbin)");
}
+
expp->nd_class = Value;
expp->nd_token = expp->nd_right->nd_token;
if (expp->nd_type == bool_type) expp->nd_symb = INTEGER;
cstset(expp)
register struct node *expp;
{
- register arith *set1 = 0, *set2;
+ register arith *set1, *set2;
arith *resultset = 0;
register int setsize, j;
expp->nd_left->nd_set = 0;
switch(expp->nd_symb) {
case '+':
+ /* Set union
+ */
if (!set1) {
resultset = set2;
expp->nd_right->nd_set = 0;
*set1++ |= *set2++;
}
break;
+
case '-':
+ /* Set difference
+ */
if (!set1 || !set2) {
/* The set from which something is substracted
is already empty, or the set that is
- substracted is empty
+ substracted is empty. In either case, the
+ result set is set1.
*/
break;
}
*set1++ &= ~*set2++;
}
break;
+
case '*':
- if (!set1) break;
+ /* Set intersection
+ */
+ if (!set1) {
+ /* set1 is empty, and so is the result set
+ */
+ break;
+ }
if (!set2) {
+ /* set 2 is empty, so the result set must be
+ empty too.
+ */
resultset = set2;
expp->nd_right->nd_set = 0;
break;
}
-
for (j = 0; j < setsize; j++) {
*set1++ &= *set2++;
}
break;
+
case '/':
+ /* Symmetric set difference
+ */
if (!set1) {
resultset = set2;
expp->nd_right->nd_set = 0;
break;
}
- if (set2) for (j = 0; j < setsize; j++) {
- *set1++ ^= *set2++;
+ if (set2) {
+ for (j = 0; j < setsize; j++) {
+ *set1++ ^= *set2++;
+ }
}
break;
+
case GREATEREQUAL:
case LESSEQUAL:
case '=':
case '#':
- /* Clumsy, but who cares? Nobody writes these things! */
- expp->nd_left->nd_set = set1;
+ /* Constant set comparisons
+ */
+ expp->nd_left->nd_set = set1; /* may be disposed of */
for (j = 0; j < setsize; j++) {
switch(expp->nd_symb) {
case GREATEREQUAL:
register struct node *expr = 0;
assert(expp->nd_class == Call);
+
if (expp->nd_right) {
expr = expp->nd_right->nd_left;
expp->nd_right->nd_left = 0;
FreeNode(expp->nd_right);
}
+
expp->nd_class = Value;
expp->nd_symb = INTEGER;
switch(call) {
else expp->nd_INT = expr->nd_INT;
CutSize(expp);
break;
+
case S_CAP:
if (expr->nd_INT >= 'a' && expr->nd_INT <= 'z') {
expp->nd_INT = expr->nd_INT + ('A' - 'a');
else expp->nd_INT = expr->nd_INT;
CutSize(expp);
break;
+
case S_CHR:
expp->nd_INT = expr->nd_INT;
CutSize(expp);
break;
+
case S_MAX:
if (expp->nd_type == int_type) {
expp->nd_INT = max_int;
}
else expp->nd_INT = expp->nd_type->enm_ncst - 1;
break;
+
case S_MIN:
if (expp->nd_type == int_type) {
expp->nd_INT = (-max_int) - 1;
}
else expp->nd_INT = 0;
break;
+
case S_ODD:
expp->nd_INT = (expr->nd_INT & 1);
break;
+
case S_ORD:
expp->nd_INT = expr->nd_INT;
CutSize(expp);
break;
+
case S_SIZE:
expp->nd_INT = WA(expr->nd_type->tp_size) / word_size;
break;
+
case S_VAL:
expp->nd_INT = expr->nd_INT;
if ( /* Check overflow of subranges or enumerations */
) node_warning(expp,"overflow in constant expression");
else CutSize(expp);
break;
+
default:
crash("(cstcall)");
}
/* The constant value of the expression expr is made to
conform to the size of the type of the expression.
*/
- arith o1 = expr->nd_INT;
- struct type *tp = BaseType(expr->nd_type);
+ register arith o1 = expr->nd_INT;
+ register struct type *tp = BaseType(expr->nd_type);
int uns;
int size = tp->tp_size;
if (o1 & ~full_mask[size]) {
node_warning(expr,
"overflow in constant expression");
+ o1 &= full_mask[size];
}
- o1 &= full_mask[size];
}
else {
int nbits = (int) (mach_long_size - size) * 8;
if (remainder != 0 && remainder != ~full_mask[size]) {
node_warning(expr, "overflow in constant expression");
+ o1 <<= nbits;
+ o1 >>= nbits;
}
- o1 <<= nbits;
- o1 >>= nbits;
}
expr->nd_INT = o1;
}
InitCst()
{
- int i = 0;
- arith bt = (arith)0;
+ register int i = 0;
+ register arith bt = (arith)0;
while (!(bt < 0)) {
bt = (bt << 8) + 0377, i++;
register struct def *df;
struct def *df1;
} :
- { proclevel++; }
+ { ++proclevel;
+ return_occurred = 0;
+ }
ProcedureHeading(&df1, D_PROCEDURE)
- {
- CurrentScope->sc_definedby = df = df1;
+ { CurrentScope->sc_definedby = df = df1;
df->prc_vis = CurrVis;
- return_occurred = 0;
}
';' block(&(df->prc_body)) IDENT
- {
- match_id(dot.TOK_IDF, df->df_idf);
+ { match_id(dot.TOK_IDF, df->df_idf);
close_scope(SC_CHKFORW|SC_REVERSE);
if (! return_occurred && ResultType(df->df_type)) {
-error("function procedure does not return a value", df->df_idf->id_text);
+error("function procedure %s does not return a value", df->df_idf->id_text);
}
- proclevel--;
+ --proclevel;
}
;
struct paramlist *params = 0;
struct type *tp = 0;
register struct def *df;
- struct def *DeclProc();
arith NBytesParams;
} :
PROCEDURE IDENT
- {
- df = DeclProc(type);
- if (proclevel > 1) {
- /* Room for static link
- */
+ { df = DeclProc(type);
+ if (proclevel > 1) { /* need room for static link */
NBytesParams = pointer_size;
}
else NBytesParams = 0;
}
FormalParameters(¶ms, &tp, &NBytesParams)?
- {
- tp = construct_type(T_PROCEDURE, tp);
+ { tp = construct_type(T_PROCEDURE, tp);
tp->prc_params = params;
tp->prc_nbpar = NBytesParams;
if (df->df_type) {
}
df->df_type = tp;
*pdf = df;
-
- if (type == D_PROCHEAD) close_scope(0);
-
}
;
;
FormalParameters(struct paramlist **pr;
- struct type **tp;
+ struct type **ptp;
arith *parmaddr;)
{
struct def *df;
]*
]?
')'
- [ ':' qualident(D_ISTYPE, &df, "type", (struct node **) 0)
- { *tp = df->df_type;
- }
+ [ ':' qualtype(ptp)
]?
;
{
struct node *FPList;
struct type *tp;
- int VARp = D_VALPAR;
+ int VARp;
struct paramlist *p = 0;
} :
- [
- VAR { VARp = D_VARPAR; }
- ]?
- IdentList(&FPList) ':' FormalType(&p, 0)
+ var(&VARp) IdentList(&FPList) ':' FormalType(&p, 0)
{ EnterParamList(ppr, FPList, p->par_def->df_type,
VARp, parmaddr);
free_def(p->par_def);
FormalType(struct paramlist **ppr; int VARp;)
{
- struct def *df1;
register struct def *df;
int ARRAYflag;
register struct type *tp;
+ struct type *tp1;
register struct paramlist *p = new_paramlist();
extern arith ArrayElSize();
} :
[ ARRAY OF { ARRAYflag = 1; }
| { ARRAYflag = 0; }
]
- qualident(D_ISTYPE, &df1, "type", (struct node **) 0)
- { df = df1;
- if (ARRAYflag) {
+ qualtype(&tp1)
+ { if (ARRAYflag) {
tp = construct_type(T_ARRAY, NULLTYPE);
- tp->arr_elem = df->df_type;
- tp->arr_elsize = ArrayElSize(df->df_type);
+ tp->arr_elem = tp1;
+ tp->arr_elsize = ArrayElSize(tp1);
tp->tp_align = lcm(word_align, pointer_align);
}
- else tp = df->df_type;
+ else tp = tp1;
p->next = *ppr;
*ppr = p;
p->par_def = df = new_def();
register struct def *df;
struct type *tp;
}:
- IDENT { df = lookup(dot.TOK_IDF, CurrentScope);
- if (!df) df = define(dot.TOK_IDF,CurrentScope,D_TYPE);
- }
+ IDENT { df = define(dot.TOK_IDF,CurrentScope,D_TYPE); }
'=' type(&tp)
- {
- if (df->df_kind == D_HIDDEN) {
+ { if (df->df_type && df->df_type->tp_fund == T_HIDDEN) {
if (tp->tp_fund != T_POINTER) {
error("opaque type \"%s\" is not a pointer type", df->df_idf->id_text);
}
- df->df_kind = D_TYPE;
+ /* Careful now ... we might have declarations
+ referring to the hidden type.
+ */
*(df->df_type) = *tp;
free_type(tp);
}
- else {
- df->df_type = tp;
- df->df_kind = D_TYPE;
- }
+ else df->df_type = tp;
}
;
SimpleType(struct type **ptp;)
{
- struct def *df;
+ struct type *tp;
} :
- qualident(D_ISTYPE, &df, "type", (struct node **) 0)
+ qualtype(ptp)
[
/* nothing */
- { *ptp = df->df_type; }
|
- SubrangeType(ptp)
+ SubrangeType(&tp)
/* The subrange type is given a base type by the
qualident (this is new modula-2).
*/
- {
- chk_basesubrange(*ptp, df->df_type);
- }
+ { chk_basesubrange(tp, *ptp); }
]
|
enumeration(ptp)
register struct type *tp;
} :
'(' IdentList(&EnumList) ')'
- {
- *ptp = tp = standard_type(T_ENUMERATION, 1, (arith) 1);
+ { *ptp = tp = standard_type(T_ENUMERATION, 1, (arith) 1);
EnterEnumList(EnumList, tp);
if (tp->enm_ncst > 256) { /* ??? is this reasonable ??? */
error("Too many enumeration literals");
{
register struct node *q;
} :
- IDENT { q = MkLeaf(Value, &dot);
- *p = q;
- }
+ IDENT { *p = q = MkLeaf(Value, &dot); }
[
',' IDENT
{ q->next = MkLeaf(Value, &dot);
'[' ConstExpression(&nd1)
UPTO ConstExpression(&nd2)
']'
- { *ptp = subr_type(nd1, nd2);
- }
+ { *ptp = subr_type(nd1, nd2); }
;
ArrayType(struct type **ptp;)
register struct type *tp2;
} :
ARRAY SimpleType(&tp)
- {
- *ptp = tp2 = construct_type(T_ARRAY, tp);
- }
+ { *ptp = tp2 = construct_type(T_ARRAY, tp); }
[
',' SimpleType(&tp)
{ tp2->arr_elem = construct_type(T_ARRAY, tp);
RecordType(struct type **ptp;)
{
- struct scope *scope;
+ register struct scope *scope;
arith count;
int xalign = struct_align;
}
:
RECORD
- { open_scope(OPENSCOPE);
- scope = CurrentScope;
- close_scope(0);
- count = 0;
- }
+ { open_scope(OPENSCOPE);
+ scope = CurrentScope;
+ close_scope(0);
+ count = 0;
+ }
FieldListSequence(scope, &count, &xalign)
- {
- *ptp = standard_type(T_RECORD, xalign, WA(count));
+ { *ptp = standard_type(T_RECORD, xalign, WA(count));
(*ptp)->rec_scope = scope;
}
END
FieldList(struct scope *scope; arith *cnt; int *palign;)
{
struct node *FldList;
- struct idf *id;
- struct def *df;
+ register struct idf *id = gen_anon_idf();
+ register struct def *df;
struct type *tp;
struct node *nd;
arith tcnt, max;
CASE
/* Also accept old fashioned Modula-2 syntax, but give a warning
*/
- [ qualident(0, &df, (char *) 0, &nd)
- [ /* This is good, in both kinds of Modula-2, if
+ [ qualident(0, (struct def **) 0, (char *) 0, &nd)
+ [ ':' qualtype(&tp)
+ /* This is correct, in both kinds of Modula-2, if
the first qualident is a single identifier.
*/
- { if (nd->nd_class != Name) {
- error("illegal variant tag");
- id = gen_anon_idf();
- }
- else id = nd->nd_IDF;
- }
- ':' qualident(D_ISTYPE, &df, "type", (struct node **) 0)
+ { if (nd->nd_class != Name) {
+ error("illegal variant tag");
+ }
+ else id = nd->nd_IDF;
+ }
|
/* Old fashioned! the first qualident now represents
the type
*/
{ warning("Old fashioned Modula-2 syntax!");
- id = gen_anon_idf();
- df = ill_df;
if (chk_designator(nd) &&
(nd->nd_class != Def ||
- !(nd->nd_def->df_kind &
- (D_ERROR|D_ISTYPE)))) {
+ !(nd->nd_def->df_kind&(D_ERROR|D_ISTYPE)) ||
+ !nd->nd_def->df_type)) {
node_error(nd, "type expected");
+ tp = error_type;
}
- else df = nd->nd_def;
+ else tp = nd->nd_def->df_type;
FreeNode(nd);
}
]
|
- /* Aha, third edition? */
- ':' qualident(D_ISTYPE, &df, "type", (struct node **) 0)
- { id = gen_anon_idf(); }
+ /* Aha, third edition. Well done! */
+ ':' qualtype(&tp)
]
- { tp = df->df_type;
- if (!(tp->tp_fund & T_DISCRETE)) {
+ { if (!(tp->tp_fund & T_DISCRETE)) {
error("Illegal type in variant");
}
df = define(id, scope, D_FIELD);
SetType(struct type **ptp;)
{
- struct type *tp;
} :
- SET OF SimpleType(&tp)
- {
- *ptp = set_type(tp);
- }
+ SET OF SimpleType(ptp)
+ { *ptp = set_type(*ptp); }
;
/* In a pointer type definition, the type pointed at does not
*/
PointerType(struct type **ptp;)
{
- struct type *tp;
- struct def *df;
- struct node *nd;
+ register struct def *df;
+ register struct node *nd;
} :
POINTER TO
- [ %if ( (df = lookup(dot.TOK_IDF, CurrentScope)))
+ { *ptp = construct_type(T_POINTER, NULLTYPE); }
+ [ %if ( lookup(dot.TOK_IDF, CurrentScope))
/* Either a Module or a Type, but in both cases defined
in this scope, so this is the correct identification
*/
- qualident(D_ISTYPE, &df, "type", (struct node **) 0)
- {
- if (!df->df_type) {
- error("type \"%s\" not declared",
- df->df_idf->id_text);
- tp = error_type;
- }
- else tp = df->df_type;
- }
+ qualtype(&((*ptp)->next))
| %if ( nd = new_node(), nd->nd_token = dot,
df = lookfor(nd, CurrVis, 0), free_node(nd),
df->df_kind == D_MODULE)
- type(&tp)
+ type(&((*ptp)->next))
|
- IDENT
- { tp = NULLTYPE; }
+ IDENT { Forward(&dot, &((*ptp)->next)); }
]
- {
- *ptp = construct_type(T_POINTER, tp);
- if (!tp) Forward(&dot, &((*ptp)->next));
- }
;
+qualtype(struct type **ptp;)
+{
+ struct def *df;
+} :
+ qualident(D_ISTYPE, &df, "type", (struct node **) 0)
+ { if (!df->df_type) {
+ error("type \"%s\" not declared", df->df_idf->id_text);
+ *ptp = error_type;
+ }
+ else *ptp = df->df_type;
+ }
+;
+
+
ProcedureType(struct type **ptp;)
{
struct paramlist *pr = 0;
- struct type *tp = 0;
+ register struct type *tp;
} :
- PROCEDURE FormalTypeList(&pr, &tp)?
- { *ptp = construct_type(T_PROCEDURE, tp);
- (*ptp)->prc_params = pr;
+ { *ptp = 0; }
+ PROCEDURE FormalTypeList(&pr, ptp)?
+ { *ptp = tp = construct_type(T_PROCEDURE, *ptp);
+ tp->prc_params = pr;
}
;
} :
'(' { *ppr = 0; }
[
- [ VAR { VARp = D_VARPAR; }
- | { VARp = D_VALPAR; }
- ]
- FormalType(ppr, VARp)
+ var(&VARp) FormalType(ppr, VARp)
[
- ','
- [ VAR {VARp = D_VARPAR; }
- | {VARp = D_VALPAR; }
- ]
- FormalType(ppr, VARp)
+ ',' var(&VARp) FormalType(ppr, VARp)
]*
]?
')'
- [ ':' qualident(D_TYPE, &df, "type", (struct node **) 0)
- { *ptp = df->df_type; }
+ [ ':' qualtype(ptp)
]?
;
+var(int *VARp;):
+ VAR { *VARp = D_VARPAR; }
+|
+ /* empty */ { *VARp = D_VALPAR; }
+;
+
ConstantDeclaration
{
- struct def *df;
struct idf *id;
struct node *nd;
}:
- IDENT { id = dot.TOK_IDF; }
- '=' ConstExpression(&nd){ df = define(id, CurrentScope, D_CONST);
- df->con_const = nd;
- }
+ IDENT { id = dot.TOK_IDF; }
+ '=' ConstExpression(&nd)
+ { define(id,CurrentScope,D_CONST)->con_const = nd; }
;
VariableDeclaration
*define(),
*DefineLocalModule(),
*MkDef(),
+ *DeclProc(),
*ill_df;
extern struct def
return df;
}
-InitProc(nd, df)
- struct node *nd;
- struct def *df;
-{
- /* Create an initialization procedure for a module.
- */
- df->mod_body = nd;
- /* Keep it this way, or really create a procedure out of it??? */
-}
-
AddModule(id)
struct idf *id;
{
#include <em_arith.h>
#include <em_label.h>
+#include <em_code.h>
#include <assert.h>
#include "type.h"
#include <alloc.h>
#include <em_arith.h>
#include <em_label.h>
+#include <em_code.h>
#include <assert.h>
#include "idf.h"
ExpList(struct node **pnd;)
{
- struct node **nd;
+ register struct node *nd;
} :
- expression(pnd) { *pnd = MkNode(Link, *pnd, NULLNODE, &dot);
+ expression(pnd) { *pnd = nd = MkNode(Link,*pnd,NULLNODE,&dot);
(*pnd)->nd_symb = ',';
- nd = &((*pnd)->nd_right);
}
[
- ',' { *nd = MkLeaf(Link, &dot);
+ ',' { nd->nd_right = MkLeaf(Link, &dot);
+ nd = nd->nd_right;
}
- expression(&(*nd)->nd_left)
- { nd = &((*nd)->nd_right); }
+ expression(&(nd->nd_left))
]*
;
;
*/
-factor(struct node **p;)
+factor(register struct node **p;)
{
struct def *df;
struct node *nd;
| %default
number(p)
|
- STRING {
- *p = MkLeaf(Value, &dot);
+ STRING { *p = MkLeaf(Value, &dot);
(*p)->nd_type = toktype;
}
|
{
register struct node *nd;
} :
- '{' {
- dot.tk_symb = SET;
+ '{' { dot.tk_symb = SET;
*pnd = nd = MkLeaf(Xset, &dot);
nd->nd_type = bitset_type;
}
]*
;
-visible_designator_tail(struct node **pnd;):
+visible_designator_tail(register struct node **pnd;):
'[' { *pnd = MkNode(Arrsel, *pnd, NULLNODE, &dot); }
expression(&((*pnd)->nd_right))
[
int state; /* either IMPLEMENTATION or PROGRAM */
char options[128];
int DefinitionModule;
-int SYSTEMModule = 0;
+int SYSTEMModule;
char *ProgName;
char *DEFPATH[NDIRS+1];
struct def *Defined;
extern int fp_used; /* set if floating point used */
main(argc, argv)
- char *argv[];
+ register char **argv;
{
register int Nargc = 1;
register char **Nargv = &argv[0];
open_scope(CLOSEDSCOPE);
GlobalScope = CurrentScope;
C_init(word_size, pointer_size);
- if (! C_open(dst)) {
- fatal("Could not open output file");
- }
+ if (! C_open(dst)) fatal("Could not open output file");
C_magic();
C_ms_emx(word_size, pointer_size);
CompUnit();
if (!err_occurred) {
C_exp(Defined->mod_vis->sc_scope->sc_name);
WalkModule(Defined);
- if (fp_used) {
- C_ms_flt();
- }
+ if (fp_used) C_ms_flt();
}
C_close();
#ifdef DEBUG
ModuleDeclaration
{
- struct idf *id;
- struct def *df;
- struct node *nd;
+ struct idf *id; /* save module identifier */
+ register struct def *df;
struct node *exportlist = 0;
int qualified;
} :
';'
import(1)*
export(&qualified, &exportlist)?
- block(&nd)
- IDENT { InitProc(nd, df);
- if (exportlist) {
+ block(&(df->mod_body))
+ IDENT { if (exportlist) {
EnterExportList(exportlist, qualified);
}
close_scope(SC_CHKFORW|SC_CHKPROC|SC_REVERSE);
import(int local;)
{
struct node *ImportList;
- struct node *id = 0;
+ register struct node *id;
} :
[ FROM
IDENT { id = MkLeaf(Value, &dot); }
- ]?
+ |
+ { id = 0; }
+ ]
IMPORT IdentList(&ImportList) ';'
/*
When parsing a global module, this is the place where we must
DefinitionModule
{
register struct def *df;
- struct idf *id;
- struct node *exportlist = 0;
+ struct idf *id; /* save module identifier */
+ struct node *exportlist;
int dummy;
} :
DEFINITION
}
';'
import(0)*
- export(&dummy, &exportlist)?
- /* New Modula-2 does not have export lists in definition modules.
- For the time being, we ignore export lists here, and a
- warning is issued.
- */
- { if (exportlist) {
+ [
+ export(&dummy, &exportlist)
+ /* New Modula-2 does not have export lists in definition
+ modules. Issue a warning.
+ */
+ {
node_warning(exportlist, "export list in definition module ignored");
FreeNode(exportlist);
- }
}
+ |
+ /* empty */
+ ]
definition* END IDENT
- {
- df = CurrentScope->sc_def;
+ { df = CurrentScope->sc_def;
while (df) {
/* Make all definitions "QUALIFIED EXPORT" */
df->df_flags |= D_QEXPORTED;
definition
{
- struct def *df;
+ register struct def *df;
+ struct def *dummy;
} :
CONST [ ConstantDeclaration Semicolon ]*
|
|
VAR [ VariableDeclaration Semicolon ]*
|
- ProcedureHeading(&df, D_PROCHEAD) Semicolon
+ ProcedureHeading(&dummy, D_PROCHEAD)
+ { close_scope(0); }
+ Semicolon
;
+/* The next nonterminal is used to relax the grammar a little.
+*/
Semicolon:
';'
|
- { warning("; expected"); }
+ /* empty */ { warning("; expected"); }
;
ProgramModule
struct idf *id;
struct def *GetDefinitionModule();
register struct def *df;
- struct node *nd;
} :
MODULE
IDENT { id = dot.TOK_IDF;
if (state == IMPLEMENTATION) {
df = GetDefinitionModule(id);
CurrVis = df->mod_vis;
- CurrentScope = CurrVis->sc_scope;
RemoveImports(&(CurrentScope->sc_def));
}
else {
- df = define(id, CurrentScope, D_MODULE);
+ Defined = df = define(id, CurrentScope, D_MODULE);
open_scope(CLOSEDSCOPE);
df->mod_vis = CurrVis;
CurrentScope->sc_name = "_M2M";
}
- Defined = df;
CurrentScope->sc_definedby = df;
}
priority(&(df->mod_priority))?
';' import(0)*
- block(&nd) IDENT
- { InitProc(nd, df);
- close_scope(SC_CHKFORW|SC_CHKPROC|SC_REVERSE);
+ block(&(df->mod_body)) IDENT
+ { close_scope(SC_CHKFORW|SC_CHKPROC|SC_REVERSE);
match_id(id, dot.TOK_IDF);
}
'.'
[
IMPLEMENTATION { state = IMPLEMENTATION; }
|
- { state = PROGRAM; }
+ /* empty */ { state = PROGRAM; }
]
ProgramModule
;
{
register struct node *nd;
} :
-[
/*
* This part is not in the reference grammar. The reference grammar
* states : assignment | ProcedureCall | ...
ReturnStatement(pnd)
|
/* empty */ { *pnd = 0; }
-]
;
/*
[
BY
ConstExpression(&dummy)
- {
- if (!(dummy->nd_type->tp_fund & T_INTORCARD)) {
+ { if (!(dummy->nd_type->tp_fund & T_INTORCARD)) {
error("illegal type in BY clause");
}
nd->nd_INT = dummy->nd_INT;
static struct tmpvar *TmpInts, /* for integer temporaries */
*TmpPtrs; /* for pointer temporaries */
-extern struct scope *ProcScope; /* scope of procedure in which the
+static struct scope *ProcScope; /* scope of procedure in which the
temporaries are allocated
*/
+TmpOpen(sc) struct scope *sc;
+{
+ /* Initialize for temporaries in scope "sc".
+ */
+ ProcScope = sc;
+}
+
arith
NewInt()
{
#include <alloc.h>
#include <em_arith.h>
#include <em_label.h>
+#include <em_code.h>
#include "def.h"
#include "type.h"
#include <em_arith.h>
#include <em_label.h>
#include <em_reg.h>
+#include <em_code.h>
#include <assert.h>
#include "def.h"
static struct type *func_type;
struct withdesig *WithDesigs;
struct node *Modules;
-struct scope *ProcScope;
STATIC
DoProfil()
First call initialization routines for modules defined within
this module.
*/
- sc->sc_off = 0;
+ sc->sc_off = 0; /* no locals (yet) */
text_label = 1;
- ProcScope = sc;
+ TmpOpen(sc); /* Initialize for temporaries */
C_pro_narg(sc->sc_name);
DoProfil();
if (module == Defined) {
proclevel++;
CurrVis = procedure->prc_vis;
- ProcScope = sc = CurrentScope;
+ sc = CurrentScope;
/* Generate code for all local modules and procedures
*/
*/
C_pro_narg(sc->sc_name);
DoProfil();
+ TmpOpen(sc);
/* Generate calls to initialization routines of modules defined within
this procedure
wds.w_next = WithDesigs;
WithDesigs = &wds;
wds.w_scope = left->nd_type->rec_scope;
- if (ds.dsg_kind != DSG_PFIXED) {
- /* In this case, we use a temporary variable
- */
- CodeAddress(&ds);
- ds.dsg_kind = DSG_FIXED;
- /* Create a designator structure for the
- temporary.
- */
- ds.dsg_offset = tmp = NewPtr();
- ds.dsg_name = 0;
- CodeStore(&ds, pointer_size);
- ds.dsg_kind = DSG_PFIXED;
- /* the record is indirectly available */
- }
+ CodeAddress(&ds);
+ ds.dsg_kind = DSG_FIXED;
+ /* Create a designator structure for the
+ temporary.
+ */
+ ds.dsg_offset = tmp = NewPtr();
+ ds.dsg_name = 0;
+ CodeStore(&ds, pointer_size);
+ ds.dsg_kind = DSG_PFIXED;
+ /* the record is indirectly available */
wds.w_desig = ds;
link.sc_scope = wds.w_scope;
link.next = CurrVis;
WalkNode(right, lab);
CurrVis = link.next;
WithDesigs = wds.w_next;
- if (tmp) FreePtr(tmp);
+ FreePtr(tmp);
break;
}
public / ack.git / commitdiff