d0p1/ack
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

make to work on sun, added copyright, etc

Browse source
This commit is contained in:
ceriel 1987-04-29 10:22:07 +00:00
parent 8482d6776b
commit fbc0415761
49 changed files with 989 additions and 224 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

48
lang/m2/comp/LLlex.c
View file

@ -1,5 +1,14 @@
/*
* (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"
@ -25,7 +34,8 @@ long str2long();
struct token dot,
aside;
struct type *toktype;
int idfsize = IDFSIZE;
int idfsize = IDFSIZE;
int ForeignFlag;
#ifdef DEBUG
extern int cntlines;
#endif
@ -42,6 +52,19 @@ SkipComment()
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++;
@ -138,10 +161,20 @@ linedirective() {
/* 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
@ -153,10 +186,10 @@ linedirective() {
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;
@ -206,7 +239,7 @@ LLlex()
tk->tk_lineno = LineNumber;
again2:
again1:
if (eofseen) {
eofseen = 0;
ch = EOI;
@ -214,7 +247,6 @@ again2:
else {
again:
LoadChar(ch);
again1:
if ((ch & 0200) && ch != EOI) {
error("non-ascii '\\%03o' read", ch & 0377);
goto again;
@ -229,10 +261,8 @@ again1:
cntlines++;
#endif
tk->tk_lineno++;
LoadChar(ch);
if (ch != '#') goto again1;
linedirective();
goto again2;
CheckForLineDirective();
goto again1;
case STSKIP:
goto again;

9
lang/m2/comp/LLlex.h
View file

@ -1,5 +1,14 @@
/*
* (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 {

9
lang/m2/comp/LLmessage.c
View file

@ -1,5 +1,14 @@
/*
* (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

293
lang/m2/comp/Makefile
View file

@ -13,9 +13,9 @@ CURRDIR = .
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)
@ -61,7 +61,8 @@ install: all
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
@ -132,36 +133,266 @@ $(CURRDIR)/main: $(OBJ)
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

18
lang/m2/comp/SYSTEM.h Normal file
View file

@ -0,0 +1,18 @@
/*
* (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"

9
lang/m2/comp/casestat.C
View file

@ -1,5 +1,14 @@
/*
* (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,

15
lang/m2/comp/chk_expr.c
View file

@ -1,5 +1,14 @@
/*
* (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.
*/
@ -1203,11 +1212,7 @@ int (*ExprChkTable[])() = {
};
int (*DesigChkTable[])() = {
#ifdef DEBUG
ChkValue,
#else
done_before,
#endif
no_desig,
ChkArr,
no_desig,
no_desig,

9
lang/m2/comp/chk_expr.h
View file

@ -1,5 +1,14 @@
/*
* (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
*/

9
lang/m2/comp/class.h
View file

@ -1,5 +1,14 @@
/*
* (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.

9
lang/m2/comp/code.c
View file

@ -1,5 +1,14 @@
/*
* (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
*/

9
lang/m2/comp/const.h
View file

@ -1,5 +1,14 @@
/*
* (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

9
lang/m2/comp/cstoper.c
View file

@ -1,5 +1,14 @@
/*
* (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"

12
lang/m2/comp/debug.h
View file

@ -1,5 +1,13 @@
/* 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"

143
lang/m2/comp/declar.g
View file

@ -1,5 +1,14 @@
/*
* (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"
@ -21,25 +30,27 @@
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;
} :
@ -67,11 +78,11 @@ block(struct node **pnd;) :
;
declaration:
CONST [ %persistent ConstantDeclaration ';' ]*
CONST [ ConstantDeclaration ';' ]*
|
TYPE [ %persistent TypeDeclaration ';' ]*
TYPE [ TypeDeclaration ';' ]*
|
VAR [ %persistent VariableDeclaration ';' ]*
VAR [ VariableDeclaration ';' ]*
|
ProcedureDeclaration ';'
|
@ -171,20 +182,7 @@ enumeration(struct type **ptp;)
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;)
@ -244,10 +242,7 @@ RecordType(struct type **ptp;)
}
:
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");
@ -271,13 +266,13 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
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);
}
|
@ -285,8 +280,7 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
/* 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.
@ -300,25 +294,20 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
| /* 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");
}
@ -351,7 +340,7 @@ variant(struct scope *scope; arith *cnt; struct type *tp; int *palign;)
CaseLabelList(&tp, &nd)
{ /* Ignore the cases for the time being.
Maybe a checking version will be supplied
later ??? (Improbable)
later ???
*/
FreeNode(nd);
}
@ -403,73 +392,21 @@ SetType(struct type **ptp;) :
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;)

10
lang/m2/comp/def.H
View file

@ -1,5 +1,14 @@
/*
* (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 */
@ -106,6 +115,7 @@ struct def { /* list of definitions for a name */
#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;

18
lang/m2/comp/def.c
View file

@ -1,5 +1,14 @@
/*
* (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>
@ -234,8 +243,13 @@ DeclProc(type, id)
*/
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.

58
lang/m2/comp/defmodule.c
View file

@ -1,10 +1,20 @@
/*
* (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"
@ -24,6 +34,28 @@ long sys_filesize();
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;
@ -33,14 +65,17 @@ GetFile(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;
@ -64,20 +99,26 @@ GetDefinitionModule(id, incr)
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;
@ -91,10 +132,13 @@ GetDefinitionModule(id, incr)
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;

13
lang/m2/comp/desig.c
View file

@ -1,5 +1,14 @@
/*
* (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"
@ -43,11 +52,11 @@ properly(ds, size, al)
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));
}

9
lang/m2/comp/desig.h
View file

@ -1,5 +1,14 @@
/*
* (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.

23
lang/m2/comp/enter.c
View file

@ -1,5 +1,14 @@
/*
* (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>
@ -94,12 +103,10 @@ EnterVarList(Idlist, type, local)
*/
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
@ -136,9 +143,15 @@ EnterVarList(Idlist, type, local)
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) {

9
lang/m2/comp/error.c
View file

@ -1,5 +1,14 @@
/*
* (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!

9
lang/m2/comp/expression.g
View file

@ -1,5 +1,14 @@
/*
* (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"

9
lang/m2/comp/f_info.h
View file

@ -1,5 +1,14 @@
/*
* (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;

9
lang/m2/comp/idf.c
View file

@ -1,4 +1,13 @@
/*
* (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>

9
lang/m2/comp/idf.h
View file

@ -1,5 +1,14 @@
/*
* (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;

9
lang/m2/comp/input.c
View file

@ -1,5 +1,14 @@
/*
* (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"

9
lang/m2/comp/input.h
View file

@ -1,5 +1,14 @@
/*
* (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

9
lang/m2/comp/lookup.c
View file

@ -1,5 +1,14 @@
/*
* (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>

26
lang/m2/comp/main.c
View file

@ -1,5 +1,14 @@
/*
* (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"
@ -19,6 +28,7 @@
#include "tokenname.h"
#include "node.h"
#include "warning.h"
#include "SYSTEM.h"
int state; /* either IMPLEMENTATION or PROGRAM */
char options[128];
@ -67,8 +77,6 @@ Compile(src, dst)
}
LineNumber = 1;
FileName = src;
DEFPATH[0] = ".";
DEFPATH[NDIRS] = 0;
init_idf();
InitCst();
reserve(tkidf);
@ -88,6 +96,7 @@ Compile(src, dst)
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) {
@ -186,26 +195,19 @@ AddStandards()
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();

9
lang/m2/comp/main.h
View file

@ -1,5 +1,14 @@
/*
* (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;

9
lang/m2/comp/misc.c
View file

@ -1,5 +1,14 @@
/*
* (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>

9
lang/m2/comp/misc.h
View file

@ -1,5 +1,14 @@
/*
* (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), ""))

9
lang/m2/comp/node.H
View file

@ -1,5 +1,14 @@
/*
* (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

9
lang/m2/comp/node.c
View file

@ -1,5 +1,14 @@
/*
* (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>

28
lang/m2/comp/options.c
View file

@ -1,5 +1,14 @@
/*
* (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"
@ -18,7 +27,7 @@ recognize some keywords!
#endif
extern int idfsize;
static int ndirs;
static int ndirs = 1;
int warning_classes;
DoOption(text)
@ -26,17 +35,16 @@ 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) {

18
lang/m2/comp/program.g
View file

@ -1,5 +1,14 @@
/*
* (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"
@ -118,14 +127,17 @@ DefinitionModule
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;
@ -207,8 +219,8 @@ ProgramModule
open_scope(CLOSEDSCOPE);
df->mod_vis = CurrVis;
CurrentScope->sc_name = "_M2M";
CurrentScope->sc_definedby = df;
}
CurrentScope->sc_definedby = df;
}
priority(df)
';' import(0)*

39
lang/m2/comp/scope.C
View file

@ -1,5 +1,14 @@
/*
* (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>
@ -44,6 +53,17 @@ open_scope(scopetype)
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();
@ -60,25 +80,6 @@ InitScope()
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;

11
lang/m2/comp/scope.h
View file

@ -1,5 +1,14 @@
/*
* (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) */
@ -40,3 +49,5 @@ extern struct scopelist
#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();

9
lang/m2/comp/standards.h
View file

@ -1,5 +1,14 @@
/*
* (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

17
lang/m2/comp/statement.g
View file

@ -1,5 +1,14 @@
/*
* (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>
@ -147,7 +156,13 @@ CaseStatement(struct node **pnd;)
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
;

9
lang/m2/comp/tmpvar.C
View file

@ -1,5 +1,14 @@
/*
* (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

9
lang/m2/comp/tokenname.c
View file

@ -1,5 +1,14 @@
/*
* (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"

9
lang/m2/comp/tokenname.h
View file

@ -1,5 +1,14 @@
/*
* (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
*/

11
lang/m2/comp/type.H
View file

@ -1,5 +1,14 @@
/*
* (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 */
@ -131,6 +140,8 @@ struct type
*set_type(),
*subr_type(),
*proc_type(),
*enum_type(),
*qualified_type(),
*RemoveEqual(); /* All from type.c */
#define NULLTYPE ((struct type *) 0)

129
lang/m2/comp/type.c
View file

@ -1,5 +1,14 @@
/*
* (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"
@ -18,6 +27,7 @@
#include "const.h"
#include "scope.h"
#include "walk.h"
#include "chk_expr.h"
int
word_align = AL_WORD,
@ -100,9 +110,10 @@ align(pos, al)
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 *
@ -113,8 +124,10 @@ standard_type(fund, align, size)
{
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;
@ -192,6 +205,59 @@ InitTypes()
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;
{
@ -275,14 +341,7 @@ subr_type(lb, ub)
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)) {
@ -505,6 +564,54 @@ RemoveEqual(tpx)
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;

9
lang/m2/comp/typequiv.c
View file

@ -1,5 +1,14 @@
/*
* (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
*/

20
lang/m2/comp/walk.c
View file

@ -1,5 +1,14 @@
/*
* (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.
*/
@ -42,6 +51,9 @@ static struct node *priority;
STATIC
DoPriority()
{
/* For the time being (???), handle priorities by calls to
the runtime system
*/
if (priority) {
C_loc(priority->nd_INT);
C_cal("_stackprio");
@ -111,10 +123,11 @@ WalkModule(module)
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
@ -422,6 +435,9 @@ WalkStat(nd, exit_label)
if (! options['L']) C_lin((arith) nd->nd_lineno);
switch(nd->nd_symb) {
case ';':
break;
case BECOMES:
DoAssign(nd, left, right);
break;

9
lang/m2/comp/walk.h
View file

@ -1,5 +1,14 @@
/*
* (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
*/

11
lang/m2/comp/warning.h
View file

@ -1,3 +1,14 @@
/*
* (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)