public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/modula-2] Bug fixes for error scope announcement and error recovery.
@ 2021-12-17 12:36 Gaius Mulley
0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2021-12-17 12:36 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:fd948137c552cfc06a023d6808ae9b58408760d5
commit fd948137c552cfc06a023d6808ae9b58408760d5
Author: Gaius Mulley <gaius.mulley@southwales.ac.uk>
Date: Fri Dec 17 12:35:08 2021 +0000
Bug fixes for error scope announcement and error recovery.
2021-12-17 Gaius Mulley <gaius.mulley@southwales.ac.uk>
gcc/m2/ChangeLog:
* bnf/m2-1.bnf (ProgramModule): Set up DefaultProgramModule scope.
(ImplementationModule) Set up DefaultImplementationModule scope.
(ProcedureHeading) Set up DefaultProcedureScope.
(ModuleDeclaration) Set up DefaultInnerModule scope.
* bnf/m2-2.bnf (ProgramModule): Set up DefaultProgramModule scope.
(ImplementationModule) Set up DefaultImplementationModule scope.
(ProcedureHeading) Set up DefaultProcedureScope.
(ModuleDeclaration) Set up DefaultInnerModule scope.
* bnf/m2-3.bnf (ProgramModule): Set up DefaultProgramModule scope.
(ImplementationModule) Set up DefaultImplementationModule scope.
(ProcedureHeading) Set up DefaultProcedureScope.
(ModuleDeclaration) Set up DefaultInnerModule scope.
* bnf/m2-c.bnf (ProgramModule): Set up DefaultProgramModule scope.
(ImplementationModule) Set up DefaultImplementationModule scope.
(ProcedureHeading) Set up DefaultProcedureScope.
(ModuleDeclaration) Set up DefaultInnerModule scope.
* bnf/m2-h.bnf (ProgramModule): Set up DefaultProgramModule scope.
(ImplementationModule) Set up DefaultImplementationModule scope.
(ProcedureHeading) Set up DefaultProcedureScope.
(ModuleDeclaration) Set up DefaultInnerModule scope.
* bnf/m2.bnf (ProgramModule): Set up DefaultProgramModule scope.
(ImplementationModule) Set up DefaultImplementationModule scope.
(ProcedureHeading) Set up DefaultProcedureScope.
(ModuleDeclaration) Set up DefaultInnerModule scope. (WasNoError)
replaced by seenError. (Expect) reformatted.
(CheckInsertCandiate) New procedure which replaces CheckAndInsert.
(PeepToken) use CheckInsertCandiate. (WarnMissingToken) generate
a warning using %W.
* gm2-compiler/M2Comp.mod (DefaultProgramModule): New procedure.
(DefaultImplementationModule) New procedure.
(DefaultDefinitionModule) New procedure. (DefaultInnerModule)
New procedure. (DefaultProcedure) New procedure.
(EnterImplementationScope) call LeaveScope if parsing.
(EnterProgramScope) call LeaveScope if parsing.
(EnterDefinitionScope) call LeaveScope if parsing.
(EnterModuleScope) call LeaveScope if parsing.
(EnterProcedureScope) call LeaveScope if parsing.
(ParsingComplete) New procedure.
* gm2-compiler/M2Comp.def (DefaultProgramModule): New procedure.
(DefaultImplementationModule) New procedure.
(DefaultDefinitionModule) New procedure. (DefaultInnerModule)
New procedure. (DefaultProcedure) New procedure.
(ParsingComplete) New procedure.
* gm2-compiler/M2Error.def (DefaultProgramModule) New procedure.
(DefaultImplementationModule) New procedure.
(DefaultDefinitionModule) New procedure. (DefaultInnerModule) New
procedure. (DefaultProcedure) New procedure. (ParsingComplete)
New procedure.
* gm2-compiler/M2Error.mod (DefaultProgramModule) New procedure.
(DefaultImplementationModule) New procedure.
(DefaultDefinitionModule) New procedure. (DefaultInnerModule) New
procedure. (DefaultProcedure) New procedure. (ParsingComplete)
New procedure. (GetAnnounceScope) check to see scopeName is non
null before using name.
* gm2-compiler/M2LexBuf.def (NameKey): Import list replaced identifiers
DisplayToken and DumpTokens.
* gm2-compiler/M2LexBuf.mod (InsertToken) Reimplemented.
(InsertTokenAndRewind) Reimplemented.
* gm2-compiler/M2MetaError.mod (doErrorScopeMod): setup
DefaultScope before calling EnterScope.
(doErrorScopeMod) (doErrorScopeDef): setup
DefaultScope before calling EnterScope.
* gm2-compiler/P0SymBuild.mod (RegisterProgramModule):
Reformatted. (RegisterImplementationModule) Reformatted.
(RegisterDefinitionModule) Reformatted.
Signed-off-by: Gaius Mulley <gaius.mulley@southwales.ac.uk>
Diff:
---
gcc/m2/Make-lang.in | 18 +-
gcc/m2/bnf/m2-1.bnf | 16 +-
gcc/m2/bnf/m2-2.bnf | 17 +-
gcc/m2/bnf/m2-3.bnf | 19 +-
gcc/m2/bnf/m2-c.bnf | 20 +-
gcc/m2/bnf/m2-h.bnf | 16 +-
gcc/m2/bnf/m2.bnf | 170 ++++---
gcc/m2/gm2-compiler/M2Comp.mod | 6 +-
gcc/m2/gm2-compiler/M2Error.def | 52 ++-
gcc/m2/gm2-compiler/M2Error.mod | 147 +++++-
gcc/m2/gm2-compiler/M2LexBuf.def | 16 +-
gcc/m2/gm2-compiler/M2LexBuf.mod | 518 +++++++++++++--------
gcc/m2/gm2-compiler/M2MetaError.mod | 10 +
gcc/m2/gm2-compiler/P0SymBuild.mod | 39 +-
.../gm2/recover/{ => pass/cannot-solve}/begin.mod | 7 +-
.../recover/pass/cannot-solve/statementsemi.mod | 12 +
gcc/testsuite/gm2/recover/{ => pass}/end2.mod | 3 +-
gcc/testsuite/gm2/recover/{ => pass}/of.mod | 3 +-
gcc/testsuite/gm2/recover/pass/procsemi.mod | 10 +
gcc/testsuite/gm2/recover/pass/recover-pass.exp | 37 ++
gcc/testsuite/gm2/recover/pass/rrbra.mod | 24 +
gcc/testsuite/gm2/recover/{ => pass}/rsbra.mod | 3 +-
gcc/testsuite/gm2/recover/{ => pass}/semi.mod | 5 +-
gm2tools/Makefile.in | 2 +-
24 files changed, 853 insertions(+), 317 deletions(-)
diff --git a/gcc/m2/Make-lang.in b/gcc/m2/Make-lang.in
index 8721879530a..04e37419f3c 100644
--- a/gcc/m2/Make-lang.in
+++ b/gcc/m2/Make-lang.in
@@ -33,6 +33,8 @@ GM2_1 = ./gm2 -B./stage1/m2 -g -fm2-g
XGCC = ./xgcc -B./
GM2_2 = ./gm2 -B./stage2/m2 -g -fm2-g
HOSTCC = gcc
+CFLAGS=-g ## remove this
+LDLAGS=-g ## remove this
# Define the name of target independent tools to be installed in $(bindir)
# Names are subject to change
@@ -64,7 +66,7 @@ else
stage1/m2/cpp$(exeext)
endif
-CPP_GM2=-fpermissive -DIN_GCC
+CPP_GM2=-fpermissive -DIN_GCC -g
TEXISRC = $(objdir)/m2/images/gnu.eps \
$(srcdir)/doc/gm2.texi \
@@ -480,7 +482,7 @@ MC_LIBS=m2/mc-boot-ch/Glibc.o m2/mc-boot-ch/Gmcrts.o
M2LINK=m2/boot-bin/mklink$(exeext)
GM2_O=
GM2_O_S3=-O
-GM2_OS=-Os -O2
+GM2_OS=-Os
GM2_G=-g -fm2-g
GM2_CPP=
# GM2_DEBUG_STRMEM=-fcpp
@@ -1578,10 +1580,10 @@ m2/mc-boot-gen/$(SRC_PREFIX)%.c: m2/gm2-auto/%.mod
./mc $(MC_OPTIONS) -I$(srcdir)/m2/mc:$(srcdir)/m2/gm2-libs:$(srcdir)/m2/gm2-libs-iso $(EXTENDED_OPAQUE) --h-file-prefix=$(SRC_PREFIX) -o=$@ $<
m2/mc-boot/$(SRC_PREFIX)%.o: m2/mc-boot/$(SRC_PREFIX)%.c
- $(HOSTCC) -O2 -g -c -I. -I$(srcdir)/m2/mc-boot-ch -I$(srcdir)/../include -I$(srcdir) $< -o $@
+ $(HOSTCC) -g -c -I. -I$(srcdir)/m2/mc-boot-ch -I$(srcdir)/../include -I$(srcdir) $< -o $@
m2/mc-boot-ch/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.c m2/gm2-libs/gm2-libs-host.h
- $(HOSTCC) -DHAVE_CONFIG_H -O2 -g -c -I. -Im2/gm2-libs -I$(srcdir)/../include -I$(srcdir) -Im2/gm2-libs $< -o $@
+ $(HOSTCC) -DHAVE_CONFIG_H -g -c -I. -Im2/gm2-libs -I$(srcdir)/../include -I$(srcdir) -Im2/gm2-libs $< -o $@
# mc-bootstrap compiles mc using the C version previously generated by mc-autogen.
# These autogenerated files will be checked into git by the maintainer.
@@ -1595,7 +1597,7 @@ m2/boot-bin/mc$(exeext): $(BUILD-MC-BOOT-O) $(BUILD-MC-INTERFACE-O) m2/mc-boot/m
m2/mc-boot/main.o: $(M2LINK) $(srcdir)/m2/init/mcinit
unset CC ; $(M2LINK) -s --gcc --exit --name mainmcinit.c $(srcdir)/m2/init/mcinit
mv mainmcinit.c m2/mc-boot/main.c
- $(HOSTCC) -O2 -g -c -I. -I$(srcdir)/../include -I$(srcdir) m2/mc-boot/main.c -o $@
+ $(HOSTCC) -g -c -I. -I$(srcdir)/../include -I$(srcdir) m2/mc-boot/main.c -o $@
# The rules which build objects in the gm2-compiler-paranoid gm2-libs-paranoid directories.
@@ -2081,7 +2083,7 @@ m2/gm2-pge-boot/main.o: m2/gm2-auto/pgeinit $(M2LINK)
$(CC) -g -c -o $@ m2/gm2-pge-boot/main.c
$(objdir)/m2/gm2-compiler-paranoid/P0SyntaxCheck.mod: $(srcdir)/m2/bnf/m2.bnf m2/pge$(exeext)
- ./m2/pge$(exeext) -k $< -o $@
+ ./m2/pge$(exeext) -k -l $< -o $@
$(objdir)/m2/gm2-compiler-paranoid/P1Build.mod: $(srcdir)/m2/bnf/m2-1.bnf m2/pge$(exeext)
./m2/pge$(exeext) -k $< -o $@
@@ -2105,7 +2107,7 @@ $(objdir)/m2/gm2-compiler-paranoid/gm2m.mod: $(srcdir)/m2/bnf/gm2m.bnf m2/pge$(e
./m2/pge$(exeext) $< -o $@
$(objdir)/m2/gm2-compiler/P0SyntaxCheck.mod: $(srcdir)/m2/bnf/m2.bnf m2/pge$(exeext)
- ./m2/pge$(exeext) -k $< -o $@
+ ./m2/pge$(exeext) -k -l $< -o $@
$(objdir)/m2/gm2-compiler/P1Build.mod: $(srcdir)/m2/bnf/m2-1.bnf m2/pge$(exeext)
./m2/pge$(exeext) -k $< -o $@
@@ -2129,7 +2131,7 @@ $(objdir)/m2/gm2-compiler/gm2m.mod: $(srcdir)/m2/bnf/gm2m.bnf m2/pge$(exeext)
./m2/pge$(exeext) $< -o $@
$(objdir)/m2/gm2-compiler-boot/P0SyntaxCheck.mod: $(srcdir)/m2/bnf/m2.bnf m2/pge$(exeext)
- ./m2/pge$(exeext) -k $< -o $@
+ ./m2/pge$(exeext) -k -l $< -o $@
$(objdir)/m2/gm2-compiler-boot/P1Build.mod: $(srcdir)/m2/bnf/m2-1.bnf m2/pge$(exeext)
./m2/pge$(exeext) -k $< -o $@
diff --git a/gcc/m2/bnf/m2-1.bnf b/gcc/m2/bnf/m2-1.bnf
index cb2aa1cc196..c51ce0cd293 100644
--- a/gcc/m2/bnf/m2-1.bnf
+++ b/gcc/m2/bnf/m2-1.bnf
@@ -55,6 +55,7 @@ FROM DynamicStrings IMPORT String, InitString, KillString, Mark, ConCat, ConCatC
FROM M2Debug IMPORT Assert ;
FROM M2Printf IMPORT printf0 ;
FROM SymbolTable IMPORT AddNameToScope ;
+IMPORT M2Error ;
(* imports for Pass1 *)
@@ -552,7 +553,8 @@ FileUnit := % Pus
ImplementationOrProgramModule ) % PopAuto %
=:
-ProgramModule := "MODULE" % PushAutoOn ; %
+ProgramModule := "MODULE" % M2Error.DefaultProgramModule %
+ % PushAutoOn ; %
Ident % P1StartBuildProgramModule ; %
% PushAutoOff ; %
[ Priority ]
@@ -566,7 +568,8 @@ ProgramModule := "MODULE" % Pus
"." % PopAuto ; PopAuto ; PopAuto %
=:
-ImplementationModule := "IMPLEMENTATION" "MODULE" % PushAutoOn ; %
+ImplementationModule := "IMPLEMENTATION" % M2Error.DefaultImplementationModule %
+ "MODULE" % PushAutoOn ; %
Ident % P1StartBuildImplementationModule ; %
% PushAutoOff ; %
[ Priority ] ";" % PushAutoOn ; %
@@ -888,7 +891,8 @@ DefineBuiltinProcedure := "__ATTRIBUTE__" "__BUILTIN__" "(" "(" Ident ")" ")"
| % PushT(NulTok) %
=:
-ProcedureHeading := "PROCEDURE" % PushAutoOn %
+ProcedureHeading := "PROCEDURE" % M2Error.DefaultProcedure %
+ % PushAutoOn %
DefineBuiltinProcedure
( PossiblyExportIdent % StartBuildProcedure %
% PushAutoOff %
@@ -964,7 +968,8 @@ DefOptArg := "[" IdentScope ":" FormalType "=" ConstExpression "]" =:
FormalType := { "ARRAY" "OF" } Qualident =:
-ModuleDeclaration := "MODULE" % PushAutoOn %
+ModuleDeclaration := "MODULE" % M2Error.DefaultInnerModule %
+ % PushAutoOn %
Ident % StartBuildInnerModule %
% PushAutoOff %
[ Priority ] ";" % PushAutoOn %
@@ -989,7 +994,8 @@ Import := "FROM" Ident "IMPORT" IdentList ";" |
(* determines whether Ident or Module *) %
IdentList ";" =:
-DefinitionModule := "DEFINITION" "MODULE" % PushAutoOn %
+DefinitionModule := "DEFINITION" % M2Error.DefaultDefinitionModule %
+ "MODULE" % PushAutoOn %
( "FOR" string | % (* epsilon *)
PushT(NulSym) %
)
diff --git a/gcc/m2/bnf/m2-2.bnf b/gcc/m2/bnf/m2-2.bnf
index a68c4fdda8b..4bee2acc559 100644
--- a/gcc/m2/bnf/m2-2.bnf
+++ b/gcc/m2/bnf/m2-2.bnf
@@ -132,6 +132,9 @@ FROM SymbolTable IMPORT MakeGnuAsm, PutGnuAsmVolatile, PutGnuAsm, PutGnuAsmInput
IsRecord, IsAModula2Type,
RequestSym ;
+IMPORT M2Error ;
+
+
CONST
Debugging = FALSE ;
Pass1 = FALSE ; (* permanently disabled for the time being *)
@@ -529,7 +532,7 @@ FileUnit := % Pus
ImplementationOrProgramModule ) % PopAuto %
=:
-ProgramModule := "MODULE"
+ProgramModule := "MODULE" % M2Error.DefaultProgramModule %
Ident % P2StartBuildProgramModule ; %
@@ -548,7 +551,8 @@ ProgramModule := "MODULE"
"."
=:
-ImplementationModule := "IMPLEMENTATION" "MODULE"
+ImplementationModule := "IMPLEMENTATION" % M2Error.DefaultImplementationModule %
+ "MODULE"
Ident % P2StartBuildImplementationModule ; %
[ Priority
@@ -979,7 +983,7 @@ DefineBuiltinProcedure := [ "__ATTRIBUTE__" "__BUILTIN__"
")" ")" | "__INLINE__" ]
=:
-ProcedureHeading := "PROCEDURE"
+ProcedureHeading := "PROCEDURE" % M2Error.DefaultProcedure %
DefineBuiltinProcedure
( Ident
% StartBuildProcedure %
@@ -993,7 +997,7 @@ ProcedureHeading := "PROCEDURE"
Builtin := [ "__BUILTIN__" | "__INLINE__" ] =:
-DefProcedureHeading := "PROCEDURE"
+DefProcedureHeading := "PROCEDURE" % M2Error.DefaultProcedure %
Builtin
( Ident
% StartBuildProcedure %
@@ -1119,7 +1123,7 @@ FormalType := "ARRAY" "OF" % VAR
PushTF(Sym, Type) %
=:
-ModuleDeclaration := "MODULE"
+ModuleDeclaration := "MODULE" % M2Error.DefaultInnerModule %
Ident % StartBuildInnerModule %
[ Priority
] ";"
@@ -1143,7 +1147,8 @@ Import := "FROM" Ident "IMPORT" IdentList ";" |
(* determines whether Ident or Module *) %
IdentList ";" =:
-DefinitionModule := "DEFINITION" "MODULE"
+DefinitionModule := "DEFINITION" % M2Error.DefaultDefinitionModule %
+ "MODULE"
[ "FOR" string ]
Ident % P2StartBuildDefModule %
";"
diff --git a/gcc/m2/bnf/m2-3.bnf b/gcc/m2/bnf/m2-3.bnf
index 83cabeaf03d..d91c6cf912f 100644
--- a/gcc/m2/bnf/m2-3.bnf
+++ b/gcc/m2/bnf/m2-3.bnf
@@ -171,6 +171,7 @@ FROM M2Batch IMPORT IsModuleKnown ;
FROM M2CaseList IMPORT BeginCaseList, EndCaseList ;
+IMPORT M2Error ;
CONST
Debugging = FALSE ;
@@ -570,7 +571,8 @@ FileUnit := % Pus
ImplementationOrProgramModule ) % PopAuto %
=:
-ProgramModule := "MODULE" % PushAutoOn %
+ProgramModule := "MODULE" % M2Error.DefaultProgramModule %
+ % PushAutoOn %
Ident % P3StartBuildProgModule %
% StartBuildModFile %
% BuildModuleStart %
@@ -585,7 +587,8 @@ ProgramModule := "MODULE" % Pus
"." % PopAuto ; PopAuto %
=:
-ImplementationModule := "IMPLEMENTATION" "MODULE" % PushAutoOn %
+ImplementationModule := "IMPLEMENTATION" % M2Error.DefaultImplementationModule %
+ "MODULE" % PushAutoOn %
Ident % StartBuildModFile %
% P3StartBuildImpModule %
% BuildModuleStart %
@@ -1266,7 +1269,8 @@ DefineBuiltinProcedure := [ "__ATTRIBUTE__" "__BUILTIN__"
")" ")" | "__INLINE__" ]
=:
-ProcedureHeading := "PROCEDURE" % PushAutoOn %
+ProcedureHeading := "PROCEDURE" % M2Error.DefaultProcedure %
+ % PushAutoOn %
DefineBuiltinProcedure
( Ident
% StartBuildProcedure ;
@@ -1279,7 +1283,8 @@ ProcedureHeading := "PROCEDURE" % Pus
Builtin := [ "__BUILTIN__" | "__INLINE__" ] =:
-DefProcedureHeading := "PROCEDURE" % PushAutoOn %
+DefProcedureHeading := "PROCEDURE" % M2Error.DefaultProcedure %
+ % PushAutoOn %
Builtin
( Ident
% StartBuildProcedure ;
@@ -1369,7 +1374,8 @@ DefOptArg := "[" Ident ":" FormalType "=" ConstExpression % Bui
FormalType := { "ARRAY" "OF" } Qualident =:
-ModuleDeclaration := "MODULE" % PushAutoOn %
+ModuleDeclaration := "MODULE" % M2Error.DefaultInnerModule %
+ % PushAutoOn %
Ident % StartBuildInnerModule %
% BuildModuleStart ;
PushAutoOff %
@@ -1403,7 +1409,8 @@ WithoutFromImport := % Pus
Import := FromImport | WithoutFromImport =:
-DefinitionModule := "DEFINITION" "MODULE" % PushAutoOn %
+DefinitionModule := "DEFINITION" % M2Error.DefaultDefinitionModule %
+ "MODULE" % PushAutoOn %
[ "FOR" string ]
Ident % StartBuildDefFile ;
P3StartBuildDefModule ;
diff --git a/gcc/m2/bnf/m2-c.bnf b/gcc/m2/bnf/m2-c.bnf
index 68eeb43e884..e5ddc516064 100644
--- a/gcc/m2/bnf/m2-c.bnf
+++ b/gcc/m2/bnf/m2-c.bnf
@@ -117,6 +117,8 @@ FROM SymbolTable IMPORT MakeGnuAsm, PutGnuAsmVolatile, PutGnuAsm, PutGnuAsmInput
FROM M2Batch IMPORT IsModuleKnown ;
+IMPORT M2Error ;
+
CONST
Debugging = FALSE ;
@@ -512,7 +514,8 @@ FileUnit := % Pus
ImplementationOrProgramModule ) % PopAuto %
=:
-ProgramModule := "MODULE" % PushAutoOn %
+ProgramModule := "MODULE" % M2Error.DefaultProgramModule %
+ % PushAutoOn %
Ident % PCStartBuildProgModule %
% PushAutoOff %
[ Priority
@@ -525,7 +528,8 @@ ProgramModule := "MODULE" % Pus
"." % PopAuto ; PopAuto %
=:
-ImplementationModule := "IMPLEMENTATION" "MODULE" % PushAutoOn %
+ImplementationModule := "IMPLEMENTATION" % M2Error.DefaultImplementationModule %
+ "MODULE" % PushAutoOn %
Ident % PCStartBuildImpModule %
% PushAutoOff %
[ Priority
@@ -1076,7 +1080,8 @@ DefineBuiltinProcedure := [ "__ATTRIBUTE__" "__BUILTIN__"
")" ")" | "__INLINE__" ]
=:
-ProcedureHeading := "PROCEDURE" % PushAutoOn %
+ProcedureHeading := "PROCEDURE" % M2Error.DefaultProcedure %
+ % PushAutoOn %
DefineBuiltinProcedure
( Ident
% PCStartBuildProcedure ;
@@ -1089,7 +1094,8 @@ ProcedureHeading := "PROCEDURE" % Pus
Builtin := [ "__BUILTIN__" | "__INLINE__" ] =:
-DefProcedureHeading := "PROCEDURE" % PushAutoOn %
+DefProcedureHeading := "PROCEDURE" % M2Error.DefaultProcedure %
+ % PushAutoOn %
Builtin
( Ident
% PCStartBuildProcedure ;
@@ -1164,7 +1170,8 @@ DefOptArg := "[" Ident ":" FormalType "=" ConstExpression "]" =:
FormalType := { "ARRAY" "OF" } Qualident =:
-ModuleDeclaration := "MODULE" % PushAutoOn %
+ModuleDeclaration := "MODULE" % M2Error.DefaultInnerModule %
+ % PushAutoOn %
Ident % PCStartBuildInnerModule %
% PushAutoOff %
[ Priority ] ";"
@@ -1191,7 +1198,8 @@ Import := % Pus
IdentList ";" ) % PopAuto %
=:
-DefinitionModule := "DEFINITION" "MODULE" % PushAutoOn %
+DefinitionModule := "DEFINITION" % M2Error.DefaultDefinitionModule %
+ "MODULE" % PushAutoOn %
[ "FOR" string ]
Ident % PCStartBuildDefModule ;
PushAutoOff %
diff --git a/gcc/m2/bnf/m2-h.bnf b/gcc/m2/bnf/m2-h.bnf
index 1f225f5cbd0..c6d0d26a9b1 100644
--- a/gcc/m2/bnf/m2-h.bnf
+++ b/gcc/m2/bnf/m2-h.bnf
@@ -141,6 +141,8 @@ FROM M2Reserved IMPORT NulTok, ImportTok, ExportTok, QualifiedTok, UnQualifiedTo
GreaterTok, GreaterEqualTok, InTok, PlusTok, MinusTok,
OrTok, TimesTok, DivTok, DivideTok, ModTok, RemTok, AndTok, AmbersandTok ;
+IMPORT M2Error ;
+
CONST
Debugging = FALSE ;
@@ -538,7 +540,8 @@ FileUnit := % Pus
ImplementationOrProgramModule ) % PopAuto %
=:
-ProgramModule := "MODULE" % PushAutoOn %
+ProgramModule := "MODULE" % M2Error.DefaultProgramModule %
+ % PushAutoOn %
Ident % P3StartBuildProgModule %
% BuildModuleStart %
% PushAutoOff %
@@ -555,7 +558,8 @@ ProgramModule := "MODULE" % Pus
PopAuto %
=:
-ImplementationModule := "IMPLEMENTATION" "MODULE" % PushAutoOn %
+ImplementationModule := "IMPLEMENTATION" % M2Error.DefaultImplementationModule %
+ "MODULE" % PushAutoOn %
Ident % StartBuildModFile %
% P3StartBuildImpModule %
% BuildModuleStart %
@@ -1105,7 +1109,7 @@ DefineBuiltinProcedure := [ "__ATTRIBUTE__" "__BUILTIN__" "(" "(" Ident ")" ")"
"__INLINE__" ]
=:
-ProcedureHeading := "PROCEDURE"
+ProcedureHeading := "PROCEDURE" % M2Error.DefaultProcedure %
DefineBuiltinProcedure % PushAutoOn %
( Ident % StartBuildProcedure %
% PushAutoOff %
@@ -1175,7 +1179,8 @@ DefOptArg := "[" Ident ":" FormalType "=" SilentConstExpression "]" =:
FormalType := { "ARRAY" "OF" } Qualident =:
-ModuleDeclaration := "MODULE" % PushAutoOn %
+ModuleDeclaration := "MODULE" % M2Error.DefaultInnerModule %
+ % PushAutoOn %
Ident % StartBuildInnerModule ;
BuildModuleStart ;
@@ -1201,7 +1206,8 @@ Import := "FROM" Ident "IMPORT" IdentList ";" |
"IMPORT"
IdentList ";" =:
-DefinitionModule := "DEFINITION" "MODULE" % PushAutoOn %
+DefinitionModule := "DEFINITION" % M2Error.DefaultDefinitionModule %
+ "MODULE" % PushAutoOn %
[ "FOR" string ]
Ident % StartBuildDefFile ;
P3StartBuildDefModule ;
diff --git a/gcc/m2/bnf/m2.bnf b/gcc/m2/bnf/m2.bnf
index b2a52606ca2..515d9997641 100644
--- a/gcc/m2/bnf/m2.bnf
+++ b/gcc/m2/bnf/m2.bnf
@@ -44,7 +44,9 @@ see <https://www.gnu.org/licenses/>. *)
IMPLEMENTATION MODULE P0SyntaxCheck ;
-FROM M2LexBuf IMPORT currentstring, currenttoken, GetToken, InsertToken, InsertTokenAndRewind, GetTokenNo ;
+FROM M2LexBuf IMPORT currentstring, currenttoken, GetToken, InsertToken,
+ InsertTokenAndRewind, GetTokenNo, DisplayToken, DumpTokens ;
+
FROM M2MetaError IMPORT MetaErrorStringT0 ;
FROM M2Quads IMPORT PushT, PushTF, IsAutoPushOn, PushAutoOff, PushAutoOn, PopAuto, DisplayStack, PushTFtok ;
FROM M2Reserved IMPORT tokToTok, toktype, NulTok, ImportTok, ExportTok, QualifiedTok, UnQualifiedTok, BuiltinTok, InlineTok ;
@@ -66,32 +68,35 @@ FROM P0SymBuild IMPORT RegisterImports, RegisterInnerImports,
FROM SymbolTable IMPORT NulSym, PutModuleContainsBuiltin, PutHiddenTypeDeclared ;
+IMPORT M2Error ;
+
CONST
- Debugging = FALSE ;
- Pass0 = TRUE ;
- Pass1 = FALSE ;
- Pass2 = FALSE ; (* permanently disabled for the time being *)
- Pass3 = FALSE ; (* permanently disabled for the time being *)
- MaxInsert = 10 ; (* allow 10 tokens to be inserted before *)
- (* giving up. *)
+ Debugging = FALSE ;
+ DebugRecover = FALSE ;
+ Pass0 = TRUE ;
+ Pass1 = FALSE ;
+ Pass2 = FALSE ; (* permanently disabled for the time being *)
+ Pass3 = FALSE ; (* permanently disabled for the time being *)
+ MaxInsert = 10 ; (* allow 10 tokens to be inserted before *)
+ (* giving up. *)
VAR
- WasNoError : BOOLEAN ;
+ seenError : BOOLEAN ;
LastIdent : Name ;
InsertCount: CARDINAL ;
PROCEDURE ErrorString (s: String) ;
BEGIN
- MetaErrorStringT0(GetTokenNo(), s) ;
- WasNoError := FALSE
+ MetaErrorStringT0 (GetTokenNo (), s) ;
+ seenError := TRUE
END ErrorString ;
PROCEDURE ErrorArray (a: ARRAY OF CHAR) ;
BEGIN
- ErrorString(InitString(a))
+ ErrorString (InitString (a))
END ErrorArray ;
@@ -134,16 +139,16 @@ BEGIN
((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
THEN
- SyntaxError(stopset0, stopset1, stopset2)
+ SyntaxError (stopset0, stopset1, stopset2)
END
END SyntaxCheck ;
(*
- WarnMissingToken - generates a warning message about a missing token, t.
+ GetMissingTokenMessage - generates and returns a string about a missing token, t.
*)
-PROCEDURE WarnMissingToken (t: toktype) ;
+PROCEDURE GetMissingTokenMessage (t: toktype) : String ;
VAR
s0 : SetOfStop0 ;
s1 : SetOfStop1 ;
@@ -162,10 +167,40 @@ BEGIN
ELSE
s2 := SetOfStop2{t}
END ;
- str := DescribeStop(s0, s1, s2) ;
+ str := DescribeStop (s0, s1, s2) ;
+ RETURN str
+END GetMissingTokenMessage ;
+
- str := ConCat(InitString('syntax error,'), Mark(str)) ;
- MetaErrorStringT0(GetTokenNo(), str)
+(*
+ ErrorMissingToken - generates an error message about a missing token, t.
+*)
+
+PROCEDURE ErrorMissingToken (t: toktype) ;
+VAR
+ str: String ;
+BEGIN
+ str := GetMissingTokenMessage (t) ;
+ str := ConCat (InitString ('syntax error,'), Mark (str)) ;
+ MetaErrorStringT0 (GetTokenNo (), str)
+END ErrorMissingToken ;
+
+
+(*
+ WarnMissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE WarnMissingToken (t: toktype) ;
+VAR
+ str: String ;
+BEGIN
+ str := GetMissingTokenMessage (t) ;
+ str := ConCat (InitString ('{%W}syntax warning,'), Mark (str)) ;
+ MetaErrorStringT0 (GetTokenNo (), str) ;
+ IF DebugRecover
+ THEN
+ printf0 ("warning note created\n")
+ END
END WarnMissingToken ;
@@ -175,37 +210,60 @@ END WarnMissingToken ;
PROCEDURE MissingToken (t: toktype) ;
BEGIN
- WarnMissingToken(t) ;
- INC(InsertCount) ;
IF (InsertCount<MaxInsert) AND
((t#identtok) AND (t#integertok) AND (t#realtok) AND (t#stringtok))
THEN
- IF Debugging
+ IF DebugRecover
+ THEN
+ printf0 ("missing token detected and going to be inserted: ");
+ DisplayToken (t)
+ END ;
+ WarnMissingToken (t) ;
+ INC (InsertCount) ;
+ IF DebugRecover
+ THEN
+ printf0 ('inserting token\n')
+ END ;
+ InsertToken (t)
+ ELSE
+ IF DebugRecover
THEN
- printf0('inserting token\n')
+ printf0 ("missing token detected but cannot be inserted: ");
+ DisplayToken (t)
END ;
- InsertToken(t)
+ ErrorMissingToken (t)
END
END MissingToken ;
(*
- CheckAndInsert -
+ CheckInsertCandidate -
*)
-PROCEDURE CheckAndInsert (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
+PROCEDURE CheckInsertCandidate (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
BEGIN
IF ((ORD(t)<32) AND (t IN stopset0)) OR
((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
((ORD(t)>=64) AND (t IN stopset2))
THEN
- WarnMissingToken(t) ;
- InsertTokenAndRewind(t) ;
- RETURN( TRUE )
- ELSE
- RETURN( FALSE )
- END
-END CheckAndInsert ;
+ INC (InsertCount) ;
+ IF InsertCount < MaxInsert
+ THEN
+ WarnMissingToken (t) ;
+ IF DebugRecover
+ THEN
+ printf0 ('buffer before\n') ;
+ DumpTokens ;
+ printf0 ('inserting token: buffer after\n') ;
+ DumpTokens ;
+ printf0 ('inserting token\n')
+ END ;
+ InsertTokenAndRewind (t) ;
+ RETURN TRUE
+ END
+ END ;
+ RETURN FALSE
+END CheckInsertCandidate ;
(*
@@ -242,16 +300,17 @@ BEGIN
((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))) AND
(NOT InStopSet(identtok, stopset0, stopset1, stopset2))
THEN
- (* SyntaxCheck would fail since currentoken is not part of the stopset
- we check to see whether any of currenttoken might be a commonly omitted token *)
- IF CheckAndInsert(semicolontok, stopset0, stopset1, stopset2) OR
- CheckAndInsert(rsbratok, stopset0, stopset1, stopset2) OR
- CheckAndInsert(rparatok, stopset0, stopset1, stopset2) OR
- CheckAndInsert(rcbratok, stopset0, stopset1, stopset2) OR
- CheckAndInsert(periodtok, stopset0, stopset1, stopset2) OR
- CheckAndInsert(oftok, stopset0, stopset1, stopset2) OR
- CheckAndInsert(endtok, stopset0, stopset1, stopset2) OR
- CheckAndInsert(commatok, stopset0, stopset1, stopset2)
+ (* SyntaxCheck will fail since currentoken is not part of the stopset
+ we check to see whether one of the following is in the stopset and
+ if not emit a warning and also the token. *)
+ IF CheckInsertCandidate (semicolontok, stopset0, stopset1, stopset2) OR
+ CheckInsertCandidate (rsbratok, stopset0, stopset1, stopset2) OR
+ CheckInsertCandidate (rparatok, stopset0, stopset1, stopset2) OR
+ CheckInsertCandidate (rcbratok, stopset0, stopset1, stopset2) OR
+ CheckInsertCandidate (periodtok, stopset0, stopset1, stopset2) OR
+ CheckInsertCandidate (oftok, stopset0, stopset1, stopset2) OR
+ CheckInsertCandidate (endtok, stopset0, stopset1, stopset2) OR
+ CheckInsertCandidate (commatok, stopset0, stopset1, stopset2)
THEN
END
END
@@ -267,19 +326,14 @@ BEGIN
IF currenttoken=t
THEN
GetToken ;
-(*
- WriteFormat2('token number %d token was %a',
- GetTokenNo(), makekey(currentstring)) ;
- FlushErrors ;
-*)
IF Pass0
THEN
- PeepToken(stopset0, stopset1, stopset2)
+ PeepToken (stopset0, stopset1, stopset2)
END
ELSE
- MissingToken(t)
+ MissingToken (t)
END ;
- SyntaxCheck(stopset0, stopset1, stopset2)
+ SyntaxCheck (stopset0, stopset1, stopset2)
END Expect ;
@@ -290,10 +344,10 @@ END Expect ;
PROCEDURE CompilationUnit () : BOOLEAN ;
BEGIN
- WasNoError := TRUE ;
+ seenError := FALSE ;
InsertCount := 0 ;
- FileUnit(SetOfStop0{eoftok}, SetOfStop1{}, SetOfStop2{}) ;
- RETURN( WasNoError )
+ FileUnit (SetOfStop0{eoftok}, SetOfStop1{}, SetOfStop2{}) ;
+ RETURN NOT seenError
END CompilationUnit ;
@@ -479,6 +533,7 @@ FileUnit := % Pus
=:
ProgramModule := "MODULE" % PushAutoOn ; %
+ % M2Error.DefaultProgramModule %
Ident % RegisterProgramModule ; %
% PushAutoOff ; %
[ Priority ]
@@ -491,7 +546,8 @@ ProgramModule := "MODULE" % Pus
% PopAuto %
=:
-ImplementationModule := "IMPLEMENTATION" "MODULE" % PushAutoOn ; %
+ImplementationModule := "IMPLEMENTATION" % M2Error.DefaultImplementationModule %
+ "MODULE" % PushAutoOn ; %
Ident % RegisterImplementationModule ; %
% PushAutoOff ; %
[ Priority ] ";" % PushAutoOn ; %
@@ -735,7 +791,7 @@ ProcedureDeclaration :=
DefineBuiltinProcedure := [ "__ATTRIBUTE__" "__BUILTIN__" "(" "(" Ident ")" ")" |
"__INLINE__" ] =:
-ProcedureHeading := "PROCEDURE"
+ProcedureHeading := "PROCEDURE" % M2Error.DefaultProcedure %
DefineBuiltinProcedure
( % PushAutoOn %
Ident % RegisterProcedure %
@@ -805,6 +861,7 @@ DefOptArg := "[" Ident ":" FormalType "=" ConstExpression "]" =:
FormalType := { "ARRAY" "OF" } Qualident =:
ModuleDeclaration := "MODULE" % PushAutoOn %
+ % M2Error.DefaultInnerModule %
Ident % RegisterInnerModule %
% PushAutoOff %
[ Priority ] ";" % PushAutoOn %
@@ -827,7 +884,8 @@ Import := "FROM" Ident "IMPORT" IdentList ";" |
(* determines whether Ident or Module *) %
IdentList ";" =:
-DefinitionModule := "DEFINITION" "MODULE" [ "FOR" string ] % PushAutoOn %
+DefinitionModule := "DEFINITION" % M2Error.DefaultDefinitionModule %
+ "MODULE" [ "FOR" string ] % PushAutoOn %
Ident % RegisterDefinitionModule %
";"
{ Import % RegisterImports %
diff --git a/gcc/m2/gm2-compiler/M2Comp.mod b/gcc/m2/gm2-compiler/M2Comp.mod
index b5dca0466de..700f96eb9b5 100644
--- a/gcc/m2/gm2-compiler/M2Comp.mod
+++ b/gcc/m2/gm2-compiler/M2Comp.mod
@@ -35,7 +35,9 @@ FROM M2FileName IMPORT CalculateFileName ;
FROM M2Preprocess IMPORT PreprocessModule ;
FROM libc IMPORT exit ;
-FROM M2Error IMPORT ErrorStringAt, ErrorStringAt2, ErrorStringsAt2, WriteFormat0, FlushErrors, FlushWarnings ;
+FROM M2Error IMPORT ErrorStringAt, ErrorStringAt2, ErrorStringsAt2,
+ WriteFormat0, FlushErrors, FlushWarnings, ParsingComplete ;
+
FROM M2MetaError IMPORT MetaErrorString1, MetaError0, MetaError1 ;
FROM FormatStrings IMPORT Sprintf1 ;
FROM P0SymBuild IMPORT P0Init, P1Init ;
@@ -139,7 +141,7 @@ BEGIN
qprintf0('Pass 3: quadruple generation\n') ;
ResetForNewPass ;
DoPass3 ;
- FlushWarnings ; FlushErrors ;
+ FlushWarnings ; FlushErrors ; ParsingComplete ;
qprintf0('Pass 4: gcc tree generation\n') ;
Code ;
FlushWarnings ; FlushErrors
diff --git a/gcc/m2/gm2-compiler/M2Error.def b/gcc/m2/gm2-compiler/M2Error.def
index 14e54223dac..842eccd18ba 100644
--- a/gcc/m2/gm2-compiler/M2Error.def
+++ b/gcc/m2/gm2-compiler/M2Error.def
@@ -45,7 +45,10 @@ EXPORT QUALIFIED Error,
WarnFormat0, WarnFormat1, MoveError,
AnnounceScope, EnterImplementationScope,
EnterModuleScope, EnterDefinitionScope, EnterProgramScope,
- EnterProcedureScope, LeaveScope, DepthScope, GetAnnounceScope ;
+ EnterProcedureScope, LeaveScope, DepthScope, GetAnnounceScope,
+ DefaultProgramModule, DefaultImplementationModule,
+ DefaultDefinitionModule, DefaultInnerModule, DefaultProcedure,
+ ParsingComplete ;
TYPE
Error ;
@@ -293,4 +296,51 @@ PROCEDURE DepthScope () : CARDINAL ;
PROCEDURE GetAnnounceScope (filename, message: String) : String ;
+(*
+ DefaultProgramModule - sets up an unnamed program scope before the Ident is seen.
+*)
+
+PROCEDURE DefaultProgramModule ;
+
+
+(*
+ DefaultImplementationModule - sets up an unnamed implementation
+ scope before the Ident is seen.
+*)
+
+PROCEDURE DefaultImplementationModule ;
+
+
+(*
+ DefaultDefinitionModule - sets up an unnamed definition
+ scope before the Ident is seen.
+*)
+
+PROCEDURE DefaultDefinitionModule ;
+
+
+(*
+ DefaultInnerModule - sets up an unnamed inner
+ scope before the Ident is seen.
+*)
+
+PROCEDURE DefaultInnerModule ;
+
+
+(*
+ DefaultProcedure - sets up an unnamed procedure
+ scope before the Ident is seen.
+*)
+
+PROCEDURE DefaultProcedure ;
+
+
+(*
+ ParsingComplete - after this is called the Enter scope procedure
+ will not assert the default scope was set.
+*)
+
+PROCEDURE ParsingComplete ;
+
+
END M2Error.
diff --git a/gcc/m2/gm2-compiler/M2Error.mod b/gcc/m2/gm2-compiler/M2Error.mod
index f1f39b3e7ad..4eb4580d790 100644
--- a/gcc/m2/gm2-compiler/M2Error.mod
+++ b/gcc/m2/gm2-compiler/M2Error.mod
@@ -71,6 +71,7 @@ VAR
lastKind,
scopeKind : KindScope ;
scopeStack : StackOfWord ;
+ parsing : BOOLEAN ;
(*
@@ -403,7 +404,7 @@ BEGIN
fatal := TRUE ;
color := FALSE ;
END ;
- Assert (scopeKind # noscope) ;
+ (* Assert (scopeKind # noscope) ; *)
e^.scopeKind := scopeKind ;
e^.scopeName := scopeName ;
IF (head=NIL) OR (head^.token>AtTokenNo)
@@ -570,7 +571,8 @@ BEGIN
scopeStack := InitStackWord () ;
scopeName := NulName ;
scopeKind := noscope ;
- lastKind := noscope
+ lastKind := noscope ;
+ parsing := TRUE
END Init ;
@@ -830,9 +832,13 @@ BEGIN
pre := Sprintf1 (Mark (InitString ("%s: ")), filename)
END ;
- quoted := quoteOpen (InitString ('')) ;
- quoted := ConCat (quoted, Mark (InitStringCharStar (KeyToCharStar (scopeName)))) ;
- quoted := quoteClose (quoted) ;
+ quoted := InitString ('') ;
+ IF scopeName # NulName
+ THEN
+ quoted := quoteOpen (quoted) ;
+ quoted := ConCat (quoted, Mark (InitStringCharStar (KeyToCharStar (scopeName)))) ;
+ quoted := quoteClose (quoted)
+ END ;
CASE scopeKind OF
definition : desc := InitString ("In definition module") |
@@ -863,14 +869,103 @@ BEGIN
lastKind := e^.scopeKind ;
scopeKind := e^.scopeKind ;
scopeName := e^.scopeName ;
- Assert (e^.scopeKind # noscope) ;
- filename := FindFileNameFromToken (e^.token, 0) ;
- message := GetAnnounceScope (filename, message)
+ IF e^.scopeKind = noscope
+ THEN
+ RETURN InitString ("no scope active")
+ ELSE
+ Assert (e^.scopeKind # noscope) ;
+ filename := FindFileNameFromToken (e^.token, 0) ;
+ message := GetAnnounceScope (filename, message)
+ END
END ;
RETURN message
END AnnounceScope ;
+(*
+ DefaultProgramModule - sets up an unnamed program scope before the Ident is seen.
+*)
+
+PROCEDURE DefaultProgramModule ;
+BEGIN
+ IF parsing
+ THEN
+ scopeKind := program ;
+ scopeName := NulName ;
+ PushWord (scopeStack, scopeKind) ;
+ PushWord (scopeStack, scopeName)
+ END
+END DefaultProgramModule ;
+
+
+(*
+ DefaultImplementationModule - sets up an unnamed implementation
+ scope before the Ident is seen.
+*)
+
+PROCEDURE DefaultImplementationModule ;
+BEGIN
+ IF parsing
+ THEN
+ scopeKind := implementation ;
+ scopeName := NulName ;
+ PushWord (scopeStack, scopeKind) ;
+ PushWord (scopeStack, scopeName)
+ END
+END DefaultImplementationModule ;
+
+
+(*
+ DefaultDefinitionModule - sets up an unnamed definition
+ scope before the Ident is seen.
+*)
+
+PROCEDURE DefaultDefinitionModule ;
+BEGIN
+ IF parsing
+ THEN
+ PushWord (scopeStack, scopeKind) ;
+ PushWord (scopeStack, scopeName) ;
+ scopeKind := definition ;
+ scopeName := NulName
+ END
+END DefaultDefinitionModule ;
+
+
+(*
+ DefaultInnerModule - sets up an unnamed inner
+ scope before the Ident is seen.
+*)
+
+PROCEDURE DefaultInnerModule ;
+BEGIN
+ IF parsing
+ THEN
+ scopeKind := module ;
+ scopeName := NulName ;
+ PushWord (scopeStack, scopeKind) ;
+ PushWord (scopeStack, scopeName)
+ END
+END DefaultInnerModule ;
+
+
+(*
+ DefaultProcedure - sets up an unnamed procedure
+ scope before the Ident is seen.
+*)
+
+PROCEDURE DefaultProcedure ;
+BEGIN
+ IF parsing
+ THEN
+ scopeKind := procedure ;
+ scopeName := NulName ;
+ PushWord (scopeStack, scopeKind) ;
+ PushWord (scopeStack, scopeName)
+ END ;
+END DefaultProcedure ;
+
+
(*
EnterImplementationScope - signifies to the error routines that the front end
has started to compile implementation module scopeName.
@@ -878,6 +973,11 @@ END AnnounceScope ;
PROCEDURE EnterImplementationScope (scopename: Name) ;
BEGIN
+ IF parsing
+ THEN
+ Assert (scopeKind = implementation) ;
+ LeaveScope (* shutdown the default implementation scope. *)
+ END ;
PushWord (scopeStack, scopeKind) ;
PushWord (scopeStack, scopeName) ;
scopeKind := implementation ;
@@ -892,6 +992,11 @@ END EnterImplementationScope ;
PROCEDURE EnterProgramScope (scopename: Name) ;
BEGIN
+ IF parsing
+ THEN
+ Assert (scopeKind = program) ;
+ LeaveScope (* shutdown the default program scope. *)
+ END ;
PushWord (scopeStack, scopeKind) ;
PushWord (scopeStack, scopeName) ;
scopeKind := program ;
@@ -906,6 +1011,11 @@ END EnterProgramScope ;
PROCEDURE EnterModuleScope (scopename: Name) ;
BEGIN
+ IF parsing
+ THEN
+ Assert (scopeKind = module) ;
+ LeaveScope (* shutdown the default inner module scope. *)
+ END ;
PushWord (scopeStack, scopeKind) ;
PushWord (scopeStack, scopeName) ;
scopeKind := module ;
@@ -920,6 +1030,11 @@ END EnterModuleScope ;
PROCEDURE EnterDefinitionScope (scopename: Name) ;
BEGIN
+ IF parsing
+ THEN
+ Assert (scopeKind = definition)
+ END ;
+ LeaveScope ; (* shutdown the default definition module scope. *)
PushWord (scopeStack, scopeKind) ;
PushWord (scopeStack, scopeName) ;
scopeKind := definition ;
@@ -934,6 +1049,11 @@ END EnterDefinitionScope ;
PROCEDURE EnterProcedureScope (scopename: Name) ;
BEGIN
+ IF parsing
+ THEN
+ Assert (scopeKind = procedure) ;
+ LeaveScope (* shutdown the default procedure scope. *)
+ END ;
PushWord (scopeStack, scopeKind) ;
PushWord (scopeStack, scopeName) ;
scopeKind := procedure ;
@@ -962,6 +1082,17 @@ BEGIN
END DepthScope ;
+(*
+ ParsingComplete - after this is called the Enter scope procedure
+ will not assert the default scope was set.
+*)
+
+PROCEDURE ParsingComplete ;
+BEGIN
+ parsing := FALSE
+END ParsingComplete ;
+
+
BEGIN
Init
END M2Error.
diff --git a/gcc/m2/gm2-compiler/M2LexBuf.def b/gcc/m2/gm2-compiler/M2LexBuf.def
index 15398e83040..c6b4ad4d55d 100644
--- a/gcc/m2/gm2-compiler/M2LexBuf.def
+++ b/gcc/m2/gm2-compiler/M2LexBuf.def
@@ -44,7 +44,7 @@ EXPORT QUALIFIED OpenSource, CloseSource, ReInitialize, GetToken, InsertToken,
currenttoken, currentstring, currentinteger,
AddTok, AddTokCharStar, AddTokInteger, MakeVirtualTok,
SetFile, PushFile, PopFile,
- PrintTokenNo,
+ PrintTokenNo, DisplayToken, DumpTokens,
BuiltinTokenNo, UnknownTokenNo ;
CONST
@@ -260,4 +260,18 @@ PROCEDURE PopFile (filename: ADDRESS) ;
PROCEDURE PrintTokenNo (tokenno: CARDINAL) ;
+(*
+ DisplayToken - display the token name using printf0 no newline is emitted.
+*)
+
+PROCEDURE DisplayToken (tok: toktype) ;
+
+
+(*
+ DumpTokens - developer debugging aid.
+*)
+
+PROCEDURE DumpTokens ;
+
+
END M2LexBuf.
diff --git a/gcc/m2/gm2-compiler/M2LexBuf.mod b/gcc/m2/gm2-compiler/M2LexBuf.mod
index c547384fca4..494015b0b74 100644
--- a/gcc/m2/gm2-compiler/M2LexBuf.mod
+++ b/gcc/m2/gm2-compiler/M2LexBuf.mod
@@ -40,11 +40,11 @@ FROM M2Error IMPORT WarnStringAt ;
CONST
MaxBucketSize = 100 ;
Debugging = FALSE ;
+ DebugRecover = FALSE ;
InitialSourceToken = 2 ; (* 0 is unknown, 1 is builtin. *)
TYPE
- SourceList = POINTER TO sourcelist ;
- sourcelist = RECORD
+ SourceList = POINTER TO RECORD
left,
right: SourceList ;
name : String ;
@@ -53,17 +53,17 @@ TYPE
END ;
TokenDesc = RECORD
- token: toktype ;
- str : Name ;
- int : INTEGER ;
- line : CARDINAL ;
- col : CARDINAL ;
- file : SourceList ;
- loc : location_t ;
+ token : toktype ;
+ str : Name ; (* ident name or string literal. *)
+ int : INTEGER ;
+ line : CARDINAL ;
+ col : CARDINAL ;
+ file : SourceList ;
+ loc : location_t ;
+ insert: TokenBucket ; (* contains any inserted tokens. *)
END ;
- TokenBucket = POINTER TO tokenbucket ;
- tokenbucket = RECORD
+ TokenBucket = POINTER TO RECORD
buf : ARRAY [0..MaxBucketSize] OF TokenDesc ;
len : CARDINAL ;
next: TokenBucket ;
@@ -81,6 +81,7 @@ VAR
CurrentUsed : BOOLEAN ;
ListOfTokens : ListDesc ;
CurrentTokNo : CARDINAL ;
+ InsertionIndex : CARDINAL ;
(*
@@ -91,8 +92,26 @@ VAR
PROCEDURE InitTokenList ;
BEGIN
- NEW(ListOfTokens.head) ;
+ NEW (ListOfTokens.head) ;
ListOfTokens.tail := ListOfTokens.head ;
+ WITH ListOfTokens.tail^.buf[0] DO
+ token := eoftok ;
+ str := NulName ;
+ int := 0 ;
+ line := 0 ;
+ col := 0 ;
+ file := NIL ;
+ loc := UnknownLocation ()
+ END ;
+ WITH ListOfTokens.tail^.buf[1] DO
+ token := eoftok ;
+ str := NulName ;
+ int := 0 ;
+ line := 0 ;
+ col := 0 ;
+ file := NIL ;
+ loc := BuiltinsLocation ()
+ END ;
ListOfTokens.tail^.len := InitialSourceToken
END InitTokenList ;
@@ -103,6 +122,7 @@ END InitTokenList ;
PROCEDURE Init ;
BEGIN
+ InsertionIndex := 0 ;
currenttoken := eoftok ;
CurrentTokNo := InitialSourceToken ;
CurrentSource := NIL ;
@@ -149,8 +169,8 @@ PROCEDURE NewElement (s: ADDRESS) : SourceList ;
VAR
l: SourceList ;
BEGIN
- NEW(l) ;
- IF l=NIL
+ NEW (l) ;
+ IF l = NIL
THEN
HALT
ELSE
@@ -160,7 +180,7 @@ BEGIN
right := NIL
END
END ;
- RETURN( l )
+ RETURN l
END NewElement ;
@@ -172,13 +192,13 @@ PROCEDURE NewList () : SourceList ;
VAR
l: SourceList ;
BEGIN
- NEW(l) ;
+ NEW (l) ;
WITH l^ DO
left := l ;
right := l ;
name := NIL
END ;
- RETURN( l )
+ RETURN l
END NewList ;
@@ -197,7 +217,7 @@ BEGIN
h := CurrentSource ;
CurrentSource := NewList() ;
WHILE l#h DO
- AddTo(NewElement(l^.name)) ;
+ AddTo (NewElement (l^.name)) ;
l := l^.right
END
END
@@ -213,7 +233,7 @@ VAR
l: SourceList ;
BEGIN
CheckIfNeedToDuplicate ;
- AddTo(NewElement(filename)) ;
+ AddTo (NewElement (filename)) ;
IF Debugging
THEN
IF CurrentSource^.right#CurrentSource
@@ -305,8 +325,8 @@ PROCEDURE SetFile (filename: ADDRESS) ;
BEGIN
KillList ;
CurrentUsed := FALSE ;
- CurrentSource := NewList() ;
- AddTo(NewElement(filename))
+ CurrentSource := NewList () ;
+ AddTo (NewElement (filename))
END SetFile ;
@@ -359,99 +379,100 @@ END CloseSource ;
PROCEDURE ResetForNewPass ;
BEGIN
+ InsertionIndex := 0 ;
CurrentTokNo := InitialSourceToken ;
UseBufferedTokens := TRUE
END ResetForNewPass ;
(*
- DisplayToken -
+ DisplayToken - display the token name using printf0 no newline is emitted.
*)
PROCEDURE DisplayToken (tok: toktype) ;
BEGIN
CASE tok OF
- eoftok: printf0('eoftok\n') |
- plustok: printf0('plustok\n') |
- minustok: printf0('minustok\n') |
- timestok: printf0('timestok\n') |
- dividetok: printf0('dividetok\n') |
- becomestok: printf0('becomestok\n') |
- ambersandtok: printf0('ambersandtok\n') |
- periodtok: printf0('periodtok\n') |
- commatok: printf0('commatok\n') |
- semicolontok: printf0('semicolontok\n') |
- lparatok: printf0('lparatok\n') |
- rparatok: printf0('rparatok\n') |
- lsbratok: printf0('lsbratok\n') |
- rsbratok: printf0('rsbratok\n') |
- lcbratok: printf0('lcbratok\n') |
- rcbratok: printf0('rcbratok\n') |
- uparrowtok: printf0('uparrowtok\n') |
- singlequotetok: printf0('singlequotetok\n') |
- equaltok: printf0('equaltok\n') |
- hashtok: printf0('hashtok\n') |
- lesstok: printf0('lesstok\n') |
- greatertok: printf0('greatertok\n') |
- lessgreatertok: printf0('lessgreatertok\n') |
- lessequaltok: printf0('lessequaltok\n') |
- greaterequaltok: printf0('greaterequaltok\n') |
- periodperiodtok: printf0('periodperiodtok\n') |
- colontok: printf0('colontok\n') |
- doublequotestok: printf0('doublequotestok\n') |
- bartok: printf0('bartok\n') |
- andtok: printf0('andtok\n') |
- arraytok: printf0('arraytok\n') |
- begintok: printf0('begintok\n') |
- bytok: printf0('bytok\n') |
- casetok: printf0('casetok\n') |
- consttok: printf0('consttok\n') |
- definitiontok: printf0('definitiontok\n') |
- divtok: printf0('divtok\n') |
- dotok: printf0('dotok\n') |
- elsetok: printf0('elsetok\n') |
- elsiftok: printf0('elsiftok\n') |
- endtok: printf0('endtok\n') |
- exittok: printf0('exittok\n') |
- exporttok: printf0('exporttok\n') |
- fortok: printf0('fortok\n') |
- fromtok: printf0('fromtok\n') |
- iftok: printf0('iftok\n') |
- implementationtok: printf0('implementationtok\n') |
- importtok: printf0('importtok\n') |
- intok: printf0('intok\n') |
- looptok: printf0('looptok\n') |
- modtok: printf0('modtok\n') |
- moduletok: printf0('moduletok\n') |
- nottok: printf0('nottok\n') |
- oftok: printf0('oftok\n') |
- ortok: printf0('ortok\n') |
- pointertok: printf0('pointertok\n') |
- proceduretok: printf0('proceduretok\n') |
- qualifiedtok: printf0('qualifiedtok\n') |
- unqualifiedtok: printf0('unqualifiedtok\n') |
- recordtok: printf0('recordtok\n') |
- repeattok: printf0('repeattok\n') |
- returntok: printf0('returntok\n') |
- settok: printf0('settok\n') |
- thentok: printf0('thentok\n') |
- totok: printf0('totok\n') |
- typetok: printf0('typetok\n') |
- untiltok: printf0('untiltok\n') |
- vartok: printf0('vartok\n') |
- whiletok: printf0('whiletok\n') |
- withtok: printf0('withtok\n') |
- asmtok: printf0('asmtok\n') |
- volatiletok: printf0('volatiletok\n') |
- periodperiodperiodtok: printf0('periodperiodperiodtok\n') |
- datetok: printf0('datetok\n') |
- linetok: printf0('linetok\n') |
- filetok: printf0('filetok\n') |
- integertok: printf0('integertok\n') |
- identtok: printf0('identtok\n') |
- realtok: printf0('realtok\n') |
- stringtok: printf0('stringtok\n')
+ eoftok: printf0('eoftok') |
+ plustok: printf0('plustok') |
+ minustok: printf0('minustok') |
+ timestok: printf0('timestok') |
+ dividetok: printf0('dividetok') |
+ becomestok: printf0('becomestok') |
+ ambersandtok: printf0('ambersandtok') |
+ periodtok: printf0('periodtok') |
+ commatok: printf0('commatok') |
+ semicolontok: printf0('semicolontok') |
+ lparatok: printf0('lparatok') |
+ rparatok: printf0('rparatok') |
+ lsbratok: printf0('lsbratok') |
+ rsbratok: printf0('rsbratok') |
+ lcbratok: printf0('lcbratok') |
+ rcbratok: printf0('rcbratok') |
+ uparrowtok: printf0('uparrowtok') |
+ singlequotetok: printf0('singlequotetok') |
+ equaltok: printf0('equaltok') |
+ hashtok: printf0('hashtok') |
+ lesstok: printf0('lesstok') |
+ greatertok: printf0('greatertok') |
+ lessgreatertok: printf0('lessgreatertok') |
+ lessequaltok: printf0('lessequaltok') |
+ greaterequaltok: printf0('greaterequaltok') |
+ periodperiodtok: printf0('periodperiodtok') |
+ colontok: printf0('colontok') |
+ doublequotestok: printf0('doublequotestok') |
+ bartok: printf0('bartok') |
+ andtok: printf0('andtok') |
+ arraytok: printf0('arraytok') |
+ begintok: printf0('begintok') |
+ bytok: printf0('bytok') |
+ casetok: printf0('casetok') |
+ consttok: printf0('consttok') |
+ definitiontok: printf0('definitiontok') |
+ divtok: printf0('divtok') |
+ dotok: printf0('dotok') |
+ elsetok: printf0('elsetok') |
+ elsiftok: printf0('elsiftok') |
+ endtok: printf0('endtok') |
+ exittok: printf0('exittok') |
+ exporttok: printf0('exporttok') |
+ fortok: printf0('fortok') |
+ fromtok: printf0('fromtok') |
+ iftok: printf0('iftok') |
+ implementationtok: printf0('implementationtok') |
+ importtok: printf0('importtok') |
+ intok: printf0('intok') |
+ looptok: printf0('looptok') |
+ modtok: printf0('modtok') |
+ moduletok: printf0('moduletok') |
+ nottok: printf0('nottok') |
+ oftok: printf0('oftok') |
+ ortok: printf0('ortok') |
+ pointertok: printf0('pointertok') |
+ proceduretok: printf0('proceduretok') |
+ qualifiedtok: printf0('qualifiedtok') |
+ unqualifiedtok: printf0('unqualifiedtok') |
+ recordtok: printf0('recordtok') |
+ repeattok: printf0('repeattok') |
+ returntok: printf0('returntok') |
+ settok: printf0('settok') |
+ thentok: printf0('thentok') |
+ totok: printf0('totok') |
+ typetok: printf0('typetok') |
+ untiltok: printf0('untiltok') |
+ vartok: printf0('vartok') |
+ whiletok: printf0('whiletok') |
+ withtok: printf0('withtok') |
+ asmtok: printf0('asmtok') |
+ volatiletok: printf0('volatiletok') |
+ periodperiodperiodtok: printf0('periodperiodperiodtok') |
+ datetok: printf0('datetok') |
+ linetok: printf0('linetok') |
+ filetok: printf0('filetok') |
+ integertok: printf0('integertok') |
+ identtok: printf0('identtok') |
+ realtok: printf0('realtok') |
+ stringtok: printf0('stringtok')
ELSE
END
@@ -466,19 +487,124 @@ END DisplayToken ;
PROCEDURE UpdateFromBucket (b: TokenBucket; offset: CARDINAL) ;
BEGIN
- WITH b^.buf[offset] DO
- currenttoken := token ;
- currentstring := KeyToCharStar(str) ;
- currentcolumn := col ;
- currentinteger := int ;
- IF Debugging
+ IF InsertionIndex > 0
+ THEN
+ (* we have an inserted token to use. *)
+ Assert (b^.buf[offset].insert # NIL) ;
+ WITH b^.buf[offset].insert^.buf[InsertionIndex] DO
+ currenttoken := token ;
+ currentstring := KeyToCharStar(str) ;
+ currentcolumn := col ;
+ currentinteger := int ;
+ IF Debugging
+ THEN
+ printf3('line %d (# %d %d) ', line, offset, CurrentTokNo)
+ END
+ END ;
+ INC (InsertionIndex) ;
+ IF InsertionIndex = b^.buf[offset].insert^.len
THEN
- printf3('line %d (# %d %d) ', line, offset, CurrentTokNo) ;
+ InsertionIndex := 0 ; (* finished consuming the inserted tokens. *)
+ INC (CurrentTokNo)
+ END
+ ELSIF (b^.buf[offset].insert # NIL) AND (InsertionIndex = 0)
+ THEN
+ (* this source token has extra tokens appended after it by the error recovery. *)
+ Assert (b^.buf[offset].insert^.len > 0) ; (* we must have at least one token. *)
+ InsertionIndex := 1 ; (* so set the index ready for the next UpdateFromBucket. *)
+ (* and read the original token. *)
+ WITH b^.buf[offset] DO
+ currenttoken := token ;
+ currentstring := KeyToCharStar(str) ;
+ currentcolumn := col ;
+ currentinteger := int ;
+ IF Debugging
+ THEN
+ printf3('line %d (# %d %d) ', line, offset, CurrentTokNo)
+ END
END
+ ELSE
+ (* no inserted tokens after this token so read it and move on. *)
+ WITH b^.buf[offset] DO
+ currenttoken := token ;
+ currentstring := KeyToCharStar(str) ;
+ currentcolumn := col ;
+ currentinteger := int ;
+ IF Debugging
+ THEN
+ printf3('line %d (# %d %d) ', line, offset, CurrentTokNo)
+ END
+ END ;
+ INC (CurrentTokNo)
END
END UpdateFromBucket ;
+(*
+ DisplayTokenEntry -
+*)
+
+PROCEDURE DisplayTokenEntry (topBucket: TokenBucket; index, total: CARDINAL) ;
+VAR
+ i: CARDINAL ;
+BEGIN
+ printf1 ("%d: ", total) ;
+ DisplayToken (topBucket^.buf[index].token) ;
+ printf1 (" %a ", topBucket^.buf[index].str) ;
+ IF total = GetTokenNo ()
+ THEN
+ printf0 (" <- current token")
+ END ;
+ printf0 ("\n") ;
+ (* now check for inserted tokens. *)
+ IF topBucket^.buf[index].insert # NIL
+ THEN
+ i := 1 ;
+ WHILE i < topBucket^.buf[index].insert^.len DO
+ printf1 (" %d: ", i) ;
+ DisplayToken (topBucket^.buf[index].insert^.buf[i].token) ;
+ printf1 (" %a\n", topBucket^.buf[index].insert^.buf[i].str) ;
+ INC (i)
+ END
+ END
+END DisplayTokenEntry ;
+
+
+(*
+ DumpTokens - developer debugging aid.
+*)
+
+PROCEDURE DumpTokens ;
+VAR
+ tb : TokenBucket ;
+ i,
+ tokenNo,
+ total,
+ length : CARDINAL ;
+BEGIN
+ tokenNo := GetTokenNo () ;
+ tb := ListOfTokens.head ;
+ total := 0 ;
+ WHILE tb # NIL DO
+ length := tb^.len ;
+ i := 0 ;
+ WHILE i < length DO
+ DisplayTokenEntry (tb, i, total) ;
+ INC (i) ;
+ INC (total)
+ END ;
+ tb := tb^.next
+ END ;
+ printf2 ("%d: tokenNo, %d: total\n", tokenNo, total) ;
+ IF (total # 0) AND (tokenNo = total)
+ THEN
+ printf1 ("%d: end of buffer ", total) ;
+ printf0 (" <- current token") ;
+ printf0 ("\n") ;
+ END ;
+END DumpTokens ;
+
+
(*
GetToken - gets the next token into currenttoken.
*)
@@ -492,7 +618,7 @@ BEGIN
THEN
t := CurrentTokNo ;
b := FindTokenBucket(t) ;
- UpdateFromBucket(b, t)
+ UpdateFromBucket (b, t)
ELSE
IF ListOfTokens.tail=NIL
THEN
@@ -507,8 +633,8 @@ BEGIN
(* CurrentTokNo is in the last bucket or needs to be read *)
IF CurrentTokNo-ListOfTokens.LastBucketOffset<ListOfTokens.tail^.len
THEN
- UpdateFromBucket(ListOfTokens.tail,
- CurrentTokNo-ListOfTokens.LastBucketOffset)
+ UpdateFromBucket (ListOfTokens.tail,
+ CurrentTokNo-ListOfTokens.LastBucketOffset)
ELSE
(* call the lexical phase to place a new token into the last bucket *)
m2flex.GetToken () ;
@@ -520,12 +646,7 @@ BEGIN
b := FindTokenBucket (t) ;
UpdateFromBucket (b, t)
END
- END ;
- IF Debugging
- THEN
- DisplayToken (currenttoken)
- END ;
- INC (CurrentTokNo)
+ END
END GetToken ;
@@ -545,24 +666,60 @@ BEGIN
END SyncOpenWithBuffer ;
+(*
+ GetInsertBucket - returns the insertion bucket associated with token count
+ and the topBucket. It creates a new TokenBucket if necessary.
+*)
+
+PROCEDURE GetInsertBucket (topBucket: TokenBucket; count: CARDINAL) : TokenBucket ;
+BEGIN
+ IF topBucket^.buf[count].insert = NIL
+ THEN
+ NEW (topBucket^.buf[count].insert) ;
+ topBucket^.buf[count].insert^.buf[0] := topBucket^.buf[count] ;
+ topBucket^.buf[count].insert^.buf[0].insert := NIL ;
+ topBucket^.buf[count].insert^.len := 1 (* empty, slot 0 contains the original token for ease. *)
+ END ;
+ RETURN topBucket^.buf[count].insert
+END GetInsertBucket ;
+
+
+(*
+ AppendToken - appends desc to the end of the insertionBucket.
+*)
+
+PROCEDURE AppendToken (insertionBucket: TokenBucket; desc: TokenDesc) ;
+BEGIN
+ IF insertionBucket^.len < MaxBucketSize
+ THEN
+ insertionBucket^.buf[insertionBucket^.len] := desc ;
+ INC (insertionBucket^.len)
+ END
+END AppendToken ;
+
+
(*
InsertToken - inserts a symbol, token, infront of the current token
ready for the next pass.
*)
PROCEDURE InsertToken (token: toktype) ;
+VAR
+ topBucket, insertionBucket: TokenBucket ;
+ count : CARDINAL ;
+ desc : TokenDesc ;
BEGIN
- IF ListOfTokens.tail#NIL
+ Assert (ListOfTokens.tail # NIL) ;
+ count := GetTokenNo () -1 ;
+ topBucket := FindTokenBucket (count) ;
+ insertionBucket := GetInsertBucket (topBucket, count) ;
+ desc := topBucket^.buf[count] ;
+ desc.token := token ;
+ desc.insert := NIL ;
+ AppendToken (insertionBucket, desc) ;
+ IF DebugRecover
THEN
- WITH ListOfTokens.tail^ DO
- IF len>0
- THEN
- buf[len-1].token := token
- END
- END ;
- AddTokToList(currenttoken, NulName, 0,
- GetLineNo(), GetColumnNo(), CurrentSource, m2flex.GetLocation()) ;
- GetToken
+ DumpTokens
END
END InsertToken ;
@@ -573,18 +730,18 @@ END InsertToken ;
*)
PROCEDURE InsertTokenAndRewind (token: toktype) ;
+VAR
+ offset : CARDINAL ;
+ topBucket: TokenBucket ;
BEGIN
- IF ListOfTokens.tail#NIL
+ IF GetTokenNo () > 0
THEN
- WITH ListOfTokens.tail^ DO
- IF len>0
- THEN
- buf[len-1].token := token
- END
- END ;
- AddTokToList(currenttoken, NulName, 0,
- GetLineNo(), GetColumnNo(), CurrentSource, m2flex.GetLocation()) ;
- currenttoken := token
+ InsertToken (token) ;
+ offset := CurrentTokNo -2 ;
+ topBucket := FindTokenBucket (offset) ;
+ InsertionIndex := topBucket^.buf[offset].insert^.len -1 ;
+ DEC (CurrentTokNo, 2) ;
+ GetToken
END
END InsertTokenAndRewind ;
@@ -603,7 +760,7 @@ BEGIN
RETURN( 0 )
END
*)
- RETURN( GetLineNo() )
+ RETURN GetLineNo ()
END GetPreviousTokenLineNo ;
@@ -614,11 +771,11 @@ END GetPreviousTokenLineNo ;
PROCEDURE GetLineNo () : CARDINAL ;
BEGIN
- IF CurrentTokNo=0
+ IF CurrentTokNo = 0
THEN
- RETURN( 0 )
+ RETURN 0
ELSE
- RETURN( TokenToLineNo(GetTokenNo(), 0) )
+ RETURN TokenToLineNo (GetTokenNo (), 0)
END
END GetLineNo ;
@@ -630,11 +787,11 @@ END GetLineNo ;
PROCEDURE GetColumnNo () : CARDINAL ;
BEGIN
- IF CurrentTokNo=0
+ IF CurrentTokNo = 0
THEN
- RETURN( 0 )
+ RETURN 0
ELSE
- RETURN( TokenToColumnNo(GetTokenNo(), 0) )
+ RETURN TokenToColumnNo (GetTokenNo (), 0)
END
END GetColumnNo ;
@@ -645,7 +802,7 @@ END GetColumnNo ;
PROCEDURE GetTokenNo () : CARDINAL ;
BEGIN
- IF CurrentTokNo=0
+ IF CurrentTokNo = 0
THEN
RETURN 0
ELSE
@@ -663,7 +820,7 @@ VAR
b: TokenBucket ;
n: Name ;
BEGIN
- b := FindTokenBucket(tokenno) ;
+ b := FindTokenBucket (tokenno) ;
IF b=NIL
THEN
RETURN NulName
@@ -696,12 +853,12 @@ BEGIN
THEN
RETURN b
ELSE
- DEC(TokenNo, len)
+ DEC (TokenNo, len)
END
END ;
b := b^.next
END ;
- RETURN( NIL )
+ RETURN NIL
END FindTokenBucket ;
@@ -722,14 +879,14 @@ BEGIN
THEN
RETURN 0
ELSE
- b := FindTokenBucket(TokenNo) ;
- IF b=NIL
+ b := FindTokenBucket (TokenNo) ;
+ IF b = NIL
THEN
- RETURN( 0 )
+ RETURN 0
ELSE
- IF depth=0
+ IF depth = 0
THEN
- RETURN( b^.buf[TokenNo].line)
+ RETURN b^.buf[TokenNo].line
ELSE
l := b^.buf[TokenNo].file^.left ;
WHILE depth>0 DO
@@ -738,7 +895,7 @@ BEGIN
THEN
RETURN 0
END ;
- DEC(depth)
+ DEC (depth)
END ;
RETURN l^.line
END
@@ -764,14 +921,14 @@ BEGIN
THEN
RETURN 0
ELSE
- b := FindTokenBucket(TokenNo) ;
+ b := FindTokenBucket (TokenNo) ;
IF b=NIL
THEN
RETURN 0
ELSE
- IF depth=0
+ IF depth = 0
THEN
- RETURN( b^.buf[TokenNo].col )
+ RETURN b^.buf[TokenNo].col
ELSE
l := b^.buf[TokenNo].file^.left ;
WHILE depth>0 DO
@@ -780,7 +937,7 @@ BEGIN
THEN
RETURN 0
END ;
- DEC(depth)
+ DEC (depth)
END ;
RETURN l^.col
END
@@ -804,12 +961,12 @@ BEGIN
THEN
RETURN BuiltinsLocation ()
ELSE
- b := FindTokenBucket(TokenNo) ;
+ b := FindTokenBucket (TokenNo) ;
IF b=NIL
THEN
RETURN UnknownLocation ()
ELSE
- RETURN( b^.buf[TokenNo].loc )
+ RETURN b^.buf[TokenNo].loc
END
END
END TokenToLocation ;
@@ -828,7 +985,7 @@ VAR
b: TokenBucket ;
l: SourceList ;
BEGIN
- b := FindTokenBucket(TokenNo) ;
+ b := FindTokenBucket (TokenNo) ;
IF b=NIL
THEN
RETURN NIL
@@ -845,11 +1002,11 @@ BEGIN
l := l^.left ;
IF l=b^.buf[TokenNo].file^.left
THEN
- RETURN( NIL )
+ RETURN NIL
END ;
- DEC(depth)
+ DEC (depth)
END ;
- RETURN( l^.name )
+ RETURN l^.name
END
END
END FindFileNameFromToken ;
@@ -878,7 +1035,7 @@ PROCEDURE AddTokToList (t: toktype; n: Name;
BEGIN
IF ListOfTokens.head=NIL
THEN
- NEW(ListOfTokens.head) ;
+ NEW (ListOfTokens.head) ;
IF ListOfTokens.head=NIL
THEN
(* list error *)
@@ -888,7 +1045,7 @@ BEGIN
ELSIF ListOfTokens.tail^.len=MaxBucketSize
THEN
Assert(ListOfTokens.tail^.next=NIL) ;
- NEW(ListOfTokens.tail^.next) ;
+ NEW (ListOfTokens.tail^.next) ;
IF ListOfTokens.tail^.next=NIL
THEN
(* list error *)
@@ -896,20 +1053,21 @@ BEGIN
ListOfTokens.tail := ListOfTokens.tail^.next ;
ListOfTokens.tail^.len := 0
END ;
- INC(ListOfTokens.LastBucketOffset, MaxBucketSize)
+ INC (ListOfTokens.LastBucketOffset, MaxBucketSize)
END ;
WITH ListOfTokens.tail^ DO
next := NIL ;
WITH buf[len] DO
- token := t ;
- str := n ;
- int := i ;
- line := l ;
- col := c ;
- file := f ;
- loc := location
+ token := t ;
+ str := n ;
+ int := i ;
+ line := l ;
+ col := c ;
+ file := f ;
+ loc := location ;
+ insert := NIL ;
END ;
- INC(len)
+ INC (len)
END
END AddTokToList ;
@@ -1002,10 +1160,6 @@ BEGIN
AddTokToList (virtualrangetok, NulName, 0,
bufLeft^.buf[left].line, bufLeft^.buf[left].col, bufLeft^.buf[left].file,
GetLocationBinary (lc, ll, lr)) ;
- IF ListOfTokens.LastBucketOffset + ListOfTokens.tail^.len - 1 = 2862
- THEN
- stop
- END ;
RETURN ListOfTokens.LastBucketOffset + ListOfTokens.tail^.len - 1
END
END ;
@@ -1050,10 +1204,6 @@ END AddTok ;
PROCEDURE AddTokCharStar (t: toktype; s: ADDRESS) ;
BEGIN
- IF strlen(s)>80
- THEN
- stop
- END ;
AddTokToList(t, makekey(s), 0, m2flex.GetLineNo(),
m2flex.GetColumnNo(), CurrentSource, m2flex.GetLocation()) ;
CurrentUsed := TRUE
diff --git a/gcc/m2/gm2-compiler/M2MetaError.mod b/gcc/m2/gm2-compiler/M2MetaError.mod
index 4289e5ec862..6bb5f6aa832 100644
--- a/gcc/m2/gm2-compiler/M2MetaError.mod
+++ b/gcc/m2/gm2-compiler/M2MetaError.mod
@@ -976,6 +976,7 @@ BEGIN
ELSE
IF IsProcedure (scope)
THEN
+ M2Error.DefaultProcedure ;
M2Error.EnterProcedureScope (GetSymName (scope)) ;
doError (eb, GetDeclaredMod (sym)) ;
ELSE
@@ -983,9 +984,11 @@ BEGIN
THEN
IF IsInnerModule (scope)
THEN
+ M2Error.DefaultInnerModule ;
M2Error.EnterModuleScope (GetSymName (scope)) ;
doError (eb, GetDeclaredMod (sym))
ELSE
+ M2Error.DefaultProgramModule ;
M2Error.EnterProgramScope (GetSymName (scope)) ;
doError (eb, GetDeclaredMod (sym))
END
@@ -997,9 +1000,11 @@ BEGIN
UNTIL GetScope(OuterModule)=NulSym ; *)
IF GetDeclaredModule (sym) = UnknownTokenNo
THEN
+ M2Error.DefaultDefinitionModule ;
M2Error.EnterDefinitionScope (GetSymName (scope)) ;
doError (eb, GetDeclaredDef (sym))
ELSE
+ M2Error.DefaultImplementationModule ;
M2Error.EnterImplementationScope (GetSymName (scope)) ;
doError (eb, GetDeclaredMod (sym))
END
@@ -1027,6 +1032,7 @@ BEGIN
ELSE
IF IsProcedure (scope)
THEN
+ M2Error.DefaultProcedure ;
M2Error.EnterProcedureScope (GetSymName (scope)) ;
doError (eb, GetDeclaredDef (sym)) ;
ELSE
@@ -1034,9 +1040,11 @@ BEGIN
THEN
IF IsInnerModule (scope)
THEN
+ M2Error.DefaultInnerModule ;
M2Error.EnterModuleScope (GetSymName (scope)) ;
doError (eb, GetDeclaredDef (sym))
ELSE
+ M2Error.DefaultProgramModule ;
M2Error.EnterProgramScope (GetSymName (scope)) ;
doError (eb, GetDeclaredDef (sym))
END
@@ -1048,9 +1056,11 @@ BEGIN
UNTIL GetScope(OuterModule)=NulSym ; *)
IF GetDeclaredDefinition (sym) = UnknownTokenNo
THEN
+ M2Error.DefaultImplementationModule ;
M2Error.EnterImplementationScope (GetSymName (scope)) ;
doError (eb, GetDeclaredMod (sym))
ELSE
+ M2Error.DefaultDefinitionModule ;
M2Error.EnterDefinitionScope (GetSymName (scope)) ;
doError (eb, GetDeclaredDef (sym))
END
diff --git a/gcc/m2/gm2-compiler/P0SymBuild.mod b/gcc/m2/gm2-compiler/P0SymBuild.mod
index bf36a7a96b3..5bde3d1edf4 100644
--- a/gcc/m2/gm2-compiler/P0SymBuild.mod
+++ b/gcc/m2/gm2-compiler/P0SymBuild.mod
@@ -41,8 +41,7 @@ CONST
TYPE
Kind = (module, program, defimp, inner, procedure, universe, unknown) ;
- BlockInfoPtr = POINTER TO BlockInfo ;
- BlockInfo = RECORD
+ BlockInfoPtr = POINTER TO RECORD
name : Name ;
kind : Kind ;
sym : CARDINAL ;
@@ -383,14 +382,14 @@ VAR
sym: CARDINAL ;
tok: CARDINAL ;
BEGIN
- Assert(Level=0) ;
- INC(Level) ;
+ Assert (Level=0) ;
+ INC (Level) ;
PopTtok (n, tok) ;
PushTtok (n, tok) ;
- sym := MakeProgramSource(tok, n) ;
- SetCurrentModule(sym) ;
- SetFileModule(sym) ;
- BeginBlock(n, program, sym, tok) ;
+ sym := MakeProgramSource (tok, n) ;
+ SetCurrentModule (sym) ;
+ SetFileModule (sym) ;
+ BeginBlock (n, program, sym, tok) ;
M2Error.EnterProgramScope (n)
END RegisterProgramModule ;
@@ -405,14 +404,14 @@ VAR
sym: CARDINAL ;
tok: CARDINAL ;
BEGIN
- Assert(Level=0) ;
- INC(Level) ;
+ Assert (Level=0) ;
+ INC (Level) ;
PopTtok (n, tok) ;
PushTtok (n, tok) ;
- sym := MakeImplementationSource(tok, n) ;
- SetCurrentModule(sym) ;
- SetFileModule(sym) ;
- BeginBlock(n, defimp, sym, tok) ;
+ sym := MakeImplementationSource (tok, n) ;
+ SetCurrentModule (sym) ;
+ SetFileModule (sym) ;
+ BeginBlock (n, defimp, sym, tok) ;
M2Error.EnterImplementationScope (n)
END RegisterImplementationModule ;
@@ -431,10 +430,10 @@ BEGIN
INC(Level) ;
PopTtok (n, tok) ;
PushTtok (n, tok) ;
- sym := MakeDefinitionSource(tok, n) ;
- SetCurrentModule(sym) ;
- SetFileModule(sym) ;
- BeginBlock(n, defimp, sym, tok) ;
+ sym := MakeDefinitionSource (tok, n) ;
+ SetCurrentModule (sym) ;
+ SetFileModule (sym) ;
+ BeginBlock (n, defimp, sym, tok) ;
M2Error.EnterDefinitionScope (n)
END RegisterDefinitionModule ;
@@ -453,8 +452,8 @@ BEGIN
INC(Level) ;
PopTtok (n, tok) ;
PushTtok (n, tok) ;
- RegisterLocalModule(n) ;
- BeginBlock(n, inner, NulSym, tok) ;
+ RegisterLocalModule (n) ;
+ BeginBlock (n, inner, NulSym, tok) ;
M2Error.EnterModuleScope (n)
END RegisterInnerModule ;
diff --git a/gcc/testsuite/gm2/recover/begin.mod b/gcc/testsuite/gm2/recover/pass/cannot-solve/begin.mod
similarity index 89%
rename from gcc/testsuite/gm2/recover/begin.mod
rename to gcc/testsuite/gm2/recover/pass/cannot-solve/begin.mod
index b2c5a4a7ac4..a0e756d8327 100644
--- a/gcc/testsuite/gm2/recover/begin.mod
+++ b/gcc/testsuite/gm2/recover/pass/cannot-solve/begin.mod
@@ -1,4 +1,4 @@
-(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. *)
+(* Copyright (C) 2001-2021 Free Software Foundation, Inc. *)
(* This file is part of GNU Modula-2.
GNU Modula-2 is free software; you can redistribute it and/or modify it under
@@ -14,16 +14,17 @@ for more details.
You should have received a copy of the GNU General Public License along
with gm2; see the file COPYING. If not, write to the Free Software
Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *)
+
MODULE begin ;
(*
- foo -
+ foo -
*)
PROCEDURE foo (a, b: CARDINAL) ;
a := a + b
-
+
END foo ;
diff --git a/gcc/testsuite/gm2/recover/pass/cannot-solve/statementsemi.mod b/gcc/testsuite/gm2/recover/pass/cannot-solve/statementsemi.mod
new file mode 100644
index 00000000000..6e33f2367a6
--- /dev/null
+++ b/gcc/testsuite/gm2/recover/pass/cannot-solve/statementsemi.mod
@@ -0,0 +1,12 @@
+MODULE statementsemi ;
+
+VAR
+ x, y: CARDINAL ;
+BEGIN
+ x := 0 ;
+ y := 10 ;
+ WHILE x < y DO
+ INC (x) (* missing semicolon *)
+ INC (x)
+ END
+END statementsemi.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/recover/end2.mod b/gcc/testsuite/gm2/recover/pass/end2.mod
similarity index 90%
rename from gcc/testsuite/gm2/recover/end2.mod
rename to gcc/testsuite/gm2/recover/pass/end2.mod
index 5450a75b7f1..401d464be78 100644
--- a/gcc/testsuite/gm2/recover/end2.mod
+++ b/gcc/testsuite/gm2/recover/pass/end2.mod
@@ -1,4 +1,4 @@
-(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. *)
+(* Copyright (C) 2001-2021 Free Software Foundation, Inc. *)
(* This file is part of GNU Modula-2.
GNU Modula-2 is free software; you can redistribute it and/or modify it under
@@ -14,6 +14,7 @@ for more details.
You should have received a copy of the GNU General Public License along
with gm2; see the file COPYING. If not, write to the Free Software
Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *)
+
MODULE end2 ;
BEGIN
diff --git a/gcc/testsuite/gm2/recover/of.mod b/gcc/testsuite/gm2/recover/pass/of.mod
similarity index 90%
rename from gcc/testsuite/gm2/recover/of.mod
rename to gcc/testsuite/gm2/recover/pass/of.mod
index 9a9f320a817..11581bf9c38 100644
--- a/gcc/testsuite/gm2/recover/of.mod
+++ b/gcc/testsuite/gm2/recover/pass/of.mod
@@ -1,4 +1,4 @@
-(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. *)
+(* Copyright (C) 2001-2021 Free Software Foundation, Inc. *)
(* This file is part of GNU Modula-2.
GNU Modula-2 is free software; you can redistribute it and/or modify it under
@@ -14,6 +14,7 @@ for more details.
You should have received a copy of the GNU General Public License along
with gm2; see the file COPYING. If not, write to the Free Software
Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *)
+
MODULE of ;
VAR
diff --git a/gcc/testsuite/gm2/recover/pass/procsemi.mod b/gcc/testsuite/gm2/recover/pass/procsemi.mod
new file mode 100644
index 00000000000..1d944d921f1
--- /dev/null
+++ b/gcc/testsuite/gm2/recover/pass/procsemi.mod
@@ -0,0 +1,10 @@
+MODULE procsemi ;
+
+PROCEDURE foo (* missing semicolon here. *)
+BEGIN
+
+END foo ;
+
+BEGIN
+ foo
+END procsemi.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/recover/pass/recover-pass.exp b/gcc/testsuite/gm2/recover/pass/recover-pass.exp
new file mode 100644
index 00000000000..da54520c03d
--- /dev/null
+++ b/gcc/testsuite/gm2/recover/pass/recover-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2004-2021 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GCC; see the file COPYING3. If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+ strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_log
+
+foreach testcase [lsort [glob -nocomplain $srcdir/../gm2/gm2-libs-pim/*.mod]] {
+ # If we're only testing specific files and this isn't one of them, skip it.
+ if ![runtest_file_p $runtests $testcase] then {
+ continue
+ }
+
+ gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/recover/pass/rrbra.mod b/gcc/testsuite/gm2/recover/pass/rrbra.mod
new file mode 100644
index 00000000000..7aac91acee5
--- /dev/null
+++ b/gcc/testsuite/gm2/recover/pass/rrbra.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2021 Free Software Foundation, Inc. *)
+(* This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 2, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING. If not, write to the Free Software
+Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *)
+
+MODULE rrbra ;
+
+VAR
+ c: CARDINAL ;
+BEGIN
+ c := ((2 + 4) DIV 2 (* missing ) *)
+END rrbra.
diff --git a/gcc/testsuite/gm2/recover/rsbra.mod b/gcc/testsuite/gm2/recover/pass/rsbra.mod
similarity index 90%
rename from gcc/testsuite/gm2/recover/rsbra.mod
rename to gcc/testsuite/gm2/recover/pass/rsbra.mod
index 441d25cafad..16813bcbd38 100644
--- a/gcc/testsuite/gm2/recover/rsbra.mod
+++ b/gcc/testsuite/gm2/recover/pass/rsbra.mod
@@ -1,4 +1,4 @@
-(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. *)
+(* Copyright (C) 2001-2021 Free Software Foundation, Inc. *)
(* This file is part of GNU Modula-2.
GNU Modula-2 is free software; you can redistribute it and/or modify it under
@@ -14,6 +14,7 @@ for more details.
You should have received a copy of the GNU General Public License along
with gm2; see the file COPYING. If not, write to the Free Software
Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *)
+
MODULE rsbra ;
VAR
diff --git a/gcc/testsuite/gm2/recover/semi.mod b/gcc/testsuite/gm2/recover/pass/semi.mod
similarity index 88%
rename from gcc/testsuite/gm2/recover/semi.mod
rename to gcc/testsuite/gm2/recover/pass/semi.mod
index 7695f0b5e9a..4ae8b639944 100644
--- a/gcc/testsuite/gm2/recover/semi.mod
+++ b/gcc/testsuite/gm2/recover/pass/semi.mod
@@ -1,4 +1,4 @@
-(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. *)
+(* Copyright (C) 2001-2021 Free Software Foundation, Inc. *)
(* This file is part of GNU Modula-2.
GNU Modula-2 is free software; you can redistribute it and/or modify it under
@@ -14,7 +14,8 @@ for more details.
You should have received a copy of the GNU General Public License along
with gm2; see the file COPYING. If not, write to the Free Software
Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *)
-MODULE semi
+
+MODULE semi
BEGIN
END semi.
diff --git a/gm2tools/Makefile.in b/gm2tools/Makefile.in
index 386f2e4163a..d228a6a9b39 100644
--- a/gm2tools/Makefile.in
+++ b/gm2tools/Makefile.in
@@ -639,8 +639,8 @@ distclean-generic:
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
-@NATIVE_FALSE@uninstall-local:
@NATIVE_FALSE@install-exec-local:
+@NATIVE_FALSE@uninstall-local:
clean: clean-am
clean-am: clean-binPROGRAMS clean-generic mostlyclean-am
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-12-17 12:36 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-12-17 12:36 [gcc/devel/modula-2] Bug fixes for error scope announcement and error recovery Gaius Mulley
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).