From ca44bfc6816c37fc4dcd3953dac8918d9a672e16 Mon Sep 17 00:00:00 2001 From: ceriel Date: Wed, 22 Oct 1986 15:38:24 +0000 Subject: [PATCH] newer version with some bug fixes --- lang/m2/comp/LLlex.c | 34 +++++++++++++------- lang/m2/comp/Makefile | 67 +++++++++++++++++++++------------------ lang/m2/comp/Resolve | 19 ++++++++--- lang/m2/comp/chk_expr.c | 18 +++++++++-- lang/m2/comp/code.c | 2 +- lang/m2/comp/declar.g | 5 +-- lang/m2/comp/enter.c | 6 ++-- lang/m2/comp/expression.g | 2 +- lang/m2/comp/lookup.c | 1 + lang/m2/comp/misc.c | 8 +++-- lang/m2/comp/misc.h | 3 +- 11 files changed, 106 insertions(+), 59 deletions(-) diff --git a/lang/m2/comp/LLlex.c b/lang/m2/comp/LLlex.c index 2884c0291..6489389cb 100644 --- a/lang/m2/comp/LLlex.c +++ b/lang/m2/comp/LLlex.c @@ -113,6 +113,7 @@ LLlex() register struct token *tk = ˙ char buf[(IDFSIZE > NUMSIZE ? IDFSIZE : NUMSIZE) + 2]; register int ch, nch; + static int eofseen; toktype = error_type; @@ -124,10 +125,16 @@ LLlex() tk->tk_lineno = LineNumber; + if (eofseen) { + eofseen = 0; + ch = EOI; + } + else { again: - LoadChar(ch); - if ((ch & 0200) && ch != EOI) { - fatal("non-ascii '\\%03o' read", ch & 0377); + LoadChar(ch); + if ((ch & 0200) && ch != EOI) { + fatal("non-ascii '\\%03o' read", ch & 0377); + } } switch (class(ch)) { @@ -159,9 +166,8 @@ again: SkipComment(); goto again; } - else { - PushBack(nch); - } + else if (nch == EOI) eofseen = 1; + else PushBack(nch); } return tk->tk_symb = ch; @@ -200,7 +206,8 @@ again: default : crash("(LLlex, STCOMP)"); } - PushBack(nch); + if (nch == EOI) eofseen = 1; + else PushBack(nch); return tk->tk_symb = ch; case STIDF: @@ -213,7 +220,8 @@ again: LoadChar(ch); } while(in_idf(ch)); - if (ch != EOI) PushBack(ch); + if (ch == EOI) eofseen = 1; + else PushBack(ch); *tag++ = '\0'; tk->TOK_IDF = id = str2idf(buf, 1); @@ -279,6 +287,7 @@ again: else { state = End; if (ch == 'H') base = 16; + else if (ch == EOI) eofseen = 1; else PushBack(ch); } break; @@ -292,7 +301,8 @@ again: state = End; if (ch != 'H') { lexerror("H expected after hex number"); - PushBack(ch); + if (ch == EOI) eofseen = 1; + else PushBack(ch); } break; @@ -308,7 +318,8 @@ again: state = Hex; break; } - PushBack(ch); + if (ch == EOI) eofseen = 1; + else PushBack(ch); ch = *--np; *np++ = '\0'; base = 8; @@ -384,7 +395,8 @@ lexwarning("Character constant out of range"); } *np++ = '\0'; - PushBack(ch); + if (ch == EOI) eofseen = 1; + else PushBack(ch); if (np >= &buf[NUMSIZE]) { tk->TOK_REL = Salloc("0.0", 5); diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile index da51723aa..3e4ad43f8 100644 --- a/lang/m2/comp/Makefile +++ b/lang/m2/comp/Makefile @@ -1,5 +1,5 @@ # make modula-2 "compiler" -EMDIR = /usr/ceriel/em +EMDIR = ../../.. MHDIR = $(EMDIR)/modules/h PKGDIR = $(EMDIR)/modules/pkg LIBDIR = $(EMDIR)/modules/lib @@ -45,12 +45,17 @@ HFILES= LLlex.h\ # GENFILES = $(GENGFILES) $(GENCFILES) $(GENHFILES) +#EXCLEXCLEXCLEXCL + all: Cfiles - sh -c 'if $(CC) nmclash.c > /dev/null 2>&1 ; then make main ; else sh Resolve main ; fi' + sh -c 'if $(CC) nmclash.c > /dev/null 2>&1 ; then make ../comp/main ; else sh Resolve ../comp/main ; fi' @rm -f nmclash.o a.out +install: all + cp main $(EMDIR)/lib/em_m2 + clean: - rm -f $(OBJ) $(GENFILES) LLfiles hfiles Cfiles tab clashes + rm -f $(OBJ) $(GENFILES) LLfiles hfiles Cfiles tab clashes main (cd .. ; rm -rf Xsrc) lint: Cfiles @@ -62,9 +67,6 @@ clashes: $(SRC) $(HFILES) # entry points not to be used directly -Xlint: - lint $(INCLUDES) $(LINTFLAGS) $(SRC) - Cfiles: hfiles LLfiles $(GENCFILES) $(GENHFILES) echo $(SRC) $(HFILES) > Cfiles @@ -76,39 +78,35 @@ hfiles: Parameters make.hfiles make.hfiles Parameters touch hfiles -main: $(OBJ) ../src/Makefile - $(CC) $(LFLAGS) $(OBJ) $(LIBDIR)/libem_mes.a $(LIBDIR)/libemk.a $(LIBDIR)/input.a $(LIBDIR)/assert.a $(LIBDIR)/alloc.a $(LIBDIR)/dickmalloc.o $(LIBDIR)/libprint.a $(LIBDIR)/libstr.a $(LIBDIR)/libsystem.a -o ../src/main - size ../src/main - tokenfile.g: tokenname.c make.tokfile make.tokfile tokenfile.g -symbol2str.c: ../src/tokenname.c ../src/make.tokcase - ../src/make.tokcase <../src/tokenname.c >symbol2str.c +symbol2str.c: tokenname.c make.tokcase + make.tokcase symbol2str.c -def.h: ../src/def.H ../src/make.allocd - ../src/make.allocd < ../src/def.H > def.h +def.h: def.H make.allocd + make.allocd < def.H > def.h -type.h: ../src/type.H ../src/make.allocd - ../src/make.allocd < ../src/type.H > type.h +type.h: type.H make.allocd + make.allocd < type.H > type.h -node.h: ../src/node.H ../src/make.allocd - ../src/make.allocd < ../src/node.H > node.h +node.h: node.H make.allocd + make.allocd < node.H > node.h -scope.c: ../src/scope.C ../src/make.allocd - ../src/make.allocd < ../src/scope.C > scope.c +scope.c: scope.C make.allocd + make.allocd < scope.C > scope.c -tmpvar.c: ../src/tmpvar.C ../src/make.allocd - ../src/make.allocd < ../src/tmpvar.C > tmpvar.c +tmpvar.c: tmpvar.C make.allocd + make.allocd < tmpvar.C > tmpvar.c -casestat.c: ../src/casestat.C ../src/make.allocd - ../src/make.allocd < ../src/casestat.C > casestat.c +casestat.c: casestat.C make.allocd + make.allocd < casestat.C > casestat.c -char.c: ../src/char.tab ../src/tab - ../src/tab -fchar.tab >char.c +char.c: char.tab tab + tab -fchar.tab >char.c -../src/tab: - $(CC) ../src/tab.c -o ../src/tab +tab: + $(CC) tab.c -o tab depend: sed '/^#AUTOAUTO/,$$d' Makefile > Makefile.new @@ -118,6 +116,15 @@ depend: mv Makefile Makefile.old mv Makefile.new Makefile +#INCLINCLINCLINCL + +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 + 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 LLmessage.o: LLlex.h Lpars.h idf.h @@ -137,14 +144,14 @@ defmodule.o: LLlex.h Lpars.h debug.h def.h f_info.h idf.h input.h inputtype.h ma 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 node.h scope.h standards.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 node.h scope.h type.h +lookup.o: LLlex.h debug.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 diff --git a/lang/m2/comp/Resolve b/lang/m2/comp/Resolve index def1f2a68..b8712499d 100755 --- a/lang/m2/comp/Resolve +++ b/lang/m2/comp/Resolve @@ -1,3 +1,6 @@ +: create a directory Xsrc with name clashes resolved +: and run make in that directory + case $# in 1) ;; @@ -6,7 +9,7 @@ case $# in ;; esac case $1 in -main|Xlint) +../comp/main|Xlint) ;; *) echo "$0: $1: Illegal argument" 1>&2 exit 1 @@ -18,8 +21,10 @@ then else mkdir ../Xsrc fi make clashes +: remove code generating routines from the clashes list as they are defines. +: code generating routine names start with C_ sed '/^C_/d' < clashes > tmp$$ -./cclash -c -l7 tmp$$ > ../Xsrc/Xclashes +cclash -c -l7 tmp$$ > ../Xsrc/Xclashes rm -f tmp$$ PW=`pwd` cd ../Xsrc @@ -30,13 +35,17 @@ else mv Xclashes clashes fi rm -f Makefile +ed - $PW/Makefile <<'EOF' +/^#EXCLEXCL/,/^#INCLINCL/d +w Makefile +q +EOF for i in `cat $PW/Cfiles` do cat >> Makefile < $i - EOF done -make `cat $PW/Cfiles` -make -f $PW/Makefile $1 +make $1 diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c index 0b9638385..40a2064a3 100644 --- a/lang/m2/comp/chk_expr.c +++ b/lang/m2/comp/chk_expr.c @@ -20,6 +20,7 @@ #include "const.h" #include "standards.h" #include "chk_expr.h" +#include "misc.h" extern char *symbol2str(); @@ -875,17 +876,30 @@ ChkStandard(expp, left) break; case S_HIGH: - if (!(left = getarg(&arg, T_ARRAY, 0))) return 0; + if (!(left = getarg(&arg, T_ARRAY|T_STRING|T_CHAR, 0))) return 0; if (IsConformantArray(left->nd_type)) { /* A conformant array has no explicit index type ??? So, what can we use as index-type ??? */ expp->nd_type = intorcard_type; + break; } - else { + if (left->nd_type->tp_fund == T_ARRAY) { expp->nd_type = IndexType(left->nd_type); cstcall(expp, S_MAX); + break; } + if (left->nd_type->tp_fund == T_CHAR) { + if (left->nd_symb != STRING) { + node_error(left,"HIGH: array parameter expected"); + return 0; + } + } + expp->nd_type = intorcard_type; + expp->nd_class = Value; + expp->nd_INT = left->nd_type->tp_fund == T_CHAR ? 0 : + left->nd_SLE - 1; + expp->nd_symb = INTEGER; break; case S_MAX: diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c index 9a58a7a16..d5d419ee3 100644 --- a/lang/m2/comp/code.c +++ b/lang/m2/comp/code.c @@ -380,7 +380,7 @@ CodeParameters(param, arg) } } else if (left->nd_symb == STRING) { - C_loc(left->nd_SLE); + C_loc(left->nd_SLE - 1); } else if (tp->arr_elem == word_type) { C_loc((left_type->tp_size+word_size-1) / word_size - 1); diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g index 9087a00f1..7bca82d62 100644 --- a/lang/m2/comp/declar.g +++ b/lang/m2/comp/declar.g @@ -219,7 +219,7 @@ ArrayType(struct type **ptp;) RecordType(struct type **ptp;) { register struct scope *scope; - arith size; + arith size = 0; int xalign = struct_align; } : @@ -301,9 +301,10 @@ FieldList(struct scope *scope; arith *cnt; int *palign;) } df->df_type = tp; df->fld_off = align(*cnt, tp->tp_align); - *cnt = tcnt = df->fld_off + tp->tp_size; + *cnt = df->fld_off + tp->tp_size; df->df_flags |= D_QEXPORTED; } + tcnt = *cnt; } OF variant(scope, &tcnt, tp, palign) { max = tcnt; tcnt = *cnt; } diff --git a/lang/m2/comp/enter.c b/lang/m2/comp/enter.c index 85f1f7640..fb87c58ce 100644 --- a/lang/m2/comp/enter.c +++ b/lang/m2/comp/enter.c @@ -393,10 +393,8 @@ EnterFromImportList(Idlist, FromDef) for (; idlist; idlist = idlist->next) { if (forwflag) df = ForwDef(idlist, vis->sc_scope); else if (! (df = lookup(idlist->nd_IDF, vis->sc_scope))) { - node_error(idlist, - "identifier \"%s\" not declared in qualifying module", - idlist->nd_IDF->id_text); - df = define(idlist->nd_IDF,vis->sc_scope,D_ERROR); + not_declared("identifier", idlist, " in qualifying module"); + df = define(idlist->nd_IDF,vis->sc_scope,D_ERROR); } else if (! (df->df_flags & (D_EXPORTED|D_QEXPORTED))) { node_error(idlist, diff --git a/lang/m2/comp/expression.g b/lang/m2/comp/expression.g index bd2f8d646..5edf0c854 100644 --- a/lang/m2/comp/expression.g +++ b/lang/m2/comp/expression.g @@ -49,7 +49,7 @@ qualident(int types; if ( !((types|D_ERROR) & df->df_kind)) { if (df->df_kind == D_FORWARD) { -node_error(nd,"%s \"%s\" not declared", str, df->df_idf->id_text); + not_declared(str, nd, ""); } else { node_error(nd,"identifier \"%s\" is not a %s", df->df_idf->id_text, str); diff --git a/lang/m2/comp/lookup.c b/lang/m2/comp/lookup.c index 7109e6a5a..6143502c0 100644 --- a/lang/m2/comp/lookup.c +++ b/lang/m2/comp/lookup.c @@ -12,6 +12,7 @@ #include "LLlex.h" #include "node.h" #include "type.h" +#include "misc.h" struct def * lookup(id, scope) diff --git a/lang/m2/comp/misc.c b/lang/m2/comp/misc.c index 573fd0356..d945e553b 100644 --- a/lang/m2/comp/misc.c +++ b/lang/m2/comp/misc.c @@ -40,7 +40,8 @@ gen_anon_idf() return str2idf(buff, 1); } -id_not_declared(id) +not_declared(what, id, where) + char *what, *where; register struct node *id; { /* The identifier "id" is not declared. If it is not generated, @@ -48,6 +49,9 @@ id_not_declared(id) */ if (!is_anon_idf(id->nd_IDF)) { node_error(id, - "identifier \"%s\" not declared", id->nd_IDF->id_text); + "%s \"%s\" not declared%s", + what, + id->nd_IDF->id_text, + where); } } diff --git a/lang/m2/comp/misc.h b/lang/m2/comp/misc.h index 5cf1ae8e5..8d8b48ed4 100644 --- a/lang/m2/comp/misc.h +++ b/lang/m2/comp/misc.h @@ -1,6 +1,7 @@ /* M I S C E L L A N E O U S */ -#define is_anon_idf(x) ((x)->id_text[0] == '#') +#define is_anon_idf(x) ((x)->id_text[0] == '#') +#define id_not_declared(x) (not_declared("identifier", (x), "")) extern struct idf *gen_anon_idf(); -- 2.34.1