+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* L E X I C A L A N A L Y S E R F O R M O D U L A - 2 */
+/* $Header$ */
+
#include "debug.h"
#include "idfsize.h"
#include "numsize.h"
struct token dot,
aside;
struct type *toktype;
-int idfsize = IDFSIZE;
+int idfsize = IDFSIZE;
+int ForeignFlag;
#ifdef DEBUG
extern int cntlines;
#endif
register int CommentLevel = 0;
LoadChar(ch);
+ if (ch == '$') {
+ LoadChar(ch);
+ switch(ch) {
+ case 'F':
+ /* Foreign; This definition module has an
+ implementation in another language.
+ In this case, don't generate prefixes in front
+ of the names
+ */
+ ForeignFlag = 1;
+ break;
+ }
+ }
for (;;) {
if (class(ch) == STNL) {
LineNumber++;
/* Read a line directive
*/
register int ch;
+}
+
+CheckForLineDirective()
+{
+ register int ch = getch();
register int i = 0;
char buf[IDFSIZE + 2];
register char *c = buf;
+
+ if (ch != '#') {
+ PushBack();
+ return;
+ }
do { /*
* Skip to next digit
* Do not skip newlines
return;
}
} while (class(ch) != STNUM);
- do {
+ while (class(ch) == STNUM) {
i = i*10 + (ch - '0');
ch = getch();
- } while (class(ch) == STNUM);
+ }
while (ch != '"' && class(ch) != STNL) ch = getch();
if (ch == '"') {
c = buf;
tk->tk_lineno = LineNumber;
-again2:
+again1:
if (eofseen) {
eofseen = 0;
ch = EOI;
else {
again:
LoadChar(ch);
-again1:
if ((ch & 0200) && ch != EOI) {
error("non-ascii '\\%03o' read", ch & 0377);
goto again;
cntlines++;
#endif
tk->tk_lineno++;
- LoadChar(ch);
- if (ch != '#') goto again1;
- linedirective();
- goto again2;
+ CheckForLineDirective();
+ goto again1;
case STSKIP:
goto again;
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* T O K E N D E S C R I P T O R D E F I N I T I O N */
+/* $Header$ */
+
/* Structure to store a string constant
*/
struct string {
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* S Y N T A X E R R O R R E P O R T I N G */
+/* $Header$ */
+
/* Defines the LLmessage routine. LLgen-generated parsers require the
existence of a routine of that name.
The routine must do syntax-error reporting and must be able to
INCLUDES = -I$(MHDIR) -I$(EMHOME)/h -I$(PKGDIR)
GFILES = tokenfile.g program.g declar.g expression.g statement.g
-LLGENOPTIONS =
+LLGENOPTIONS = -v
PROFILE =
-CFLAGS = $(PROFILE) $(INCLUDES) -DSTATIC=
+CFLAGS = $(PROFILE) $(INCLUDES) -O -DSTATIC=
LINTFLAGS = -DSTATIC= -DNORCSID
MALLOC = $(LIBDIR)/malloc.o
LFLAGS = $(PROFILE)
cp $(CURRDIR)/main $(EMHOME)/lib/em_m2
clean:
- rm -f $(OBJ) $(GENFILES) LLfiles hfiles Cfiles tab clashes $(CURRDIR)/main
+ rm -f $(OBJ) $(GENFILES) LLfiles hfiles Cfiles tab clashes \
+ $(CURRDIR)/main LL.output
(cd .. ; rm -rf Xsrc)
lint: Cfiles
size $(CURRDIR)/main
#AUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTO
-LLlex.o: LLlex.h Lpars.h class.h const.h debug.h debugcst.h f_info.h idf.h idfsize.h input.h inputtype.h numsize.h strsize.h type.h warning.h
-LLmessage.o: LLlex.h Lpars.h idf.h
+LLlex.o: LLlex.h
+LLlex.o: Lpars.h
+LLlex.o: class.h
+LLlex.o: const.h
+LLlex.o: debug.h
+LLlex.o: debugcst.h
+LLlex.o: f_info.h
+LLlex.o: idf.h
+LLlex.o: idfsize.h
+LLlex.o: input.h
+LLlex.o: inputtype.h
+LLlex.o: numsize.h
+LLlex.o: strsize.h
+LLlex.o: type.h
+LLlex.o: warning.h
+LLmessage.o: LLlex.h
+LLmessage.o: Lpars.h
+LLmessage.o: idf.h
char.o: class.h
-error.o: LLlex.h debug.h debugcst.h errout.h f_info.h input.h inputtype.h main.h node.h warning.h
-main.o: LLlex.h Lpars.h debug.h debugcst.h def.h f_info.h idf.h input.h inputtype.h ndir.h node.h scope.h standards.h tokenname.h type.h warning.h
+error.o: LLlex.h
+error.o: debug.h
+error.o: debugcst.h
+error.o: errout.h
+error.o: f_info.h
+error.o: input.h
+error.o: inputtype.h
+error.o: main.h
+error.o: node.h
+error.o: warning.h
+main.o: LLlex.h
+main.o: Lpars.h
+main.o: debug.h
+main.o: debugcst.h
+main.o: def.h
+main.o: f_info.h
+main.o: idf.h
+main.o: input.h
+main.o: inputtype.h
+main.o: ndir.h
+main.o: node.h
+main.o: scope.h
+main.o: standards.h
+main.o: tokenname.h
+main.o: type.h
+main.o: warning.h
symbol2str.o: Lpars.h
-tokenname.o: Lpars.h idf.h tokenname.h
+tokenname.o: Lpars.h
+tokenname.o: idf.h
+tokenname.o: tokenname.h
idf.o: idf.h
-input.o: def.h f_info.h idf.h input.h inputtype.h scope.h
-type.o: LLlex.h const.h debug.h debugcst.h def.h idf.h maxset.h node.h scope.h target_sizes.h type.h walk.h
-def.o: LLlex.h Lpars.h debug.h debugcst.h def.h idf.h main.h node.h scope.h type.h
-scope.o: LLlex.h debug.h debugcst.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 debug.h debugcst.h def.h idf.h main.h misc.h node.h scope.h type.h
-defmodule.o: LLlex.h Lpars.h debug.h debugcst.h def.h f_info.h idf.h input.h inputtype.h main.h misc.h node.h scope.h type.h
-typequiv.o: LLlex.h debug.h debugcst.h def.h node.h type.h warning.h
-node.o: LLlex.h debug.h debugcst.h def.h node.h type.h
-cstoper.o: LLlex.h Lpars.h debug.h debugcst.h idf.h node.h standards.h target_sizes.h type.h warning.h
-chk_expr.o: LLlex.h Lpars.h chk_expr.h const.h debug.h debugcst.h def.h idf.h misc.h node.h scope.h standards.h type.h warning.h
-options.o: idfsize.h main.h ndir.h type.h warning.h
-walk.o: LLlex.h Lpars.h chk_expr.h debug.h debugcst.h def.h desig.h f_info.h idf.h main.h node.h scope.h type.h walk.h warning.h
-casestat.o: LLlex.h Lpars.h debug.h debugcst.h density.h desig.h node.h type.h walk.h
-desig.o: LLlex.h debug.h debugcst.h def.h desig.h node.h scope.h type.h
-code.o: LLlex.h Lpars.h debug.h debugcst.h def.h desig.h node.h scope.h standards.h type.h walk.h
-tmpvar.o: debug.h debugcst.h def.h main.h scope.h type.h
-lookup.o: LLlex.h debug.h debugcst.h def.h idf.h misc.h node.h scope.h type.h
-next.o: debug.h debugcst.h
+input.o: def.h
+input.o: f_info.h
+input.o: idf.h
+input.o: input.h
+input.o: inputtype.h
+input.o: scope.h
+type.o: LLlex.h
+type.o: chk_expr.h
+type.o: const.h
+type.o: debug.h
+type.o: debugcst.h
+type.o: def.h
+type.o: idf.h
+type.o: maxset.h
+type.o: node.h
+type.o: scope.h
+type.o: target_sizes.h
+type.o: type.h
+type.o: walk.h
+def.o: LLlex.h
+def.o: Lpars.h
+def.o: debug.h
+def.o: debugcst.h
+def.o: def.h
+def.o: idf.h
+def.o: main.h
+def.o: node.h
+def.o: scope.h
+def.o: type.h
+scope.o: LLlex.h
+scope.o: debug.h
+scope.o: debugcst.h
+scope.o: def.h
+scope.o: idf.h
+scope.o: node.h
+scope.o: scope.h
+scope.o: type.h
+misc.o: LLlex.h
+misc.o: f_info.h
+misc.o: idf.h
+misc.o: misc.h
+misc.o: node.h
+enter.o: LLlex.h
+enter.o: debug.h
+enter.o: debugcst.h
+enter.o: def.h
+enter.o: idf.h
+enter.o: main.h
+enter.o: misc.h
+enter.o: node.h
+enter.o: scope.h
+enter.o: type.h
+defmodule.o: LLlex.h
+defmodule.o: Lpars.h
+defmodule.o: debug.h
+defmodule.o: debugcst.h
+defmodule.o: def.h
+defmodule.o: f_info.h
+defmodule.o: idf.h
+defmodule.o: input.h
+defmodule.o: inputtype.h
+defmodule.o: main.h
+defmodule.o: misc.h
+defmodule.o: node.h
+defmodule.o: scope.h
+defmodule.o: type.h
+typequiv.o: LLlex.h
+typequiv.o: debug.h
+typequiv.o: debugcst.h
+typequiv.o: def.h
+typequiv.o: node.h
+typequiv.o: type.h
+typequiv.o: warning.h
+node.o: LLlex.h
+node.o: debug.h
+node.o: debugcst.h
+node.o: def.h
+node.o: node.h
+node.o: type.h
+cstoper.o: LLlex.h
+cstoper.o: Lpars.h
+cstoper.o: debug.h
+cstoper.o: debugcst.h
+cstoper.o: idf.h
+cstoper.o: node.h
+cstoper.o: standards.h
+cstoper.o: target_sizes.h
+cstoper.o: type.h
+cstoper.o: warning.h
+chk_expr.o: LLlex.h
+chk_expr.o: Lpars.h
+chk_expr.o: chk_expr.h
+chk_expr.o: const.h
+chk_expr.o: debug.h
+chk_expr.o: debugcst.h
+chk_expr.o: def.h
+chk_expr.o: idf.h
+chk_expr.o: misc.h
+chk_expr.o: node.h
+chk_expr.o: scope.h
+chk_expr.o: standards.h
+chk_expr.o: type.h
+chk_expr.o: warning.h
+options.o: idfsize.h
+options.o: main.h
+options.o: ndir.h
+options.o: type.h
+options.o: warning.h
+walk.o: LLlex.h
+walk.o: Lpars.h
+walk.o: chk_expr.h
+walk.o: debug.h
+walk.o: debugcst.h
+walk.o: def.h
+walk.o: desig.h
+walk.o: f_info.h
+walk.o: idf.h
+walk.o: main.h
+walk.o: node.h
+walk.o: scope.h
+walk.o: type.h
+walk.o: walk.h
+walk.o: warning.h
+casestat.o: LLlex.h
+casestat.o: Lpars.h
+casestat.o: debug.h
+casestat.o: debugcst.h
+casestat.o: density.h
+casestat.o: desig.h
+casestat.o: node.h
+casestat.o: type.h
+casestat.o: walk.h
+desig.o: LLlex.h
+desig.o: debug.h
+desig.o: debugcst.h
+desig.o: def.h
+desig.o: desig.h
+desig.o: node.h
+desig.o: scope.h
+desig.o: type.h
+code.o: LLlex.h
+code.o: Lpars.h
+code.o: debug.h
+code.o: debugcst.h
+code.o: def.h
+code.o: desig.h
+code.o: node.h
+code.o: scope.h
+code.o: standards.h
+code.o: type.h
+code.o: walk.h
+tmpvar.o: debug.h
+tmpvar.o: debugcst.h
+tmpvar.o: def.h
+tmpvar.o: main.h
+tmpvar.o: scope.h
+tmpvar.o: type.h
+lookup.o: LLlex.h
+lookup.o: debug.h
+lookup.o: debugcst.h
+lookup.o: def.h
+lookup.o: idf.h
+lookup.o: misc.h
+lookup.o: node.h
+lookup.o: scope.h
+lookup.o: type.h
+next.o: debug.h
+next.o: debugcst.h
tokenfile.o: Lpars.h
-program.o: LLlex.h Lpars.h debug.h debugcst.h def.h f_info.h idf.h main.h node.h scope.h type.h warning.h
-declar.o: LLlex.h Lpars.h chk_expr.h debug.h debugcst.h def.h idf.h main.h misc.h node.h scope.h type.h warning.h
-expression.o: LLlex.h Lpars.h chk_expr.h const.h debug.h debugcst.h def.h idf.h node.h type.h warning.h
-statement.o: LLlex.h Lpars.h def.h idf.h node.h scope.h type.h
+program.o: LLlex.h
+program.o: Lpars.h
+program.o: debug.h
+program.o: debugcst.h
+program.o: def.h
+program.o: f_info.h
+program.o: idf.h
+program.o: main.h
+program.o: node.h
+program.o: scope.h
+program.o: type.h
+program.o: warning.h
+declar.o: LLlex.h
+declar.o: Lpars.h
+declar.o: chk_expr.h
+declar.o: debug.h
+declar.o: debugcst.h
+declar.o: def.h
+declar.o: idf.h
+declar.o: main.h
+declar.o: misc.h
+declar.o: node.h
+declar.o: scope.h
+declar.o: type.h
+declar.o: warning.h
+expression.o: LLlex.h
+expression.o: Lpars.h
+expression.o: chk_expr.h
+expression.o: const.h
+expression.o: debug.h
+expression.o: debugcst.h
+expression.o: def.h
+expression.o: idf.h
+expression.o: node.h
+expression.o: type.h
+expression.o: warning.h
+statement.o: LLlex.h
+statement.o: Lpars.h
+statement.o: def.h
+statement.o: idf.h
+statement.o: node.h
+statement.o: scope.h
+statement.o: type.h
Lpars.o: Lpars.h
--- /dev/null
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
+/* S Y S T E M M O D U L E T E X T */
+
+/* $Header$ */
+
+/* Text of SYSTEM module, for as far as it can be expressed in Modula-2 */
+
+#define SYSTEMTEXT "DEFINITION MODULE SYSTEM;\n\
+TYPE PROCESS = ADDRESS;\n\
+PROCEDURE NEWPROCESS(P:PROC; A:ADDRESS; n:CARDINAL; VAR p1:ADDRESS);\n\
+PROCEDURE TRANSFER(VAR p1,p2:ADDRESS);\n\
+END SYSTEM.\n"
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* C A S E S T A T E M E N T C O D E G E N E R A T I O N */
+/* $Header$ */
+
/* Generation of case statements is done by first creating a
description structure for the statement, build a list of the
case-labels, then generating a case description in the code,
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* E X P R E S S I O N C H E C K I N G */
+/* $Header$ */
+
/* Check expressions, and try to evaluate them as far as possible.
*/
};
int (*DesigChkTable[])() = {
-#ifdef DEBUG
- ChkValue,
-#else
- done_before,
-#endif
+ no_desig,
ChkArr,
no_desig,
no_desig,
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* E X P R E S S I O N C H E C K I N G */
+/* $Header$ */
+
extern int (*ExprChkTable[])(); /* table of expression checking
functions, indexed by node class
*/
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* U S E O F C H A R A C T E R C L A S S E S */
+/* $Header$ */
+
/* As a starter, chars are divided into classes, according to which
token they can be the start of.
At present such a class number is supposed to fit in 4 bits.
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* C O D E G E N E R A T I O N R O U T I N E S */
+/* $Header$ */
+
/* Code generation for expressions and coercions
*/
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* C O N S T A N T S F O R E X P R E S S I O N H A N D L I N G */
+/* $Header$ */
+
extern long
mach_long_sign; /* sign bit of the machine long */
extern int
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* C O N S T A N T E X P R E S S I O N H A N D L I N G */
+/* $Header$ */
+
#include "debug.h"
#include "target_sizes.h"
-/* A debugging macro
-*/
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
+/* D E B U G G I N G M A C R O */
+
+/* $Header$ */
#include "debugcst.h"
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* D E C L A R A T I O N S */
+/* $Header$ */
+
{
#include "debug.h"
int proclevel = 0; /* nesting level of procedures */
int return_occurred; /* set if a return occurs in a block */
+
+#define needs_static_link() (proclevel > 1)
+
}
ProcedureDeclaration
{
struct def *df;
} :
- { ++proclevel; }
+ { ++proclevel; }
ProcedureHeading(&df, D_PROCEDURE)
';' block(&(df->prc_body))
IDENT
- { EndProc(df, dot.TOK_IDF);
- --proclevel;
+ { EndProc(df, dot.TOK_IDF);
+ --proclevel;
}
;
ProcedureHeading(struct def **pdf; int type;)
{
struct type *tp = 0;
-#define needs_static_link() (proclevel > 1)
arith parmaddr = needs_static_link() ? pointer_size : 0;
struct paramlist *pr = 0;
} :
;
declaration:
- CONST [ %persistent ConstantDeclaration ';' ]*
+ CONST [ ConstantDeclaration ';' ]*
|
- TYPE [ %persistent TypeDeclaration ';' ]*
+ TYPE [ TypeDeclaration ';' ]*
|
- VAR [ %persistent VariableDeclaration ';' ]*
+ VAR [ VariableDeclaration ';' ]*
|
ProcedureDeclaration ';'
|
struct node *EnumList;
} :
'(' IdentList(&EnumList) ')'
- { register struct type *tp =
- standard_type(T_ENUMERATION, int_align, int_size);
-
- *ptp = tp;
- EnterEnumList(EnumList, tp);
- if (ufit(tp->enm_ncst-1, 1)) {
- tp->tp_size = 1;
- tp->tp_align = 1;
- }
- else if (ufit(tp->enm_ncst-1, short_size)) {
- tp->tp_size = short_size;
- tp->tp_align = short_align;
- }
- }
+ { *ptp = enum_type(EnumList); }
;
IdentList(struct node **p;)
}
:
RECORD
- { open_scope(OPENSCOPE); /* scope for fields of record */
- scope = CurrentScope;
- close_scope(0);
- }
+ { scope = open_and_close_scope(OPENSCOPE); }
FieldListSequence(scope, &size, &xalign)
{ if (size == 0) {
warning(W_ORDINARY, "empty record declaration");
struct node *FldList;
register struct idf *id = 0;
struct type *tp;
- struct node *nd1;
- register struct node *nd;
+ struct node *nd;
arith tcnt, max;
} :
[
IdentList(&FldList) ':' type(&tp)
- { *palign = lcm(*palign, tp->tp_align);
+ {
+ *palign = lcm(*palign, tp->tp_align);
EnterFieldList(FldList, tp, scope, cnt);
}
|
/* Also accept old fashioned Modula-2 syntax, but give a warning.
Sorry for the complicated code.
*/
- [ qualident(&nd1)
- { nd = nd1; }
+ [ qualident(&nd)
[ ':' qualtype(&tp)
/* This is correct, in both kinds of Modula-2, if
the first qualident is a single identifier.
| /* Old fashioned! the first qualident now represents
the type
*/
- { warning(W_OLDFASHIONED, "old fashioned Modula-2 syntax; ':' missing");
- if (ChkDesignator(nd) &&
- (nd->nd_class != Def ||
- !(nd->nd_def->df_kind&(D_ERROR|D_ISTYPE)) ||
- !nd->nd_def->df_type)) {
- node_error(nd, "type expected");
- tp = error_type;
- }
- else tp = nd->nd_def->df_type;
- FreeNode(nd);
+ { warning(W_OLDFASHIONED,
+ "old fashioned Modula-2 syntax; ':' missing");
+ tp = qualified_type(nd);
}
]
| ':' qualtype(&tp)
/* Aha, third edition. Well done! */
]
- { if (id) {
- register struct def *df = define(id,
- scope,
- D_FIELD);
+ {
+ *palign = lcm(*palign, tp->tp_align);
+ if (id) {
+ register struct def *df =
+ define(id, scope, D_FIELD);
+
if (!(tp->tp_fund & T_DISCRETE)) {
error("illegal type in variant");
}
CaseLabelList(&tp, &nd)
{ /* Ignore the cases for the time being.
Maybe a checking version will be supplied
- later ??? (Improbable)
+ later ???
*/
FreeNode(nd);
}
have to be declared yet, so be careful about identifying
type-identifiers
*/
-PointerType(struct type **ptp;)
-{
- register struct node *nd = 0;
-} :
+PointerType(struct type **ptp;) :
POINTER TO
- { *ptp = construct_type(T_POINTER, NULLTYPE); }
- [ %if ( lookup(dot.TOK_IDF, CurrentScope, 1)
- /* Either a Module or a Type, but in both cases defined
- in this scope, so this is the correct identification
- */
- ||
- ( nd = new_node(),
- nd->nd_token = dot,
- lookfor(nd, CurrVis, 0)->df_kind == D_MODULE
- )
- /* A Modulename in one of the enclosing scopes.
- It is not clear from the language definition that
- it is correct to handle these like this, but
- existing compilers do it like this, and the
- alternative is difficult with a lookahead of only
- one token.
- ???
- */
- )
+ [ %if (type_or_forward(ptp))
type(&((*ptp)->next))
- { if (nd) free_node(nd); }
|
- IDENT { if (nd) {
- /* nd could be a null pointer, if we had a
- syntax error exactly at this alternation.
- MORAL: Be careful with %if resolvers with
- side effects!
- */
- Forward(nd, (*ptp));
- }
- }
+ IDENT
]
;
qualtype(struct type **ptp;)
{
- register struct node *nd;
- struct node *nd1; /* because &nd is illegal */
+ struct node *nd;
} :
- qualident(&nd1)
- { nd = nd1;
- *ptp = error_type;
- if (ChkDesignator(nd)) {
- if (nd->nd_class != Def) {
- node_error(nd, "type expected");
- }
- else {
- register struct def *df = nd->nd_def;
-
- if (df->df_kind&(D_ISTYPE|D_FORWARD|D_ERROR)) {
- if (! df->df_type) {
-node_error(nd,"type \"%s\" not (yet) declared", df->df_idf->id_text);
- }
- else *ptp = df->df_type;
- }
- else {
-node_error(nd,"identifier \"%s\" is not a type", df->df_idf->id_text);
- }
- }
- }
- FreeNode(nd);
- }
+ qualident(&nd)
+ { *ptp = qualified_type(nd); }
;
ProcedureType(struct type **ptp;)
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* I D E N T I F I E R D E S C R I P T O R S T R U C T U R E */
+/* $Header$ */
+
struct module {
struct node *mo_priority;/* priority of a module */
struct scopelist *mo_vis;/* scope of this module */
#define D_EXPORTED 0x20 /* set if exported */
#define D_QEXPORTED 0x40 /* set if qualified exported */
#define D_BUSY 0x80 /* set if busy reading this definition module */
+#define D_FOREIGN 0x100 /* set for foreign language modules */
struct type *df_type;
union {
struct module df_module;
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* D E F I N I T I O N M E C H A N I S M */
+/* $Header$ */
+
#include "debug.h"
#include <alloc.h>
*/
df = define(id, CurrentScope, type);
df->for_node = MkLeaf(Name, &dot);
- sprint(buf,"%s_%s",CurrentScope->sc_name,id->id_text);
- df->for_name = Salloc(buf, (unsigned) (strlen(buf)+1));
+ if (CurrentScope->sc_definedby->df_flags & D_FOREIGN) {
+ df->for_name = id->id_text;
+ }
+ else {
+ sprint(buf,"%s_%s",CurrentScope->sc_name,id->id_text);
+ df->for_name = Salloc(buf, (unsigned) (strlen(buf)+1));
+ }
if (CurrVis == Defined->mod_vis) {
/* The current module will define this routine.
make sure the name is exported.
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* D E F I N I T I O N M O D U L E S */
+/* $Header$ */
+
#include "debug.h"
#include <assert.h>
#include <em_arith.h>
#include <em_label.h>
+#include <alloc.h>
#include "idf.h"
#include "input.h"
struct idf *DefId;
+STATIC char *
+getwdir(fn)
+ char *fn;
+{
+ register char *p;
+ char *strrindex();
+
+ p = strrindex(fn, '/');
+ while (p && *(p + 1) == '\0') { /* remove trailing /'s */
+ *p = '\0';
+ p = strrindex(fn, '/');
+ }
+
+ if (p) {
+ *p = '\0';
+ fn = Salloc(fn, p - &fn[0] + 1);
+ *p = '/';
+ return fn;
+ }
+ else return ".";
+}
+
STATIC
GetFile(name)
char *name;
*/
char buf[15];
char *strcpy(), *strcat();
+ static char *WorkingDir = ".";
strncpy(buf, name, 10);
buf[10] = '\0'; /* maximum length */
strcat(buf, ".def");
+ DEFPATH[0] = WorkingDir;
if (! InsertFile(buf, DEFPATH, &(FileName))) {
error("could not find a DEFINITION MODULE for \"%s\"", name);
return 0;
}
+ WorkingDir = getwdir(FileName);
LineNumber = 1;
DO_DEBUG(options['F'], debug("File %s : %ld characters", FileName, sys_filesize(FileName)));
return 1;
if (!df) {
/* Read definition module. Make an exception for SYSTEM.
*/
+ DefId = id;
if (!strcmp(id->id_text, "SYSTEM")) {
do_SYSTEM();
+ df = lookup(id, GlobalScope, 1);
}
else {
+ extern int ForeignFlag;
+
+ ForeignFlag = 0;
open_scope(CLOSEDSCOPE);
if (!is_anon_idf(id) && GetFile(id->id_text)) {
- DefId = id;
DefModule();
- if (level == 1) {
+ df = lookup(id, GlobalScope, 1);
+ if (level == 1 &&
+ (!df || !(df->df_flags & D_FOREIGN))) {
/* The module is directly imported by
- the currently defined module, so we
- have to remember its name because
- we have to call its initialization
- routine
+ the currently defined module, and
+ is not foreign, so we have to
+ remember its name because we have
+ to call its initialization routine
*/
static struct node *nd_end;
register struct node *n;
nd_end = n;
}
}
+ else {
+ df = lookup(id, GlobalScope, 1);
+ CurrentScope->sc_name = id->id_text;
+ }
vis = CurrVis;
close_scope(SC_CHKFORW);
}
- df = lookup(id, GlobalScope, 1);
if (! df) {
df = MkDef(id, GlobalScope, D_ERROR);
df->df_type = error_type;
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* D E S I G N A T O R E V A L U A T I O N */
+/* $Header$ */
+
/* Code generation for designators.
This file contains some routines that generate code common to address
as well as value computations, and leave a description in a "desig"
arith wordmodsz = word_size % size; /* 0 if dividor of wordsize */
if (szmodword && wordmodsz) return 0;
- if (al >= word_size) return 1;
+ if (al >= word_align) return 1;
if (szmodword && al >= szmodword) return 1;
return ds->dsg_kind == DSG_FIXED &&
- ((! szmodword && ds->dsg_offset % word_size == 0) ||
+ ((! szmodword && ds->dsg_offset % word_align == 0) ||
(! wordmodsz && ds->dsg_offset % size == 0));
}
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* D E S I G N A T O R D E S C R I P T I O N S */
+/* $Header$ */
+
/* Generating code for designators is not particularly easy, especially if
you don't know wether you want the address or the value.
The next structure is used to generate code for designators.
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* H I G H L E V E L S Y M B O L E N T R Y */
+/* $Header$ */
+
#include "debug.h"
#include <alloc.h>
*/
register struct def *df;
register struct node *idlist = Idlist;
- register struct scopelist *sc;
+ register struct scopelist *sc = CurrVis;
char buf[256];
extern char *sprint();
- sc = CurrVis;
-
if (local) {
/* Find the closest enclosing open scope. This
is the procedure that we are dealing with
else {
/* Global name, possibly external
*/
- sprint(buf,"%s_%s", sc->sc_scope->sc_name,
+ if (sc->sc_scope->sc_definedby->df_flags & D_FOREIGN) {
+ df->var_name = df->df_idf->id_text;
+ }
+ else {
+ sprint(buf,"%s_%s", sc->sc_scope->sc_name,
df->df_idf->id_text);
- df->var_name = Salloc(buf, (unsigned)(strlen(buf)+1));
+ df->var_name = Salloc(buf,
+ (unsigned)(strlen(buf)+1));
+ }
df->df_flags |= D_NOREG;
if (DefinitionModule) {
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* E R R O R A N D D I A G N O S T I C R O U T I N E S */
+/* $Header$ */
+
/* This file contains the (non-portable) error-message and diagnostic
giving functions. Be aware that they are called with a variable
number of arguments!
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* E X P R E S S I O N S */
+/* $Header$ */
+
{
#include "debug.h"
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* F I L E D E S C R I P T O R S T R U C T U R E */
+/* $Header$ */
+
struct f_info {
unsigned short f_lineno;
char *f_filename;
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* I N S T A N T I A T I O N O F I D F P A C K A G E */
+/* $Header$ */
+
#include "idf.h"
#include <idf_pkg.body>
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* U S E R D E C L A R E D P A R T O F I D F */
+/* $Header$ */
+
struct id_u {
int id_res;
struct def *id_df;
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* I N S T A N T I A T I O N O F I N P U T P A C K A G E */
+/* $Header$ */
+
#include "f_info.h"
struct f_info file_info;
#include "input.h"
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* I N S T A N T I A T I O N O F I N P U T M O D U L E */
+/* $Header$ */
+
#include "inputtype.h"
#define INP_NPUSHBACK 2
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* L O O K U P R O U T I N E S */
+/* $Header$ */
+
#include "debug.h"
#include <em_arith.h>
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* M A I N P R O G R A M */
+/* $Header$ */
+
#include "debug.h"
#include "ndir.h"
#include "tokenname.h"
#include "node.h"
#include "warning.h"
+#include "SYSTEM.h"
int state; /* either IMPLEMENTATION or PROGRAM */
char options[128];
}
LineNumber = 1;
FileName = src;
- DEFPATH[0] = ".";
- DEFPATH[NDIRS] = 0;
init_idf();
InitCst();
reserve(tkidf);
if (! C_open(dst)) fatal("could not open output file");
C_magic();
C_ms_emx(word_size, pointer_size);
+ CheckForLineDirective();
CompUnit();
C_ms_src((arith) (LineNumber - 1), FileName);
if (!err_occurred) {
df->enm_next = 0;
}
-/* How do you like that! Modula-2 in a C-program.
-*/
-char SYSTEM[] = "\
-DEFINITION MODULE SYSTEM;\n\
-TYPE PROCESS = ADDRESS;\n\
-PROCEDURE NEWPROCESS(P:PROC; A:ADDRESS; n:CARDINAL; VAR p1:ADDRESS);\n\
-PROCEDURE TRANSFER(VAR p1,p2:ADDRESS);\n\
-END SYSTEM.\n";
-
do_SYSTEM()
{
/* Simulate the reading of the SYSTEM definition module
*/
+ static char systemtext[] = SYSTEMTEXT;
+
open_scope(CLOSEDSCOPE);
Enter("WORD", D_TYPE, word_type, 0);
Enter("BYTE", D_TYPE, byte_type, 0);
Enter("ADDRESS", D_TYPE, address_type, 0);
Enter("ADR", D_PROCEDURE, std_type, S_ADR);
Enter("TSIZE", D_PROCEDURE, std_type, S_TSIZE);
- if (!InsertText(SYSTEM, sizeof(SYSTEM) - 1)) {
+ if (!InsertText(systemtext, sizeof(systemtext) - 1)) {
fatal("could not insert text");
}
DefModule();
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* S O M E G L O B A L V A R I A B L E S */
+/* $Header$ */
+
extern char options[]; /* indicating which options were given */
extern int DefinitionModule;
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* M I S C E L L A N E O U S R O U T I N E S */
+/* $Header$ */
+
#include <alloc.h>
#include <em_arith.h>
#include <em_label.h>
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* M I S C E L L A N E O U S */
+/* $Header$ */
+
#define is_anon_idf(x) ((x)->id_text[0] == '#')
#define id_not_declared(x) (not_declared("identifier", (x), ""))
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* N O D E O F A N A B S T R A C T P A R S E T R E E */
+/* $Header$ */
+
struct node {
struct node *next;
#define nd_left next
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* N O D E O F A N A B S T R A C T P A R S E T R E E */
+/* $Header$ */
+
#include "debug.h"
#include <em_label.h>
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* U S E R O P T I O N - H A N D L I N G */
+/* $Header$ */
+
#include "idfsize.h"
#include "ndir.h"
#endif
extern int idfsize;
-static int ndirs;
+static int ndirs = 1;
int warning_classes;
DoOption(text)
{
switch(*text++) {
- default:
- options[text[-1]]++; /* flags, debug options etc. */
+ case '-':
+ options[*text]++; /* debug options etc. */
break;
- /* recognized flags:
- -L: don't generate fil/lin
- -p: generate procentry/procexit
- -w: no warnings
- -n: no register messages
- and many more if DEBUG
- */
+ case 'L': /* no fil/lin */
+ case 'p': /* call procentry/procexit */
+ case 'n': /* no register messages */
+ case 'x': /* every name global */
+ options[text[-1]]++;
+ break;
case 'w':
if (*text) {
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* O V E R A L L S T R U C T U R E */
+/* $Header$ */
+
{
#include "debug.h"
struct node *exportlist;
int dummy;
extern struct idf *DefId;
+ extern int ForeignFlag;
} :
DEFINITION
MODULE IDENT { df = define(dot.TOK_IDF, GlobalScope, D_MODULE);
df->df_flags |= D_BUSY;
+ if (ForeignFlag) df->df_flags |= D_FOREIGN;
if (!Defined) Defined = df;
+ CurrentScope->sc_definedby = df;
if (df->df_idf != DefId) {
- error("DEFINITION MODULE name is not \"%s\"",
- DefId->id_text);
+ error("DEFINITION MODULE name is \"%s\", not \"%s\"",
+ df->df_idf->id_text, DefId->id_text);
}
CurrentScope->sc_name = df->df_idf->id_text;
df->mod_vis = CurrVis;
open_scope(CLOSEDSCOPE);
df->mod_vis = CurrVis;
CurrentScope->sc_name = "_M2M";
+ CurrentScope->sc_definedby = df;
}
- CurrentScope->sc_definedby = df;
}
priority(df)
';' import(0)*
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* S C O P E M E C H A N I S M */
+/* $Header$ */
+
#include "debug.h"
#include <assert.h>
CurrVis = ls;
}
+struct scope *
+open_and_close_scope(scopetype)
+{
+ struct scope *sc;
+
+ open_scope(scopetype);
+ sc = CurrentScope;
+ close_scope();
+ return sc;
+}
+
InitScope()
{
register struct scope *sc = new_scope();
CurrVis = ls;
}
-Forward(tk, ptp)
- struct node *tk;
- struct type *ptp;
-{
- /* Enter a forward reference into a list belonging to the
- current scope. This is used for POINTER declarations, which
- may have forward references that must howewer be declared in the
- same scope.
- */
- register struct def *df = define(tk->nd_IDF, CurrentScope, D_FORWTYPE);
-
- if (df->df_kind == D_TYPE) {
- ptp->next = df->df_type;
- return;
- }
- df->df_forw_type = ptp;
- df->df_forw_node = tk;
-}
-
STATIC
chk_proc(df)
register struct def *df;
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* S C O P E M E C H A N I S M */
+/* $Header$ */
+
#define OPENSCOPE 0 /* Indicating an open scope */
#define CLOSEDSCOPE 1 /* Indicating a closed scope (module) */
#define enclosing(x) ((x)->sc_encl)
#define scopeclosed(x) ((x)->sc_scopeclosed)
#define nextvisible(x) ((x)->next) /* use with scopelists */
+
+struct scope *open_and_close_scope();
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* S T A N D A R D P R O C E D U R E S A N D F U N C T I O N S */
+/* $Header$ */
+
#define S_ABS 1
#define S_CAP 2
#define S_CHR 3
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* S T A T E M E N T S */
+/* $Header$ */
+
{
#include <assert.h>
#include <em_arith.h>
case(&(nd->nd_right), &tp)
{ nd = nd->nd_right; }
]*
- [ ELSE StatementSequence(&(nd->nd_right)) ]?
+ [ ELSE StatementSequence(&(nd->nd_right))
+ { if (! nd->nd_right) {
+ nd->nd_right = MkLeaf(Stat, &dot);
+ nd->nd_right->nd_symb = ';';
+ }
+ }
+ ]?
END
;
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* T E M P O R A R Y V A R I A B L E S */
+/* $Header$ */
+
/* Code for the allocation and de-allocation of temporary variables,
allowing re-use.
The routines use "ProcScope" instead of "CurrentScope", because
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* T O K E N D E F I N I T I O N S */
+/* $Header$ */
+
#include "tokenname.h"
#include "Lpars.h"
#include "idf.h"
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* T O K E N N A M E S T R U C T U R E */
+/* $Header$ */
+
struct tokenname { /* Used for defining the name of a
token as identified by its symbol
*/
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* T Y P E D E S C R I P T O R S T R U C T U R E */
+/* $Header$ */
+
struct paramlist { /* structure for parameterlist of a PROCEDURE */
struct paramlist *next;
struct def *par_def; /* "df" of parameter */
*set_type(),
*subr_type(),
*proc_type(),
+ *enum_type(),
+ *qualified_type(),
*RemoveEqual(); /* All from type.c */
#define NULLTYPE ((struct type *) 0)
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* T Y P E D E F I N I T I O N M E C H A N I S M */
+/* $Header$ */
+
#include "target_sizes.h"
#include "debug.h"
#include "maxset.h"
#include "const.h"
#include "scope.h"
#include "walk.h"
+#include "chk_expr.h"
int
word_align = AL_WORD,
arith pos;
int al;
{
- arith i;
+ arith i = pos % al;
- return pos + ((i = pos % al) ? al - i : 0);
+ if (i) return pos + al - i;
+ return pos;
}
struct type *
{
register struct type *tp = new_type();
+ if (align == 0) align = 1;
+
tp->tp_fund = fund;
- tp->tp_align = align ? align : 1;
+ tp->tp_align = align;
tp->tp_size = size;
return tp;
error_type = standard_type(T_CHAR, 1, (arith) 1);
}
+STATIC
+u_small(tp, n)
+ register struct type *tp;
+ arith n;
+{
+ if (ufit(n, 1)) {
+ tp->tp_size = 1;
+ tp->tp_align = 1;
+ }
+ else if (ufit(n, short_size)) {
+ tp->tp_size = short_size;
+ tp->tp_align = short_align;
+ }
+}
+
+struct type *
+enum_type(EnumList)
+ struct node *EnumList;
+{
+ register struct type *tp =
+ standard_type(T_ENUMERATION, int_align, int_size);
+
+ EnterEnumList(EnumList, tp);
+ u_small(tp, (arith) (tp->enm_ncst-1));
+ return tp;
+}
+
+struct type *
+qualified_type(nd)
+ struct node *nd;
+{
+ struct type *tp = error_type;
+
+ if (ChkDesignator(nd)) {
+ if (nd->nd_class != Def) node_error(nd, "type expected");
+ else {
+ register struct def *df = nd->nd_def;
+
+ if (df->df_kind&(D_ISTYPE|D_FORWARD|D_ERROR)) {
+ if (! df->df_type) {
+node_error(nd,"type \"%s\" not (yet) declared", df->df_idf->id_text);
+ }
+ else tp = df->df_type;
+ }
+ else {
+node_error(nd,"identifier \"%s\" is not a type", df->df_idf->id_text);
+ }
+ }
+ }
+ FreeNode(nd);
+ return tp;
+}
+
chk_basesubrange(tp, base)
register struct type *tp, *base;
{
res->tp_size = tp->tp_size;
res->tp_align = tp->tp_align;
if (tp == card_type) {
- if (ufit(res->sub_ub, 1)) {
- res->tp_size = 1;
- res->tp_align = 1;
- }
- else if (ufit(res->sub_ub, 2)) {
- res->tp_size = short_size;
- res->tp_align = short_align;
- }
+ u_small(res, res->sub_ub);
}
else if (tp == int_type) {
if (fit(res->sub_lb, 1) && fit(res->sub_ub, 1)) {
return tpx;
}
+int
+type_or_forward(ptp)
+ struct type **ptp;
+{
+ struct node *nd = 0;
+
+ *ptp = construct_type(T_POINTER, NULLTYPE);
+ if (lookup(dot.TOK_IDF, CurrentScope, 1)
+ /* Either a Module or a Type, but in both cases defined
+ in this scope, so this is the correct identification
+ */
+ ||
+ ( nd = new_node(),
+ nd->nd_token = dot,
+ lookfor(nd, CurrVis, 0)->df_kind == D_MODULE
+ )
+ /* A Modulename in one of the enclosing scopes.
+ It is not clear from the language definition that
+ it is correct to handle these like this, but
+ existing compilers do it like this, and the
+ alternative is difficult with a lookahead of only
+ one token.
+ ???
+ */
+ ) {
+ if (nd) free_node(nd);
+ return 1;
+ }
+ /* Enter a forward reference into a list belonging to the
+ current scope. This is used for POINTER declarations, which
+ may have forward references that must howewer be declared in the
+ same scope.
+ */
+ {
+ register struct def *df =
+ define(nd->nd_IDF, CurrentScope, D_FORWTYPE);
+
+ if (df->df_kind == D_TYPE) {
+ (*ptp)->next = df->df_type;
+ }
+ else {
+ df->df_forw_type = *ptp;
+ df->df_forw_node = nd;
+ }
+ }
+ return 0;
+}
+
int
gcd(m, n)
register int m, n;
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* T Y P E E Q U I V A L E N C E */
+/* $Header$ */
+
/* Routines for testing type equivalence, type compatibility, and
assignment compatibility
*/
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* P A R S E T R E E W A L K E R */
+/* $Header$ */
+
/* Routines to walk through parts of the parse tree, and generate
code for these parts.
*/
STATIC
DoPriority()
{
+ /* For the time being (???), handle priorities by calls to
+ the runtime system
+ */
if (priority) {
C_loc(priority->nd_INT);
C_cal("_stackprio");
register struct node *nd = Modules;
if (state == IMPLEMENTATION) {
- label l1 = ++data_label;
- /* we don't actually prevent recursive calls,
+ /* We don't actually prevent recursive calls,
but do nothing if called recursively
*/
+ label l1 = ++data_label;
+
C_df_dlb(l1);
C_bss_cst(word_size, (arith) 0, 1);
/* if this one is set to non-zero, the initialization
if (! options['L']) C_lin((arith) nd->nd_lineno);
switch(nd->nd_symb) {
+ case ';':
+ break;
+
case BECOMES:
DoAssign(nd, left, right);
break;
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
/* P A R S E T R E E W A L K E R */
+/* $Header$ */
+
/* Definition of WalkNode macro
*/
+/*
+ * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ * See the copyright notice in the ACK home directory, in the file "Copyright".
+ *
+ * Author: Ceriel J.H. Jacobs
+ */
+
+/* W A R N I N G C L A S S E S */
+
+/* $Header$ */
+
/* Warning classes, at the moment three of them:
Strict (R)
Ordinary (W)
public / ack.git / commitdiff