newer version with some bug fixes
This commit is contained in:
ceriel
parent
aac1207beb
commit
ca44bfc681
11 changed files with 106 additions and 59 deletions
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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 <tokenname.c >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 <tokenname.c >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
|
||||
|
|
|
|||
|
|
@ -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 <<EOF
|
||||
|
||||
$i: clashes $PW/$i
|
||||
cid -Fclashes < $PW/$i > $i
|
||||
|
||||
EOF
|
||||
done
|
||||
make `cat $PW/Cfiles`
|
||||
make -f $PW/Makefile $1
|
||||
make $1
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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; }
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -12,6 +12,7 @@
|
|||
#include "LLlex.h"
|
||||
#include "node.h"
|
||||
#include "type.h"
|
||||
#include "misc.h"
|
||||
|
||||
struct def *
|
||||
lookup(id, scope)
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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();
|
||||
|
|
|
|||
Loading…
Reference in a new issue