Several bug fixes
This commit is contained in:
ceriel
parent
97e027db33
commit
9291d87dab
26 changed files with 401 additions and 164 deletions
|
|
@ -18,6 +18,7 @@
|
|||
#include "type.h"
|
||||
#include "LLlex.h"
|
||||
#include "const.h"
|
||||
#include "warning.h"
|
||||
|
||||
long str2long();
|
||||
|
||||
|
|
@ -29,6 +30,8 @@ int idfsize = IDFSIZE;
|
|||
extern int cntlines;
|
||||
#endif
|
||||
|
||||
static int eofseen;
|
||||
|
||||
STATIC
|
||||
SkipComment()
|
||||
{
|
||||
|
|
@ -104,6 +107,81 @@ GetString(upto)
|
|||
return str;
|
||||
}
|
||||
|
||||
static char *s_error = "illegal line directive";
|
||||
|
||||
STATIC int
|
||||
getch()
|
||||
{
|
||||
register int ch;
|
||||
|
||||
for (;;) {
|
||||
LoadChar(ch);
|
||||
if ((ch & 0200) && ch != EOI) {
|
||||
error("non-ascii '\\%03o' read", ch & 0377);
|
||||
continue;
|
||||
}
|
||||
break;
|
||||
}
|
||||
if (ch == EOI) {
|
||||
eofseen = 1;
|
||||
return '\n';
|
||||
}
|
||||
return ch;
|
||||
}
|
||||
|
||||
STATIC
|
||||
linedirective() {
|
||||
/* Read a line directive
|
||||
*/
|
||||
register int ch;
|
||||
register int i = 0;
|
||||
char buf[IDFSIZE + 2];
|
||||
register char *c = buf;
|
||||
|
||||
do { /*
|
||||
* Skip to next digit
|
||||
* Do not skip newlines
|
||||
*/
|
||||
ch = getch();
|
||||
if (class(ch) == STNL) {
|
||||
LineNumber++;
|
||||
error(s_error);
|
||||
return;
|
||||
}
|
||||
} while (class(ch) != STNUM);
|
||||
do {
|
||||
i = i*10 + (ch - '0');
|
||||
ch = getch();
|
||||
} while (class(ch) == STNUM);
|
||||
while (ch != '"' && class(ch) != STNL) ch = getch();
|
||||
if (ch == '"') {
|
||||
c = buf;
|
||||
do {
|
||||
*c++ = ch = getch();
|
||||
if (class(ch) == STNL) {
|
||||
LineNumber++;
|
||||
error(s_error);
|
||||
return;
|
||||
}
|
||||
} while (ch != '"');
|
||||
*--c = '\0';
|
||||
do {
|
||||
ch = getch();
|
||||
} while (class(ch) != STNL);
|
||||
/*
|
||||
* Remember the file name
|
||||
*/
|
||||
if (!eofseen && strcmp(FileName,buf)) {
|
||||
FileName = Salloc(buf,strlen(buf) + 1);
|
||||
}
|
||||
}
|
||||
if (eofseen) {
|
||||
error(s_error);
|
||||
return;
|
||||
}
|
||||
LineNumber = i;
|
||||
}
|
||||
|
||||
int
|
||||
LLlex()
|
||||
{
|
||||
|
|
@ -113,7 +191,6 @@ LLlex()
|
|||
register struct token *tk = ˙
|
||||
char buf[(IDFSIZE > NUMSIZE ? IDFSIZE : NUMSIZE) + 2];
|
||||
register int ch, nch;
|
||||
static int eofseen;
|
||||
|
||||
toktype = error_type;
|
||||
|
||||
|
|
@ -125,6 +202,7 @@ LLlex()
|
|||
|
||||
tk->tk_lineno = LineNumber;
|
||||
|
||||
again2:
|
||||
if (eofseen) {
|
||||
eofseen = 0;
|
||||
ch = EOI;
|
||||
|
|
@ -132,8 +210,10 @@ LLlex()
|
|||
else {
|
||||
again:
|
||||
LoadChar(ch);
|
||||
again1:
|
||||
if ((ch & 0200) && ch != EOI) {
|
||||
fatal("non-ascii '\\%03o' read", ch & 0377);
|
||||
error("non-ascii '\\%03o' read", ch & 0377);
|
||||
goto again;
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -145,7 +225,10 @@ again:
|
|||
cntlines++;
|
||||
#endif
|
||||
tk->tk_lineno++;
|
||||
/* Fall Through */
|
||||
LoadChar(ch);
|
||||
if (ch != '#') goto again1;
|
||||
linedirective();
|
||||
goto again2;
|
||||
|
||||
case STSKIP:
|
||||
goto again;
|
||||
|
|
@ -192,7 +275,7 @@ again:
|
|||
return tk->tk_symb = LESSEQUAL;
|
||||
}
|
||||
if (nch == '>') {
|
||||
lexwarning("'<>' is old-fashioned; use '#'");
|
||||
lexwarning(W_STRICT, "'<>' is old-fashioned; use '#'");
|
||||
return tk->tk_symb = '#';
|
||||
}
|
||||
break;
|
||||
|
|
@ -331,7 +414,7 @@ again:
|
|||
if (ch == 'C' && base == 8) {
|
||||
toktype = char_type;
|
||||
if (tk->TOK_INT<0 || tk->TOK_INT>255) {
|
||||
lexwarning("Character constant out of range");
|
||||
lexwarning(W_ORDINARY, "character constant out of range");
|
||||
}
|
||||
}
|
||||
else if (tk->TOK_INT>=0 &&
|
||||
|
|
|
|||
|
|
@ -21,15 +21,16 @@ extern int err_occurred;
|
|||
LLmessage(tk)
|
||||
int tk;
|
||||
{
|
||||
if (tk) {
|
||||
/* if (tk != 0), it represents the token to be inserted.
|
||||
otherwize, the current token is deleted
|
||||
if (tk > 0) {
|
||||
/* if (tk > 0), it represents the token to be inserted.
|
||||
*/
|
||||
error("%s missing", symbol2str(tk));
|
||||
insert_token(tk);
|
||||
}
|
||||
else
|
||||
error("%s deleted", symbol2str(dot.tk_symb));
|
||||
else if (tk < 0) {
|
||||
error("garbage at end of program");
|
||||
}
|
||||
else error("%s deleted", symbol2str(dot.tk_symb));
|
||||
}
|
||||
|
||||
insert_token(tk)
|
||||
|
|
|
|||
|
|
@ -3,6 +3,7 @@ EMDIR = ../../..
|
|||
MHDIR = $(EMDIR)/modules/h
|
||||
PKGDIR = $(EMDIR)/modules/pkg
|
||||
LIBDIR = $(EMDIR)/modules/lib
|
||||
OBJECTCODE = $(LIBDIR)/libemk.a
|
||||
LLGEN = $(EMDIR)/bin/LLgen
|
||||
|
||||
INCLUDES = -I$(MHDIR) -I$(EMDIR)/h -I$(PKGDIR)
|
||||
|
|
@ -13,6 +14,7 @@ LLGENOPTIONS =
|
|||
PROFILE =
|
||||
CFLAGS = $(PROFILE) $(INCLUDES) -DSTATIC=
|
||||
LINTFLAGS = -DSTATIC= -DNORCSID
|
||||
MALLOC = $(LIBDIR)/dickmalloc.o
|
||||
LFLAGS = $(PROFILE)
|
||||
LSRC = tokenfile.c program.c declar.c expression.c statement.c
|
||||
LOBJ = tokenfile.o program.o declar.o expression.o statement.o
|
||||
|
|
@ -35,13 +37,13 @@ GENCFILES= tokenfile.c \
|
|||
symbol2str.c char.c Lpars.c casestat.c tmpvar.c scope.c
|
||||
GENGFILES= tokenfile.g
|
||||
GENHFILES= errout.h\
|
||||
idfsize.h numsize.h strsize.h target_sizes.h debug.h\
|
||||
idfsize.h numsize.h strsize.h target_sizes.h \
|
||||
inputtype.h maxset.h ndir.h density.h\
|
||||
def.h type.h Lpars.h node.h
|
||||
def.h debugcst.h type.h Lpars.h node.h
|
||||
HFILES= LLlex.h\
|
||||
chk_expr.h class.h const.h desig.h f_info.h idf.h\
|
||||
chk_expr.h class.h const.h debug.h desig.h f_info.h idf.h\
|
||||
input.h main.h misc.h scope.h standards.h tokenname.h\
|
||||
walk.h $(GENHFILES)
|
||||
walk.h warning.h $(GENHFILES)
|
||||
#
|
||||
GENFILES = $(GENGFILES) $(GENCFILES) $(GENHFILES)
|
||||
|
||||
|
|
@ -67,7 +69,7 @@ clashes: $(SRC) $(HFILES)
|
|||
|
||||
# entry points not to be used directly
|
||||
|
||||
Cfiles: hfiles LLfiles $(GENCFILES) $(GENHFILES)
|
||||
Cfiles: hfiles LLfiles $(GENCFILES) $(GENHFILES) Makefile
|
||||
echo $(SRC) $(HFILES) > Cfiles
|
||||
|
||||
LLfiles: $(GFILES)
|
||||
|
|
@ -122,39 +124,39 @@ Xlint:
|
|||
lint $(INCLUDES) $(LINTFLAGS) $(SRC)
|
||||
|
||||
../comp/main: $(OBJ) ../comp/Makefile
|
||||
$(CC) $(LFLAGS) $(OBJ) $(LIBDIR)/libem_mes.a $(LIBDIR)/libemk.a $(LIBDIR)/input.a $(LIBDIR)/assert.a $(LIBDIR)/alloc.a $(LIBDIR)/malloc.o $(LIBDIR)/libprint.a $(LIBDIR)/libstr.a $(LIBDIR)/libsystem.a -o ../comp/main
|
||||
$(CC) $(LFLAGS) $(OBJ) $(LIBDIR)/libem_mes.a $(OBJECTCODE) $(LIBDIR)/libinput.a $(LIBDIR)/libassert.a $(LIBDIR)/liballoc.a $(MALLOC) $(LIBDIR)/libprint.a $(LIBDIR)/libstring.a $(LIBDIR)/libsystem.a -o ../comp/main
|
||||
size ../comp/main
|
||||
|
||||
#AUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTO
|
||||
LLlex.o: LLlex.h Lpars.h class.h const.h debug.h f_info.h idf.h idfsize.h input.h inputtype.h numsize.h strsize.h type.h
|
||||
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
|
||||
char.o: class.h
|
||||
error.o: LLlex.h debug.h errout.h f_info.h input.h inputtype.h main.h node.h
|
||||
main.o: LLlex.h Lpars.h debug.h def.h f_info.h idf.h input.h inputtype.h ndir.h node.h scope.h standards.h tokenname.h type.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
|
||||
symbol2str.o: Lpars.h
|
||||
tokenname.o: Lpars.h idf.h 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 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 def.h idf.h main.h node.h scope.h type.h
|
||||
scope.o: LLlex.h debug.h def.h idf.h node.h scope.h type.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 def.h idf.h main.h node.h scope.h type.h
|
||||
defmodule.o: LLlex.h Lpars.h debug.h def.h f_info.h idf.h input.h inputtype.h main.h node.h scope.h
|
||||
typequiv.o: LLlex.h debug.h def.h node.h type.h
|
||||
node.o: LLlex.h debug.h def.h node.h type.h
|
||||
cstoper.o: LLlex.h Lpars.h debug.h idf.h node.h standards.h target_sizes.h type.h
|
||||
chk_expr.o: LLlex.h Lpars.h chk_expr.h const.h debug.h def.h idf.h misc.h node.h scope.h standards.h type.h
|
||||
options.o: idfsize.h main.h ndir.h type.h
|
||||
walk.o: LLlex.h Lpars.h chk_expr.h debug.h def.h desig.h f_info.h idf.h main.h node.h scope.h type.h walk.h
|
||||
casestat.o: LLlex.h Lpars.h debug.h density.h desig.h node.h type.h walk.h
|
||||
desig.o: LLlex.h debug.h def.h desig.h node.h scope.h type.h
|
||||
code.o: LLlex.h Lpars.h debug.h def.h desig.h node.h scope.h standards.h type.h walk.h
|
||||
tmpvar.o: debug.h def.h main.h scope.h type.h
|
||||
lookup.o: LLlex.h debug.h def.h idf.h misc.h node.h scope.h type.h
|
||||
enter.o: LLlex.h debug.h debugcst.h def.h idf.h main.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 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
|
||||
tokenfile.o: Lpars.h
|
||||
program.o: LLlex.h Lpars.h debug.h def.h f_info.h idf.h main.h node.h scope.h type.h
|
||||
declar.o: LLlex.h Lpars.h chk_expr.h debug.h def.h idf.h main.h misc.h node.h scope.h type.h
|
||||
expression.o: LLlex.h Lpars.h chk_expr.h const.h debug.h def.h idf.h node.h type.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
|
||||
Lpars.o: Lpars.h
|
||||
|
|
|
|||
|
|
@ -45,14 +45,8 @@
|
|||
#define AL_UNION 1
|
||||
|
||||
|
||||
!File: debug.h
|
||||
!File: debugcst.h
|
||||
#define DEBUG 1 /* perform various self-tests */
|
||||
extern char options[];
|
||||
#ifdef DEBUG
|
||||
#define DO_DEBUG(y, x) ((y) && (x))
|
||||
#else
|
||||
#define DO_DEBUG(y, x)
|
||||
#endif DEBUG
|
||||
|
||||
!File: inputtype.h
|
||||
#define INP_READ_IN_ONE 1 /* read input file in one */
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
char Version[] = "Version 0.6";
|
||||
char Version[] = "Version 0.7";
|
||||
|
|
|
|||
|
|
@ -69,6 +69,7 @@ CaseCode(nd, exitlabel)
|
|||
register struct case_entry *ce;
|
||||
register arith val;
|
||||
label CaseDescrLab;
|
||||
int casecnt = 0;
|
||||
|
||||
assert(pnode->nd_class == Stat && pnode->nd_symb == CASE);
|
||||
|
||||
|
|
@ -85,6 +86,7 @@ CaseCode(nd, exitlabel)
|
|||
/* non-empty case
|
||||
*/
|
||||
pnode->nd_lab = ++text_label;
|
||||
casecnt++;
|
||||
if (! AddCases(sh, /* to descriptor */
|
||||
pnode->nd_left->nd_left,
|
||||
/* of case labels */
|
||||
|
|
@ -105,6 +107,17 @@ CaseCode(nd, exitlabel)
|
|||
}
|
||||
}
|
||||
|
||||
if (!casecnt) {
|
||||
/* There were no cases, so we have to check the case-expression
|
||||
here
|
||||
*/
|
||||
if (! (sh->sh_type->tp_fund & T_DISCRETE)) {
|
||||
node_error(nd, "illegal type in CASE-expression");
|
||||
FreeSh(sh);
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
/* Now generate code for the switch itself
|
||||
First the part that CSA and CSB descriptions have in common.
|
||||
*/
|
||||
|
|
@ -232,7 +245,7 @@ AddOneCase(sh, node, lbl)
|
|||
ce->ce_label = lbl;
|
||||
ce->ce_value = node->nd_INT;
|
||||
if (! TstCompat(sh->sh_type, node->nd_type)) {
|
||||
node_error(node, "Type incompatibility in case");
|
||||
node_error(node, "type incompatibility in case");
|
||||
free_case_entry(ce);
|
||||
return 0;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -21,6 +21,7 @@
|
|||
#include "standards.h"
|
||||
#include "chk_expr.h"
|
||||
#include "misc.h"
|
||||
#include "warning.h"
|
||||
|
||||
extern char *symbol2str();
|
||||
|
||||
|
|
@ -936,7 +937,7 @@ node_error(left, "illegal type in %s", std == S_MAX ? "MAX" : "MIN");
|
|||
|
||||
if (!warning_given) {
|
||||
warning_given = 1;
|
||||
node_warning(expp, "NEW and DISPOSE are old-fashioned");
|
||||
node_warning(expp, W_OLDFASHIONED, "NEW and DISPOSE are old-fashioned");
|
||||
}
|
||||
}
|
||||
if (! (left = getvariable(&arg))) return 0;
|
||||
|
|
|
|||
|
|
@ -13,6 +13,7 @@
|
|||
#include "node.h"
|
||||
#include "Lpars.h"
|
||||
#include "standards.h"
|
||||
#include "warning.h"
|
||||
|
||||
long mach_long_sign; /* sign bit of the machine long */
|
||||
int mach_long_size; /* size of long on this machine == sizeof(long) */
|
||||
|
|
@ -22,6 +23,8 @@ arith max_unsigned; /* maximum unsigned on target machine */
|
|||
arith max_longint; /* maximum longint on target machine */
|
||||
arith wrd_bits; /* number of bits in a word */
|
||||
|
||||
static char ovflow[] = "overflow in constant expression";
|
||||
|
||||
cstunary(expp)
|
||||
register struct node *expp;
|
||||
{
|
||||
|
|
@ -485,7 +488,7 @@ cstcall(expp, call)
|
|||
|| expp->nd_INT >= expp->nd_type->enm_ncst
|
||||
)
|
||||
)
|
||||
) node_warning(expp,"overflow in constant expression");
|
||||
) node_warning(expp, W_ORDINARY, ovflow);
|
||||
else CutSize(expp);
|
||||
break;
|
||||
|
||||
|
|
@ -512,8 +515,7 @@ CutSize(expr)
|
|||
uns = (tp->tp_fund & (T_CARDINAL|T_CHAR));
|
||||
if (uns) {
|
||||
if (o1 & ~full_mask[size]) {
|
||||
node_warning(expr,
|
||||
"overflow in constant expression");
|
||||
node_warning(expr, W_ORDINARY, ovflow);
|
||||
o1 &= full_mask[size];
|
||||
}
|
||||
}
|
||||
|
|
@ -522,7 +524,7 @@ CutSize(expr)
|
|||
long remainder = o1 & ~full_mask[size];
|
||||
|
||||
if (remainder != 0 && remainder != ~full_mask[size]) {
|
||||
node_warning(expr, "overflow in constant expression");
|
||||
node_warning(expr, W_ORDINARY, ovflow);
|
||||
o1 <<= nbits;
|
||||
o1 >>= nbits;
|
||||
}
|
||||
|
|
|
|||
10
lang/m2/comp/debug.h
Normal file
10
lang/m2/comp/debug.h
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
/* A debugging macro
|
||||
*/
|
||||
|
||||
#include "debugcst.h"
|
||||
|
||||
#ifdef DEBUG
|
||||
#define DO_DEBUG(x, y) ((x) && (y))
|
||||
#else
|
||||
#define DO_DEBUG(x, y)
|
||||
#endif
|
||||
|
|
@ -17,6 +17,7 @@
|
|||
#include "misc.h"
|
||||
#include "main.h"
|
||||
#include "chk_expr.h"
|
||||
#include "warning.h"
|
||||
|
||||
int proclevel = 0; /* nesting level of procedures */
|
||||
int return_occurred; /* set if a return occurs in a block */
|
||||
|
|
@ -162,7 +163,7 @@ enumeration(struct type **ptp;)
|
|||
*ptp = standard_type(T_ENUMERATION, 1, (arith) 1);
|
||||
EnterEnumList(EnumList, *ptp);
|
||||
if ((*ptp)->enm_ncst > 256) { /* ??? is this reasonable ??? */
|
||||
error("Too many enumeration literals");
|
||||
error("too many enumeration literals");
|
||||
}
|
||||
}
|
||||
;
|
||||
|
|
@ -277,7 +278,7 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
|
|||
| /* Old fashioned! the first qualident now represents
|
||||
the type
|
||||
*/
|
||||
{ warning("Old fashioned Modula-2 syntax; ':' missing");
|
||||
{ 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)) ||
|
||||
|
|
@ -297,7 +298,7 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
|
|||
scope,
|
||||
D_FIELD);
|
||||
if (!(tp->tp_fund & T_DISCRETE)) {
|
||||
error("Illegal type in variant");
|
||||
error("illegal type in variant");
|
||||
}
|
||||
df->df_type = tp;
|
||||
df->fld_off = align(*cnt, tp->tp_align);
|
||||
|
|
@ -386,18 +387,36 @@ PointerType(struct type **ptp;)
|
|||
} :
|
||||
POINTER TO
|
||||
{ *ptp = construct_type(T_POINTER, NULLTYPE); }
|
||||
[ %if ( lookup(dot.TOK_IDF, CurrentScope))
|
||||
/* Either a Module or a Type, but in both cases defined
|
||||
in this scope, so this is the correct identification
|
||||
*/
|
||||
qualtype(&((*ptp)->next))
|
||||
| %if ( nd = new_node(),
|
||||
nd->nd_token = dot,
|
||||
lookfor(nd, CurrVis, 0)->df_kind == D_MODULE)
|
||||
[ %if ( lookup(dot.TOK_IDF, CurrentScope)
|
||||
/* Either a Module or a Type, but in both cases defined
|
||||
in this scope, so this is the correct identification
|
||||
*/
|
||||
||
|
||||
( 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.
|
||||
???
|
||||
*/
|
||||
)
|
||||
type(&((*ptp)->next))
|
||||
{ if (nd) free_node(nd); }
|
||||
|
|
||||
IDENT { Forward(nd, (*ptp)); }
|
||||
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));
|
||||
}
|
||||
}
|
||||
]
|
||||
;
|
||||
|
||||
|
|
|
|||
|
|
@ -15,13 +15,13 @@
|
|||
#include "f_info.h"
|
||||
#include "main.h"
|
||||
#include "node.h"
|
||||
#include "type.h"
|
||||
|
||||
#ifdef DEBUG
|
||||
long sys_filesize();
|
||||
#endif
|
||||
|
||||
struct idf * CurrentId;
|
||||
|
||||
STATIC
|
||||
GetFile(name)
|
||||
char *name;
|
||||
{
|
||||
|
|
@ -35,10 +35,12 @@ GetFile(name)
|
|||
buf[10] = '\0'; /* maximum length */
|
||||
strcat(buf, ".def");
|
||||
if (! InsertFile(buf, DEFPATH, &(FileName))) {
|
||||
fatal("Could'nt find a DEFINITION MODULE for \"%s\"", name);
|
||||
error("could'nt find a DEFINITION MODULE for \"%s\"", name);
|
||||
return 0;
|
||||
}
|
||||
LineNumber = 1;
|
||||
DO_DEBUG(options['F'], debug("File %s : %ld characters", FileName, sys_filesize(FileName)));
|
||||
return 1;
|
||||
}
|
||||
|
||||
struct def *
|
||||
|
|
@ -52,6 +54,7 @@ GetDefinitionModule(id, incr)
|
|||
*/
|
||||
struct def *df;
|
||||
static int level;
|
||||
struct scopelist *vis;
|
||||
|
||||
level += incr;
|
||||
df = lookup(id, GlobalScope);
|
||||
|
|
@ -62,33 +65,40 @@ GetDefinitionModule(id, incr)
|
|||
do_SYSTEM();
|
||||
}
|
||||
else {
|
||||
GetFile(id->id_text);
|
||||
CurrentId = id;
|
||||
open_scope(CLOSEDSCOPE);
|
||||
DefModule();
|
||||
if (level == 1) {
|
||||
/* 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
|
||||
*/
|
||||
static struct node *nd_end; /* end of list */
|
||||
register struct node *n;
|
||||
extern struct node *Modules;
|
||||
if (GetFile(id->id_text)) {
|
||||
DefModule();
|
||||
if (level == 1) {
|
||||
/* 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
|
||||
*/
|
||||
static struct node *nd_end;
|
||||
register struct node *n;
|
||||
extern struct node *Modules;
|
||||
|
||||
n = MkLeaf(Name, &dot);
|
||||
n->nd_IDF = id;
|
||||
n->nd_symb = IDENT;
|
||||
if (nd_end) nd_end->next = n;
|
||||
else Modules = n;
|
||||
nd_end = n;
|
||||
n = MkLeaf(Name, &dot);
|
||||
n->nd_IDF = id;
|
||||
n->nd_symb = IDENT;
|
||||
if (nd_end) nd_end->next = n;
|
||||
else Modules = n;
|
||||
nd_end = n;
|
||||
}
|
||||
}
|
||||
vis = CurrVis;
|
||||
close_scope(SC_CHKFORW);
|
||||
}
|
||||
df = lookup(id, GlobalScope);
|
||||
if (! df) {
|
||||
df = MkDef(id, GlobalScope, D_ERROR);
|
||||
df->df_type = error_type;
|
||||
df->mod_vis = CurrVis;
|
||||
return df;
|
||||
}
|
||||
}
|
||||
CurrentId = 0;
|
||||
assert(df && df->df_kind == D_MODULE);
|
||||
assert(df);
|
||||
level -= incr;
|
||||
return df;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -116,7 +116,7 @@ EnterVarList(Idlist, type, local)
|
|||
df->df_flags |= D_NOREG;
|
||||
if (idlist->nd_left->nd_type != card_type) {
|
||||
node_error(idlist->nd_left,
|
||||
"Illegal type for address");
|
||||
"illegal type for address");
|
||||
}
|
||||
df->var_off = idlist->nd_left->nd_INT;
|
||||
}
|
||||
|
|
@ -235,17 +235,20 @@ DoImport(df, scope)
|
|||
}
|
||||
|
||||
STATIC struct scopelist *
|
||||
ForwModule(df, idn)
|
||||
ForwModule(df, nd)
|
||||
register struct def *df;
|
||||
struct node *idn;
|
||||
struct node *nd;
|
||||
{
|
||||
/* An import is done from a not yet defined module "idn".
|
||||
/* An import is done from a not yet defined module "df".
|
||||
We could also end up here for not found DEFINITION MODULES.
|
||||
Create a declaration and a scope for this module.
|
||||
*/
|
||||
struct scopelist *vis;
|
||||
|
||||
df->df_scope = enclosing(CurrVis)->sc_scope;
|
||||
df->df_kind = D_FORWMODULE;
|
||||
if (df->df_scope != GlobalScope) {
|
||||
df->df_scope = enclosing(CurrVis)->sc_scope;
|
||||
df->df_kind = D_FORWMODULE;
|
||||
}
|
||||
open_scope(CLOSEDSCOPE);
|
||||
vis = CurrVis; /* The new scope, but watch out, it's "sc_encl"
|
||||
field is not set right. It must indicate the
|
||||
|
|
@ -256,7 +259,7 @@ ForwModule(df, idn)
|
|||
vis->sc_encl = enclosing(CurrVis);
|
||||
/* Here ! */
|
||||
df->for_vis = vis;
|
||||
df->for_node = MkLeaf(Name, &(idn->nd_token));
|
||||
df->for_node = nd;
|
||||
return vis;
|
||||
}
|
||||
|
||||
|
|
@ -289,7 +292,9 @@ EnterExportList(Idlist, qualified)
|
|||
register struct def *df, *df1;
|
||||
|
||||
for (;idlist; idlist = idlist->next) {
|
||||
df = lookup(idlist->nd_IDF, CurrentScope);
|
||||
extern struct def *NoImportlookup();
|
||||
|
||||
df = NoImportlookup(idlist->nd_IDF, CurrentScope);
|
||||
|
||||
if (!df) {
|
||||
/* undefined item in export list
|
||||
|
|
@ -306,6 +311,8 @@ EnterExportList(Idlist, qualified)
|
|||
idlist->nd_IDF->id_text);
|
||||
}
|
||||
|
||||
if (df->df_kind == D_IMPORT) df = df->imp_def;
|
||||
|
||||
df->df_flags |= qualified;
|
||||
if (qualified == D_EXPORTED) {
|
||||
/* Export, but not qualified.
|
||||
|
|
@ -357,9 +364,10 @@ EnterExportList(Idlist, qualified)
|
|||
FreeNode(Idlist);
|
||||
}
|
||||
|
||||
EnterFromImportList(Idlist, FromDef)
|
||||
EnterFromImportList(Idlist, FromDef, FromId)
|
||||
struct node *Idlist;
|
||||
register struct def *FromDef;
|
||||
struct node *FromId;
|
||||
{
|
||||
/* Import the list Idlist from the module indicated by Fromdef.
|
||||
*/
|
||||
|
|
@ -373,9 +381,11 @@ EnterFromImportList(Idlist, FromDef)
|
|||
/* The module from which the import was done
|
||||
is not yet declared. I'm not sure if I must
|
||||
accept this, but for the time being I will.
|
||||
We also end up here if some definition module could not
|
||||
be found.
|
||||
???
|
||||
*/
|
||||
vis = ForwModule(FromDef, FromDef->df_idf);
|
||||
vis = ForwModule(FromDef, FromId);
|
||||
forwflag = 1;
|
||||
break;
|
||||
case D_FORWMODULE:
|
||||
|
|
@ -385,7 +395,7 @@ EnterFromImportList(Idlist, FromDef)
|
|||
vis = FromDef->mod_vis;
|
||||
break;
|
||||
default:
|
||||
error("identifier \"%s\" does not represent a module",
|
||||
node_error(FromId, "identifier \"%s\" does not represent a module",
|
||||
FromDef->df_idf->id_text);
|
||||
break;
|
||||
}
|
||||
|
|
@ -405,6 +415,7 @@ EnterFromImportList(Idlist, FromDef)
|
|||
DoImport(df, CurrentScope);
|
||||
}
|
||||
|
||||
if (!forwflag) FreeNode(FromId);
|
||||
FreeNode(Idlist);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -17,6 +17,7 @@
|
|||
#include "LLlex.h"
|
||||
#include "main.h"
|
||||
#include "node.h"
|
||||
#include "warning.h"
|
||||
|
||||
/* error classes */
|
||||
#define ERROR 1
|
||||
|
|
@ -30,6 +31,7 @@
|
|||
#endif
|
||||
|
||||
int err_occurred;
|
||||
static int warn_class;
|
||||
|
||||
extern char *symbol2str();
|
||||
|
||||
|
|
@ -69,18 +71,20 @@ node_error(node, fmt, args)
|
|||
}
|
||||
|
||||
/*VARARGS1*/
|
||||
warning(fmt, args)
|
||||
warning(class, fmt, args)
|
||||
char *fmt;
|
||||
{
|
||||
_error(WARNING, NULLNODE, fmt, &args);
|
||||
warn_class = class;
|
||||
if (class & warning_classes) _error(WARNING, NULLNODE, fmt, &args);
|
||||
}
|
||||
|
||||
/*VARARGS2*/
|
||||
node_warning(node, fmt, args)
|
||||
node_warning(node, class, fmt, args)
|
||||
struct node *node;
|
||||
char *fmt;
|
||||
{
|
||||
_error(WARNING, node, fmt, &args);
|
||||
warn_class = class;
|
||||
if (class & warning_classes) _error(WARNING, node, fmt, &args);
|
||||
}
|
||||
|
||||
/*VARARGS1*/
|
||||
|
|
@ -91,10 +95,11 @@ lexerror(fmt, args)
|
|||
}
|
||||
|
||||
/*VARARGS1*/
|
||||
lexwarning(fmt, args)
|
||||
lexwarning(class, fmt, args)
|
||||
char *fmt;
|
||||
{
|
||||
_error(LEXWARNING, NULLNODE, fmt, &args);
|
||||
warn_class = class;
|
||||
if (class & warning_classes) _error(LEXWARNING, NULLNODE, fmt, &args);
|
||||
}
|
||||
|
||||
/*VARARGS1*/
|
||||
|
|
@ -149,19 +154,23 @@ _error(class, node, fmt, argv)
|
|||
if (C_busy()) C_ms_err();
|
||||
err_occurred = 1;
|
||||
break;
|
||||
|
||||
case WARNING:
|
||||
case LEXWARNING:
|
||||
if (options['w'])
|
||||
return;
|
||||
break;
|
||||
}
|
||||
|
||||
/* the remark */
|
||||
switch (class) {
|
||||
case WARNING:
|
||||
case LEXWARNING:
|
||||
remark = "(warning)";
|
||||
switch(warn_class) {
|
||||
case W_OLDFASHIONED:
|
||||
remark = "(old-fashioned use)";
|
||||
break;
|
||||
case W_STRICT:
|
||||
remark = "(strict)";
|
||||
break;
|
||||
default:
|
||||
remark = "(warning)";
|
||||
break;
|
||||
}
|
||||
break;
|
||||
case CRASH:
|
||||
remark = "CRASH\007";
|
||||
|
|
|
|||
|
|
@ -15,6 +15,9 @@
|
|||
#include "const.h"
|
||||
#include "type.h"
|
||||
#include "chk_expr.h"
|
||||
#include "warning.h"
|
||||
|
||||
extern char options[];
|
||||
}
|
||||
|
||||
number(struct node **p;) :
|
||||
|
|
@ -93,7 +96,7 @@ ConstExpression(struct node **pnd;):
|
|||
DO_DEBUG(options['X'], PrNode(*pnd, 0));
|
||||
if (ChkExpression(*pnd) &&
|
||||
((*pnd)->nd_class != Set && (*pnd)->nd_class != Value)) {
|
||||
error("Constant expression expected");
|
||||
error("constant expression expected");
|
||||
}
|
||||
DO_DEBUG(options['X'], print("RESULTS IN\n"));
|
||||
DO_DEBUG(options['X'], PrNode(*pnd, 0));
|
||||
|
|
@ -234,7 +237,8 @@ designator(struct node **pnd;)
|
|||
|
||||
designator_tail(struct node **pnd;):
|
||||
visible_designator_tail(pnd)
|
||||
[
|
||||
[ %persistent
|
||||
%default
|
||||
selector(pnd)
|
||||
|
|
||||
visible_designator_tail(pnd)
|
||||
|
|
|
|||
|
|
@ -10,16 +10,12 @@ struct f_info file_info;
|
|||
#include "scope.h"
|
||||
#include <inp_pkg.body>
|
||||
|
||||
extern struct idf *CurrentId;
|
||||
|
||||
AtEoIF()
|
||||
{
|
||||
/* Make the unstacking of input streams noticable to the
|
||||
lexical analyzer
|
||||
*/
|
||||
if (CurrentId && ! lookup(CurrentId, GlobalScope)) {
|
||||
fatal("No definition module read for \"%s\"", CurrentId->id_text);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -51,6 +51,38 @@ lookup(id, scope)
|
|||
return df;
|
||||
}
|
||||
|
||||
struct def *
|
||||
NoImportlookup(id, scope)
|
||||
register struct idf *id;
|
||||
struct scope *scope;
|
||||
{
|
||||
/* Look up a definition of an identifier in scope "scope".
|
||||
Make the "def" list self-organizing.
|
||||
Don't check if the definition is imported!
|
||||
*/
|
||||
register struct def *df, *df1;
|
||||
|
||||
/* Look in the chain of definitions of this "id" for one with scope
|
||||
"scope".
|
||||
*/
|
||||
for (df = id->id_def, df1 = 0;
|
||||
df && df->df_scope != scope;
|
||||
df1 = df, df = df->next) { /* nothing */ }
|
||||
|
||||
if (df) {
|
||||
/* Found it
|
||||
*/
|
||||
if (df1) {
|
||||
/* Put the definition in front
|
||||
*/
|
||||
df1->next = df->next;
|
||||
df->next = id->id_def;
|
||||
id->id_def = df;
|
||||
}
|
||||
}
|
||||
return df;
|
||||
}
|
||||
|
||||
struct def *
|
||||
lookfor(id, vis, give_error)
|
||||
register struct node *id;
|
||||
|
|
|
|||
|
|
@ -18,6 +18,7 @@
|
|||
#include "standards.h"
|
||||
#include "tokenname.h"
|
||||
#include "node.h"
|
||||
#include "warning.h"
|
||||
|
||||
int state; /* either IMPLEMENTATION or PROGRAM */
|
||||
char options[128];
|
||||
|
|
@ -35,6 +36,7 @@ main(argc, argv)
|
|||
register char **Nargv = &argv[0];
|
||||
|
||||
ProgName = *argv++;
|
||||
warning_classes = W_INITIAL;
|
||||
|
||||
while (--argc > 0) {
|
||||
if (**argv == '-')
|
||||
|
|
@ -78,7 +80,7 @@ Compile(src, dst)
|
|||
open_scope(CLOSEDSCOPE);
|
||||
GlobalScope = CurrentScope;
|
||||
C_init(word_size, pointer_size);
|
||||
if (! C_open(dst)) fatal("Could not open output file");
|
||||
if (! C_open(dst)) fatal("could not open output file");
|
||||
C_magic();
|
||||
C_ms_emx(word_size, pointer_size);
|
||||
CompUnit();
|
||||
|
|
@ -199,7 +201,7 @@ do_SYSTEM()
|
|||
(void) Enter("ADR", D_PROCEDURE, std_type, S_ADR);
|
||||
(void) Enter("TSIZE", D_PROCEDURE, std_type, S_TSIZE);
|
||||
if (!InsertText(SYSTEM, sizeof(SYSTEM) - 1)) {
|
||||
fatal("Could not insert text");
|
||||
fatal("could not insert text");
|
||||
}
|
||||
DefModule();
|
||||
close_scope(SC_CHKFORW);
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@ match_id(id1, id2)
|
|||
first place, and if not, give an error message
|
||||
*/
|
||||
if (id1 != id2 && !is_anon_idf(id1) && !is_anon_idf(id2)) {
|
||||
error("Name \"%s\" does not match block name \"%s\"",
|
||||
error("name \"%s\" does not match block name \"%s\"",
|
||||
id1->id_text,
|
||||
id2->id_text
|
||||
);
|
||||
|
|
|
|||
|
|
@ -8,9 +8,11 @@
|
|||
|
||||
#include "type.h"
|
||||
#include "main.h"
|
||||
#include "warning.h"
|
||||
|
||||
extern int idfsize;
|
||||
static int ndirs;
|
||||
int warning_classes;
|
||||
|
||||
DoOption(text)
|
||||
register char *text;
|
||||
|
|
@ -29,6 +31,41 @@ DoOption(text)
|
|||
*/
|
||||
|
||||
|
||||
case 'w':
|
||||
if (*text) {
|
||||
while (*text) {
|
||||
switch(*text++) {
|
||||
case 'O':
|
||||
warning_classes &= ~W_OLDFASHIONED;
|
||||
break;
|
||||
case 'R':
|
||||
warning_classes &= ~W_STRICT;
|
||||
break;
|
||||
case 'W':
|
||||
warning_classes &= ~W_ORDINARY;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
else warning_classes = 0;
|
||||
break;
|
||||
|
||||
case 'W':
|
||||
while (*text) {
|
||||
switch(*text++) {
|
||||
case 'O':
|
||||
warning_classes |= W_OLDFASHIONED;
|
||||
break;
|
||||
case 'R':
|
||||
warning_classes |= W_STRICT;
|
||||
break;
|
||||
case 'W':
|
||||
warning_classes |= W_ORDINARY;
|
||||
break;
|
||||
}
|
||||
}
|
||||
break;
|
||||
|
||||
case 'M': { /* maximum identifier length */
|
||||
char *t = text; /* because &text is illegal */
|
||||
|
||||
|
|
@ -42,7 +79,7 @@ DoOption(text)
|
|||
|
||||
case 'I' :
|
||||
if (++ndirs >= NDIRS) {
|
||||
fatal("Too many -I options");
|
||||
fatal("too many -I options");
|
||||
}
|
||||
DEFPATH[ndirs] = text;
|
||||
break;
|
||||
|
|
|
|||
|
|
@ -15,6 +15,7 @@
|
|||
#include "type.h"
|
||||
#include "node.h"
|
||||
#include "f_info.h"
|
||||
#include "warning.h"
|
||||
|
||||
}
|
||||
/*
|
||||
|
|
@ -62,7 +63,7 @@ priority(arith *pprio;)
|
|||
} :
|
||||
'[' ConstExpression(&nd) ']'
|
||||
{ if (!(nd->nd_type->tp_fund & T_CARDINAL)) {
|
||||
node_error(nd, "Illegal priority");
|
||||
node_error(nd, "illegal priority");
|
||||
}
|
||||
*pprio = nd->nd_INT;
|
||||
FreeNode(nd);
|
||||
|
|
@ -85,23 +86,16 @@ export(int *QUALflag; struct node **ExportList;)
|
|||
import(int local;)
|
||||
{
|
||||
struct node *ImportList;
|
||||
struct node *FromId = 0;
|
||||
register struct def *df;
|
||||
int fromid;
|
||||
extern struct def *GetDefinitionModule();
|
||||
} :
|
||||
[ FROM
|
||||
IDENT { fromid = 1;
|
||||
if (local) {
|
||||
struct node *nd = MkLeaf(Name, &dot);
|
||||
|
||||
df = lookfor(nd,enclosing(CurrVis),0);
|
||||
FreeNode(nd);
|
||||
}
|
||||
else df = GetDefinitionModule(dot.TOK_IDF, 1);
|
||||
IDENT { FromId = MkLeaf(Name, &dot);
|
||||
if (local) df = lookfor(FromId,enclosing(CurrVis),0);
|
||||
else df = GetDefinitionModule(dot.TOK_IDF, 1);
|
||||
}
|
||||
|
|
||||
{ fromid = 0; }
|
||||
]
|
||||
]?
|
||||
IMPORT IdentList(&ImportList) ';'
|
||||
/*
|
||||
When parsing a global module, this is the place where we must
|
||||
|
|
@ -109,7 +103,9 @@ import(int local;)
|
|||
If the FROM clause is present, the identifier in it is a module
|
||||
name, otherwise the names in the import list are module names.
|
||||
*/
|
||||
{ if (fromid) EnterFromImportList(ImportList, df);
|
||||
{ if (FromId) {
|
||||
EnterFromImportList(ImportList, df, FromId);
|
||||
}
|
||||
else EnterImportList(ImportList, local);
|
||||
}
|
||||
;
|
||||
|
|
@ -137,7 +133,7 @@ DefinitionModule
|
|||
modules. Issue a warning.
|
||||
*/
|
||||
{
|
||||
node_warning(exportlist, "export list in definition module ignored");
|
||||
node_warning(exportlist, W_ORDINARY, "export list in definition module ignored");
|
||||
FreeNode(exportlist);
|
||||
}
|
||||
|
|
||||
|
|
@ -161,7 +157,7 @@ definition
|
|||
register struct def *df;
|
||||
struct def *dummy;
|
||||
} :
|
||||
CONST [ ConstantDeclaration Semicolon ]*
|
||||
CONST [ ConstantDeclaration ';' ]*
|
||||
|
|
||||
TYPE
|
||||
[ IDENT { df = define(dot.TOK_IDF, CurrentScope, D_TYPE); }
|
||||
|
|
@ -176,21 +172,13 @@ definition
|
|||
df->df_type = construct_type(T_HIDDEN, NULLTYPE);
|
||||
}
|
||||
]
|
||||
Semicolon
|
||||
';'
|
||||
]*
|
||||
|
|
||||
VAR [ VariableDeclaration Semicolon ]*
|
||||
VAR [ VariableDeclaration ';' ]*
|
||||
|
|
||||
ProcedureHeading(&dummy, D_PROCHEAD)
|
||||
Semicolon
|
||||
;
|
||||
|
||||
/* The next nonterminal is used to relax the grammar a little.
|
||||
*/
|
||||
Semicolon:
|
||||
';'
|
||||
|
|
||||
/* empty */ { warning("; expected"); }
|
||||
;
|
||||
|
||||
ProgramModule
|
||||
|
|
|
|||
|
|
@ -18,6 +18,7 @@ struct scope *PervasiveScope, *GlobalScope;
|
|||
struct scopelist *CurrVis;
|
||||
extern int proclevel;
|
||||
static struct scopelist *PervVis;
|
||||
extern char options[];
|
||||
|
||||
/* STATICALLOCDEF "scope" 10 */
|
||||
|
||||
|
|
@ -107,7 +108,7 @@ chk_proc(df)
|
|||
|
||||
STATIC
|
||||
chk_forw(pdf)
|
||||
struct def **pdf;
|
||||
register struct def **pdf;
|
||||
{
|
||||
/* Called at scope close. Look for all forward definitions and
|
||||
if the scope was a closed scope, give an error message for
|
||||
|
|
|
|||
|
|
@ -92,7 +92,7 @@ reserve(resv)
|
|||
|
||||
while (resv->tn_symbol) {
|
||||
p = str2idf(resv->tn_name, 0);
|
||||
if (!p) fatal("Out of Memory");
|
||||
if (!p) fatal("out of Memory");
|
||||
p->id_reserved = resv->tn_symbol;
|
||||
resv++;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -107,7 +107,9 @@ align(pos, al)
|
|||
arith pos;
|
||||
int al;
|
||||
{
|
||||
return ((pos + al - 1) / al) * al;
|
||||
arith i;
|
||||
|
||||
return pos + ((i = pos % al) ? al - i : 0);
|
||||
}
|
||||
|
||||
struct type *
|
||||
|
|
@ -209,25 +211,25 @@ chk_basesubrange(tp, base)
|
|||
of "base".
|
||||
*/
|
||||
if (base->sub_lb > tp->sub_lb || base->sub_ub < tp->sub_ub) {
|
||||
error("Base type has insufficient range");
|
||||
error("base type has insufficient range");
|
||||
}
|
||||
base = base->next;
|
||||
}
|
||||
|
||||
if (base->tp_fund & (T_ENUMERATION|T_CHAR)) {
|
||||
if (tp->next != base) {
|
||||
error("Specified base does not conform");
|
||||
error("specified base does not conform");
|
||||
}
|
||||
}
|
||||
else if (base != card_type && base != int_type) {
|
||||
error("Illegal base for a subrange");
|
||||
error("illegal base for a subrange");
|
||||
}
|
||||
else if (base == int_type && tp->next == card_type &&
|
||||
(tp->sub_ub > max_int || tp->sub_ub < 0)) {
|
||||
error("Upperbound to large for type INTEGER");
|
||||
error("upperbound to large for type INTEGER");
|
||||
}
|
||||
else if (base != tp->next && base != int_type) {
|
||||
error("Specified base does not conform");
|
||||
error("specified base does not conform");
|
||||
}
|
||||
|
||||
tp->next = base;
|
||||
|
|
@ -246,7 +248,7 @@ subr_type(lb, ub)
|
|||
register struct type *tp = BaseType(lb->nd_type), *res;
|
||||
|
||||
if (!TstCompat(lb->nd_type, ub->nd_type)) {
|
||||
node_error(ub, "Types of subrange bounds not equal");
|
||||
node_error(ub, "types of subrange bounds not equal");
|
||||
return error_type;
|
||||
}
|
||||
|
||||
|
|
@ -261,14 +263,14 @@ subr_type(lb, ub)
|
|||
/* Check base type
|
||||
*/
|
||||
if (! (tp->tp_fund & T_DISCRETE)) {
|
||||
node_error(ub, "Illegal base type for subrange");
|
||||
node_error(ub, "illegal base type for subrange");
|
||||
return error_type;
|
||||
}
|
||||
|
||||
/* Check bounds
|
||||
*/
|
||||
if (lb->nd_INT > ub->nd_INT) {
|
||||
node_error(ub, "Lower bound exceeds upper bound");
|
||||
node_error(ub, "lower bound exceeds upper bound");
|
||||
}
|
||||
|
||||
/* Now construct resulting type
|
||||
|
|
@ -361,12 +363,12 @@ set_type(tp)
|
|||
getbounds(tp, &lb, &ub);
|
||||
|
||||
if (lb < 0 || ub > MAXSET-1) {
|
||||
error("Set type limits exceeded");
|
||||
error("set type limits exceeded");
|
||||
return error_type;
|
||||
}
|
||||
|
||||
tp = construct_type(T_SET, tp);
|
||||
tp->tp_size = WA(((ub - lb) + 8)/8);
|
||||
tp->tp_size = WA(((ub - lb) + 8) >> 3);
|
||||
return tp;
|
||||
}
|
||||
|
||||
|
|
@ -406,7 +408,7 @@ ArraySizes(tp)
|
|||
/* check index type
|
||||
*/
|
||||
if (! bounded(index_type)) {
|
||||
error("Illegal index type");
|
||||
error("illegal index type");
|
||||
tp->tp_size = 0;
|
||||
return;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -13,6 +13,7 @@
|
|||
#include "def.h"
|
||||
#include "LLlex.h"
|
||||
#include "node.h"
|
||||
#include "warning.h"
|
||||
|
||||
int
|
||||
TstTypeEquiv(tp1, tp2)
|
||||
|
|
@ -218,7 +219,7 @@ TstParCompat(formaltype, actualtype, VARflag, nd)
|
|||
( VARflag
|
||||
&& ( TstCompat(formaltype, actualtype)
|
||||
&&
|
||||
(node_warning(nd, "oldfashioned! types of formal and actual must be identical"),
|
||||
(node_warning(nd, W_OLDFASHIONED, "types of formal and actual must be identical"),
|
||||
1)
|
||||
)
|
||||
)
|
||||
|
|
|
|||
|
|
@ -24,6 +24,7 @@
|
|||
#include "idf.h"
|
||||
#include "chk_expr.h"
|
||||
#include "walk.h"
|
||||
#include "warning.h"
|
||||
|
||||
extern arith NewPtr();
|
||||
extern arith NewInt();
|
||||
|
|
@ -147,7 +148,7 @@ WalkProcedure(procedure)
|
|||
DoProfil();
|
||||
TmpOpen(sc);
|
||||
|
||||
func_type = tp = ResultType(procedure->df_type);
|
||||
func_type = tp = RemoveEqual(ResultType(procedure->df_type));
|
||||
|
||||
if (tp && IsConstructed(tp)) {
|
||||
/* The result type of this procedure is constructed.
|
||||
|
|
@ -678,7 +679,7 @@ DoForInit(nd, left)
|
|||
node_error(nd, "type incompatibility in FOR statement");
|
||||
return 0;
|
||||
}
|
||||
node_warning(nd, "old-fashioned! compatibility required in FOR statement");
|
||||
node_warning(nd, W_OLDFASHIONED, "compatibility required in FOR statement");
|
||||
}
|
||||
|
||||
return 1;
|
||||
|
|
|
|||
18
lang/m2/comp/warning.h
Normal file
18
lang/m2/comp/warning.h
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
/* Warning classes, at the moment three of them:
|
||||
Strict (R)
|
||||
Ordinary (W)
|
||||
Old-fashioned(O)
|
||||
*/
|
||||
|
||||
/* Bits for a bit mask: */
|
||||
|
||||
#define W_ORDINARY 1
|
||||
#define W_STRICT 2
|
||||
#define W_OLDFASHIONED 4
|
||||
|
||||
#define W_ALL (W_ORDINARY|W_STRICT|W_OLDFASHIONED)
|
||||
|
||||
#define W_INITIAL (W_ORDINARY | W_OLDFASHIONED)
|
||||
|
||||
/* The bit mask itself: */
|
||||
extern int warning_classes;
|
||||
Loading…
Add table
Reference in a new issue