minor fixes

lang/m2/comp/LLlex.c

@@ -252,7 +252,7 @@ again1:
 				goto again;
 			}
 			else if (nch == EOI) eofseen = 1;
-			else PushBack(nch);
+			else PushBack();
 		}
 		return tk->tk_symb = ch;
 
@@ -292,7 +292,7 @@ again1:
 			crash("(LLlex, STCOMP)");
 		}
 		if (nch == EOI) eofseen = 1;
-		else PushBack(nch);
+		else PushBack();
 		return tk->tk_symb = ch;
 
 	case STIDF:
@@ -306,7 +306,7 @@ again1:
 		} while(in_idf(ch));
 
 		if (ch == EOI) eofseen = 1;
-		else PushBack(ch);
+		else PushBack();
 		*tag++ = '\0';
 
 		tk->TOK_IDF = id = str2idf(buf, 1);
@@ -373,7 +373,7 @@ again1:
 					state = End;
 					if (ch == 'H') base = 16;
 					else if (ch == EOI) eofseen = 1;
-					else PushBack(ch);
+					else PushBack();
 				}
 				break;
 
@@ -387,7 +387,7 @@ again1:
 				if (ch != 'H') {
 					lexerror("H expected after hex number");
 					if (ch == EOI) eofseen = 1;
-					else PushBack(ch);
+					else PushBack();
 				}
 				break;
 
@@ -404,7 +404,7 @@ again1:
 					break;
 				}
 				if (ch == EOI) eofseen = 1;
-				else PushBack(ch);
+				else PushBack();
 				ch = *--np;
 				*np++ = '\0';
 				base = 8;
@@ -447,8 +447,8 @@ lexwarning(W_ORDINARY, "character constant out of range");
 				if (ch == '.') {
 					/*	Indeed the '..' token
 					*/
-					PushBack(ch);
-					PushBack(ch);
+					PushBack();
+					PushBack();
 					state = End;
 					base = 10;
 					break;
@@ -493,7 +493,7 @@ lexwarning(W_ORDINARY, "character constant out of range");
 
 		*np++ = '\0';
 		if (ch == EOI) eofseen = 1;
-		else PushBack(ch);
+		else PushBack();
 
 		if (np >= &buf[NUMSIZE]) {
 			tk->TOK_REL = Salloc("0.0", 5);

lang/m2/comp/Makefile

@@ -22,19 +22,19 @@ CSRC =	LLlex.c LLmessage.c char.c error.c main.c \
 	symbol2str.c tokenname.c idf.c input.c type.c def.c \
 	scope.c misc.c enter.c defmodule.c typequiv.c node.c \
 	cstoper.c chk_expr.c options.c walk.c casestat.c desig.c \
-	code.c tmpvar.c lookup.c Version.c
+	code.c tmpvar.c lookup.c Version.c next.c
 COBJ =	LLlex.o LLmessage.o char.o error.o main.o \
 	symbol2str.o tokenname.o idf.o input.o type.o def.o \
 	scope.o misc.o enter.o defmodule.o typequiv.o node.o \
 	cstoper.o chk_expr.o options.o walk.o casestat.o desig.o \
-	code.o tmpvar.o lookup.o Version.o
+	code.o tmpvar.o lookup.o Version.o next.o
 SRC =	$(CSRC) $(LSRC) Lpars.c
 OBJ =	$(COBJ) $(LOBJ) Lpars.o
 
 # Keep the next entries up to date!
 GENCFILES=	tokenfile.c \
 	program.c declar.c expression.c statement.c \
-	symbol2str.c char.c Lpars.c casestat.c tmpvar.c scope.c
+	symbol2str.c char.c Lpars.c casestat.c tmpvar.c scope.c next.c
 GENGFILES=	tokenfile.g
 GENHFILES=	errout.h\
 	idfsize.h numsize.h strsize.h target_sizes.h \
@@ -46,6 +46,7 @@ HFILES=		LLlex.h\
 	walk.h warning.h $(GENHFILES)
 #
 GENFILES = $(GENGFILES) $(GENCFILES) $(GENHFILES)
+NEXTFILES = def.H type.H node.H scope.C tmpvar.C casestat.C
 
 #EXCLEXCLEXCLEXCL
 
@@ -86,23 +87,23 @@ tokenfile.g:	tokenname.c make.tokfile
 symbol2str.c:	tokenname.c make.tokcase
 	make.tokcase <tokenname.c >symbol2str.c
 
-def.h:		def.H make.allocd
-		make.allocd < def.H > def.h
+.SUFFIXES:	.H .h
+.H.h:
+		./make.allocd < $*.H > $*.h
 
-type.h:		type.H make.allocd
-		make.allocd < type.H > type.h
+.SUFFIXES:	.C .c
+.C.c:
+		./make.allocd < $*.C > $*.c
 
-node.h:		node.H make.allocd
-		make.allocd < node.H > node.h
+def.h:		make.allocd
+type.h:		make.allocd
+node.h:		make.allocd
+scope.c:	make.allocd
+tmpvar.c:	make.allocd
+casestat.c:	make.allocd
 
-scope.c:	scope.C make.allocd
-		make.allocd < scope.C > scope.c
-
-tmpvar.c:	tmpvar.C make.allocd
-		make.allocd < tmpvar.C > tmpvar.c
-
-casestat.c:	casestat.C make.allocd
-		make.allocd < casestat.C > casestat.c
+next.c:		$(NEXTFILES) ./make.next
+		./make.next $(NEXTFILES) > next.c
 
 char.c: char.tab tab
 	tab -fchar.tab >char.c
@@ -154,6 +155,7 @@ 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
+next.o: debug.h debugcst.h
 tokenfile.o: Lpars.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

lang/m2/comp/Version.c

@@ -1 +1 @@
-static char Version[] = "ACK Modula-2 compiler Version 0.9";
+static char Version[] = "ACK Modula-2 compiler Version 0.10";

lang/m2/comp/declar.g

@@ -46,7 +46,12 @@ ProcedureHeading(struct def **pdf; int type;)
 	PROCEDURE IDENT
 			{ *pdf = DeclProc(type, dot.TOK_IDF); }
 	FormalParameters(&pr, &parmaddr, &tp)?
-			{ CheckWithDef(*pdf, proc_type(tp, pr, parmaddr)); }
+			{ CheckWithDef(*pdf, proc_type(tp, pr, parmaddr));
+			  if (tp && IsConstructed(tp)) {
+warning(W_STRICT, "procedure \"%s\" has a constructed result type",
+	(*pdf)->df_idf->id_text);
+			  }
+			}
 ;
 
 block(struct node **pnd;) :

lang/m2/comp/def.c

@@ -16,11 +16,6 @@
 #include	"node.h"
 #include	"Lpars.h"
 
-struct def *h_def;		/* pointer to free list of def structures */
-#ifdef DEBUG
-int	cnt_def;		/* count number of allocated ones */
-#endif
-
 extern int	(*c_inp)();
 
 STATIC

lang/m2/comp/defmodule.c

@@ -22,6 +22,8 @@
 long	sys_filesize();
 #endif
 
+struct idf *DefId;
+
 STATIC
 GetFile(name)
 	char *name;
@@ -56,7 +58,6 @@ GetDefinitionModule(id, incr)
 	struct def *df;
 	static int level;
 	struct scopelist *vis;
-	int didread = 0;
 
 	level += incr;
 	df = lookup(id, GlobalScope, 1);
@@ -69,7 +70,7 @@ GetDefinitionModule(id, incr)
 		else {
 			open_scope(CLOSEDSCOPE);
 			if (!is_anon_idf(id) && GetFile(id->id_text)) {
-				didread = 1;
+				DefId = id;
 				DefModule();
 				if (level == 1) {
 					/* The module is directly imported by
@@ -95,9 +96,6 @@ GetDefinitionModule(id, incr)
 		}
 		df = lookup(id, GlobalScope, 1);
 		if (! df) {
-			if (didread) {
-				error("did not read a DEFINITION MODULE for \"%s\"", id->id_text);
-			}
 			df = MkDef(id, GlobalScope, D_ERROR);
 			df->df_type = error_type;
 			df->mod_vis = vis;

lang/m2/comp/main.c

@@ -67,7 +67,7 @@ Compile(src, dst)
 	}
 	LineNumber = 1;
 	FileName = src;
-	DEFPATH[0] = "";
+	DEFPATH[0] = ".";
 	DEFPATH[NDIRS] = 0;
 	init_idf();
 	InitCst();

lang/m2/comp/make.next

@@ -0,0 +1,7 @@
+echo '#include "debug.h"'
+sed -n '
+s:^.*[ 	]ALLOCDEF[ 	].*"\(.*\)".*$:struct \1 *h_\1 = 0;\
+#ifdef DEBUG\
+int cnt_\1 = 0;\
+#endif:p
+' $*

lang/m2/comp/node.c

@@ -12,11 +12,6 @@
 #include	"LLlex.h"
 #include	"node.h"
 
-struct node *h_node;		/* header of free list */
-#ifdef DEBUG
-int	cnt_node;		/* count number of allocated ones */
-#endif
-
 struct node *
 MkNode(class, left, right, token)
 	struct node *left, *right;

lang/m2/comp/options.c

@@ -91,10 +91,19 @@ DoOption(text)
 		break;
 
 	case 'I' :
-		if (++ndirs >= NDIRS) {
-			fatal("too many -I options");
+		if (*text) {
+			register int i = ndirs++;
+			register char *new = text;
+			while (new) {
+				register char *tmp = DEFPATH[i];
+	
+				if (i >= NDIRS)
+					fatal("too many -I options");
+				DEFPATH[i++] = new;
+				new = tmp;
+			}
 		}
-		DEFPATH[ndirs] = text;
+		else	DEFPATH[ndirs] = 0;
 		break;
 
 	case 'V' :	/* set object sizes and alignment requirements	*/

lang/m2/comp/program.g

@@ -117,10 +117,15 @@ DefinitionModule
 	register struct def *df;
 	struct node *exportlist;
 	int dummy;
+	extern struct idf *DefId;
 } :
 	DEFINITION
 	MODULE IDENT	{ df = define(dot.TOK_IDF, GlobalScope, D_MODULE);
 			  if (!Defined) Defined = df;
+			  if (df->df_idf != DefId) {
+				error("DEFINITION MODULE name is not \"%s\"",
+					DefId->id_text);
+			  }
 			  CurrentScope->sc_name = df->df_idf->id_text;
 			  df->mod_vis = CurrVis;
 			  df->df_type = standard_type(T_RECORD, 1, (arith) 1);

lang/m2/comp/type.c

@@ -55,16 +55,6 @@ struct type
 	*std_type,
 	*error_type;
 
-struct paramlist *h_paramlist;
-#ifdef DEBUG
-int	cnt_paramlist;
-#endif
-
-struct type *h_type;
-#ifdef DEBUG
-int	cnt_type;
-#endif
-
 struct type *
 construct_type(fund, tp)
 	int fund;