newer version, partial parse trees
This commit is contained in:
ceriel
parent
0e4311490c
commit
376c47c98f
|
|
@ -17,7 +17,7 @@ LFLAGS = $(PROFILE)
|
|||
LOBJ = tokenfile.o program.o declar.o expression.o statement.o
|
||||
COBJ = LLlex.o LLmessage.o char.o error.o main.o \
|
||||
symbol2str.o tokenname.o idf.o input.o type.o def.o \
|
||||
scope.o misc.o enter.o defmodule.o typequiv.o
|
||||
scope.o misc.o enter.o defmodule.o typequiv.o node.o
|
||||
OBJ = $(COBJ) $(LOBJ) Lpars.o
|
||||
GENFILES= tokenfile.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
|
||||
def.h: def.H make.allocd
|
||||
type.h: type.H make.allocd
|
||||
node.h: node.H make.allocd
|
||||
scope.c: scope.C make.allocd
|
||||
|
||||
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
|
||||
LLmessage.o: LLlex.h Lpars.h idf.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
|
||||
symbol2str.o: Lpars.h
|
||||
tokenname.o: Lpars.h idf.h tokenname.h
|
||||
idf.o: idf.h
|
||||
input.o: f_info.h input.h
|
||||
type.o: Lpars.h def.h def_sizes.h idf.h misc.h type.h
|
||||
def.o: Lpars.h debug.h def.h idf.h main.h misc.h scope.h type.h
|
||||
type.o: LLlex.h Lpars.h def.h def_sizes.h idf.h node.h type.h
|
||||
def.o: LLlex.h Lpars.h debug.h def.h idf.h main.h node.h scope.h type.h
|
||||
scope.o: LLlex.h debug.h def.h idf.h scope.h type.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
|
||||
typequiv.o: Lpars.h def.h type.h
|
||||
node.o: LLlex.h def.h node.h type.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
|
||||
declar.o: LLlex.h Lpars.h def.h idf.h misc.h scope.h type.h
|
||||
expression.o: LLlex.h Lpars.h def.h idf.h scope.h
|
||||
program.o: LLlex.h Lpars.h debug.h def.h idf.h main.h node.h scope.h type.h
|
||||
declar.o: LLlex.h Lpars.h def.h idf.h misc.h node.h scope.h type.h
|
||||
expression.o: LLlex.h Lpars.h def.h idf.h node.h scope.h
|
||||
statement.o: Lpars.h
|
||||
Lpars.o: Lpars.h
|
||||
|
|
|
|||
|
|
@ -7,11 +7,12 @@ static char *RcsId = "$Header$";
|
|||
#include <em_label.h>
|
||||
#include <assert.h>
|
||||
#include "idf.h"
|
||||
#include "misc.h"
|
||||
#include "LLlex.h"
|
||||
#include "def.h"
|
||||
#include "type.h"
|
||||
#include "scope.h"
|
||||
#include "node.h"
|
||||
#include "misc.h"
|
||||
}
|
||||
|
||||
ProcedureDeclaration
|
||||
|
|
@ -95,7 +96,7 @@ FormalParameters(int doparams; struct paramlist **pr; struct type **tp;)
|
|||
]?
|
||||
')'
|
||||
{ *tp = 0; }
|
||||
[ ':' qualident(D_TYPE | D_HTYPE, &df, "type")
|
||||
[ ':' qualident(D_TYPE | D_HTYPE, &df, "type", (struct node **) 0)
|
||||
{ *tp = df->df_type; }
|
||||
]?
|
||||
;
|
||||
|
|
@ -108,7 +109,7 @@ FormalParameters(int doparams; struct paramlist **pr; struct type **tp;)
|
|||
*/
|
||||
FPSection(int doparams; struct paramlist **ppr;)
|
||||
{
|
||||
struct id_list *FPList;
|
||||
struct node *FPList;
|
||||
struct paramlist *ParamList();
|
||||
struct type *tp;
|
||||
int VARp = 0;
|
||||
|
|
@ -122,7 +123,7 @@ FPSection(int doparams; struct paramlist **ppr;)
|
|||
EnterIdList(FPList, D_VARIABLE, VARp, tp, CurrentScope);
|
||||
}
|
||||
*ppr = ParamList(FPList, tp);
|
||||
FreeIdList(FPList);
|
||||
FreeNode(FPList);
|
||||
}
|
||||
;
|
||||
|
||||
|
|
@ -133,7 +134,7 @@ FormalType(struct type **tp;)
|
|||
} :
|
||||
[ ARRAY OF { ARRAYflag = 1; }
|
||||
]?
|
||||
qualident(D_TYPE | D_HTYPE, &df, "type")
|
||||
qualident(D_TYPE | D_HTYPE, &df, "type", (struct node **) 0)
|
||||
{ if (ARRAYflag) {
|
||||
*tp = construct_type(ARRAY, NULLTYPE);
|
||||
(*tp)->arr_elem = df->df_type;
|
||||
|
|
@ -182,7 +183,7 @@ SimpleType(struct type **ptp;)
|
|||
struct def *df;
|
||||
struct type *tp;
|
||||
} :
|
||||
qualident(D_TYPE | D_HTYPE, &df, "type")
|
||||
qualident(D_TYPE | D_HTYPE, &df, "type", (struct node **) 0)
|
||||
[
|
||||
/* nothing */
|
||||
|
|
||||
|
|
@ -202,41 +203,44 @@ SimpleType(struct type **ptp;)
|
|||
|
||||
enumeration(struct type **ptp;)
|
||||
{
|
||||
struct id_list *EnumList;
|
||||
struct node *EnumList;
|
||||
} :
|
||||
'(' IdentList(&EnumList) ')'
|
||||
{
|
||||
*ptp = standard_type(ENUMERATION,int_align,int_size);
|
||||
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();
|
||||
q = q->next;
|
||||
q->id_ptr = dot.TOK_IDF;
|
||||
}
|
||||
',' IDENT
|
||||
{ q->next = MkNode(Value,NULLNODE,NULLNODE,&dot);
|
||||
q = q->next;
|
||||
}
|
||||
]*
|
||||
{ q->next = 0; }
|
||||
{ q->next = 0; }
|
||||
;
|
||||
|
||||
SubrangeType(struct type **ptp;)
|
||||
{
|
||||
struct type *tp;
|
||||
struct node *nd1 = 0, *nd2 = 0;
|
||||
}:
|
||||
/*
|
||||
This is not exactly the rule in the new report, but see
|
||||
the rule for "SimpleType".
|
||||
*/
|
||||
'[' ConstExpression
|
||||
UPTO ConstExpression
|
||||
'[' ConstExpression(&nd1)
|
||||
UPTO ConstExpression(&nd2)
|
||||
']'
|
||||
/*
|
||||
Evaluate the expressions. Check that they are indeed constant.
|
||||
|
|
@ -295,7 +299,7 @@ FieldListSequence(struct scope *scope;):
|
|||
|
||||
FieldList(struct scope *scope;)
|
||||
{
|
||||
struct id_list *FldList;
|
||||
struct node *FldList;
|
||||
struct idf *id;
|
||||
struct def *df, *df1;
|
||||
struct type *tp;
|
||||
|
|
@ -303,7 +307,7 @@ FieldList(struct scope *scope;)
|
|||
[
|
||||
IdentList(&FldList) ':' type(&tp)
|
||||
{ EnterIdList(FldList, D_FIELD, 0, tp, scope);
|
||||
FreeIdList(FldList);
|
||||
FreeNode(FldList);
|
||||
}
|
||||
|
|
||||
CASE
|
||||
|
|
@ -312,7 +316,7 @@ FieldList(struct scope *scope;)
|
|||
|
|
||||
{ id = gen_anon_idf(); }
|
||||
] /* 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->df_type = df->df_type;
|
||||
}
|
||||
|
|
@ -335,8 +339,11 @@ CaseLabelList:
|
|||
CaseLabels [ ',' CaseLabels ]*
|
||||
;
|
||||
|
||||
CaseLabels:
|
||||
ConstExpression [ UPTO ConstExpression ]?
|
||||
CaseLabels
|
||||
{
|
||||
struct node *nd1, *nd2 = 0;
|
||||
}:
|
||||
ConstExpression(&nd1) [ UPTO ConstExpression(&nd2) ]?
|
||||
;
|
||||
|
||||
SetType(struct type **ptp;)
|
||||
|
|
@ -364,7 +371,7 @@ PointerType(struct type **ptp;)
|
|||
/* Either a Module or a Type, but in both cases defined
|
||||
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) {
|
||||
error("type \"%s\" not declared",
|
||||
|
|
@ -429,7 +436,7 @@ FormalTypeList(struct paramlist **ppr; struct type **ptp;)
|
|||
{ p->next = 0; }
|
||||
]?
|
||||
')'
|
||||
[ ':' qualident(D_TYPE|D_HTYPE, &df, "type")
|
||||
[ ':' qualident(D_TYPE|D_HTYPE, &df, "type", (struct node **) 0)
|
||||
{ *ptp = df->df_type; }
|
||||
]?
|
||||
;
|
||||
|
|
@ -438,24 +445,26 @@ ConstantDeclaration
|
|||
{
|
||||
struct def *df;
|
||||
struct idf *id;
|
||||
struct node *nd;
|
||||
}:
|
||||
IDENT { id = dot.TOK_IDF; }
|
||||
'=' ConstExpression { df = define(id, CurrentScope, D_CONST);
|
||||
'=' ConstExpression(&nd){ df = define(id, CurrentScope, D_CONST);
|
||||
/* ???? */
|
||||
}
|
||||
;
|
||||
|
||||
VariableDeclaration
|
||||
{
|
||||
struct id_list *VarList;
|
||||
struct node *VarList;
|
||||
struct type *tp;
|
||||
struct node *nd = 0;
|
||||
} :
|
||||
IdentList(&VarList)
|
||||
[
|
||||
ConstExpression
|
||||
ConstExpression(&nd)
|
||||
]?
|
||||
':' type(&tp)
|
||||
{ EnterIdList(VarList, D_VARIABLE, 0, tp, CurrentScope);
|
||||
FreeIdList(VarList);
|
||||
FreeNode(VarList);
|
||||
}
|
||||
;
|
||||
|
|
|
|||
|
|
@ -10,9 +10,10 @@ static char *RcsId = "$Header$";
|
|||
#include "def.h"
|
||||
#include "type.h"
|
||||
#include "idf.h"
|
||||
#include "misc.h"
|
||||
#include "main.h"
|
||||
#include "scope.h"
|
||||
#include "LLlex.h"
|
||||
#include "node.h"
|
||||
#include "debug.h"
|
||||
|
||||
struct def *h_def; /* Pointer to free list of def structures */
|
||||
|
|
@ -63,7 +64,7 @@ define(id, scope, kind)
|
|||
return df;
|
||||
}
|
||||
if (kind != D_ERROR) {
|
||||
error("identifier \"%s\" already declared", id->id_text);
|
||||
error("identifier \"%s\" already declared", id->id_text);
|
||||
}
|
||||
return df;
|
||||
}
|
||||
|
|
@ -115,7 +116,7 @@ lookup(id, scope)
|
|||
}
|
||||
|
||||
Export(ids, qualified)
|
||||
register struct id_list *ids;
|
||||
register struct node *ids;
|
||||
{
|
||||
/* From the current scope, the list of identifiers "ids" is
|
||||
exported. Note this fact. If the export is not qualified, make
|
||||
|
|
@ -125,36 +126,38 @@ Export(ids, qualified)
|
|||
register struct def *df;
|
||||
|
||||
while (ids) {
|
||||
df = define(ids->id_ptr, CurrentScope, D_ISEXPORTED);
|
||||
df = define(ids->nd_IDF, CurrentScope, D_ISEXPORTED);
|
||||
if (qualified) {
|
||||
df->df_flags |= D_QEXPORTED;
|
||||
}
|
||||
else {
|
||||
df->df_flags |= D_EXPORTED;
|
||||
df = define(ids->id_ptr, enclosing(CurrentScope),
|
||||
df = define(ids->nd_IDF, enclosing(CurrentScope),
|
||||
D_IMPORT);
|
||||
}
|
||||
ids = ids->next;
|
||||
}
|
||||
}
|
||||
|
||||
Import(ids, id, local)
|
||||
register struct id_list *ids;
|
||||
struct idf *id;
|
||||
Import(ids, idn, local)
|
||||
register struct node *ids;
|
||||
struct node *idn;
|
||||
{
|
||||
/* "ids" is a list of imported identifiers.
|
||||
If "id" is a null-pointer, the identifiers are imported from the
|
||||
enclosing scope. Otherwise they are imported from the module
|
||||
indicated by "id", which must be visible in the enclosing scope.
|
||||
An exception must be made for imports of the Compilation Unit.
|
||||
If "idn" is a null-pointer, the identifiers are imported from
|
||||
the enclosing scope. Otherwise they are imported from the module
|
||||
indicated by "idn", which must be visible in the enclosing
|
||||
scope. An exception must be made for imports of the
|
||||
Compilation Unit.
|
||||
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
|
||||
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
|
||||
identifiers defined in this module.
|
||||
*/
|
||||
register struct def *df;
|
||||
register struct idf *id = 0;
|
||||
int scope;
|
||||
int kind;
|
||||
int imp_kind;
|
||||
|
|
@ -162,6 +165,7 @@ Import(ids, id, local)
|
|||
#define FROM_ENCLOSING 1
|
||||
struct def *lookfor(), *GetDefinitionModule();
|
||||
|
||||
if (idn) id = idn->nd_IDF;
|
||||
kind = D_IMPORT;
|
||||
scope = enclosing(CurrentScope)->sc_scope;
|
||||
if (!id) imp_kind = FROM_ENCLOSING;
|
||||
|
|
@ -173,35 +177,35 @@ Import(ids, id, local)
|
|||
/* enter all "ids" with type D_ERROR */
|
||||
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;
|
||||
}
|
||||
while (ids) {
|
||||
if (imp_kind == FROM_MODULE) {
|
||||
if (!(df = lookup(ids->id_ptr, scope))) {
|
||||
error("identifier \"%s\" not declared in qualifying module",
|
||||
ids->id_ptr->id_text);
|
||||
if (!(df = lookup(ids->nd_IDF, scope))) {
|
||||
node_error(ids, "identifier \"%s\" not declared in qualifying module",
|
||||
ids->nd_IDF->id_text);
|
||||
df = ill_df;
|
||||
}
|
||||
else
|
||||
if (!(df->df_flags&(D_EXPORTED|D_QEXPORTED))) {
|
||||
error("identifier \"%s\" not exported from qualifying module",
|
||||
ids->id_ptr->id_text);
|
||||
node_error(ids,"identifier \"%s\" not exported from qualifying module",
|
||||
ids->nd_IDF->id_text);
|
||||
}
|
||||
}
|
||||
else {
|
||||
if (local) {
|
||||
df = lookfor(ids->id_ptr,
|
||||
df = lookfor(ids->nd_IDF,
|
||||
enclosing(CurrentScope), 0);
|
||||
} else df = GetDefinitionModule(ids->id_ptr);
|
||||
} else df = GetDefinitionModule(ids->nd_IDF);
|
||||
if (df->df_kind == D_ERROR) {
|
||||
error("identifier \"%s\" not visible in enclosing scope",
|
||||
ids->id_ptr->id_text);
|
||||
node_error(ids, "identifier \"%s\" not visible in enclosing scope",
|
||||
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 &&
|
||||
df->df_type->tp_fund == ENUMERATION) {
|
||||
/* Also import all enumeration literals */
|
||||
|
|
|
|||
|
|
@ -9,7 +9,8 @@ static char *RcsId = "$Header$";
|
|||
#include "def.h"
|
||||
#include "type.h"
|
||||
#include "scope.h"
|
||||
#include "misc.h"
|
||||
#include "LLlex.h"
|
||||
#include "node.h"
|
||||
|
||||
struct def *
|
||||
Enter(name, kind, type, pnam)
|
||||
|
|
@ -30,7 +31,7 @@ Enter(name, kind, type, pnam)
|
|||
}
|
||||
|
||||
EnterIdList(idlist, kind, flags, type, scope)
|
||||
register struct id_list *idlist;
|
||||
register struct node *idlist;
|
||||
struct type *type;
|
||||
struct scope *scope;
|
||||
{
|
||||
|
|
@ -39,7 +40,7 @@ EnterIdList(idlist, kind, flags, type, scope)
|
|||
int assval = 0;
|
||||
|
||||
while (idlist) {
|
||||
df = define(idlist->id_ptr, scope, kind);
|
||||
df = define(idlist->nd_IDF, scope, kind);
|
||||
df->df_type = type;
|
||||
df->df_flags = flags;
|
||||
if (kind == D_ENUM) {
|
||||
|
|
|
|||
|
|
@ -13,6 +13,7 @@ static char *RcsId = "$Header$";
|
|||
#include "f_info.h"
|
||||
#include "LLlex.h"
|
||||
#include "main.h"
|
||||
#include "node.h"
|
||||
|
||||
#define MAXERR_LINE 5 /* Number of error messages on one line ... */
|
||||
#define ERROUT STDERR
|
||||
|
|
@ -28,8 +29,6 @@ static char *RcsId = "$Header$";
|
|||
#define VDEBUG 7
|
||||
#endif
|
||||
|
||||
#define NILEXPR ((struct expr *) 0)
|
||||
|
||||
int err_occurred;
|
||||
|
||||
extern char *symbol2str();
|
||||
|
|
@ -37,12 +36,12 @@ extern char *symbol2str();
|
|||
/* There are three general error-message functions:
|
||||
lexerror() lexical and pre-processor 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
|
||||
number come from.
|
||||
Lexical errors report from the global variables LineNumber and
|
||||
FileName, expression errors get their information from the
|
||||
expression, whereas other errors use the information in the token.
|
||||
FileName, node errors get their information from the
|
||||
node, whereas other errors use the information in the token.
|
||||
*/
|
||||
|
||||
#ifdef DEBUG
|
||||
|
|
@ -50,7 +49,7 @@ extern char *symbol2str();
|
|||
debug(level, fmt, args)
|
||||
char *fmt;
|
||||
{
|
||||
if (level <= options['D']) _error(VDEBUG, NILEXPR, fmt, &args);
|
||||
if (level <= options['D']) _error(VDEBUG, NULLNODE, fmt, &args);
|
||||
}
|
||||
#endif DEBUG
|
||||
|
||||
|
|
@ -58,44 +57,44 @@ debug(level, fmt, args)
|
|||
error(fmt, args)
|
||||
char *fmt;
|
||||
{
|
||||
_error(ERROR, NILEXPR, fmt, &args);
|
||||
_error(ERROR, NULLNODE, fmt, &args);
|
||||
}
|
||||
|
||||
/*VARARGS2*/
|
||||
expr_error(expr, fmt, args)
|
||||
struct expr *expr;
|
||||
node_error(node, fmt, args)
|
||||
struct node *node;
|
||||
char *fmt;
|
||||
{
|
||||
_error(ERROR, expr, fmt, &args);
|
||||
_error(ERROR, node, fmt, &args);
|
||||
}
|
||||
|
||||
/*VARARGS1*/
|
||||
warning(fmt, args)
|
||||
char *fmt;
|
||||
{
|
||||
_error(WARNING, NILEXPR, fmt, &args);
|
||||
_error(WARNING, NULLNODE, fmt, &args);
|
||||
}
|
||||
|
||||
/*VARARGS2*/
|
||||
expr_warning(expr, fmt, args)
|
||||
struct expr *expr;
|
||||
node_warning(node, fmt, args)
|
||||
struct node *node;
|
||||
char *fmt;
|
||||
{
|
||||
_error(WARNING, expr, fmt, &args);
|
||||
_error(WARNING, node, fmt, &args);
|
||||
}
|
||||
|
||||
/*VARARGS1*/
|
||||
lexerror(fmt, args)
|
||||
char *fmt;
|
||||
{
|
||||
_error(LEXERROR, NILEXPR, fmt, &args);
|
||||
_error(LEXERROR, NULLNODE, fmt, &args);
|
||||
}
|
||||
|
||||
/*VARARGS1*/
|
||||
lexwarning(fmt, args)
|
||||
char *fmt;
|
||||
{
|
||||
_error(LEXWARNING, NILEXPR, fmt, &args);
|
||||
_error(LEXWARNING, NULLNODE, fmt, &args);
|
||||
}
|
||||
|
||||
/*VARARGS1*/
|
||||
|
|
@ -104,13 +103,13 @@ fatal(fmt, args)
|
|||
int args;
|
||||
{
|
||||
|
||||
_error(FATAL, NILEXPR, fmt, &args);
|
||||
_error(FATAL, NULLNODE, fmt, &args);
|
||||
sys_stop(S_EXIT);
|
||||
}
|
||||
|
||||
_error(class, expr, fmt, argv)
|
||||
_error(class, node, fmt, argv)
|
||||
int class;
|
||||
struct expr *expr;
|
||||
struct node *node;
|
||||
char *fmt;
|
||||
int argv[];
|
||||
{
|
||||
|
|
@ -118,8 +117,10 @@ _error(class, expr, fmt, argv)
|
|||
for a given line to MAXERR_LINE.
|
||||
*/
|
||||
static unsigned int last_ln = 0;
|
||||
static int e_seen = 0;
|
||||
unsigned int ln = 0;
|
||||
static char * last_fn = 0;
|
||||
char *fn = 0;
|
||||
static int e_seen = 0;
|
||||
char *remark = 0;
|
||||
|
||||
/* Since name and number are gathered from different places
|
||||
|
|
@ -158,13 +159,19 @@ _error(class, expr, fmt, argv)
|
|||
case FATAL:
|
||||
remark = "fatal error --";
|
||||
break;
|
||||
#ifdef DEBUG
|
||||
case VDEBUG:
|
||||
remark = "(debug)";
|
||||
break;
|
||||
#endif DEBUG
|
||||
}
|
||||
|
||||
/* the place */
|
||||
switch (class) {
|
||||
case WARNING:
|
||||
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;
|
||||
case LEXWARNING:
|
||||
case LEXERROR:
|
||||
|
|
@ -174,13 +181,14 @@ _error(class, expr, fmt, argv)
|
|||
case VDEBUG:
|
||||
#endif DEBUG
|
||||
ln = LineNumber;
|
||||
fn = FileName;
|
||||
break;
|
||||
}
|
||||
|
||||
#ifdef DEBUG
|
||||
if (class != VDEBUG) {
|
||||
#endif
|
||||
if (ln == last_ln) {
|
||||
if (fn == last_fn && ln == last_ln) {
|
||||
/* we've seen this place before */
|
||||
e_seen++;
|
||||
if (e_seen == MAXERR_LINE) fmt = "etc ...";
|
||||
|
|
@ -192,13 +200,14 @@ _error(class, expr, fmt, argv)
|
|||
else {
|
||||
/* brand new place */
|
||||
last_ln = ln;
|
||||
last_fn = fn;
|
||||
e_seen = 0;
|
||||
}
|
||||
#ifdef 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);
|
||||
|
||||
|
|
|
|||
|
|
@ -10,15 +10,18 @@ static char *RcsId = "$Header$";
|
|||
#include "idf.h"
|
||||
#include "def.h"
|
||||
#include "scope.h"
|
||||
#include "node.h"
|
||||
}
|
||||
|
||||
number:
|
||||
number(struct node **p;):
|
||||
[
|
||||
INTEGER
|
||||
|
|
||||
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 module;
|
||||
|
|
@ -30,6 +33,9 @@ qualident(int types; struct def **pdf; char *str;)
|
|||
*pdf = df;
|
||||
if (df->df_kind == D_ERROR) types = 0;
|
||||
}
|
||||
if (p) {
|
||||
*p = MkNode(Value, NULLNODE, NULLNODE,&dot);
|
||||
}
|
||||
}
|
||||
[
|
||||
{ if (types &&!(scope = has_selectors(df))) {
|
||||
|
|
@ -38,8 +44,13 @@ qualident(int types; struct def **pdf; char *str;)
|
|||
}
|
||||
}
|
||||
/* selector */
|
||||
'.' IDENT
|
||||
{ if (types) {
|
||||
'.' { if (p) *p = MkNode(Link, *p, NULLNODE, &dot); }
|
||||
IDENT
|
||||
{ if (p) {
|
||||
p = &((*p)->nd_right);
|
||||
*p = MkNode(Value, NULLNODE, NULLNODE,&dot);
|
||||
}
|
||||
if (types) {
|
||||
module = (df->df_kind == D_MODULE);
|
||||
df = lookup(dot.TOK_IDF, scope);
|
||||
if (!df) {
|
||||
|
|
@ -62,99 +73,179 @@ qualident(int types; struct def **pdf; char *str;)
|
|||
}
|
||||
;
|
||||
|
||||
/* Inline substituted wherever it occurred
|
||||
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:
|
||||
expression [ ',' expression ]*
|
||||
;
|
||||
|
||||
ConstExpression:
|
||||
expression
|
||||
ConstExpression(struct node **pnd;):
|
||||
expression(pnd)
|
||||
/*
|
||||
* Changed rule in new Modula-2.
|
||||
* Check that the expression is a constant expression and evaluate!
|
||||
*/
|
||||
;
|
||||
|
||||
expression:
|
||||
SimpleExpression [ relation SimpleExpression ]?
|
||||
expression(struct node **pnd;)
|
||||
{
|
||||
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:
|
||||
'=' | '#' | UNEQUAL | '<' | LESSEQUAL | '>' | GREATEREQUAL | IN
|
||||
;
|
||||
*/
|
||||
|
||||
SimpleExpression:
|
||||
[ '+' | '-' ]? term [ AddOperator term ]*
|
||||
;
|
||||
|
||||
AddOperator:
|
||||
'+' | '-' | OR
|
||||
;
|
||||
|
||||
term:
|
||||
factor [ MulOperator factor ]*
|
||||
;
|
||||
|
||||
MulOperator:
|
||||
'*' | '/' | DIV | MOD | AND | '&'
|
||||
;
|
||||
|
||||
factor
|
||||
SimpleExpression(struct node **pnd;)
|
||||
{
|
||||
struct def *df;
|
||||
register struct node *nd;
|
||||
} :
|
||||
qualident(0, &df, (char *) 0)
|
||||
[ '+' | '-' ]?
|
||||
term(pnd) { nd = *pnd; }
|
||||
[
|
||||
designator_tail? ActualParameters?
|
||||
|
|
||||
bare_set
|
||||
]
|
||||
|
|
||||
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
|
||||
/* AddOperator */
|
||||
[ '+' | '-' | OR ]
|
||||
{ *pnd = nd = MkNode(Oper, nd, NULLNODE, &dot); }
|
||||
term(&(nd->nd_right))
|
||||
]*
|
||||
;
|
||||
|
||||
visible_designator_tail:
|
||||
'[' ExpList ']'
|
||||
|
|
||||
'^'
|
||||
/* Inline in "SimpleExpression"
|
||||
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); }
|
||||
;
|
||||
|
|
|
|||
|
|
@ -2,13 +2,6 @@
|
|||
|
||||
/* $Header$ */
|
||||
|
||||
/* Structure to link idf structures together
|
||||
*/
|
||||
struct id_list {
|
||||
struct id_list *next;
|
||||
struct idf *id_ptr;
|
||||
};
|
||||
|
||||
/* ALLOCDEF "id_list" */
|
||||
|
||||
#define is_anon_idf(x) ((x)->id_text[0] == '#')
|
||||
|
|
|
|||
|
|
@ -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 *
|
||||
gen_anon_idf()
|
||||
{
|
||||
|
|
|
|||
31
lang/m2/comp/node.H
Normal file
31
lang/m2/comp/node.H
Normal 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
41
lang/m2/comp/node.c
Normal 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);
|
||||
}
|
||||
|
|
@ -7,12 +7,12 @@ static char *RcsId = "$Header$";
|
|||
#include <em_arith.h>
|
||||
#include <em_label.h>
|
||||
#include "idf.h"
|
||||
#include "misc.h"
|
||||
#include "main.h"
|
||||
#include "LLlex.h"
|
||||
#include "scope.h"
|
||||
#include "def.h"
|
||||
#include "type.h"
|
||||
#include "node.h"
|
||||
#include "debug.h"
|
||||
|
||||
static struct idf *impl_name = 0;
|
||||
|
|
@ -57,13 +57,16 @@ ModuleDeclaration
|
|||
}
|
||||
;
|
||||
|
||||
priority:
|
||||
'[' ConstExpression ']'
|
||||
priority
|
||||
{
|
||||
struct node *nd;
|
||||
}:
|
||||
'[' ConstExpression(&nd) ']'
|
||||
;
|
||||
|
||||
export(int def;)
|
||||
{
|
||||
struct id_list *ExportList;
|
||||
struct node *ExportList;
|
||||
int QUALflag = 0;
|
||||
} :
|
||||
EXPORT
|
||||
|
|
@ -74,17 +77,17 @@ export(int def;)
|
|||
{
|
||||
if (!def) Export(ExportList, QUALflag);
|
||||
else warning("export list in definition module ignored");
|
||||
FreeIdList(ExportList);
|
||||
FreeNode(ExportList);
|
||||
}
|
||||
;
|
||||
|
||||
import(int local;)
|
||||
{
|
||||
struct id_list *ImportList;
|
||||
struct idf *id = 0;
|
||||
struct node *ImportList;
|
||||
struct node *id = 0;
|
||||
} :
|
||||
[ FROM
|
||||
IDENT { id = dot.TOK_IDF; }
|
||||
IDENT { id = MkNode(Value, NULLNODE, NULLNODE, &dot); }
|
||||
]?
|
||||
IMPORT IdentList(&ImportList) ';'
|
||||
/*
|
||||
|
|
@ -95,7 +98,8 @@ import(int local;)
|
|||
*/
|
||||
{
|
||||
Import(ImportList, id, local);
|
||||
FreeIdList(ImportList);
|
||||
FreeNode(ImportList);
|
||||
if (id) FreeNode(id);
|
||||
}
|
||||
;
|
||||
|
||||
|
|
|
|||
|
|
@ -2,20 +2,27 @@
|
|||
|
||||
{
|
||||
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
|
||||
* states : assignment | ProcedureCall | ...
|
||||
* but this gives LL(1) conflicts
|
||||
*/
|
||||
designator
|
||||
designator(&nd1)
|
||||
[
|
||||
ActualParameters?
|
||||
ActualParameters(&nd2)?
|
||||
|
|
||||
BECOMES expression
|
||||
BECOMES expression(&nd2)
|
||||
]
|
||||
/*
|
||||
* end of changed part
|
||||
|
|
@ -37,7 +44,10 @@ statement:
|
|||
|
|
||||
EXIT
|
||||
|
|
||||
RETURN expression?
|
||||
RETURN
|
||||
[
|
||||
expression(&nd1)
|
||||
]?
|
||||
]?
|
||||
;
|
||||
|
||||
|
|
@ -57,15 +67,21 @@ StatementSequence:
|
|||
statement [ ';' statement ]*
|
||||
;
|
||||
|
||||
IfStatement:
|
||||
IF expression THEN StatementSequence
|
||||
[ ELSIF expression THEN StatementSequence ]*
|
||||
IfStatement
|
||||
{
|
||||
struct node *nd1;
|
||||
} :
|
||||
IF expression(&nd1) THEN StatementSequence
|
||||
[ ELSIF expression(&nd1) THEN StatementSequence ]*
|
||||
[ ELSE StatementSequence ]?
|
||||
END
|
||||
;
|
||||
|
||||
CaseStatement:
|
||||
CASE expression OF case [ '|' case ]*
|
||||
CaseStatement
|
||||
{
|
||||
struct node *nd;
|
||||
} :
|
||||
CASE expression(&nd) OF case [ '|' case ]*
|
||||
[ ELSE StatementSequence ]?
|
||||
END
|
||||
;
|
||||
|
|
@ -75,19 +91,28 @@ case:
|
|||
/* This rule is changed in new modula-2 */
|
||||
;
|
||||
|
||||
WhileStatement:
|
||||
WHILE expression DO StatementSequence END
|
||||
WhileStatement
|
||||
{
|
||||
struct node *nd;
|
||||
}:
|
||||
WHILE expression(&nd) DO StatementSequence END
|
||||
;
|
||||
|
||||
RepeatStatement:
|
||||
REPEAT StatementSequence UNTIL expression
|
||||
RepeatStatement
|
||||
{
|
||||
struct node *nd;
|
||||
}:
|
||||
REPEAT StatementSequence UNTIL expression(&nd)
|
||||
;
|
||||
|
||||
ForStatement:
|
||||
ForStatement
|
||||
{
|
||||
struct node *nd1, *nd2, *nd3;
|
||||
}:
|
||||
FOR IDENT
|
||||
BECOMES expression
|
||||
TO expression
|
||||
[ BY ConstExpression ]?
|
||||
BECOMES expression(&nd1)
|
||||
TO expression(&nd2)
|
||||
[ BY ConstExpression(&nd3) ]?
|
||||
DO StatementSequence END
|
||||
;
|
||||
|
||||
|
|
@ -95,6 +120,9 @@ LoopStatement:
|
|||
LOOP StatementSequence END
|
||||
;
|
||||
|
||||
WithStatement:
|
||||
WITH designator DO StatementSequence END
|
||||
WithStatement
|
||||
{
|
||||
struct node *nd;
|
||||
}:
|
||||
WITH designator(&nd) DO StatementSequence END
|
||||
;
|
||||
|
|
|
|||
|
|
@ -11,7 +11,8 @@ static char *RcsId = "$Header$";
|
|||
#include "def.h"
|
||||
#include "type.h"
|
||||
#include "idf.h"
|
||||
#include "misc.h"
|
||||
#include "LLlex.h"
|
||||
#include "node.h"
|
||||
|
||||
/* To be created dynamically in main() from defaults or from command
|
||||
line parameters.
|
||||
|
|
@ -164,7 +165,7 @@ has_selectors(df)
|
|||
*/
|
||||
struct paramlist *
|
||||
ParamList(ids, tp, VARp)
|
||||
register struct id_list *ids;
|
||||
register struct node *ids;
|
||||
struct type *tp;
|
||||
{
|
||||
register struct paramlist *pr;
|
||||
|
|
|
|||
Loading…
Reference in a new issue