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

newer version, partial parse trees

Browse source
This commit is contained in:
ceriel 1986-04-06 17:42:56 +00:00
parent 0e4311490c
commit 376c47c98f
13 changed files with 418 additions and 220 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
lang/m2/comp/Makefile
View file

@ -17,7 +17,7 @@ LFLAGS = $(PROFILE)
LOBJ = tokenfile.o program.o declar.o expression.o statement.o LOBJ = tokenfile.o program.o declar.o expression.o statement.o
COBJ = LLlex.o LLmessage.o char.o error.o main.o \ COBJ = LLlex.o LLmessage.o char.o error.o main.o \
symbol2str.o tokenname.o idf.o input.o type.o def.o \ symbol2str.o tokenname.o idf.o input.o type.o def.o \
scope.o misc.o enter.o defmodule.o typequiv.o scope.o misc.o enter.o defmodule.o typequiv.o node.o
OBJ = $(COBJ) $(LOBJ) Lpars.o OBJ = $(COBJ) $(LOBJ) Lpars.o
GENFILES= tokenfile.c \ GENFILES= tokenfile.c \
program.c declar.c expression.c statement.c \ program.c declar.c expression.c statement.c \
@ -47,6 +47,7 @@ symbol2str.c: tokenname.c make.tokcase
misc.h: misc.H make.allocd misc.h: misc.H make.allocd
def.h: def.H make.allocd def.h: def.H make.allocd
type.h: type.H make.allocd type.h: type.H make.allocd
node.h: node.H make.allocd
scope.c: scope.C make.allocd scope.c: scope.C make.allocd
char.c: char.tab tab char.c: char.tab tab
@ -71,22 +72,23 @@ depend:
LLlex.o: LLlex.h Lpars.h class.h f_info.h idf.h input.h LLlex.o: LLlex.h Lpars.h class.h f_info.h idf.h input.h
LLmessage.o: LLlex.h Lpars.h idf.h LLmessage.o: LLlex.h Lpars.h idf.h
char.o: class.h char.o: class.h
error.o: LLlex.h f_info.h input.h main.h error.o: LLlex.h f_info.h input.h main.h node.h
main.o: LLlex.h Lpars.h debug.h def.h f_info.h idf.h input.h main.h scope.h standards.h type.h main.o: LLlex.h Lpars.h debug.h def.h f_info.h idf.h input.h main.h scope.h standards.h type.h
symbol2str.o: Lpars.h symbol2str.o: Lpars.h
tokenname.o: Lpars.h idf.h tokenname.h tokenname.o: Lpars.h idf.h tokenname.h
idf.o: idf.h idf.o: idf.h
input.o: f_info.h input.h input.o: f_info.h input.h
type.o: Lpars.h def.h def_sizes.h idf.h misc.h type.h type.o: LLlex.h Lpars.h def.h def_sizes.h idf.h node.h type.h
def.o: Lpars.h debug.h def.h idf.h main.h misc.h scope.h type.h def.o: LLlex.h Lpars.h debug.h def.h idf.h main.h node.h scope.h type.h
scope.o: LLlex.h debug.h def.h idf.h scope.h type.h scope.o: LLlex.h debug.h def.h idf.h scope.h type.h
misc.o: LLlex.h f_info.h idf.h misc.h misc.o: LLlex.h f_info.h idf.h misc.h
enter.o: def.h idf.h misc.h scope.h type.h enter.o: LLlex.h def.h idf.h node.h scope.h type.h
defmodule.o: LLlex.h def.h f_info.h idf.h input.h scope.h defmodule.o: LLlex.h def.h f_info.h idf.h input.h scope.h
typequiv.o: Lpars.h def.h type.h typequiv.o: Lpars.h def.h type.h
node.o: LLlex.h def.h node.h type.h
tokenfile.o: Lpars.h tokenfile.o: Lpars.h
program.o: LLlex.h Lpars.h debug.h def.h idf.h main.h misc.h scope.h type.h program.o: LLlex.h Lpars.h debug.h def.h idf.h main.h node.h scope.h type.h
declar.o: LLlex.h Lpars.h def.h idf.h misc.h scope.h type.h declar.o: LLlex.h Lpars.h def.h idf.h misc.h node.h scope.h type.h
expression.o: LLlex.h Lpars.h def.h idf.h scope.h expression.o: LLlex.h Lpars.h def.h idf.h node.h scope.h
statement.o: Lpars.h statement.o: Lpars.h
Lpars.o: Lpars.h Lpars.o: Lpars.h

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

@ -7,11 +7,12 @@ static char *RcsId = "$Header$";
#include <em_label.h> #include <em_label.h>
#include <assert.h> #include <assert.h>
#include "idf.h" #include "idf.h"
#include "misc.h"
#include "LLlex.h" #include "LLlex.h"
#include "def.h" #include "def.h"
#include "type.h" #include "type.h"
#include "scope.h" #include "scope.h"
#include "node.h"
#include "misc.h"
} }
ProcedureDeclaration ProcedureDeclaration
@ -95,7 +96,7 @@ FormalParameters(int doparams; struct paramlist **pr; struct type **tp;)
]? ]?
')' ')'
{ *tp = 0; } { *tp = 0; }
[ ':' qualident(D_TYPE | D_HTYPE, &df, "type") [ ':' qualident(D_TYPE | D_HTYPE, &df, "type", (struct node **) 0)
{ *tp = df->df_type; } { *tp = df->df_type; }
]? ]?
; ;
@ -108,7 +109,7 @@ FormalParameters(int doparams; struct paramlist **pr; struct type **tp;)
*/ */
FPSection(int doparams; struct paramlist **ppr;) FPSection(int doparams; struct paramlist **ppr;)
{ {
struct id_list *FPList; struct node *FPList;
struct paramlist *ParamList(); struct paramlist *ParamList();
struct type *tp; struct type *tp;
int VARp = 0; int VARp = 0;
@ -122,7 +123,7 @@ FPSection(int doparams; struct paramlist **ppr;)
EnterIdList(FPList, D_VARIABLE, VARp, tp, CurrentScope); EnterIdList(FPList, D_VARIABLE, VARp, tp, CurrentScope);
} }
*ppr = ParamList(FPList, tp); *ppr = ParamList(FPList, tp);
FreeIdList(FPList); FreeNode(FPList);
} }
; ;
@ -133,7 +134,7 @@ FormalType(struct type **tp;)
} : } :
[ ARRAY OF { ARRAYflag = 1; } [ ARRAY OF { ARRAYflag = 1; }
]? ]?
qualident(D_TYPE | D_HTYPE, &df, "type") qualident(D_TYPE | D_HTYPE, &df, "type", (struct node **) 0)
{ if (ARRAYflag) { { if (ARRAYflag) {
*tp = construct_type(ARRAY, NULLTYPE); *tp = construct_type(ARRAY, NULLTYPE);
(*tp)->arr_elem = df->df_type; (*tp)->arr_elem = df->df_type;
@ -182,7 +183,7 @@ SimpleType(struct type **ptp;)
struct def *df; struct def *df;
struct type *tp; struct type *tp;
} : } :
qualident(D_TYPE | D_HTYPE, &df, "type") qualident(D_TYPE | D_HTYPE, &df, "type", (struct node **) 0)
[ [
/* nothing */ /* nothing */
| |
@ -202,41 +203,44 @@ SimpleType(struct type **ptp;)
enumeration(struct type **ptp;) enumeration(struct type **ptp;)
{ {
struct id_list *EnumList; struct node *EnumList;
} : } :
'(' IdentList(&EnumList) ')' '(' IdentList(&EnumList) ')'
{ {
*ptp = standard_type(ENUMERATION,int_align,int_size); *ptp = standard_type(ENUMERATION,int_align,int_size);
EnterIdList(EnumList, D_ENUM, 0, *ptp, CurrentScope); EnterIdList(EnumList, D_ENUM, 0, *ptp, CurrentScope);
FreeIdList(EnumList); FreeNode(EnumList);
} }
; ;
IdentList(struct id_list **p;) IdentList(struct node **p;)
{ {
register struct id_list *q = new_id_list(); register struct node *q;
} : } :
IDENT { q->id_ptr = dot.TOK_IDF; *p = q;} IDENT { q = MkNode(Value, NULLNODE, NULLNODE, &dot);
*p = q;
}
[ [
',' IDENT { q->next = new_id_list(); ',' IDENT
q = q->next; { q->next = MkNode(Value,NULLNODE,NULLNODE,&dot);
q->id_ptr = dot.TOK_IDF; q = q->next;
} }
]* ]*
{ q->next = 0; } { q->next = 0; }
; ;
SubrangeType(struct type **ptp;) SubrangeType(struct type **ptp;)
{ {
struct type *tp; struct type *tp;
struct node *nd1 = 0, *nd2 = 0;
}: }:
/* /*
This is not exactly the rule in the new report, but see This is not exactly the rule in the new report, but see
the rule for "SimpleType". the rule for "SimpleType".
*/ */
'[' ConstExpression '[' ConstExpression(&nd1)
UPTO ConstExpression UPTO ConstExpression(&nd2)
']' ']'
/* /*
Evaluate the expressions. Check that they are indeed constant. Evaluate the expressions. Check that they are indeed constant.
@ -295,7 +299,7 @@ FieldListSequence(struct scope *scope;):
FieldList(struct scope *scope;) FieldList(struct scope *scope;)
{ {
struct id_list *FldList; struct node *FldList;
struct idf *id; struct idf *id;
struct def *df, *df1; struct def *df, *df1;
struct type *tp; struct type *tp;
@ -303,7 +307,7 @@ FieldList(struct scope *scope;)
[ [
IdentList(&FldList) ':' type(&tp) IdentList(&FldList) ':' type(&tp)
{ EnterIdList(FldList, D_FIELD, 0, tp, scope); { EnterIdList(FldList, D_FIELD, 0, tp, scope);
FreeIdList(FldList); FreeNode(FldList);
} }
| |
CASE CASE
@ -312,7 +316,7 @@ FieldList(struct scope *scope;)
| |
{ id = gen_anon_idf(); } { id = gen_anon_idf(); }
] /* Changed rule in new modula-2 */ ] /* Changed rule in new modula-2 */
':' qualident(D_TYPE|D_HTYPE, &df, "type") ':' qualident(D_TYPE|D_HTYPE, &df, "type", (struct node **) 0)
{ df1 = define(id, scope, D_FIELD); { df1 = define(id, scope, D_FIELD);
df1->df_type = df->df_type; df1->df_type = df->df_type;
} }
@ -335,8 +339,11 @@ CaseLabelList:
CaseLabels [ ',' CaseLabels ]* CaseLabels [ ',' CaseLabels ]*
; ;
CaseLabels: CaseLabels
ConstExpression [ UPTO ConstExpression ]? {
struct node *nd1, *nd2 = 0;
}:
ConstExpression(&nd1) [ UPTO ConstExpression(&nd2) ]?
; ;
SetType(struct type **ptp;) SetType(struct type **ptp;)
@ -364,7 +371,7 @@ PointerType(struct type **ptp;)
/* Either a Module or a Type, but in both cases defined /* Either a Module or a Type, but in both cases defined
in this scope, so this is the correct identification in this scope, so this is the correct identification
*/ */
qualident(D_TYPE|D_HTYPE, &df, "type") qualident(D_TYPE|D_HTYPE, &df, "type", (struct node **) 0)
{ {
if (!df->df_type) { if (!df->df_type) {
error("type \"%s\" not declared", error("type \"%s\" not declared",
@ -429,7 +436,7 @@ FormalTypeList(struct paramlist **ppr; struct type **ptp;)
{ p->next = 0; } { p->next = 0; }
]? ]?
')' ')'
[ ':' qualident(D_TYPE|D_HTYPE, &df, "type") [ ':' qualident(D_TYPE|D_HTYPE, &df, "type", (struct node **) 0)
{ *ptp = df->df_type; } { *ptp = df->df_type; }
]? ]?
; ;
@ -438,24 +445,26 @@ ConstantDeclaration
{ {
struct def *df; struct def *df;
struct idf *id; struct idf *id;
struct node *nd;
}: }:
IDENT { id = dot.TOK_IDF; } IDENT { id = dot.TOK_IDF; }
'=' ConstExpression { df = define(id, CurrentScope, D_CONST); '=' ConstExpression(&nd){ df = define(id, CurrentScope, D_CONST);
/* ???? */ /* ???? */
} }
; ;
VariableDeclaration VariableDeclaration
{ {
struct id_list *VarList; struct node *VarList;
struct type *tp; struct type *tp;
struct node *nd = 0;
} : } :
IdentList(&VarList) IdentList(&VarList)
[ [
ConstExpression ConstExpression(&nd)
]? ]?
':' type(&tp) ':' type(&tp)
{ EnterIdList(VarList, D_VARIABLE, 0, tp, CurrentScope); { EnterIdList(VarList, D_VARIABLE, 0, tp, CurrentScope);
FreeIdList(VarList); FreeNode(VarList);
} }
; ;

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

@ -10,9 +10,10 @@ static char *RcsId = "$Header$";
#include "def.h" #include "def.h"
#include "type.h" #include "type.h"
#include "idf.h" #include "idf.h"
#include "misc.h"
#include "main.h" #include "main.h"
#include "scope.h" #include "scope.h"
#include "LLlex.h"
#include "node.h"
#include "debug.h" #include "debug.h"
struct def *h_def; /* Pointer to free list of def structures */ struct def *h_def; /* Pointer to free list of def structures */
@ -63,7 +64,7 @@ define(id, scope, kind)
return df; return df;
} }
if (kind != D_ERROR) { if (kind != D_ERROR) {
error("identifier \"%s\" already declared", id->id_text); error("identifier \"%s\" already declared", id->id_text);
} }
return df; return df;
} }
@ -115,7 +116,7 @@ lookup(id, scope)
} }
Export(ids, qualified) Export(ids, qualified)
register struct id_list *ids; register struct node *ids;
{ {
/* From the current scope, the list of identifiers "ids" is /* From the current scope, the list of identifiers "ids" is
exported. Note this fact. If the export is not qualified, make exported. Note this fact. If the export is not qualified, make
@ -125,36 +126,38 @@ Export(ids, qualified)
register struct def *df; register struct def *df;
while (ids) { while (ids) {
df = define(ids->id_ptr, CurrentScope, D_ISEXPORTED); df = define(ids->nd_IDF, CurrentScope, D_ISEXPORTED);
if (qualified) { if (qualified) {
df->df_flags |= D_QEXPORTED; df->df_flags |= D_QEXPORTED;
} }
else { else {
df->df_flags |= D_EXPORTED; df->df_flags |= D_EXPORTED;
df = define(ids->id_ptr, enclosing(CurrentScope), df = define(ids->nd_IDF, enclosing(CurrentScope),
D_IMPORT); D_IMPORT);
} }
ids = ids->next; ids = ids->next;
} }
} }
Import(ids, id, local) Import(ids, idn, local)
register struct id_list *ids; register struct node *ids;
struct idf *id; struct node *idn;
{ {
/* "ids" is a list of imported identifiers. /* "ids" is a list of imported identifiers.
If "id" is a null-pointer, the identifiers are imported from the If "idn" is a null-pointer, the identifiers are imported from
enclosing scope. Otherwise they are imported from the module the enclosing scope. Otherwise they are imported from the module
indicated by "id", which must be visible in the enclosing scope. indicated by "idn", which must be visible in the enclosing
An exception must be made for imports of the Compilation Unit. scope. An exception must be made for imports of the
Compilation Unit.
This case is indicated by the value 0 of the flag "local". This case is indicated by the value 0 of the flag "local".
In this case, if "id" is a null pointer, the "ids" identifiers In this case, if "idn" is a null pointer, the "ids" identifiers
are all module identifiers. Their Definition Modules must be are all module identifiers. Their Definition Modules must be
read. Otherwise "id" is a module identifier whose Definition read. Otherwise "idn" is a module identifier whose Definition
Module must be read. "ids" then represents a list of Module must be read. "ids" then represents a list of
identifiers defined in this module. identifiers defined in this module.
*/ */
register struct def *df; register struct def *df;
register struct idf *id = 0;
int scope; int scope;
int kind; int kind;
int imp_kind; int imp_kind;
@ -162,6 +165,7 @@ Import(ids, id, local)
#define FROM_ENCLOSING 1 #define FROM_ENCLOSING 1
struct def *lookfor(), *GetDefinitionModule(); struct def *lookfor(), *GetDefinitionModule();
if (idn) id = idn->nd_IDF;
kind = D_IMPORT; kind = D_IMPORT;
scope = enclosing(CurrentScope)->sc_scope; scope = enclosing(CurrentScope)->sc_scope;
if (!id) imp_kind = FROM_ENCLOSING; if (!id) imp_kind = FROM_ENCLOSING;
@ -173,35 +177,35 @@ Import(ids, id, local)
/* enter all "ids" with type D_ERROR */ /* enter all "ids" with type D_ERROR */
kind = D_ERROR; kind = D_ERROR;
if (df->df_kind != D_ERROR) { if (df->df_kind != D_ERROR) {
error("identifier \"%s\" does not represent a module", id->id_text); node_error(idn, "identifier \"%s\" does not represent a module", id->id_text);
} }
} }
else scope = df->mod_scope; else scope = df->mod_scope;
} }
while (ids) { while (ids) {
if (imp_kind == FROM_MODULE) { if (imp_kind == FROM_MODULE) {
if (!(df = lookup(ids->id_ptr, scope))) { if (!(df = lookup(ids->nd_IDF, scope))) {
error("identifier \"%s\" not declared in qualifying module", node_error(ids, "identifier \"%s\" not declared in qualifying module",
ids->id_ptr->id_text); ids->nd_IDF->id_text);
df = ill_df; df = ill_df;
} }
else else
if (!(df->df_flags&(D_EXPORTED|D_QEXPORTED))) { if (!(df->df_flags&(D_EXPORTED|D_QEXPORTED))) {
error("identifier \"%s\" not exported from qualifying module", node_error(ids,"identifier \"%s\" not exported from qualifying module",
ids->id_ptr->id_text); ids->nd_IDF->id_text);
} }
} }
else { else {
if (local) { if (local) {
df = lookfor(ids->id_ptr, df = lookfor(ids->nd_IDF,
enclosing(CurrentScope), 0); enclosing(CurrentScope), 0);
} else df = GetDefinitionModule(ids->id_ptr); } else df = GetDefinitionModule(ids->nd_IDF);
if (df->df_kind == D_ERROR) { if (df->df_kind == D_ERROR) {
error("identifier \"%s\" not visible in enclosing scope", node_error(ids, "identifier \"%s\" not visible in enclosing scope",
ids->id_ptr->id_text); ids->nd_IDF->id_text);
} }
} }
define(ids->id_ptr, CurrentScope, kind)->imp_def = df; define(ids->nd_IDF, CurrentScope, kind)->imp_def = df;
if (df->df_kind == D_TYPE && if (df->df_kind == D_TYPE &&
df->df_type->tp_fund == ENUMERATION) { df->df_type->tp_fund == ENUMERATION) {
/* Also import all enumeration literals */ /* Also import all enumeration literals */

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

@ -9,7 +9,8 @@ static char *RcsId = "$Header$";
#include "def.h" #include "def.h"
#include "type.h" #include "type.h"
#include "scope.h" #include "scope.h"
#include "misc.h" #include "LLlex.h"
#include "node.h"
struct def * struct def *
Enter(name, kind, type, pnam) Enter(name, kind, type, pnam)
@ -30,7 +31,7 @@ Enter(name, kind, type, pnam)
} }
EnterIdList(idlist, kind, flags, type, scope) EnterIdList(idlist, kind, flags, type, scope)
register struct id_list *idlist; register struct node *idlist;
struct type *type; struct type *type;
struct scope *scope; struct scope *scope;
{ {
@ -39,7 +40,7 @@ EnterIdList(idlist, kind, flags, type, scope)
int assval = 0; int assval = 0;
while (idlist) { while (idlist) {
df = define(idlist->id_ptr, scope, kind); df = define(idlist->nd_IDF, scope, kind);
df->df_type = type; df->df_type = type;
df->df_flags = flags; df->df_flags = flags;
if (kind == D_ENUM) { if (kind == D_ENUM) {

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

@ -13,6 +13,7 @@ static char *RcsId = "$Header$";
#include "f_info.h" #include "f_info.h"
#include "LLlex.h" #include "LLlex.h"
#include "main.h" #include "main.h"
#include "node.h"
#define MAXERR_LINE 5 /* Number of error messages on one line ... */ #define MAXERR_LINE 5 /* Number of error messages on one line ... */
#define ERROUT STDERR #define ERROUT STDERR
@ -28,8 +29,6 @@ static char *RcsId = "$Header$";
#define VDEBUG 7 #define VDEBUG 7
#endif #endif
#define NILEXPR ((struct expr *) 0)
int err_occurred; int err_occurred;
extern char *symbol2str(); extern char *symbol2str();
@ -37,12 +36,12 @@ extern char *symbol2str();
/* There are three general error-message functions: /* There are three general error-message functions:
lexerror() lexical and pre-processor error messages lexerror() lexical and pre-processor error messages
error() syntactic and semantic error messages error() syntactic and semantic error messages
expr_error() errors in expressions node_error() errors in nodes
The difference lies in the place where the file name and line The difference lies in the place where the file name and line
number come from. number come from.
Lexical errors report from the global variables LineNumber and Lexical errors report from the global variables LineNumber and
FileName, expression errors get their information from the FileName, node errors get their information from the
expression, whereas other errors use the information in the token. node, whereas other errors use the information in the token.
*/ */
#ifdef DEBUG #ifdef DEBUG
@ -50,7 +49,7 @@ extern char *symbol2str();
debug(level, fmt, args) debug(level, fmt, args)
char *fmt; char *fmt;
{ {
if (level <= options['D']) _error(VDEBUG, NILEXPR, fmt, &args); if (level <= options['D']) _error(VDEBUG, NULLNODE, fmt, &args);
} }
#endif DEBUG #endif DEBUG
@ -58,44 +57,44 @@ debug(level, fmt, args)
error(fmt, args) error(fmt, args)
char *fmt; char *fmt;
{ {
_error(ERROR, NILEXPR, fmt, &args); _error(ERROR, NULLNODE, fmt, &args);
} }
/*VARARGS2*/ /*VARARGS2*/
expr_error(expr, fmt, args) node_error(node, fmt, args)
struct expr *expr; struct node *node;
char *fmt; char *fmt;
{ {
_error(ERROR, expr, fmt, &args); _error(ERROR, node, fmt, &args);
} }
/*VARARGS1*/ /*VARARGS1*/
warning(fmt, args) warning(fmt, args)
char *fmt; char *fmt;
{ {
_error(WARNING, NILEXPR, fmt, &args); _error(WARNING, NULLNODE, fmt, &args);
} }
/*VARARGS2*/ /*VARARGS2*/
expr_warning(expr, fmt, args) node_warning(node, fmt, args)
struct expr *expr; struct node *node;
char *fmt; char *fmt;
{ {
_error(WARNING, expr, fmt, &args); _error(WARNING, node, fmt, &args);
} }
/*VARARGS1*/ /*VARARGS1*/
lexerror(fmt, args) lexerror(fmt, args)
char *fmt; char *fmt;
{ {
_error(LEXERROR, NILEXPR, fmt, &args); _error(LEXERROR, NULLNODE, fmt, &args);
} }
/*VARARGS1*/ /*VARARGS1*/
lexwarning(fmt, args) lexwarning(fmt, args)
char *fmt; char *fmt;
{ {
_error(LEXWARNING, NILEXPR, fmt, &args); _error(LEXWARNING, NULLNODE, fmt, &args);
} }
/*VARARGS1*/ /*VARARGS1*/
@ -104,13 +103,13 @@ fatal(fmt, args)
int args; int args;
{ {
_error(FATAL, NILEXPR, fmt, &args); _error(FATAL, NULLNODE, fmt, &args);
sys_stop(S_EXIT); sys_stop(S_EXIT);
} }
_error(class, expr, fmt, argv) _error(class, node, fmt, argv)
int class; int class;
struct expr *expr; struct node *node;
char *fmt; char *fmt;
int argv[]; int argv[];
{ {
@ -118,8 +117,10 @@ _error(class, expr, fmt, argv)
for a given line to MAXERR_LINE. for a given line to MAXERR_LINE.
*/ */
static unsigned int last_ln = 0; static unsigned int last_ln = 0;
static int e_seen = 0;
unsigned int ln = 0; unsigned int ln = 0;
static char * last_fn = 0;
char *fn = 0;
static int e_seen = 0;
char *remark = 0; char *remark = 0;
/* Since name and number are gathered from different places /* Since name and number are gathered from different places
@ -158,13 +159,19 @@ _error(class, expr, fmt, argv)
case FATAL: case FATAL:
remark = "fatal error --"; remark = "fatal error --";
break; break;
#ifdef DEBUG
case VDEBUG:
remark = "(debug)";
break;
#endif DEBUG
} }
/* the place */ /* the place */
switch (class) { switch (class) {
case WARNING: case WARNING:
case ERROR: case ERROR:
ln = /* ???? expr ? expr->ex_line : */ dot.tk_lineno; fn = node ? node->nd_filename : dot.tk_filename;
ln = node ? node->nd_lineno : dot.tk_lineno;
break; break;
case LEXWARNING: case LEXWARNING:
case LEXERROR: case LEXERROR:
@ -174,13 +181,14 @@ _error(class, expr, fmt, argv)
case VDEBUG: case VDEBUG:
#endif DEBUG #endif DEBUG
ln = LineNumber; ln = LineNumber;
fn = FileName;
break; break;
} }
#ifdef DEBUG #ifdef DEBUG
if (class != VDEBUG) { if (class != VDEBUG) {
#endif #endif
if (ln == last_ln) { if (fn == last_fn && ln == last_ln) {
/* we've seen this place before */ /* we've seen this place before */
e_seen++; e_seen++;
if (e_seen == MAXERR_LINE) fmt = "etc ..."; if (e_seen == MAXERR_LINE) fmt = "etc ...";
@ -192,13 +200,14 @@ _error(class, expr, fmt, argv)
else { else {
/* brand new place */ /* brand new place */
last_ln = ln; last_ln = ln;
last_fn = fn;
e_seen = 0; e_seen = 0;
} }
#ifdef DEBUG #ifdef DEBUG
} }
#endif DEBUG #endif DEBUG
if (FileName) fprint(ERROUT, "\"%s\", line %u: ", FileName, ln); if (fn) fprint(ERROUT, "\"%s\", line %u: ", fn, ln);
if (remark) fprint(ERROUT, "%s ", remark); if (remark) fprint(ERROUT, "%s ", remark);

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

@ -10,15 +10,18 @@ static char *RcsId = "$Header$";
#include "idf.h" #include "idf.h"
#include "def.h" #include "def.h"
#include "scope.h" #include "scope.h"
#include "node.h"
} }
number: number(struct node **p;):
[
INTEGER INTEGER
| |
REAL REAL
] { *p = MkNode(Value, NULLNODE, NULLNODE, dot); }
; ;
qualident(int types; struct def **pdf; char *str;) qualident(int types; struct def **pdf; char *str; struct node **p;)
{ {
int scope; int scope;
int module; int module;
@ -30,6 +33,9 @@ qualident(int types; struct def **pdf; char *str;)
*pdf = df; *pdf = df;
if (df->df_kind == D_ERROR) types = 0; if (df->df_kind == D_ERROR) types = 0;
} }
if (p) {
*p = MkNode(Value, NULLNODE, NULLNODE,&dot);
}
} }
[ [
{ if (types &&!(scope = has_selectors(df))) { { if (types &&!(scope = has_selectors(df))) {
@ -38,8 +44,13 @@ qualident(int types; struct def **pdf; char *str;)
} }
} }
/* selector */ /* selector */
'.' IDENT '.' { if (p) *p = MkNode(Link, *p, NULLNODE, &dot); }
{ if (types) { IDENT
{ if (p) {
p = &((*p)->nd_right);
*p = MkNode(Value, NULLNODE, NULLNODE,&dot);
}
if (types) {
module = (df->df_kind == D_MODULE); module = (df->df_kind == D_MODULE);
df = lookup(dot.TOK_IDF, scope); df = lookup(dot.TOK_IDF, scope);
if (!df) { if (!df) {
@ -62,99 +73,179 @@ qualident(int types; struct def **pdf; char *str;)
} }
; ;
/* Inline substituted wherever it occurred
selector: selector:
'.' /* field */ IDENT '.' IDENT
;
*/
ExpList(struct node **pnd;)
{
struct node **nd;
} :
expression(pnd) { nd = pnd; }
[
',' { *nd = MkNode(Link, *nd, NULLNODE, &dot);
nd = &(*nd)->nd_right;
}
expression(nd)
]*
; ;
ExpList: ConstExpression(struct node **pnd;):
expression [ ',' expression ]* expression(pnd)
;
ConstExpression:
expression
/* /*
* Changed rule in new Modula-2. * Changed rule in new Modula-2.
* Check that the expression is a constant expression and evaluate! * Check that the expression is a constant expression and evaluate!
*/ */
; ;
expression: expression(struct node **pnd;)
SimpleExpression [ relation SimpleExpression ]? {
struct node *nd;
} :
SimpleExpression(&nd)
[
/* relation */
[ '=' | '#' | UNEQUAL | '<' | LESSEQUAL | '>' |
GREATEREQUAL | IN
]
{ nd = MkNode(Oper, nd, NULLNODE, &dot); }
SimpleExpression(&(nd->nd_right))
]?
{ *pnd = nd; }
; ;
/* Inline in expression
relation: relation:
'=' | '#' | UNEQUAL | '<' | LESSEQUAL | '>' | GREATEREQUAL | IN '=' | '#' | UNEQUAL | '<' | LESSEQUAL | '>' | GREATEREQUAL | IN
; ;
*/
SimpleExpression: SimpleExpression(struct node **pnd;)
[ '+' | '-' ]? term [ AddOperator term ]*
;
AddOperator:
'+' | '-' | OR
;
term:
factor [ MulOperator factor ]*
;
MulOperator:
'*' | '/' | DIV | MOD | AND | '&'
;
factor
{ {
struct def *df; register struct node *nd;
} : } :
qualident(0, &df, (char *) 0) [ '+' | '-' ]?
term(pnd) { nd = *pnd; }
[ [
designator_tail? ActualParameters? /* AddOperator */
| [ '+' | '-' | OR ]
bare_set { *pnd = nd = MkNode(Oper, nd, NULLNODE, &dot); }
] term(&(nd->nd_right))
|
bare_set
| %default
number
|
STRING
|
'(' expression ')'
|
NOT factor
;
bare_set:
'{' [ element [ ',' element ]* ]? '}'
;
ActualParameters:
'(' ExpList? ')'
;
element:
expression [ UPTO expression ]?
;
designator
{
struct def *df;
} :
qualident(0, &df, (char *) 0)
designator_tail?
;
designator_tail:
visible_designator_tail
[
selector
|
visible_designator_tail
]* ]*
; ;
visible_designator_tail: /* Inline in "SimpleExpression"
'[' ExpList ']' AddOperator:
| '+' | '-' | OR
'^' ;
*/
term(struct node **pnd;)
{
register struct node *nd;
}:
factor(pnd) { nd = *pnd; }
[
/* MulOperator */
[ '*' | '/' | DIV | MOD | AND | '&' ]
{ *pnd = nd = MkNode(Oper, nd, NULLNODE, &dot); }
factor(&(nd->nd_right))
]*
;
/* inline in "term"
MulOperator:
'*' | '/' | DIV | MOD | AND | '&'
;
*/
factor(struct node **p;)
{
struct def *df;
} :
qualident(0, &df, (char *) 0, p)
[
designator_tail(p)?
[
{ *p = MkNode(Call, p, NULLNODE, &dot); }
ActualParameters(&((*p)->nd_right))
]?
| { *p = MkNode(Call, p, NULLNODE, &dot); }
bare_set(&((*p)->nd_right))
]
|
bare_set(p)
| %default
number(p)
|
STRING { *p = MkNode(Value, NULLNODE, NULLNODE, &dot); }
|
'(' expression(p) ')'
|
NOT { *p = MkNode(Uoper, NULLNODE, NULLNODE, &dot); }
factor(&((*p)->nd_left))
;
bare_set(struct node **pnd;)
{
struct node **nd;
} :
'{' {
dot.tk_symb = SET;
*pnd = MkNode(Link, NULLNODE, NULLNODE, &dot);
nd = &((*pnd)->nd_left);
}
[
element(nd)
[
',' { *nd = MkNode(Link, *nd, NULLNODE, &dot);
nd = &((*nd)->nd_right);
}
element(nd)
]*
]?
'}'
;
ActualParameters(struct node **pnd;):
'(' ExpList(pnd)? ')'
;
element(struct node **pnd;):
expression(pnd)
[
UPTO { *pnd = MkNode(Link, *pnd, NULLNODE, &dot);}
expression(&((*pnd)->nd_right))
]?
;
designator(struct node **pnd;)
{
struct def *df;
} :
qualident(0, &df, (char *) 0, pnd)
designator_tail(pnd)?
;
designator_tail(struct node **pnd;):
visible_designator_tail(pnd)
[
/* selector */
'.' { *pnd = MkNode(Oper, *pnd, NULLNODE, &dot); }
IDENT { (*pnd)->nd_right =
MkNode(Value, NULLNODE, NULLNODE, &dot);
}
|
visible_designator_tail(pnd)
]*
;
visible_designator_tail(struct node **pnd;):
'[' { *pnd = MkNode(Oper, *pnd, NULLNODE, &dot); }
ExpList(&((*pnd)->nd_right))
']'
|
'^' { *pnd = MkNode(Oper, *pnd, NULLNODE, &dot); }
; ;

7
lang/m2/comp/misc.H
View file

@ -2,13 +2,6 @@
/* $Header$ */ /* $Header$ */
/* Structure to link idf structures together
*/
struct id_list {
struct id_list *next;
struct idf *id_ptr;
};
/* ALLOCDEF "id_list" */ /* ALLOCDEF "id_list" */
#define is_anon_idf(x) ((x)->id_text[0] == '#') #define is_anon_idf(x) ((x)->id_text[0] == '#')

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

@ -24,22 +24,6 @@ match_id(id1, id2)
} }
} }
struct id_list *h_id_list; /* Header of free list of id_list structures */
/* FreeIdList: take a list of id_list structures and put them
on the free list of id_list structures
*/
FreeIdList(p)
struct id_list *p;
{
register struct id_list *q;
while (q = p) {
p = p->next;
free_id_list(q);
}
}
struct idf * struct idf *
gen_anon_idf() gen_anon_idf()
{ {

31
lang/m2/comp/node.H Normal file
View file

@ -0,0 +1,31 @@
/* 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
struct node *nd_right;
int nd_class; /* kind of node */
#define Value 1 /* idf or constant */
#define Oper 2 /* binary operator */
#define Uoper 3 /* unary operator */
#define Call 4 /* cast or procedure - or function call */
#define Link 5
struct type *nd_type; /* type of this node */
struct token nd_token;
#define nd_symb nd_token.tk_symb
#define nd_lineno nd_token.tk_lineno
#define nd_filename nd_token.tk_filename
#define nd_IDF nd_token.TOK_IDF
#define nd_STR nd_token.TOK_STR
#define nd_SLE nd_token.TOK_SLE
#define nd_INT nd_token.TOK_INT
#define nd_REL nd_token.TOK_REL
};
/* ALLOCDEF "node" */
extern struct node *MkNode();
#define NULLNODE ((struct node *) 0)

41
lang/m2/comp/node.c Normal file
View file

@ -0,0 +1,41 @@
/* 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 */
static char *RcsId = "$Header$";
#include <em_label.h>
#include <em_arith.h>
#include <alloc.h>
#include "def.h"
#include "type.h"
#include "LLlex.h"
#include "node.h"
struct node *h_node; /* header of free list */
struct node *
MkNode(class, left, right, token)
struct node *left, *right;
struct token *token;
{
/* Create a node and initialize it with the given parameters
*/
register struct node *nd = new_node();
nd->nd_left = left;
nd->nd_right = right;
nd->nd_token = *token;
nd->nd_class = class;
nd->nd_type = NULLTYPE;
return nd;
}
FreeNode(nd)
register struct node *nd;
{
/* Put nodes that are no longer needed back onto the free
list
*/
if (nd->nd_left) FreeNode(nd->nd_left);
if (nd->nd_right) FreeNode(nd->nd_right);
free_node(nd);
}

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

@ -7,12 +7,12 @@ static char *RcsId = "$Header$";
#include <em_arith.h> #include <em_arith.h>
#include <em_label.h> #include <em_label.h>
#include "idf.h" #include "idf.h"
#include "misc.h"
#include "main.h" #include "main.h"
#include "LLlex.h" #include "LLlex.h"
#include "scope.h" #include "scope.h"
#include "def.h" #include "def.h"
#include "type.h" #include "type.h"
#include "node.h"
#include "debug.h" #include "debug.h"
static struct idf *impl_name = 0; static struct idf *impl_name = 0;
@ -57,13 +57,16 @@ ModuleDeclaration
} }
; ;
priority: priority
'[' ConstExpression ']' {
struct node *nd;
}:
'[' ConstExpression(&nd) ']'
; ;
export(int def;) export(int def;)
{ {
struct id_list *ExportList; struct node *ExportList;
int QUALflag = 0; int QUALflag = 0;
} : } :
EXPORT EXPORT
@ -74,17 +77,17 @@ export(int def;)
{ {
if (!def) Export(ExportList, QUALflag); if (!def) Export(ExportList, QUALflag);
else warning("export list in definition module ignored"); else warning("export list in definition module ignored");
FreeIdList(ExportList); FreeNode(ExportList);
} }
; ;
import(int local;) import(int local;)
{ {
struct id_list *ImportList; struct node *ImportList;
struct idf *id = 0; struct node *id = 0;
} : } :
[ FROM [ FROM
IDENT { id = dot.TOK_IDF; } IDENT { id = MkNode(Value, NULLNODE, NULLNODE, &dot); }
]? ]?
IMPORT IdentList(&ImportList) ';' IMPORT IdentList(&ImportList) ';'
/* /*
@ -95,7 +98,8 @@ import(int local;)
*/ */
{ {
Import(ImportList, id, local); Import(ImportList, id, local);
FreeIdList(ImportList); FreeNode(ImportList);
if (id) FreeNode(id);
} }
; ;

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

@ -2,20 +2,27 @@
{ {
static char *RcsId = "$Header$"; static char *RcsId = "$Header$";
#include <em_arith.h>
#include "LLlex.h"
#include "node.h"
} }
statement: statement
{
struct node *nd1, *nd2;
} :
[ [
/* /*
* This part is not in the reference grammar. The reference grammar * This part is not in the reference grammar. The reference grammar
* states : assignment | ProcedureCall | ... * states : assignment | ProcedureCall | ...
* but this gives LL(1) conflicts * but this gives LL(1) conflicts
*/ */
designator designator(&nd1)
[ [
ActualParameters? ActualParameters(&nd2)?
| |
BECOMES expression BECOMES expression(&nd2)
] ]
/* /*
* end of changed part * end of changed part
@ -37,7 +44,10 @@ statement:
| |
EXIT EXIT
| |
RETURN expression? RETURN
[
expression(&nd1)
]?
]? ]?
; ;
@ -57,15 +67,21 @@ StatementSequence:
statement [ ';' statement ]* statement [ ';' statement ]*
; ;
IfStatement: IfStatement
IF expression THEN StatementSequence {
[ ELSIF expression THEN StatementSequence ]* struct node *nd1;
} :
IF expression(&nd1) THEN StatementSequence
[ ELSIF expression(&nd1) THEN StatementSequence ]*
[ ELSE StatementSequence ]? [ ELSE StatementSequence ]?
END END
; ;
CaseStatement: CaseStatement
CASE expression OF case [ '|' case ]* {
struct node *nd;
} :
CASE expression(&nd) OF case [ '|' case ]*
[ ELSE StatementSequence ]? [ ELSE StatementSequence ]?
END END
; ;
@ -75,19 +91,28 @@ case:
/* This rule is changed in new modula-2 */ /* This rule is changed in new modula-2 */
; ;
WhileStatement: WhileStatement
WHILE expression DO StatementSequence END {
struct node *nd;
}:
WHILE expression(&nd) DO StatementSequence END
; ;
RepeatStatement: RepeatStatement
REPEAT StatementSequence UNTIL expression {
struct node *nd;
}:
REPEAT StatementSequence UNTIL expression(&nd)
; ;
ForStatement: ForStatement
{
struct node *nd1, *nd2, *nd3;
}:
FOR IDENT FOR IDENT
BECOMES expression BECOMES expression(&nd1)
TO expression TO expression(&nd2)
[ BY ConstExpression ]? [ BY ConstExpression(&nd3) ]?
DO StatementSequence END DO StatementSequence END
; ;
@ -95,6 +120,9 @@ LoopStatement:
LOOP StatementSequence END LOOP StatementSequence END
; ;
WithStatement: WithStatement
WITH designator DO StatementSequence END {
struct node *nd;
}:
WITH designator(&nd) DO StatementSequence END
; ;

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

@ -11,7 +11,8 @@ static char *RcsId = "$Header$";
#include "def.h" #include "def.h"
#include "type.h" #include "type.h"
#include "idf.h" #include "idf.h"
#include "misc.h" #include "LLlex.h"
#include "node.h"
/* To be created dynamically in main() from defaults or from command /* To be created dynamically in main() from defaults or from command
line parameters. line parameters.
@ -164,7 +165,7 @@ has_selectors(df)
*/ */
struct paramlist * struct paramlist *
ParamList(ids, tp, VARp) ParamList(ids, tp, VARp)
register struct id_list *ids; register struct node *ids;
struct type *tp; struct type *tp;
{ {
register struct paramlist *pr; register struct paramlist *pr;