#include "type.h"
#include "LLlex.h"
#include "const.h"
+#include "warning.h"
long str2long();
extern int cntlines;
#endif
+static int eofseen;
+
STATIC
SkipComment()
{
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()
{
register struct token *tk = ˙
char buf[(IDFSIZE > NUMSIZE ? IDFSIZE : NUMSIZE) + 2];
register int ch, nch;
- static int eofseen;
toktype = error_type;
tk->tk_lineno = LineNumber;
+again2:
if (eofseen) {
eofseen = 0;
ch = EOI;
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;
}
}
cntlines++;
#endif
tk->tk_lineno++;
- /* Fall Through */
+ LoadChar(ch);
+ if (ch != '#') goto again1;
+ linedirective();
+ goto again2;
case STSKIP:
goto 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;
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 &&
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)
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)
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
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)
# entry points not to be used directly
-Cfiles: hfiles LLfiles $(GENCFILES) $(GENHFILES)
+Cfiles: hfiles LLfiles $(GENCFILES) $(GENHFILES) Makefile
echo $(SRC) $(HFILES) > Cfiles
LLfiles: $(GFILES)
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
#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 */
-char Version[] = "Version 0.6";
+char Version[] = "Version 0.7";
register struct case_entry *ce;
register arith val;
label CaseDescrLab;
+ int casecnt = 0;
assert(pnode->nd_class == Stat && pnode->nd_symb == CASE);
/* non-empty case
*/
pnode->nd_lab = ++text_label;
+ casecnt++;
if (! AddCases(sh, /* to descriptor */
pnode->nd_left->nd_left,
/* of case labels */
}
}
+ 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.
*/
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;
}
#include "standards.h"
#include "chk_expr.h"
#include "misc.h"
+#include "warning.h"
extern char *symbol2str();
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;
#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) */
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;
{
|| 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;
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];
}
}
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;
}
--- /dev/null
+/* A debugging macro
+*/
+
+#include "debugcst.h"
+
+#ifdef DEBUG
+#define DO_DEBUG(x, y) ((x) && (y))
+#else
+#define DO_DEBUG(x, y)
+#endif
#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 */
*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");
}
}
;
| /* 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)) ||
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);
} :
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));
+ }
+ }
]
;
#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;
{
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 *
*/
struct def *df;
static int level;
+ struct scopelist *vis;
level += incr;
df = lookup(id, GlobalScope);
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;
}
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;
}
}
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
vis->sc_encl = enclosing(CurrVis);
/* Here ! */
df->for_vis = vis;
- df->for_node = MkLeaf(Name, &(idn->nd_token));
+ df->for_node = nd;
return vis;
}
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
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.
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.
*/
/* 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:
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;
}
DoImport(df, CurrentScope);
}
+ if (!forwflag) FreeNode(FromId);
FreeNode(Idlist);
}
#include "LLlex.h"
#include "main.h"
#include "node.h"
+#include "warning.h"
/* error classes */
#define ERROR 1
#endif
int err_occurred;
+static int warn_class;
extern char *symbol2str();
}
/*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*/
}
/*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*/
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";
#include "const.h"
#include "type.h"
#include "chk_expr.h"
+#include "warning.h"
+
+extern char options[];
}
number(struct node **p;) :
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));
designator_tail(struct node **pnd;):
visible_designator_tail(pnd)
- [
+ [ %persistent
+ %default
selector(pnd)
|
visible_designator_tail(pnd)
#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;
}
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;
#include "standards.h"
#include "tokenname.h"
#include "node.h"
+#include "warning.h"
int state; /* either IMPLEMENTATION or PROGRAM */
char options[128];
register char **Nargv = &argv[0];
ProgName = *argv++;
+ warning_classes = W_INITIAL;
while (--argc > 0) {
if (**argv == '-')
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();
(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);
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
);
#include "type.h"
#include "main.h"
+#include "warning.h"
extern int idfsize;
static int ndirs;
+int warning_classes;
DoOption(text)
register char *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 */
case 'I' :
if (++ndirs >= NDIRS) {
- fatal("Too many -I options");
+ fatal("too many -I options");
}
DEFPATH[ndirs] = text;
break;
#include "type.h"
#include "node.h"
#include "f_info.h"
+#include "warning.h"
}
/*
} :
'[' 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);
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
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);
}
;
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);
}
|
register struct def *df;
struct def *dummy;
} :
- CONST [ ConstantDeclaration Semicolon ]*
+ CONST [ ConstantDeclaration ';' ]*
|
TYPE
[ IDENT { df = define(dot.TOK_IDF, CurrentScope, D_TYPE); }
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
struct scopelist *CurrVis;
extern int proclevel;
static struct scopelist *PervVis;
+extern char options[];
/* STATICALLOCDEF "scope" 10 */
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
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++;
}
arith pos;
int al;
{
- return ((pos + al - 1) / al) * al;
+ arith i;
+
+ return pos + ((i = pos % al) ? al - i : 0);
}
struct type *
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;
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;
}
/* 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
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;
}
/* check index type
*/
if (! bounded(index_type)) {
- error("Illegal index type");
+ error("illegal index type");
tp->tp_size = 0;
return;
}
#include "def.h"
#include "LLlex.h"
#include "node.h"
+#include "warning.h"
int
TstTypeEquiv(tp1, tp2)
( 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)
)
)
#include "idf.h"
#include "chk_expr.h"
#include "walk.h"
+#include "warning.h"
extern arith NewPtr();
extern arith NewInt();
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.
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;
--- /dev/null
+/* 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;
public / ack.git / commitdiff