public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/modula-2] First working commit of the new scaffold implementation.
@ 2022-07-07 16:02 Gaius Mulley
0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2022-07-07 16:02 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:c196fa13e030f0033dcd84faea150b26a9b6ed39
commit c196fa13e030f0033dcd84faea150b26a9b6ed39
Author: Gaius Mulley <gaius.mulley@southwales.ac.uk>
Date: Thu Jul 7 15:58:02 2022 +0100
First working commit of the new scaffold implementation.
A large commit consisting of a re-implementing of the scaffold
generation for modula-2. The changes allow the compiler
to be built, installed and hello world can be compiled and linked.
The default scaffold generated by modula-2 is propagated to M2RTS
via ctors. At runtime M2RTS resolves the dependency import graph
and calls each module init/fini code.
2022-06-20 Gaius Mulley <gaius.mulley@southwales.ac.uk>
gcc/ChangeLog:
* doc/gm2.texi: Replaced English spelling to American.
(-fscaffold-static) New option documented. (-fscaffold-dynamic)
New option documented. (-fscaffold-c) New option documented.
(-fscaffold-c++) New option documented.
gcc/m2/ChangeLog:
* Make-lang.in (stage1/m2/cc1gm2$(exeext)): M2LINK.o added.
(GM2-LIBS-BOOT-MODS) M2Dependent.mod added. (GM2-COMP-BOOT-MODS)
M2Scaffold.mod added. (GM2-LIBS-DEFS) M2Dependent.def added.
(GM2-LIBS-MODS) added. (GM2-COMP-DEFS) M2Scaffold.def added.
(GM2-COMP-MODS) M2Scaffold.mod added.
(m2/gm2-libs-boot/M2LINK.o) New rule. (stage1/m2/gm2l$(exeext))
added M2LINK.o. (stage1/m2/gm2lcc$(exeext)) added M2LINK.o
(stage1/m2/gm2lcc$(exeext)) added M2LINK.o.
(stage1/m2/gm2lgen$(exeext)) added M2LINK.o.
(stage1/m2/gm2lgen$(exeext)) added M2Link.o.
(stage1/m2/gm2lorder$(exeext)) added M2Link.o.
(stage1/m2/gm2m$(exeext)) added M2Link.o.
(MC-LIB-DEFS) M2LINK.def added. (MC-INTERFACE-C)
M2LINK.c added. (PPG-LIB-DEFS) M2Dependent.def added.
(PPG-LIB-MODS) M2Dependent.mod added.
(m2/gm2-ppg-boot/$(SRC_PREFIX)%.o) search m2/gm2-libs-boot.
(m2/ppg$(exeext)) added M2LINK.o.
(m2/gm2-pg-boot/$(SRC_PREFIX)%.o) added M2LINK.o.
(m2/gm2-pge-boot/$(SRC_PREFIX)%.o) added M2LINK.o.
* bnf/m2-1.bnf: Added production rules to record import
statements and module dependents.
* bnf/m2-2.bnf: Added production rules to record block
begin/end pairs.
* bnf/m2-3.bnf (ProgramModule): Call BuildScaffold.
(ImplementationModule) Call BuildScaffold.
* gm2-compiler/M2Base.mod: Reformatted.
* gm2-compiler/M2GCCDeclare.mod (DeclareProcedureToGcc):
Re-implemented. (DeclareModuleInit) re-implemented.
* gm2-compiler/M2GenGCC.mod (IsExportedGcc): Check IsPublic.
(CallInnerInit) get init function using GetModuleCtors
and build call to init. (CallInnerFinally) get fini
function using GetModuleCtors and build call to fini.
(CodeInitEnd) call GetModuleCtors and finish call to init.
(CodeFinallyStart) call GetModuleCtors and start function fini.
(CodeFinallyEnd) call GetModuleCtors and finish function fini.
Call DeclareM2linkGlobals to set the ScaffoldStatic and
ForcedModuleInitOrder variables in the main program.
(CodeKillLocalVar) test the procedure is a ctor if so call
DeclareModuleCtor and BuildModuleCtor.
(ConvertForComparison) Removed. (DetermineFieldOf) Removed.
* gm2-compiler/M2MetaError.mod: Added import of Storage.
* gm2-compiler/M2Options.def (ScaffoldDynamic): New procedure.
(ScaffoldStatic) New procedure. (SetScaffoldDynamic) New procedure.
(SetScaffoldStatic) New procedure. (SetScaffoldMain) New
procedure. (ScaffoldMain) New procedure.
(SetRuntimeModuleOverride) New procedure.
(GetRuntimeModuleOverride) New procedure.
* gm2-compiler/M2Options.mod: (ScaffoldDynamic): New procedure
implemented. (ScaffoldStatic) New procedure implemented.
(SetScaffoldDynamic) New procedure implemented.
(SetScaffoldStatic) New procedure implemented.
(SetScaffoldMain) New procedure implemented.
(ScaffoldMain) New procedure implemented.
(SetRuntimeModuleOverride) New procedure implemented.
(GetRuntimeModuleOverride) New procedure implemented.
* gm2-compiler/M2Quads.def (BuildScaffold) New procedure defined.
* gm2-compiler/M2Quads.mod (BuildScaffold) New procedure
implemented. (callRequestDependant) New procedure.
(ForeachImportedModuleDo) New procedure. (BuildM2DepFunction)
New procedure. (BuildM2MainFunction) New procedure.
(BuildM2InitFunction) New procedure. (BuildM2FiniFunction)
New procedure. (BuildM2CtorFunction) New procedure.
(BuildScaffold) New procedure. (GetQualidentImport) use %1a
rather than %Ea.
* gm2-compiler/P1SymBuild.def (BuildImportStatement): New
procedure definition. (AddImportToImportStatement) New
procedure definition.
* gm2-compiler/P1SymBuild.mod: (BuildImportStatement): New
procedure implementation. (AddImportToImportStatement) New
procedure implementation.
* gm2-compiler/P2SymBuild.def (BlockStart): New procedure
definition. (BlockEnd) New procedure definition.
(BlockBegin) New procedure definition. (BlockFinally)
New procedure definition.
* gm2-compiler/P2SymBuild.mod (BlockStart): New procedure
implementation. (BlockEnd) New procedure implementation.
(BlockBegin) New procedure implementation. (BlockFinally)
New procedure implementation.
* gm2-compiler/SymbolTable.def (MakeModuleCtor):
New procedure definition. (PutPublic) New procedure.
(IsPublic) New procedure. (PutCtor) New procedure.
(IsCtor) New procedure. (GetModuleCtors) New procedure.
(MakeModuleCtor) New procedure. (MakeImport) New procedure.
(MakeImportStatement) New procedure. (IsImport) New procedure.
(IsImportStatement) New procedure. (GetImportModule) New
procedure. (GetImportDeclared) New procedure.
(GetImportStatementList) New procedure.
(GetModuleDefImportStatementList) New procedure.
(GetModuleModImportStatementList) New procedure.
(AppendModuleImportStatement) New procedure.
(AppendModuleOnImportStatement) New procedure.
* gm2-compiler/SymbolTable.mod (MakeModuleCtor):
New procedure definition. (PutPublic) New procedure.
(IsPublic) New procedure. (PutCtor) New procedure.
(IsCtor) New procedure. (GetModuleCtors) New procedure.
(MakeModuleCtor) New procedure. (MakeImport) New procedure.
(MakeImportStatement) New procedure. (IsImport) New procedure.
(IsImportStatement) New procedure. (GetImportModule) New
procedure. (GetImportDeclared) New procedure.
(GetImportStatementList) New procedure.
(GetModuleDefImportStatementList) New procedure.
(GetModuleModImportStatementList) New procedure.
(AppendModuleImportStatement) New procedure.
(AppendModuleOnImportStatement) New procedure.
* gm2-gcc/m2decl.cc (DeclareM2linkGlobals) New function
implementation.
(BuildModuleCtor) New function implementation.
(DeclareModuleCtor) New function implementation.
* gm2-gcc/m2decl.def (DeclareM2linkGlobals) New function.
(BuildModuleCtor) New function. (DeclareModuleCtor)
New function.
* gm2-gcc/m2decl.h (DeclareM2linkGlobals) New function.
(BuildModuleCtor) New function. (DeclareModuleCtor)
New function.
* gm2-gcc/m2options.h (SetScaffoldStatic) New function.
(SetScaffoldDynamic) New function. (SetScaffoldMain)
New function. (SetRuntimeModuleOverride) New function.
* gm2-lang.cc (fscaffold_dynamic) Handle option.
(fscaffold_static) Handle option. (fscaffold_main)
Handle option. (fonlylink) Commented out.
* gm2-libs-iso/M2RTS.def (ConstructModules) New procedure.
(DeconstructModules) New procedure. (RegisterModule)
New procedure. (RequestDependant) New procedure.
* gm2-libs-iso/M2RTS.mod (ConstructModules) New procedure.
(DeconstructModules) New procedure. (RegisterModule)
New procedure. (RequestDependant) New procedure.
Replace termination and initial procedures using a dynamic
data structure. Call upon M2Dependent to solve module
dependencies.
* gm2-libs/M2RTS.def (ConstructModules) New procedure.
(DeconstructModules) New procedure. (RegisterModule)
New procedure. (RequestDependant) New procedure.
* gm2-libs/M2RTS.mod (ConstructModules) New procedure.
(DeconstructModules) New procedure. (RegisterModule)
New procedure. (RequestDependant) New procedure.
Replace termination and initial procedures using a dynamic
data structure. Call upon M2Dependent to solve module
dependencies.
* gm2spec.cc (check_gm2_root): Commented out.
(add_exec_prefix) Commented out. (fonlylink) Commented out.
(fmakeall) Commented out. (fmakeall0) Commented out.
(add_exec_prefix) Commented out. (lang_register_spec_functions)
body commented out.
* lang-specs.h (m2-link-support.h) no longer included.
(M2CPP) defined.
* lang.opt (fuselist) New description. (fmakelist)
New description. (fonlylink) removed. (fscaffold-static)
New option. (fscaffold-dynamic) New option. (ftarget-ranlib=)
Removed. (fscaffold-c) New option. (fscaffold-c++) New option.
(fscaffold-main) New option.
* mc-boot-ch/GM2LINK.c: New file.
* mc-boot/GAssertion.h: Rebuilt.
* mc-boot/GDynamicStrings.c: Rebuilt.
* mc-boot/GDynamicStrings.h: Rebuilt.
* mc-boot/GEnvironment.h: Rebuilt.
* mc-boot/GFIO.c: Rebuilt.
* mc-boot/GFIO.h: Rebuilt.
* mc-boot/GFormatStrings.h: Rebuilt.
* mc-boot/GIndexing.c: Rebuilt.
* mc-boot/GM2EXCEPTION.c: Rebuilt.
* mc-boot/GM2RTS.c: Rebuilt.
* mc-boot/GM2RTS.h: Rebuilt.
* mc-boot/GPushBackInput.c: Rebuilt.
* mc-boot/GRTExceptions.c: Rebuilt.
* mc-boot/GRTint.c: Rebuilt.
* mc-boot/GSYSTEM.h: Rebuilt.
* mc-boot/GStdIO.c: Rebuilt.
* mc-boot/GStringConvert.c: Rebuilt.
* mc-boot/GSysStorage.c:
* mc-boot/Gdecl.c: Rebuilt.
* mc-boot/Gkeyc.c: Rebuilt.
* mc-boot/GmcComment.c: Rebuilt.
* mc-boot/GmcComp.c: Rebuilt.
* mc-boot/GmcDebug.c: Rebuilt.
* mc-boot/GmcMetaError.c: Rebuilt.
* mc-boot/GmcStack.c: Rebuilt.
* mc-boot/GnameKey.c: Rebuilt.
* mc-boot/GsymbolKey.c: Rebuilt.
* mc/decl.mod (isLastStatement) Check if n = NIL
* mc/mcComp.mod: Change spelling to initialization.
and return FALSE.
* tools-src/makeSystem (MINIMAL): New variable.
Use MINIMAL when invoking gm2 to generate the SYSTEM exports.
libgm2/Changelog:
* libm2min/Makefile.am (libm2min_la_M2FLAGS):
Added -fno-scaffold-dynamic -fno-scaffold-main.
* libm2pim/Makefile.am (M2DEFS): Added M2LINK.def.
Signed-off-by: Gaius Mulley <gaius.mulley@southwales.ac.uk>
Diff:
---
gcc/doc/gm2.texi | 31 +-
gcc/m2/Make-lang.in | 116 ++--
gcc/m2/bnf/m2-1.bnf | 34 +-
gcc/m2/bnf/m2-2.bnf | 15 +-
gcc/m2/bnf/m2-3.bnf | 8 +-
gcc/m2/gm2-compiler/M2Base.mod | 14 +-
gcc/m2/gm2-compiler/M2GCCDeclare.mod | 77 +--
gcc/m2/gm2-compiler/M2GenGCC.mod | 293 ++++------
gcc/m2/gm2-compiler/M2MetaError.mod | 1 +
gcc/m2/gm2-compiler/M2Options.def | 92 +++-
gcc/m2/gm2-compiler/M2Options.mod | 89 +++-
gcc/m2/gm2-compiler/M2Quads.def | 10 +-
gcc/m2/gm2-compiler/M2Quads.mod | 371 ++++++++++++-
gcc/m2/gm2-compiler/P1SymBuild.def | 34 +-
gcc/m2/gm2-compiler/P1SymBuild.mod | 75 ++-
gcc/m2/gm2-compiler/P2SymBuild.def | 28 +
gcc/m2/gm2-compiler/P2SymBuild.mod | 111 +++-
gcc/m2/gm2-compiler/SymbolTable.def | 188 ++++++-
gcc/m2/gm2-compiler/SymbolTable.mod | 537 ++++++++++++++++++-
gcc/m2/gm2-gcc/m2decl.cc | 61 ++-
gcc/m2/gm2-gcc/m2decl.def | 28 +
gcc/m2/gm2-gcc/m2decl.h | 4 +
gcc/m2/gm2-gcc/m2options.h | 4 +
gcc/m2/gm2-gcc/m2statement.cc | 29 +-
gcc/m2/gm2-gcc/m2statement.def | 15 -
gcc/m2/gm2-gcc/m2statement.h | 2 -
gcc/m2/gm2-lang.cc | 15 +-
gcc/m2/gm2-libs-iso/M2RTS.def | 33 +-
gcc/m2/gm2-libs-iso/M2RTS.mod | 334 ++++++++----
gcc/m2/gm2-libs/M2RTS.def | 50 +-
gcc/m2/gm2-libs/M2RTS.mod | 241 ++++++---
gcc/m2/gm2spec.cc | 11 +-
gcc/m2/lang-specs.h | 9 +-
gcc/m2/lang.opt | 28 +-
gcc/m2/mc-boot/GAssertion.h | 3 +-
gcc/m2/mc-boot/GDynamicStrings.c | 32 +-
gcc/m2/mc-boot/GDynamicStrings.h | 44 +-
gcc/m2/mc-boot/GEnvironment.h | 3 +-
gcc/m2/mc-boot/GFIO.c | 34 +-
gcc/m2/mc-boot/GFIO.h | 23 +-
gcc/m2/mc-boot/GFormatStrings.h | 11 +-
gcc/m2/mc-boot/GIndexing.c | 6 +-
gcc/m2/mc-boot/GM2EXCEPTION.c | 4 +-
gcc/m2/mc-boot/GM2RTS.c | 998 +++++++++++++++++++++++++++++++++--
gcc/m2/mc-boot/GM2RTS.h | 22 +
gcc/m2/mc-boot/GPushBackInput.c | 6 +-
gcc/m2/mc-boot/GRTExceptions.c | 34 +-
gcc/m2/mc-boot/GRTint.c | 20 +-
gcc/m2/mc-boot/GSYSTEM.h | 19 +-
gcc/m2/mc-boot/GStdIO.c | 4 +-
gcc/m2/mc-boot/GStringConvert.c | 4 +-
gcc/m2/mc-boot/GSysStorage.c | 6 +-
gcc/m2/mc-boot/Gdecl.c | 150 +++---
gcc/m2/mc-boot/Gkeyc.c | 2 +-
| 2 +-
gcc/m2/mc-boot/GmcComp.c | 8 +-
gcc/m2/mc-boot/GmcDebug.c | 2 +-
gcc/m2/mc-boot/GmcMetaError.c | 8 +-
gcc/m2/mc-boot/GmcStack.c | 4 +-
gcc/m2/mc-boot/GnameKey.c | 4 +-
gcc/m2/mc-boot/GsymbolKey.c | 6 +-
gcc/m2/mc/decl.mod | 5 +-
gcc/m2/mc/mcComp.mod | 4 +-
gcc/m2/tools-src/makeSystem | 8 +-
libgm2/libm2min/Makefile.am | 3 +-
libgm2/libm2pim/Makefile.am | 3 +-
66 files changed, 3591 insertions(+), 879 deletions(-)
diff --git a/gcc/doc/gm2.texi b/gcc/doc/gm2.texi
index fb12f91bb9f..0491b044f63 100644
--- a/gcc/doc/gm2.texi
+++ b/gcc/doc/gm2.texi
@@ -737,12 +737,11 @@ compiler will generate a @file{modulename.lst} file which contains a
list indicating the initialisation order of all modules which are to
be linked. The actual link does not occur. The GNU Modula-2 linker
scans all @code{IMPORT}s, generates a list of dependencies and
-produces an ordered list for initialisation. It will probably get the
-order wrong if your project has cyclic dependencies, but the
+produces an ordered list for initialization.
+This might be useful should your project has cyclic dependencies as the
@file{.lst} file is plain text and can be modified if required. Once
the @file{.lst} file is created it can be used by the compiler to link
-your project via the @samp{-fuselist} option. It has no effect if the
-@samp{-c} option is present.
+your project via the @samp{-fuselist} option.
@item fno-pthread
do not automatically link against the pthread library. This option is
@@ -753,9 +752,31 @@ module).
@item -fuselist
providing @samp{gm2} has been told to link the program module this
-option uses the file @file{modulename.lst} for the initialisation
+option uses the file @file{modulename.lst} for the initialization
order of modules.
+@item -fscaffold-static
+the option ensures that @samp{gm2} will generate a static scaffold
+within the program module. The static scaffold is useful for
+debugging and single stepping the initialization blocks of
+implementation modules.
+
+@item -fscaffold-dynamic
+the option ensures that @samp{gm2} will generate a dynamic scaffold
+infastructure when compiling implementation and program modules.
+By default this option is on. Use @samp{-fno-scaffold-dynamic}
+to turn it off or select @samp{-fno-scaffold-dynamic}.
+
+@item -fscaffold-c
+this option generates a C source scaffold file for the program module.
+This file can be compiled and linked with the module objects to
+produce the application.
+
+@item -fscaffold-c++
+this option generates a C++ source scaffold file for the program module.
+This file can be compiled and linked with the module objects to
+produce the application.
+
@item -fcpp
preprocess the source with @samp{cpp -lang-asm -traditional-cpp}
For further details about these options @xref{Invocation, , ,cpp}.
diff --git a/gcc/m2/Make-lang.in b/gcc/m2/Make-lang.in
index fddd7934454..4832eb671db 100644
--- a/gcc/m2/Make-lang.in
+++ b/gcc/m2/Make-lang.in
@@ -576,11 +576,14 @@ stage2/m2/cc1gm2$(exeext): stage1/m2/cc1gm2$(exeext) m2/gm2-compiler/m2flex.o $(
stage1/m2/cc1gm2$(exeext): gm2$(exeext) m2/gm2-compiler-boot/m2flex.o \
$(P) $(GM2_C_OBJS) $(BACKEND) $(LIBDEPS) \
$(GM2_LIBS_BOOT) $(MC_LIBS) \
- m2/gm2-gcc/rtegraph.o plugin/m2rte$(exeext).so $(m2.prev)
+ m2/gm2-gcc/rtegraph.o plugin/m2rte$(exeext).so \
+ m2/gm2-libs-boot/M2LINK.o \
+ $(m2.prev)
@$(call LINK_PROGRESS,$(INDEX.m2),start)
+$(LLINKER) $(ALL_CFLAGS) $(LDFLAGS) -o $@ $(GM2_C_OBJS) m2/gm2-compiler-boot/m2flex.o \
attribs.o \
- $(GM2_LIBS_BOOT) $(MC_LIBS) m2/gm2-gcc/rtegraph.o \
+ $(GM2_LIBS_BOOT) $(MC_LIBS) \
+ m2/gm2-gcc/rtegraph.o m2/gm2-libs-boot/M2LINK.o \
$(BACKEND) $(LIBS) $(BACKENDLIBS)
@$(call LINK_PROGRESS,$(INDEX.m2),end)
@@ -634,7 +637,7 @@ GM2-LIBS-BOOT-DEFS = ASCII.def IO.def Args.def M2RTS.def
StringConvert.def M2EXCEPTION.def RTExceptions.def \
dtoa.def ldtoa.def termios.def errno.def \
SysExceptions.def Indexing.def libc.def \
- libm.def
+ libm.def M2LINK.def M2Dependent.def
GM2-LIBS-BOOT-MODS = ASCII.mod IO.mod Args.mod Assertion.mod \
NumberIO.mod Break.mod CmdArgs.mod Scan.mod \
@@ -646,7 +649,7 @@ GM2-LIBS-BOOT-MODS = ASCII.mod IO.mod Args.mod Assertion.m
FormatStrings.mod PushBackInput.mod \
SEnvironment.mod StringConvert.mod \
M2EXCEPTION.mod RTExceptions.mod \
- Indexing.mod
+ Indexing.mod M2Dependent.mod
GM2-LIBS-BOOT-C = wrapc.c UnixArgs.c StdIO.c \
choosetemp.c dtoa.c ldtoa.c termios.c \
@@ -673,7 +676,7 @@ GM2-COMP-BOOT-DEFS = FifoQueue.def M2Debug.def M2Optimize.def M2Defaults.
PCBuild.def M2Const.def M2DebugStack.def \
M2DriverOptions.def ObjectFiles.def \
M2ColorString.def M2Emit.def M2Check.def \
- M2SSA.def Output.def
+ M2SSA.def Output.def M2Scaffold.def
GM2-COMP-BOOT-MODS = FifoQueue.mod M2LexBuf.mod \
M2AsmUtil.mod M2Optimize.mod M2StackWord.mod \
@@ -696,7 +699,7 @@ GM2-COMP-BOOT-MODS = FifoQueue.mod M2LexBuf.mod \
M2DriverOptions.mod \
SymbolKey.mod NameKey.mod Lists.mod ObjectFiles.mod \
M2ColorString.mod M2Emit.mod M2Check.mod \
- M2SSA.mod Output.mod
+ M2SSA.mod Output.mod M2Scaffold.mod
GM2-GCC-DEFS = m2builtins.def m2except.def m2convert.def m2decl.def \
m2except.def m2expr.def m2misc.def m2block.def \
@@ -720,7 +723,8 @@ GM2-LIBS-DEFS = ASCII.def IO.def Args.def M2RTS.def
Builtins.def cbuiltin.def MathLib0.def M2EXCEPTION.def \
RTExceptions.def SMathLib0.def dtoa.def ldtoa.def \
termios.def RTint.def COROUTINES.def Indexing.def \
- LMathLib0.def LegacyReal.def MemUtils.def GetOpt.def
+ LMathLib0.def LegacyReal.def MemUtils.def GetOpt.def \
+ M2LINK.def M2Dependent.def
GM2-LIBS-MODS = ASCII.mod IO.mod Args.mod M2RTS.mod \
Assertion.mod NumberIO.mod Break.mod SYSTEM.mod \
@@ -734,7 +738,7 @@ GM2-LIBS-MODS = ASCII.mod IO.mod Args.mod M2RTS.mod
Builtins.mod MathLib0.mod M2EXCEPTION.mod \
RTExceptions.mod SMathLib0.mod RTint.mod COROUTINES.mod \
Indexing.mod LMathLib0.mod LegacyReal.mod MemUtils.mod \
- GetOpt.mod
+ GetOpt.mod M2Dependent.mod
GM2-LIBS-C = wrapc.c UnixArgs.c Selective.c choosetemp.c \
errno.c dtoa.c ldtoa.c \
@@ -757,7 +761,7 @@ GM2-COMP-DEFS = FifoQueue.def M2Debug.def M2Optimize.def M2Default
M2Swig.def M2MetaError.def Sets.def M2CaseList.def \
PCSymBuild.def PCBuild.def M2Const.def M2DebugStack.def \
M2DriverOptions.def ObjectFiles.def M2ColorString.def \
- M2Emit.def M2Check.def M2SSA.def
+ M2Emit.def M2Check.def M2SSA.def M2Scaffold.def
GM2-COMP-MODS = FifoQueue.mod M2AsmUtil.mod M2Optimize.mod \
M2StackWord.mod M2Options.mod M2Pass.mod M2Batch.mod \
@@ -777,7 +781,8 @@ GM2-COMP-MODS = FifoQueue.mod M2AsmUtil.mod M2Optimiz
M2Swig.mod M2MetaError.mod Sets.mod M2CaseList.mod \
PCSymBuild.mod M2Const.mod M2DebugStack.mod \
M2DriverOptions.mod ObjectFiles.mod M2ColorString.mod \
- M2Emit.mod M2Check.mod M2SSA.mod Output.mod
+ M2Emit.mod M2Check.mod M2SSA.mod Output.mod \
+ M2Scaffold.mod
GM2-TOOLS-MOD = gm2l.mod gm2lcc.mod gm2lgen.mod gm2lorder.mod \
gm2m.mod ppg.mod
@@ -934,6 +939,9 @@ m2/gm2-libs-boot/RTintdummy.o: $(srcdir)/m2/gm2-libs-ch/RTintdummy.c m2/gm2-libs
m2/gm2-libs-boot/wrapc.o: $(srcdir)/m2/gm2-libs-ch/wrapc.c m2/gm2-libs-boot/$(SRC_PREFIX)wrapc.h m2/gm2-libs/gm2-libs-host.h
$(CXX) -c -DHAVE_CONFIG_H $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot -Im2/gm2-libs $(INCLUDES) $< -o $@
+m2/gm2-libs-boot/M2LINK.o: $(srcdir)/m2/gm2-libs-ch/M2LINK.c m2/gm2-libs-boot/$(SRC_PREFIX)M2LINK.h m2/gm2-libs/gm2-libs-host.h
+ $(CXX) -c -DHAVE_CONFIG_H $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot -Im2/gm2-libs $(INCLUDES) $< -o $@
+
m2/gm2-libs-boot/UnixArgs.o: $(srcdir)/m2/gm2-libs-ch/UnixArgs.c m2/gm2-libs-boot/$(SRC_PREFIX)UnixArgs.h m2/gm2-libs/gm2-libs-host.h
$(CXX) -c -DIN_GCC $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(INCLUDES) $< -o $@
@@ -1312,7 +1320,8 @@ stage1/m2/gm2l$(exeext): \
m2/gm2-ici-boot/M2Emit.o \
m2/gm2-libs-boot/libgm2.a m2/gm2-compiler-boot/gm2l.o \
m2/gm2-ici/m2flex.o \
- $(GCC_COLOR) $(GM2_LIBS_BOOT) $(MC_LIBS) $(LIBS)
+ $(GCC_COLOR) $(GM2_LIBS_BOOT) $(MC_LIBS) $(LIBS) \
+ m2/gm2-libs-boot/M2LINK.o
unset CC ; $(M2LINK) -s --langc++ --exit --name gm2l_init.c $(srcdir)/m2/init/gm2linit
mv gm2l_init.c m2/gm2-compiler-boot/gm2l_init.c
$(COMPILER) -c -g m2/gm2-compiler-boot/gm2l_init.c -o m2/gm2-compiler-boot/gm2l_init.o
@@ -1321,6 +1330,7 @@ stage1/m2/gm2l$(exeext): \
m2/gm2-ici/m2flex.o \
m2/gm2-ici-boot/M2Emit.o \
m2/gm2-ici-boot/m2linemap.o \
+ m2/gm2-libs-boot/M2LINK.o \
m2/gm2-compiler-boot/gm2l.o $(GCC_COLOR) $(GM2_LIBS_BOOT) $(MC_LIBS) $(LIBS) -lm
stage1/m2/gm2lcc$(exeext): \
@@ -1329,7 +1339,8 @@ stage1/m2/gm2lcc$(exeext): \
m2/gm2-ici/m2flex.o \
m2/gm2-ici-boot/m2linemap.o \
m2/gm2-libs-boot/libgm2.a m2/gm2-compiler-boot/gm2lcc.o \
- $(GCC_COLOR) $(GM2_LIBS_BOOT) $(MC_LIBS) $(LIBS)
+ $(GCC_COLOR) $(GM2_LIBS_BOOT) $(MC_LIBS) $(LIBS) \
+ m2/gm2-libs-boot/M2LINK.o
unset CC ; $(M2LINK) -s --langc++ --exit --name gm2lcc_init.c $(srcdir)/m2/init/gm2lccinit
mv gm2lcc_init.c m2/gm2-compiler-boot/gm2lcc_init.c
$(COMPILER) -c -g m2/gm2-compiler-boot/gm2lcc_init.c -o m2/gm2-compiler-boot/gm2lcc_init.o
@@ -1338,6 +1349,7 @@ stage1/m2/gm2lcc$(exeext): \
m2/gm2-ici-boot/M2Emit.o \
m2/gm2-ici/m2flex.o \
m2/gm2-ici-boot/m2linemap.o \
+ m2/gm2-libs-boot/M2LINK.o \
m2/gm2-compiler-boot/gm2lcc.o $(GCC_COLOR) $(GM2_LIBS_BOOT) $(MC_LIBS) $(LIBS) -lm
stage1/m2/gm2lgen$(exeext): \
@@ -1346,7 +1358,8 @@ stage1/m2/gm2lgen$(exeext): \
m2/gm2-ici/m2flex.o \
m2/gm2-ici-boot/m2linemap.o \
m2/gm2-libs-boot/libgm2.a m2/gm2-compiler-boot/gm2lgen.o \
- $(GCC_COLOR) $(GM2_LIBS_BOOT) $(MC_LIBS) $(LIBS)
+ $(GCC_COLOR) $(GM2_LIBS_BOOT) $(MC_LIBS) $(LIBS) \
+ m2/gm2-libs-boot/M2LINK.o
unset CC ; $(M2LINK) -s --langc++ --exit --name gm2lgen_init.c $(srcdir)/m2/init/gm2lgeninit
mv gm2lgen_init.c m2/gm2-compiler-boot/gm2lgen_init.c
$(COMPILER) -c -g m2/gm2-compiler-boot/gm2lgen_init.c -o m2/gm2-compiler-boot/gm2lgen_init.o
@@ -1355,6 +1368,7 @@ stage1/m2/gm2lgen$(exeext): \
m2/gm2-ici-boot/M2Emit.o \
m2/gm2-ici/m2flex.o \
m2/gm2-ici-boot/m2linemap.o \
+ m2/gm2-libs-boot/M2LINK.o \
m2/gm2-compiler-boot/gm2lgen.o $(GCC_COLOR) $(GM2_LIBS_BOOT) $(MC_LIBS) $(LIBS) -lm
stage1/m2/gm2lorder$(exeext): \
@@ -1363,7 +1377,8 @@ stage1/m2/gm2lorder$(exeext): \
m2/gm2-ici-boot/M2Emit.o \
m2/gm2-ici/m2flex.o \
m2/gm2-ici-boot/m2linemap.o \
- $(GCC_COLOR) $(GM2_LIBS_BOOT) $(MC_LIBS) $(LIBS)
+ $(GCC_COLOR) $(GM2_LIBS_BOOT) $(MC_LIBS) $(LIBS) \
+ m2/gm2-libs-boot/M2LINK.o
unset CC ; $(M2LINK) -s --langc++ --exit --name gm2lorder_init.c $(srcdir)/m2/init/gm2lorderinit
mv gm2lorder_init.c m2/gm2-compiler-boot/gm2lorder_init.c
$(COMPILER) -c -g m2/gm2-compiler-boot/gm2lorder_init.c -o m2/gm2-compiler-boot/gm2lorder_init.o
@@ -1372,6 +1387,7 @@ stage1/m2/gm2lorder$(exeext): \
m2/gm2-ici-boot/M2Emit.o \
m2/gm2-ici/m2flex.o \
m2/gm2-ici-boot/m2linemap.o \
+ m2/gm2-libs-boot/M2LINK.o \
m2/gm2-compiler-boot/gm2lorder.o $(GCC_COLOR) $(GM2_LIBS_BOOT) $(MC_LIBS) $(LIBS) -lm
stage1/m2/gm2m$(exeext): \
@@ -1380,7 +1396,8 @@ stage1/m2/gm2m$(exeext): \
m2/gm2-ici-boot/M2Emit.o \
m2/gm2-ici/m2flex.o \
m2/gm2-ici-boot/m2linemap.o \
- $(GCC_COLOR) $(GM2_LIBS_BOOT) $(MC_LIBS) $(LIBS)
+ $(GCC_COLOR) $(GM2_LIBS_BOOT) $(MC_LIBS) $(LIBS) \
+ m2/gm2-libs-boot/M2LINK.o
unset CC ; $(M2LINK) -s --langc++ --exit --name gm2m_init.c $(srcdir)/m2/init/gm2minit
mv gm2m_init.c m2/gm2-compiler-boot/gm2m_init.c
$(COMPILER) -c -g m2/gm2-compiler-boot/gm2m_init.c -o m2/gm2-compiler-boot/gm2m_init.o
@@ -1389,6 +1406,7 @@ stage1/m2/gm2m$(exeext): \
m2/gm2-ici/m2flex.o \
m2/gm2-ici-boot/m2linemap.o \
m2/gm2-ici-boot/M2Emit.o \
+ m2/gm2-libs-boot/M2LINK.o \
m2/gm2-compiler-boot/gm2m.o $(GCC_COLOR) $(GM2_LIBS_BOOT) $(MC_LIBS) $(LIBS) -lm
stage2/m2/gm2l$(exeext): $(GM2_LIBS) $(GM2_C_OBJS) $(GM2_LINK_TOOLS_BOOT) m2/gm2-compiler/gm2l.o
@@ -1615,7 +1633,7 @@ MC-LIB-DEFS = Args.def ASCII.def Assertion.def Break.def \
SYSTEM.def TimeString.def \
UnixArgs.def wrapc.def \
RTco.def \
- COROUTINES.def Selective.def termios.def
+ COROUTINES.def Selective.def termios.def M2LINK.def
MC-LIB-MODS = Args.mod ASCII.mod Assertion.mod Break.mod \
CmdArgs.mod Debug.mod \
@@ -1660,7 +1678,7 @@ MC-BOOT-C = $(MC-MODS:%.mod=%.c) $(MC-AUTO-MODS:%.mod=%.c)
MC-INTERFACE-C = libc.c mcrts.c UnixArgs.c Selective.c termios.c \
SysExceptions.c ldtoa.c dtoa.c wrapc.c \
- SYSTEM.c errno.c abort.c
+ SYSTEM.c errno.c abort.c M2LINK.c
BUILD-MC-BOOT-H = $(MC-LIB-DEFS:%.def=m2/mc-boot-gen/$(SRC_PREFIX)%.h) \
$(MC-DEFS:%.def=m2/mc-boot-gen/$(SRC_PREFIX)%.h)
@@ -1867,17 +1885,36 @@ PPG-INTERFACE-C = libc.c mcrts.c UnixArgs.c Selective.c termios.c \
PPG-MODS = SymbolKey.mod NameKey.mod Lists.mod bnflex.mod Output.mod
-PPG-LIB-DEFS = ASCII.def Args.def Indexing.def FIO.def \
- StrIO.def StrLib.def M2RTS.def Indexing.def FIO.def SFIO.def \
- Storage.def Debug.def IO.def StdIO.def M2EXCEPTION.def \
- StrCase.def NumberIO.def Assertion.def PushBackInput.def \
- SysStorage.def DynamicStrings.def M2RTS.def RTExceptions.def
-
-PPG-LIB-MODS = ASCII.mod Args.mod FIO.mod SFIO.mod StrIO.mod StrLib.mod \
- Indexing.mod Storage.mod Debug.mod IO.mod \
- StdIO.mod M2EXCEPTION.mod StrCase.mod NumberIO.mod \
- Assertion.mod PushBackInput.mod SysStorage.mod \
- DynamicStrings.mod M2RTS.mod RTExceptions.mod
+PPG-LIB-DEFS = Args.def Assertion.def ASCII.def Debug.def \
+ DynamicStrings.def FIO.def Indexing.def IO.def \
+ NumberIO.def PushBackInput.def \
+ M2Dependent.def \
+ M2EXCEPTION.def M2LINK.def M2RTS.def \
+ RTExceptions.def \
+ StdIO.def SFIO.def StrIO.def StrLib.def \
+ Storage.def StrCase.def SysStorage.def
+
+PPG-LIB-MODS = ASCII.mod \
+ Args.mod \
+ Assertion.mod \
+ Debug.mod \
+ DynamicStrings.mod \
+ FIO.mod \
+ IO.mod \
+ Indexing.mod \
+ M2Dependent.mod \
+ M2EXCEPTION.mod \
+ M2RTS.mod \
+ NumberIO.mod \
+ PushBackInput.mod \
+ RTExceptions.mod \
+ SFIO.mod \
+ StdIO.mod \
+ Storage.mod \
+ StrCase.mod \
+ StrIO.mod \
+ StrLib.mod \
+ SysStorage.mod
PPG-SRC = ppg.mod
@@ -1909,7 +1946,7 @@ m2/gm2-ppg-boot/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.c m2/gm2-libs/gm2
m2/gm2-ppg-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-libs/%.mod $(MCDEPS) $(BUILD-BOOT-H)
$(MCC) -o=m2/gm2-ppg-boot/$(SRC_PREFIX)$*.c $(srcdir)/m2/gm2-libs/$*.mod
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) \
- -Im2/gm2-ppg-boot -I$(srcdir)/m2/mc-boot \
+ -Im2/gm2-ppg-boot -I$(srcdir)/m2/mc-boot -Im2/gm2-libs-boot \
-I$(srcdir)/m2/mc-boot-ch $(INCLUDES) -g -c m2/gm2-ppg-boot/$(SRC_PREFIX)$*.c -o $@
m2/gm2-ppg-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-compiler/%.mod $(MCDEPS) $(BUILD-BOOT-H)
@@ -1918,8 +1955,12 @@ m2/gm2-ppg-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-compiler/%.mod $(MCDEPS) $(BU
-Im2/mc-boot -Im2/gm2-compiler-boot -Im2/gm2-libs-boot \
-I$(srcdir)/m2/mc-boot-ch $(INCLUDES) -g -c m2/gm2-ppg-boot/$(SRC_PREFIX)$*.c -o $@
-m2/ppg$(exeext): m2/boot-bin/mc $(BUILD-PPG-O) $(BUILD-MC-INTERFACE-O) m2/gm2-ppg-boot/main.o m2/gm2-libs-boot/RTcodummy.o m2/mc-boot-ch/$(SRC_PREFIX)abort.o
- +$(LINKER) $(ALL_LINKERFLAGS) $(LDFLAGS) -o $@ $(BUILD-PPG-O) m2/gm2-ppg-boot/main.o m2/gm2-libs-boot/RTcodummy.o m2/mc-boot-ch/$(SRC_PREFIX)abort.o -lm
+m2/ppg$(exeext): m2/boot-bin/mc $(BUILD-PPG-O) $(BUILD-MC-INTERFACE-O) m2/gm2-ppg-boot/main.o \
+ m2/gm2-libs-boot/RTcodummy.o m2/mc-boot-ch/$(SRC_PREFIX)abort.o \
+ m2/gm2-libs-boot/M2LINK.o
+ +$(LINKER) $(ALL_LINKERFLAGS) $(LDFLAGS) -o $@ $(BUILD-PPG-O) m2/gm2-ppg-boot/main.o \
+ m2/gm2-libs-boot/RTcodummy.o m2/mc-boot-ch/$(SRC_PREFIX)abort.o \
+ m2/gm2-libs-boot/M2LINK.o -lm
m2/gm2-ppg-boot/main.o: $(M2LINK) $(srcdir)/m2/init/mcinit
unset CC ; $(M2LINK) -s --langc++ --exit --name mainppginit.c $(srcdir)/m2/init/ppginit
@@ -1947,7 +1988,9 @@ m2/gm2-pg-boot/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.c m2/gm2-libs/gm2-
m2/gm2-pg-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-libs/%.mod $(MCDEPS) $(BUILD-BOOT-H)
$(MCC) -o=m2/gm2-pg-boot/$(SRC_PREFIX)$*.c $(srcdir)/m2/gm2-libs/$*.mod
- $(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -Im2/gm2-pg-boot -I$(srcdir)/m2/mc-boot -I$(srcdir)/m2/mc-boot-ch $(INCLUDES) \
+ $(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -Im2/gm2-pg-boot -I$(srcdir)/m2/mc-boot \
+ -I$(srcdir)/m2/mc-boot-ch \
+ -Im2/gm2-libs-boot $(INCLUDES) \
-g -c m2/gm2-pg-boot/$(SRC_PREFIX)$*.c -o $@
m2/gm2-pg-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-compiler/%.mod $(MCDEPS) $(BUILD-BOOT-H)
@@ -1963,9 +2006,10 @@ m2/gm2-pg-boot/$(SRC_PREFIX)pg.o: m2/gm2-auto/pg.mod $(MCDEPS) $(BUILD-BOOT-H)
m2/pg$(exeext): m2/boot-bin/mc \
$(BUILD-PG-O) $(GM2-PPG-MODS:%.mod=m2/gm2-pg-boot/%.o) \
$(BUILD-MC-INTERFACE-O) m2/gm2-pg-boot/main.o m2/gm2-libs-boot/RTcodummy.o \
- m2/mc-boot-ch/$(SRC_PREFIX)abort.o
+ m2/mc-boot-ch/$(SRC_PREFIX)abort.o m2/gm2-libs-boot/M2LINK.o
+$(LINKER) $(ALL_LINKERFLAGS) $(LDFLAGS) -o $@ $(BUILD-PG-O) \
m2/gm2-pg-boot/main.o m2/gm2-libs-boot/RTcodummy.o \
+ m2/gm2-libs-boot/M2LINK.o \
m2/mc-boot-ch/$(SRC_PREFIX)abort.o -lm
m2/gm2-auto/pginit:
@@ -2042,7 +2086,7 @@ m2/gm2-pge-boot/$(SRC_PREFIX)errno.o: $(srcdir)/m2/mc-boot-ch/Gerrno.c
m2/gm2-pge-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-libs/%.mod $(MCDEPS) $(BUILD-BOOT-H)
$(MCC) -o=m2/gm2-pge-boot/$(SRC_PREFIX)$*.c $(srcdir)/m2/gm2-libs/$*.mod
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -Im2/gm2-pge-boot -I$(srcdir)/m2/mc-boot \
- -I$(srcdir)/m2/mc-boot-ch \
+ -I$(srcdir)/m2/mc-boot-ch -Im2/gm2-libs-boot \
$(INCLUDES) -g -c m2/gm2-pge-boot/$(SRC_PREFIX)$*.c -o $@
m2/gm2-pge-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-compiler/%.mod $(MCDEPS) $(BUILD-BOOT-H)
@@ -2060,10 +2104,10 @@ m2/gm2-pge-boot/$(SRC_PREFIX)pge.o: m2/gm2-auto/pge.mod $(MCDEPS) $(BUILD-BOOT-
m2/pge$(exeext): m2/boot-bin/mc \
$(BUILD-PGE-O) $(GM2-PPG-MODS:%.mod=m2/gm2-pge-boot/%.o) \
$(BUILD-MC-INTERFACE-O) m2/gm2-pge-boot/main.o m2/gm2-libs-boot/RTcodummy.o \
- m2/mc-boot-ch/$(SRC_PREFIX)abort.o
+ m2/mc-boot-ch/$(SRC_PREFIX)abort.o m2/gm2-libs-boot/M2LINK.o
+$(LINKER) $(ALL_LINKERFLAGS) $(LDFLAGS) -o $@ $(BUILD-PGE-O) \
m2/gm2-pge-boot/main.o m2/gm2-libs-boot/RTcodummy.o \
- m2/mc-boot-ch/$(SRC_PREFIX)abort.o -lm
+ m2/mc-boot-ch/$(SRC_PREFIX)abort.o m2/gm2-libs-boot/M2LINK.o -lm
$(SHELL) $(srcdir)/m2/tools-src/buildpg $(srcdir)/m2/gm2-compiler/ppg.mod t > m2/gm2-auto/t.bnf
./m2/pge$(exeext) m2/gm2-auto/t.bnf -o m2/gm2-auto/t1.mod
./m2/pg$(exeext) m2/gm2-auto/t.bnf -o m2/gm2-auto/t2.mod
diff --git a/gcc/m2/bnf/m2-1.bnf b/gcc/m2/bnf/m2-1.bnf
index 3b3695b8de7..a68908a0bbd 100644
--- a/gcc/m2/bnf/m2-1.bnf
+++ b/gcc/m2/bnf/m2-1.bnf
@@ -89,7 +89,10 @@ FROM P1SymBuild IMPORT P1StartBuildProgramModule,
BuildProcedureHeading,
StartBuildProcedure,
- EndBuildProcedure ;
+ EndBuildProcedure,
+ AddImportToImportStatement,
+ BuildImportStatement ;
+
FROM SymbolTable IMPORT MakeGnuAsm, PutGnuAsmVolatile, PutGnuAsm, PutGnuAsmInput,
PutGnuAsmOutput, PutGnuAsmTrash, PutGnuAsmVolatile,
@@ -990,10 +993,33 @@ Export := "EXPORT" ( "QUALIFIED" % Pus
IdentList | % PushT(ExportTok) %
IdentList ) ";" =:
-Import := "FROM" Ident "IMPORT" IdentList ";" |
- "IMPORT" % PushT(ImportTok)
+Import := "FROM" % BuildImportStatement (GetTokenNo () -1) %
+ Ident % AddImportToImportStatement (TRUE) %
+ "IMPORT" IdentList ";" |
+ "IMPORT" % BuildImportStatement (GetTokenNo () -1) %
+ % PushT(ImportTok)
(* determines whether Ident or Module *) %
- IdentList ";" =:
+ IdentImportList ";" =:
+
+IdentImportList := Ident % VAR
+ on: BOOLEAN ;
+ n : CARDINAL ; %
+ % on := IsAutoPushOn() ;
+ IF on
+ THEN
+ AddImportToImportStatement (FALSE) ;
+ n := 1
+ END %
+ { "," Ident % IF on
+ THEN
+ AddImportToImportStatement (FALSE) ;
+ INC(n)
+ END %
+ } % IF on
+ THEN
+ PushT(n)
+ END %
+ =:
DefinitionModule := "DEFINITION" % M2Error.DefaultDefinitionModule %
"MODULE" % PushAutoOn %
diff --git a/gcc/m2/bnf/m2-2.bnf b/gcc/m2/bnf/m2-2.bnf
index d25f7b4334e..999da57aed0 100644
--- a/gcc/m2/bnf/m2-2.bnf
+++ b/gcc/m2/bnf/m2-2.bnf
@@ -78,6 +78,7 @@ FROM P2SymBuild IMPORT P2StartBuildProgramModule,
BuildExportOuterModule,
BuildExportInnerModule,
+ BlockStart, BlockEnd, BlockBegin, BlockFinally,
BuildString, BuildNumber,
BuildConst,
BuildVariable,
@@ -533,6 +534,7 @@ FileUnit := % Pus
=:
ProgramModule := "MODULE" % M2Error.DefaultProgramModule %
+ % BlockStart (GetTokenNo () -1) %
Ident % P2StartBuildProgramModule ; %
@@ -546,12 +548,13 @@ ProgramModule := "MODULE" % M2E
}
Block
-
+ % BlockEnd (GetTokenNo () -1) %
Ident % P2EndBuildProgramModule ; %
"."
=:
ImplementationModule := "IMPLEMENTATION" % M2Error.DefaultImplementationModule %
+ % BlockStart (GetTokenNo () -1) %
"MODULE"
Ident % P2StartBuildImplementationModule ; %
@@ -560,7 +563,7 @@ ImplementationModule := "IMPLEMENTATION" % M2E
{ Import % BuildImportOuterModule %
}
Block
-
+ % BlockEnd (GetTokenNo () -1) %
Ident % P2EndBuildImplementationModule ; %
"." =:
@@ -1024,9 +1027,11 @@ ProcedureBlock := % Ass
Block := { Declaration } InitialBlock FinalBlock "END" =:
-InitialBlock := [ "BEGIN" InitialBlockBody ] =:
+InitialBlock := [ "BEGIN" % BlockBegin (GetTokenNo () -1) %
+ InitialBlockBody ] =:
-FinalBlock := [ "FINALLY" FinalBlockBody ] =:
+FinalBlock := [ "FINALLY" % BlockFinally (GetTokenNo () -1) %
+ FinalBlockBody ] =:
InitialBlockBody := NormalPart [ "EXCEPT" % PutExceptionBlock(GetCurrentScope()) %
ExceptionalPart ] =:
@@ -1124,6 +1129,7 @@ FormalType := "ARRAY" "OF" % VAR
=:
ModuleDeclaration := "MODULE" % M2Error.DefaultInnerModule %
+ % BlockStart (GetTokenNo () -1) %
Ident % StartBuildInnerModule %
[ Priority
] ";"
@@ -1131,6 +1137,7 @@ ModuleDeclaration := "MODULE" % M2E
} [ Export % BuildExportInnerModule %
]
Block
+ % BlockEnd (GetTokenNo () -1) %
Ident % EndBuildInnerModule %
=:
diff --git a/gcc/m2/bnf/m2-3.bnf b/gcc/m2/bnf/m2-3.bnf
index ed4e21d5556..ae93beecc8f 100644
--- a/gcc/m2/bnf/m2-3.bnf
+++ b/gcc/m2/bnf/m2-3.bnf
@@ -79,6 +79,7 @@ FROM M2Quads IMPORT PushT, PopT, PushTF, PopTF, PopNothing, Annotate,
BuildProcedureStart,
BuildProcedureBegin,
BuildProcedureEnd,
+ BuildScaffold,
BuildStmtNote,
BuildFunctionCall, BuildConstFunctionCall,
BuildBinaryOp, BuildUnaryOp, BuildRelOp, BuildNot,
@@ -158,6 +159,7 @@ FROM SymbolTable IMPORT MakeGnuAsm, PutGnuAsmVolatile, PutGnuAsm, PutGnuAsmInput
MakeRegInterface,
PutRegInterface,
IsRegInterface, IsGnuAsmVolatile, IsGnuAsm,
+ GetCurrentModule,
GetSymName, GetType, SkipType,
NulSym,
StartScope, EndScope,
@@ -579,7 +581,8 @@ ProgramModule := "MODULE" % M2E
% PushAutoOff %
[ Priority
]
- ";"
+ ";" % BuildScaffold (GetTokenNo () -1,
+ GetCurrentModule ()) %
{ Import }
Block % PushAutoOn %
Ident % EndBuildFile %
@@ -594,7 +597,8 @@ ImplementationModule := "IMPLEMENTATION" % M2E
% BuildModuleStart %
% PushAutoOff %
[ Priority
- ] ";"
+ ] ";" % BuildScaffold (GetTokenNo () -1,
+ GetCurrentModule ()) %
{ Import }
Block % PushAutoOn %
diff --git a/gcc/m2/gm2-compiler/M2Base.mod b/gcc/m2/gm2-compiler/M2Base.mod
index 638596daadd..e4610447146 100644
--- a/gcc/m2/gm2-compiler/M2Base.mod
+++ b/gcc/m2/gm2-compiler/M2Base.mod
@@ -187,7 +187,7 @@ BEGIN
IF DebugBuiltins
THEN
(* we will need to parse this module as functions alloca/memcpy will be used *)
- builtins := MakeDefinitionSource(BuiltinTokenNo, MakeKey('Builtins')) ;
+ builtins := MakeDefinitionSource (BuiltinTokenNo, MakeKey ('Builtins')) ;
IF builtins = NulSym
THEN
MetaError0 ('unable to find core module Builtins')
@@ -209,10 +209,11 @@ BEGIN
InitBaseSimpleTypes(location) ;
- (* initialise the SYSTEM module before we used CARDINAL and ADDRESS! *)
+ (* Initialise the SYSTEM module before we ADDRESS. *)
InitSystem ;
- MakeBitset ; (* we do this after SYSTEM has been created as BITSET is dependant upon WORD *)
+ MakeBitset ; (* We do this after SYSTEM has been created as BITSET
+ is dependant upon WORD *)
InitBaseConstants ;
InitBaseFunctions ;
@@ -231,9 +232,10 @@ END InitBase ;
(*
IsNeededAtRunTime - returns TRUE if procedure, sym, is a
- runtime procedure. Ie a procedure which is
- not a pseudo procedure and which is implemented
- in M2RTS or SYSTEM and also exported.
+ runtime procedure. A runtime procedure is
+ not a pseudo procedure (like NEW/DISPOSE)
+ and it is implemented in M2RTS or SYSTEM
+ and also exported.
*)
PROCEDURE IsNeededAtRunTime (tok: CARDINAL; sym: CARDINAL) : BOOLEAN ;
diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.mod b/gcc/m2/gm2-compiler/M2GCCDeclare.mod
index b94f3602c79..799a704533f 100644
--- a/gcc/m2/gm2-compiler/M2GCCDeclare.mod
+++ b/gcc/m2/gm2-compiler/M2GCCDeclare.mod
@@ -113,6 +113,7 @@ FROM SymbolTable IMPORT NulSym,
GetPackedEquivalent,
GetParameterShadowVar,
GetUnboundedRecordType,
+ GetModuleCtors,
ForeachOAFamily, GetOAFamily,
IsModuleWithinProcedure, IsVariableSSA,
IsVariableAtAddress, IsConstructorConstant,
@@ -554,20 +555,20 @@ END Chained ;
(*
DoStartDeclaration - returns a tree representing a symbol which has
- not yet been finished. (Useful when declaring
- recursive types).
+ not yet been finished. Used when declaring
+ recursive types.
*)
PROCEDURE DoStartDeclaration (sym: CARDINAL; p: StartProcedure) : Tree ;
VAR
location: location_t ;
BEGIN
- IF NOT GccKnowsAbout(sym)
+ IF NOT GccKnowsAbout (sym)
THEN
- location := TokenToLocation(GetDeclaredMod(sym)) ;
- PreAddModGcc(sym, p(location, KeyToCharStar(GetFullSymName(sym))))
+ location := TokenToLocation (GetDeclaredMod (sym)) ;
+ PreAddModGcc(sym, p (location, KeyToCharStar (GetFullSymName (sym))))
END ;
- RETURN( Mod2Gcc(sym) )
+ RETURN Mod2Gcc (sym)
END DoStartDeclaration ;
@@ -636,7 +637,7 @@ BEGIN
WatchIncludeList(sym, finishedalignment) ;
IF AllDependantsFullyDeclared(sym)
THEN
- (* ready to be solved.. *)
+ (* All good and ready to be solved. *)
END
END DeclareRecordKind ;
@@ -1307,7 +1308,7 @@ END ForeachTryDeclare ;
all outstanding types have been written.
*)
-PROCEDURE DeclaredOutstandingTypes (MustHaveCompleted: BOOLEAN) : BOOLEAN ;
+PROCEDURE DeclaredOutstandingTypes (ForceComplete: BOOLEAN) : BOOLEAN ;
VAR
finished : BOOLEAN ;
d, a, p, f, n, b: CARDINAL ;
@@ -1396,7 +1397,7 @@ BEGIN
finished := TRUE
END
UNTIL finished ;
- IF MustHaveCompleted
+ IF ForceComplete
THEN
IF ForeachTryDeclare (todolist, ToDoList,
circulartodo,
@@ -2484,13 +2485,16 @@ END DeclareProcedureToGccSeparateProgram ;
DeclareProcedureToGcc - traverses all parameters and interfaces to gm2gcc.
*)
-PROCEDURE DeclareProcedureToGcc (Sym: CARDINAL) ;
+PROCEDURE DeclareProcedureToGcc (sym: CARDINAL) ;
BEGIN
- IF WholeProgram
+ IF sym # NulSym
THEN
- DeclareProcedureToGccWholeProgram(Sym)
- ELSE
- DeclareProcedureToGccSeparateProgram(Sym)
+ IF WholeProgram
+ THEN
+ DeclareProcedureToGccWholeProgram (sym)
+ ELSE
+ DeclareProcedureToGccSeparateProgram (sym)
+ END
END
END DeclareProcedureToGcc ;
@@ -2657,40 +2661,19 @@ END AssertAllTypesDeclared ;
(*
- DeclareModuleInit - declared the initialization `function' within
+ DeclareModuleInit - declare all the ctor related functions within
a module.
*)
-PROCEDURE DeclareModuleInit (sym: WORD) ;
+PROCEDURE DeclareModuleInit (moduleSym: WORD) ;
VAR
- t : Tree ;
- begin, end,
- location : location_t ;
+ ctor, init, fini, dep: CARDINAL ;
BEGIN
- IF IsModuleWithinProcedure(sym)
- THEN
- location := TokenToLocation(GetDeclaredMod(sym)) ;
- begin := TokenToLocation(GetDeclaredMod(sym)) ;
- end := TokenToLocation(GetDeclaredMod(sym)+10) ;
-
- BuildStartFunctionDeclaration(FALSE) ;
- t := BuildEndFunctionDeclaration(begin, end,
- KeyToCharStar(GetModuleInitName(sym)),
- NIL, FALSE, TRUE, FALSE) ;
- pushFunctionScope(t) ;
- finishFunctionDecl(location, t) ;
- t := popFunctionScope() ;
-
- PreAddModGcc(sym, t) ;
- BuildStartFunctionDeclaration(FALSE) ;
- t := BuildEndFunctionDeclaration(begin, end,
- KeyToCharStar(GetModuleFinallyName(sym)),
- NIL, FALSE, TRUE, FALSE) ;
- pushFunctionScope(t) ;
- finishFunctionDecl(location, t) ;
- t := popFunctionScope() ;
- PutModuleFinallyFunction(sym, t)
- END
+ GetModuleCtors (moduleSym, ctor, init, fini, dep) ;
+ DeclareProcedureToGcc (ctor) ;
+ DeclareProcedureToGcc (init) ;
+ DeclareProcedureToGcc (fini) ;
+ DeclareProcedureToGcc (dep)
END DeclareModuleInit ;
@@ -2736,7 +2719,8 @@ BEGIN
ForeachProcedureDo(scope, DeclareProcedure) ;
ForeachInnerModuleDo(scope, WalkTypesInModule) ;
ForeachInnerModuleDo(scope, DeclareTypesConstantsProcedures) ;
- ForeachInnerModuleDo(scope, StartDeclareScope)
+ ForeachInnerModuleDo(scope, StartDeclareScope) ;
+ DeclareModuleInit(scope)
ELSE
DeclareTypesConstantsProcedures(scope) ;
AssertAllTypesDeclared(scope) ;
@@ -6194,8 +6178,3 @@ BEGIN
HaveInitDefaultTypes := FALSE ;
recursionCaught := FALSE
END M2GCCDeclare.
-(*
- * Local variables:
- * compile-command: "gm2 -c -g -I.:../gm2-libs:../gm2-libs-ch:../gm2-libiberty/ M2GCCDeclare.mod"
- * End:
- *)
diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod
index 5564fcac9c3..570713c4126 100644
--- a/gcc/m2/gm2-compiler/M2GenGCC.mod
+++ b/gcc/m2/gm2-compiler/M2GenGCC.mod
@@ -35,9 +35,8 @@ FROM SymbolTable IMPORT PushSize, PopSize, PushValue, PopValue,
GetGnuAsm, IsGnuAsmVolatile, IsGnuAsmSimple,
GetGnuAsmInput, GetGnuAsmOutput, GetGnuAsmTrash,
GetLowestType,
- GetModuleFinallyFunction, PutModuleFinallyFunction,
GetLocalSym, GetVarWritten,
- GetVarient, GetVarBackEndType,
+ GetVarient, GetVarBackEndType, GetModuleCtors,
NoOfVariables,
NoOfParam, GetParent, GetDimension, IsAModula2Type,
IsModule, IsDefImp, IsType, IsModuleWithinProcedure,
@@ -56,7 +55,7 @@ FROM SymbolTable IMPORT PushSize, PopSize, PushValue, PopValue,
IsParameter, IsParameterVar,
IsValueSolved, IsSizeSolved,
IsProcedureNested, IsInnerModule, IsArrayLarge,
- IsComposite, IsVariableSSA,
+ IsComposite, IsVariableSSA, IsPublic, IsCtor,
ForeachExportedDo,
ForeachImportedDo,
ForeachProcedureDo,
@@ -89,10 +88,12 @@ FROM M2MetaError IMPORT MetaErrorT0, MetaErrorT1, MetaErrorT2, MetaErrorT3, Meta
FROM M2Options IMPORT DisplayQuadruples, UnboundedByReference, PedanticCast,
VerboseUnbounded, Iso, Pim, DebugBuiltins, WholeProgram,
- StrictTypeChecking, AutoInit,
+ StrictTypeChecking, AutoInit, cflag, ScaffoldMain,
+ ScaffoldDynamic, ScaffoldStatic, GetRuntimeModuleOverride,
DebugTraceQuad, DebugTraceAPI ;
FROM M2Printf IMPORT printf0, printf1, printf2, printf4 ;
+FROM M2Quiet IMPORT qprintf0 ;
FROM M2Base IMPORT MixTypes, NegateType, ActivationPointer, IsMathType,
IsRealType, IsComplexType, IsBaseType,
@@ -201,12 +202,14 @@ FROM m2tree IMPORT Tree, debug_tree ;
FROM m2linemap IMPORT location_t ;
FROM m2decl IMPORT BuildStringConstant, DeclareKnownConstant, GetBitsPerBitset,
- BuildIntegerConstant ;
+ BuildIntegerConstant, DeclareM2linkGlobals,
+ BuildModuleCtor, DeclareModuleCtor ;
FROM m2statement IMPORT BuildAsm, BuildProcedureCallTree, BuildParam, BuildFunctValue,
DoJump, BuildUnaryForeachWordDo, BuildGoto, BuildCall2, BuildCall3,
BuildStart, BuildEnd, BuildCallInner, BuildStartFunctionCode,
- BuildEndFunctionCode, BuildAssignmentTree, DeclareLabel,
+ BuildEndFunctionCode,
+ BuildAssignmentTree, DeclareLabel,
BuildFunctionCallTree,
BuildAssignmentStatement,
BuildIndirectProcedureCallTree,
@@ -364,6 +367,12 @@ PROCEDURE IsExportedGcc (sym: CARDINAL) : BOOLEAN ;
VAR
scope: CARDINAL ;
BEGIN
+ (* Has a procedure been overridden as public? *)
+ IF IsProcedure (sym) AND IsPublic (sym)
+ THEN
+ RETURN TRUE
+ END ;
+ (* Check for whole program. *)
IF WholeProgram
THEN
scope := GetScope (sym) ;
@@ -379,6 +388,7 @@ BEGIN
END ;
Assert (FALSE)
ELSE
+ (* Otherwise it is public if it were exported. *)
RETURN IsExported (GetMainModule (), sym)
END
END IsExportedGcc ;
@@ -444,13 +454,13 @@ BEGIN
ModuleScopeOp : CodeModuleScope (op3) |
EndFileOp : CodeEndFile |
InitStartOp : CodeInitStart (op2, op3, IsCompilingMainModule (op3)) |
- InitEndOp : CodeInitEnd (op3, IsCompilingMainModule(op3)) |
+ InitEndOp : CodeInitEnd (op3, IsCompilingMainModule (op3)) |
FinallyStartOp : CodeFinallyStart (op2, op3, IsCompilingMainModule (op3)) |
- FinallyEndOp : CodeFinallyEnd (op3, IsCompilingMainModule(op3)) |
+ FinallyEndOp : CodeFinallyEnd (op3, IsCompilingMainModule (op3)) |
NewLocalVarOp : CodeNewLocalVar (op1, op3) |
KillLocalVarOp : CodeKillLocalVar (op3) |
ProcedureScopeOp : CodeProcedureScope (op3) |
- ReturnOp : (* not used as return is achieved by KillLocalVar. *) |
+ ReturnOp : (* Not used as return is achieved by KillLocalVar. *) |
ReturnValueOp : CodeReturnValue (op1, op3) |
TryOp : CodeTry |
ThrowOp : CodeThrow (op3) |
@@ -522,7 +532,7 @@ BEGIN
RestoreExceptionOp : CodeRestoreException (op1, op3)
ELSE
- WriteFormat1('quadruple %d not yet implemented', q) ;
+ WriteFormat1 ('quadruple %d not yet implemented', q) ;
InternalError ('quadruple not implemented yet')
END ;
LastOperator := op
@@ -971,9 +981,9 @@ END CodeModuleScope ;
StartModFileOp _ _ moduleSym
- Its function is to reset the source file to another
- file, hence all line numbers emitted with the
- generated code will be relative to this source file.
+ A new source file has been encountered therefore
+ set LastLine to 1.
+ Call pushGlobalScope.
*)
PROCEDURE CodeStartModFile (moduleSym: CARDINAL) ;
@@ -985,14 +995,14 @@ END CodeStartModFile ;
(*
- CodeStartDefFile - StartDefFileOp is a quadruple which has the following
+ CodeStartDefFile - StartDefFileOp is a quadruple with the following
format:
StartDefFileOp _ _ moduleSym
- Its function is to reset the source file to another
- file, hence all line numbers emitted with the
- generated code will be relative to this source file.
+ A new source file has been encountered therefore
+ set LastLine to 1.
+ Call pushGlobalScope.
*)
PROCEDURE CodeStartDefFile (moduleSym: CARDINAL) ;
@@ -1004,13 +1014,7 @@ END CodeStartDefFile ;
(*
- CodeEndFile - FileOp is a quadruple which has the following format:
-
- EndFileOp
-
- Its function is to reset the source file to another
- file, hence all line numbers emitted with the
- generated code will be relative to this source file.
+ CodeEndFile - pops the GlobalScope.
*)
PROCEDURE CodeEndFile ;
@@ -1023,12 +1027,14 @@ END CodeEndFile ;
CallInnerInit - produce a call to inner module initialization routine.
*)
-PROCEDURE CallInnerInit (Sym: WORD) ;
+PROCEDURE CallInnerInit (moduleSym: WORD) ;
VAR
- location: location_t;
+ location : location_t;
+ ctor, init, fini, dep: CARDINAL ;
BEGIN
- location := TokenToLocation(CurrentQuadToken) ;
- BuildCallInner(location, Mod2Gcc(Sym))
+ location := TokenToLocation (CurrentQuadToken) ;
+ GetModuleCtors (moduleSym, ctor, init, fini, dep) ;
+ BuildCallInner (location, Mod2Gcc (init))
END CallInnerInit ;
@@ -1036,12 +1042,14 @@ END CallInnerInit ;
CallInnerFinally - produce a call to inner module finalization routine.
*)
-PROCEDURE CallInnerFinally (Sym: WORD) ;
+PROCEDURE CallInnerFinally (moduleSym: WORD) ;
VAR
- location: location_t;
+ location : location_t;
+ ctor, init, fini, dep: CARDINAL ;
BEGIN
- location := TokenToLocation(CurrentQuadToken) ;
- BuildCallInner(location, GetModuleFinallyFunction(Sym))
+ location := TokenToLocation (CurrentQuadToken) ;
+ GetModuleCtors (moduleSym, ctor, init, fini, dep) ;
+ BuildCallInner (location, Mod2Gcc (fini))
END CallInnerFinally ;
@@ -1053,47 +1061,22 @@ END CallInnerFinally ;
PROCEDURE CodeInitStart (currentScope, moduleSym: CARDINAL;
CompilingMainModule: BOOLEAN) ;
VAR
- CurrentModuleInitFunction: Tree ;
- location : location_t;
+ location : location_t;
+ ctor, init,
+ fini, dep : CARDINAL ;
BEGIN
IF CompilingMainModule OR WholeProgram
THEN
- (* SetFileNameAndLineNo(string(FileName), op1) ; *)
+ (* SetFileNameAndLineNo (string (FileName), op1) ; *)
location := TokenToLocation (CurrentQuadToken) ;
- IF IsModuleWithinProcedure (moduleSym)
- THEN
- CurrentModuleInitFunction := Mod2Gcc (moduleSym) ;
- BuildStartFunctionCode (location, CurrentModuleInitFunction, FALSE, FALSE)
- ELSE
- CurrentModuleInitFunction := BuildStart (location, KeyToCharStar (GetModuleInitName (moduleSym)), currentScope#moduleSym) ;
- AddModGcc (moduleSym, CurrentModuleInitFunction)
- END ;
- (* EmitLineNote(string(FileName), op1) ; *)
+ GetModuleCtors (moduleSym, ctor, init, fini, dep) ;
+ BuildStartFunctionCode (location, Mod2Gcc (init),
+ IsExportedGcc (init), FALSE) ;
ForeachInnerModuleDo (moduleSym, CallInnerInit)
END
END CodeInitStart ;
-(*
- BuildTerminationCall - generates a call to the termination handler.
- After checking that, module, is a MODULE and
- is also the main module.
-*)
-
-(*
-PROCEDURE BuildTerminationCall (module: CARDINAL) ;
-BEGIN
- IF (GetMainModule()=module) AND IsModule(module)
- THEN
- IF Pim
- THEN
- CodeDirectCall(FromModuleGetSym(MakeKey('Terminate'),
- GetModule(MakeKey('M2RTS'))))
- END
- END
-END BuildTerminationCall ;
-*)
-
(*
CodeInitEnd - emits terminating code after the main BEGIN END of the
current module.
@@ -1102,8 +1085,9 @@ END BuildTerminationCall ;
PROCEDURE CodeInitEnd (moduleSym: CARDINAL;
CompilingMainModule: BOOLEAN) ;
VAR
- moduleTree: Tree ;
- location : location_t ;
+ location : location_t;
+ ctor, init,
+ fini, dep : CARDINAL ;
BEGIN
IF CompilingMainModule OR WholeProgram
THEN
@@ -1113,15 +1097,10 @@ BEGIN
*)
location := TokenToLocation (GetDeclaredMod (moduleSym)) ;
- moduleTree := Mod2Gcc (moduleSym) ;
- finishFunctionDecl (location, moduleTree) ;
-
- IF IsModuleWithinProcedure (moduleSym)
- THEN
- BuildEndFunctionCode (location, moduleTree, TRUE)
- ELSE
- BuildEnd (location, moduleTree, FALSE)
- END
+ GetModuleCtors (moduleSym, ctor, init, fini, dep) ;
+ finishFunctionDecl (location, Mod2Gcc (init)) ;
+ BuildEndFunctionCode (location, Mod2Gcc (init),
+ IsModuleWithinProcedure (moduleSym))
END
END CodeInitEnd ;
@@ -1134,23 +1113,17 @@ END CodeInitEnd ;
PROCEDURE CodeFinallyStart (outerModule, moduleSym: CARDINAL;
CompilingMainModule: BOOLEAN) ;
VAR
- CurrentModuleFinallyFunction: Tree ;
- location : location_t;
+ location : location_t;
+ ctor, init,
+ fini, dep : CARDINAL ;
BEGIN
IF CompilingMainModule OR WholeProgram
THEN
- (* SetFileNameAndLineNo(string(FileName), op1) ; *)
+ (* SetFileNameAndLineNo (string (FileName), op1) ; *)
location := TokenToLocation (CurrentQuadToken) ;
- IF IsModuleWithinProcedure (moduleSym)
- THEN
- CurrentModuleFinallyFunction := GetModuleFinallyFunction (moduleSym) ;
- BuildStartFunctionCode (location, CurrentModuleFinallyFunction, FALSE, FALSE)
- ELSE
- CurrentModuleFinallyFunction := BuildStart (location,
- KeyToCharStar(GetModuleFinallyName (moduleSym)), outerModule#moduleSym) ;
- PutModuleFinallyFunction (moduleSym, CurrentModuleFinallyFunction)
- END ;
- (* EmitLineNote(string(FileName), op1) ; *)
+ GetModuleCtors (moduleSym, ctor, init, fini, dep) ;
+ BuildStartFunctionCode (location, Mod2Gcc (fini),
+ IsExportedGcc (fini), FALSE) ;
ForeachInnerModuleDo (moduleSym, CallInnerFinally)
END
END CodeFinallyStart ;
@@ -1158,14 +1131,16 @@ END CodeFinallyStart ;
(*
CodeFinallyEnd - emits terminating code after the main BEGIN END of the
- current module.
+ current module. It also creates the scaffold if the
+ cflag was not present.
*)
PROCEDURE CodeFinallyEnd (moduleSym: CARDINAL;
CompilingMainModule: BOOLEAN) ;
VAR
- moduleTree: Tree ;
- location : location_t ;
+ location : location_t;
+ ctor, init,
+ fini, dep : CARDINAL ;
BEGIN
IF CompilingMainModule OR WholeProgram
THEN
@@ -1175,14 +1150,17 @@ BEGIN
*)
location := TokenToLocation (GetDeclaredMod (moduleSym)) ;
- moduleTree := GetModuleFinallyFunction (moduleSym) ;
- finishFunctionDecl (TokenToLocation (GetDeclaredMod (moduleSym)), moduleTree) ;
-
- IF IsModuleWithinProcedure (moduleSym)
+ GetModuleCtors (moduleSym, ctor, init, fini, dep) ;
+ finishFunctionDecl (location, Mod2Gcc (fini)) ;
+ BuildEndFunctionCode (location, Mod2Gcc (fini),
+ IsModuleWithinProcedure (moduleSym)) ;
+ IF ScaffoldMain OR (NOT cflag)
THEN
- BuildEndFunctionCode (location, moduleTree, TRUE)
- ELSE
- BuildEnd (location, moduleTree, FALSE)
+ IF CompilingMainModule AND (ScaffoldDynamic OR ScaffoldStatic OR ScaffoldMain)
+ THEN
+ qprintf0 ("generating scaffold m2link information\n");
+ DeclareM2linkGlobals (location, VAL (INTEGER, ScaffoldStatic), GetRuntimeModuleOverride ())
+ END
END
END
END CodeFinallyEnd ;
@@ -1801,12 +1779,22 @@ END CodeNewLocalVar ;
PROCEDURE CodeKillLocalVar (CurrentProcedure: CARDINAL) ;
VAR
begin, end: CARDINAL ;
+ proc : Tree ;
BEGIN
GetProcedureBeginEnd (CurrentProcedure, begin, end) ;
CurrentQuadToken := end ;
+ proc := NIL ;
+ IF IsCtor (CurrentProcedure)
+ THEN
+ proc := DeclareModuleCtor (Mod2Gcc (CurrentProcedure))
+ END ;
BuildEndFunctionCode (TokenToLocation (end),
Mod2Gcc (CurrentProcedure),
IsProcedureGccNested (CurrentProcedure)) ;
+ IF IsCtor (CurrentProcedure) AND (proc # NIL)
+ THEN
+ BuildModuleCtor (proc)
+ END ;
PoisonSymbols (CurrentProcedure) ;
removeStmtNote () ;
PopScope
@@ -2088,45 +2076,6 @@ BEGIN
END ConvertRHS ;
-(*
- ConvertForComparison - converts, sym, into a tree which is type compatible with, with.
-*)
-
-(*
-PROCEDURE ConvertForComparison (tokenno: CARDINAL; sym, with: CARDINAL) : Tree ;
-VAR
- symType,
- withType: CARDINAL ;
- t : Tree ;
- location: location_t ;
-BEGIN
- location := TokenToLocation(tokenno) ;
- symType := SkipType(GetType(sym)) ;
- withType := SkipType(GetType(with)) ;
- IF (symType#NulSym) AND IsPointer(symType) AND (symType#withType)
- THEN
- RETURN( BuildConvert(location, GetPointerType (), Mod2Gcc(sym), FALSE) )
- ELSIF IsProcedure(sym)
- THEN
- RETURN( BuildConvert(location, GetPointerType (), BuildAddr(location, Mod2Gcc(sym), FALSE), FALSE) )
- ELSIF (symType#NulSym) AND IsProcType(symType)
- THEN
- RETURN( BuildConvert(location, GetPointerType (), Mod2Gcc(sym), FALSE) )
- ELSIF (symType#NulSym) AND IsSubrange(symType) AND (symType#withType) AND (withType#NulSym)
- THEN
- RETURN( BuildConvert(location, Mod2Gcc(withType), Mod2Gcc(sym), FALSE) )
- END ;
- t := StringToChar(NIL, GetType(with), sym) ;
- IF t=NIL
- THEN
- RETURN( ZConstToTypedConst(LValueToGenericPtr(location, sym), sym, with) )
- ELSE
- RETURN( t )
- END
-END ConvertForComparison ;
-*)
-
-
(*
IsCoerceableParameter - returns TRUE if symbol, sym, is a
coerceable parameter.
@@ -3018,16 +2967,16 @@ PROCEDURE CodeInitAddress (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
VAR
location: location_t ;
BEGIN
- DeclareConstant(CurrentQuadToken, op3) ; (* checks to see whether it is a constant and declares it *)
- DeclareConstructor(CurrentQuadToken, quad, op3) ;
+ DeclareConstant (CurrentQuadToken, op3) ; (* checks to see whether it is a constant and declares it *)
+ DeclareConstructor (CurrentQuadToken, quad, op3) ;
- location := TokenToLocation(CurrentQuadToken) ;
+ location := TokenToLocation (CurrentQuadToken) ;
- Assert(op2=NulSym) ;
- Assert(GetMode(op1)=LeftValue) ;
+ Assert (op2 = NulSym) ;
+ Assert (GetMode (op1) = LeftValue) ;
BuildAssignmentStatement (location,
- Mod2Gcc(op1),
- BuildConvert(location, GetPointerType(), Mod2Gcc(op3), FALSE))
+ Mod2Gcc (op1),
+ BuildConvert (location, GetPointerType (), Mod2Gcc (op3), FALSE))
END CodeInitAddress ;
@@ -5335,60 +5284,6 @@ BEGIN
END CodeSize ;
-(*
- DetermineFieldOf - is sadly complicated by the way varient records are encoded in the front end
- symbol table. The symbol, sym, is a RecordField which is either in the structure:
-
- RecordSym
- RecordField: Type ;
- RecordField: Type ;
- End
-
- or alternatively:
-
- RecordSym
- Varient: VarientField: RecordField: Type ;
- RecordField: Type ;
- VarientField: RecordField: Type ;
- RecordField: Type ;
- Varient: VarientField: RecordField: Type ;
- RecordField: Type ;
- VarientField: RecordField: Type ;
- RecordField: Type ;
- End
-
- Thus when we are asked to calculate Offset RecordField
- we need to know which of the two alternatives we are dealing with.
- The GCC BuildOffset calculates the offset between RecordField its
- Varient parent. We need to add the offset between varient parent and
- the RecordSym. This code is bridging the difference in symbol table
- construction between the front end and GCC.
-
- We return the Varient symbol if sym was declared in the second method.
-*)
-
-(*
-PROCEDURE DetermineFieldOf (parent, sym: CARDINAL) : CARDINAL ;
-VAR
- varient: CARDINAL ;
-BEGIN
- Assert(IsRecordField(sym)) ;
- varient := GetVarient(sym) ;
- IF (varient=NulSym) OR IsRecord(varient)
- THEN
- RETURN( NulSym )
- ELSE
- sym := NulSym ;
- WHILE (varient#NulSym) AND (IsVarient(varient) OR IsFieldVarient(varient)) DO
- sym := varient ;
- varient := GetVarient(varient)
- END ;
- RETURN( sym )
- END
-END DetermineFieldOf ;
-*)
-
-
(*
FoldRecordField - check whether we can fold an RecordFieldOp quadruple.
Very similar to FoldBinary, except that we need to
@@ -7204,5 +7099,5 @@ END CodeXIndr ;
BEGIN
UnboundedLabelNo := 0 ;
CurrentQuadToken := 0 ;
- ScopeStack := InitStackWord()
+ ScopeStack := InitStackWord ()
END M2GenGCC.
diff --git a/gcc/m2/gm2-compiler/M2MetaError.mod b/gcc/m2/gm2-compiler/M2MetaError.mod
index 7fbc68a5c93..f12de430ef5 100644
--- a/gcc/m2/gm2-compiler/M2MetaError.mod
+++ b/gcc/m2/gm2-compiler/M2MetaError.mod
@@ -37,6 +37,7 @@ FROM libc IMPORT printf ;
FROM SYSTEM IMPORT ADDRESS ;
FROM M2Error IMPORT MoveError ;
FROM M2Debug IMPORT Assert ;
+FROM Storage IMPORT ALLOCATE ;
FROM Indexing IMPORT Index, InitIndex, KillIndex, GetIndice, PutIndice,
DeleteIndice, HighIndice ;
diff --git a/gcc/m2/gm2-compiler/M2Options.def b/gcc/m2/gm2-compiler/M2Options.def
index f134c43a0db..a470e3a317c 100644
--- a/gcc/m2/gm2-compiler/M2Options.def
+++ b/gcc/m2/gm2-compiler/M2Options.def
@@ -55,6 +55,7 @@ EXPORT QUALIFIED SetReturnCheck, SetNilCheck, SetCaseCheck,
Setc, Getc,
Iso, Pim, Pim2, Pim3, Pim4,
+ cflag,
PositiveModFloorDiv,
Pedantic, Verbose, Statistics,
UnboundedByReference, VerboseUnbounded,
@@ -83,7 +84,11 @@ EXPORT QUALIFIED SetReturnCheck, SetNilCheck, SetCaseCheck,
SaveTemps,
CppProg, CppArg, CppCommandLine, CppRemember,
SetDebugFunctionLineNumbers, DebugFunctionLineNumbers,
- SetGenerateStatementNote, GenerateStatementNote ;
+ SetGenerateStatementNote, GenerateStatementNote,
+ ScaffoldDynamic, ScaffoldStatic,
+ SetScaffoldDynamic, SetScaffoldStatic,
+ SetScaffoldMain, ScaffoldMain,
+ SetRuntimeModuleOverride, GetRuntimeModuleOverride ;
VAR
@@ -93,7 +98,7 @@ VAR
Pim2, (* -fpim2 use strict rules. *)
Pim3, (* -fpim3 use strict rules. *)
Pim4, (* -fpim4 use strict rules. *)
- PositiveModFloorDiv, (* force PIM4 behaviour for DIV and MOD *)
+ PositiveModFloorDiv, (* Force PIM4 behaviour for DIV and MOD *)
CompilerDebugging, (* -fd internal debugging messages *)
DebugTraceQuad, (* -fdebug-trace-quad *)
DebugTraceAPI, (* -fdebug-trace-api *)
@@ -113,7 +118,7 @@ VAR
OptimizeCommonSubExpressions, (* -Ocse optimize common subexpressions *)
WholeProgram, (* -fwhole-program optimization. *)
NilChecking, (* -fnil makes compiler test for pointer *)
- (* NIL *)
+ (* NIL. *)
WholeDivChecking, (* -fwholediv produces code to raise an *)
(* exception if a whole number divide by *)
(* zero occurs. *)
@@ -131,31 +136,34 @@ VAR
CaseElseChecking, (* -fcase checks program does not need an *)
(* else statement within an case statement *)
(* when the user omits one *)
- VariantValueChecking, (* should we check all values are present *)
+ VariantValueChecking, (* Should we check all values are present *)
(* in a variant record? True for ISO and *)
(* false for PIM. *)
Quiet, (* -fquiet option specified. *)
- LineDirectives, (* should compiler understand preprocessor *)
+ LineDirectives, (* Should compiler understand preprocessor *)
(* # linenumber "filename" markers? *)
StrictTypeChecking, (* -fm2-strict-type experimental checker. *)
- CPreProcessor, (* must we run the cpp on the source? *)
- Xcode, (* should errors follow Xcode format? *)
- ExtendedOpaque, (* do we allow non pointer opaque types? *)
- DumpSystemExports, (* print all inbuilt system items? *)
- GenerateSwig, (* should we generate a swig interface file?*)
- Exceptions, (* should we generate exception code? *)
- UnusedVariableChecking, (* should we warn about unused variables? *)
- UnusedParameterChecking, (* should we warn about unused parameters? *)
- LowerCaseKeywords, (* should keywords in errors be in lower? *)
- DebugBuiltins, (* should we always call a real function? *)
+ CPreProcessor, (* Must we run the cpp on the source? *)
+ Xcode, (* Should errors follow Xcode format? *)
+ ExtendedOpaque, (* Do we allow non pointer opaque types? *)
+ DumpSystemExports, (* Print all inbuilt system items? *)
+ GenerateSwig, (* Should we generate a swig interface file?*)
+ Exceptions, (* Should we generate exception code? *)
+ UnusedVariableChecking, (* Should we warn about unused variables? *)
+ UnusedParameterChecking, (* Should we warn about unused parameters? *)
+ LowerCaseKeywords, (* Should keywords in errors be in lower? *)
+ DebugBuiltins, (* Should we always call a real function? *)
AutoInit, (* -fauto-init assigns pointers to NIL. *)
SaveTemps, (* -save-temps save all temporary files. *)
+ ScaffoldDynamic, (* Should we generate a dynamic scaffold? *)
+ ScaffoldStatic, (* Should we generate a static scaffold? *)
+ ScaffoldMain, (* Should we generate a main function? *)
ForcedLocation,
DebugFunctionLineNumbers,
GenerateStatementNote,
Optimizing,
Coding,
- Profiling : BOOLEAN ;
+ Profiling : BOOLEAN ;
(*
@@ -179,6 +187,58 @@ PROCEDURE Setc (value: BOOLEAN) ;
PROCEDURE Getc () : BOOLEAN ;
+(*
+ SetScaffoldDynamic - set the -fscaffold-dynamic flag.
+*)
+
+PROCEDURE SetScaffoldDynamic (value: BOOLEAN) ;
+
+
+(*
+ SetScaffoldStatic - set the -fscaffold-static flag.
+*)
+
+PROCEDURE SetScaffoldStatic (value: BOOLEAN) ;
+
+
+(*
+ GetScaffoldDynamic - get the -fscaffold-dynamic flag.
+*)
+
+PROCEDURE GetScaffoldDynamic () : BOOLEAN ;
+
+
+(*
+ GetScaffoldStatic - get the -fscaffold-static flag.
+*)
+
+PROCEDURE GetScaffoldStatic () : BOOLEAN ;
+
+
+(*
+ SetScaffoldMain - set the -fscaffold-main flag.
+*)
+
+PROCEDURE SetScaffoldMain (value: BOOLEAN) ;
+
+
+(*
+ SetRuntimeModuleOverride - set the override sequence used for module
+ initialization and finialization.
+*)
+
+PROCEDURE SetRuntimeModuleOverride (override: ADDRESS) ;
+
+
+(*
+ GetRuntimeModuleOverride - return a string containing any user override
+ or the default module initialization override
+ sequence.
+*)
+
+PROCEDURE GetRuntimeModuleOverride () : ADDRESS ;
+
+
(*
SetWholeProgram - sets the WholeProgram flag (-fwhole-program).
*)
diff --git a/gcc/m2/gm2-compiler/M2Options.mod b/gcc/m2/gm2-compiler/M2Options.mod
index 510742c3f2a..f513f52f533 100644
--- a/gcc/m2/gm2-compiler/M2Options.mod
+++ b/gcc/m2/gm2-compiler/M2Options.mod
@@ -51,11 +51,12 @@ CONST
Debugging = FALSE ;
VAR
+ RuntimeModuleOverride,
CppProgram,
- CppArgs : String ;
+ CppArgs : String ;
CC1Quiet,
- SeenSources : BOOLEAN ;
- ForcedLocationValue: location_t ;
+ SeenSources : BOOLEAN ;
+ ForcedLocationValue : location_t ;
(* String garbage collection debugging routines.
@@ -250,7 +251,7 @@ END SetWholeProgram ;
PROCEDURE SetReturnCheck (value: BOOLEAN) : BOOLEAN ;
BEGIN
ReturnChecking := value ;
- RETURN( TRUE )
+ RETURN TRUE
END SetReturnCheck ;
@@ -1035,8 +1036,83 @@ BEGIN
END SetSaveTempsDir ;
+(*
+ SetScaffoldDynamic - set the -fscaffold-dynamic flag.
+*)
+
+PROCEDURE SetScaffoldDynamic (value: BOOLEAN) ;
+BEGIN
+ ScaffoldDynamic := value
+END SetScaffoldDynamic ;
+
+
+(*
+ SetScaffoldStatic - set the -fscaffold-static flag.
+*)
+
+PROCEDURE SetScaffoldStatic (value: BOOLEAN) ;
+BEGIN
+ ScaffoldStatic := value
+END SetScaffoldStatic ;
+
+
+(*
+ GetScaffoldDynamic - get the -fscaffold-dynamic flag.
+*)
+
+PROCEDURE GetScaffoldDynamic () : BOOLEAN ;
+BEGIN
+ RETURN ScaffoldDynamic
+END GetScaffoldDynamic ;
+
+
+(*
+ GetScaffoldStatic - get the -fscaffold-static flag.
+*)
+
+PROCEDURE GetScaffoldStatic () : BOOLEAN ;
+BEGIN
+ RETURN ScaffoldStatic
+END GetScaffoldStatic ;
+
+
+(*
+ SetScaffoldMain - set the -fscaffold-main flag.
+*)
+
+PROCEDURE SetScaffoldMain (value: BOOLEAN) ;
+BEGIN
+ ScaffoldMain := value
+END SetScaffoldMain ;
+
+
+(*
+ SetRuntimeModuleOverride - set the override sequence used for module
+ initialization and finialization.
+*)
+
+PROCEDURE SetRuntimeModuleOverride (override: ADDRESS) ;
+BEGIN
+ RuntimeModuleOverride := KillString (RuntimeModuleOverride) ;
+ RuntimeModuleOverride := InitStringCharStar (override)
+END SetRuntimeModuleOverride ;
+
+
+(*
+ GetRuntimeModuleOverride - return a string containing any user override
+ or the default module initialization override
+ sequence.
+*)
+
+PROCEDURE GetRuntimeModuleOverride () : ADDRESS ;
+BEGIN
+ RETURN RuntimeModuleOverride
+END GetRuntimeModuleOverride ;
+
+
BEGIN
cflag := FALSE ; (* -c. *)
+ RuntimeModuleOverride := NIL ;
CppArgs := InitString ('') ;
CppProgram := InitString ('') ;
Pim := TRUE ;
@@ -1091,5 +1167,8 @@ BEGIN
UnusedParameterChecking := FALSE ;
StrictTypeChecking := TRUE ;
AutoInit := FALSE ;
- SaveTemps := FALSE
+ SaveTemps := FALSE ;
+ ScaffoldDynamic := TRUE ;
+ ScaffoldStatic := FALSE ;
+ ScaffoldMain := FALSE
END M2Options.
diff --git a/gcc/m2/gm2-compiler/M2Quads.def b/gcc/m2/gm2-compiler/M2Quads.def
index b361e4dca7f..cebf6ae2158 100644
--- a/gcc/m2/gm2-compiler/M2Quads.def
+++ b/gcc/m2/gm2-compiler/M2Quads.def
@@ -32,7 +32,7 @@ FROM SYSTEM IMPORT WORD ;
FROM DynamicStrings IMPORT String ;
EXPORT QUALIFIED StartBuildDefFile, StartBuildModFile, EndBuildFile,
- BuildModuleStart,
+ BuildModuleStart, BuildScaffold,
StartBuildInit, EndBuildInit,
StartBuildFinally, EndBuildFinally,
BuildExceptInitial, BuildExceptFinally,
@@ -510,6 +510,14 @@ PROCEDURE EraseQuad (QuadNo: CARDINAL) ;
PROCEDURE CountQuads () : CARDINAL ;
+(*
+ BuildScaffold - generate the main, init, finish functions if
+ no -c and this is the application module.
+*)
+
+PROCEDURE BuildScaffold (tok: CARDINAL; moduleSym: CARDINAL) ;
+
+
(*
StartBuildDefFile - generates a StartFileOp quadruple indicating the file
that has produced the subsequent quadruples.
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index a388c2ace94..d5dc6d164a9 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -24,9 +24,11 @@ IMPLEMENTATION MODULE M2Quads ;
FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
FROM M2Debug IMPORT Assert, WriteDebug ;
-FROM NameKey IMPORT Name, NulName, MakeKey, GetKey, makekey, KeyToCharStar ;
+FROM NameKey IMPORT Name, NulName, MakeKey, GetKey, makekey, KeyToCharStar, WriteKey ;
FROM FormatStrings IMPORT Sprintf0, Sprintf1, Sprintf2, Sprintf3 ;
FROM M2DebugStack IMPORT DebugStack ;
+FROM M2Scaffold IMPORT DeclareScaffold, mainFunction, initFunction,
+ finiFunction ;
FROM M2MetaError IMPORT MetaError0, MetaError1, MetaError2, MetaError3,
MetaErrors1, MetaErrors2, MetaErrors3,
@@ -65,6 +67,7 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown,
GetWriteLimitQuads, GetReadLimitQuads,
GetVarScope,
GetModuleQuads, GetProcedureQuads,
+ GetModuleCtors,
MakeProcedure,
MakeConstStringCnul, MakeConstStringM2nul,
PutConstString,
@@ -108,6 +111,9 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown,
GetVariableAtAddress, IsVariableAtAddress,
MakeError, UnknownReported,
IsInnerModule,
+ IsImportStatement, IsImport, GetImportModule, GetImportDeclared,
+ GetImportStatementList,
+ GetModuleDefImportStatementList, GetModuleModImportStatementList,
GetUnboundedRecordType,
GetUnboundedAddressOffset,
@@ -196,7 +202,8 @@ FROM M2Options IMPORT NilChecking,
Iso, Pim, Pim2, Pim3, Pim4, PositiveModFloorDiv,
Pedantic, CompilerDebugging, GenerateDebugging,
GenerateLineDebug, Exceptions,
- Profiling, Coding, Optimizing ;
+ Profiling, Coding, Optimizing,
+ ScaffoldDynamic, ScaffoldStatic, cflag, ScaffoldMain ;
FROM M2Pass IMPORT IsPassCodeGeneration, IsNoPass ;
@@ -2219,11 +2226,363 @@ BEGIN
'{%E}the {%kRETRY} statement must occur after an {%kEXCEPT} statement in the same module or procedure block')
ELSE
BuildRTExceptLeave (tok, FALSE) ;
- GenQuadO (tok, RetryOp, NulSym, NulSym, PeepWord(TryStack, 1), FALSE)
+ GenQuadO (tok, RetryOp, NulSym, NulSym, PeepWord (TryStack, 1), FALSE)
END
END BuildRetry ;
+(*
+ callRequestDependant - create a call:
+ RequestDependant (GetSymName (modulesym), GetSymName (depModuleSym));
+*)
+
+PROCEDURE callRequestDependant (tokno: CARDINAL;
+ moduleSym, depModuleSym: CARDINAL;
+ requestDep: CARDINAL) ;
+BEGIN
+ Assert (requestDep # NulSym) ;
+ PushTtok (requestDep, tokno) ;
+ PushTF (Adr, Address) ;
+ PushTtok (MakeConstLitString (tokno, GetSymName (moduleSym)), tokno) ;
+ PushT (1) ;
+ BuildAdrFunction ;
+
+ IF depModuleSym = NulSym
+ THEN
+ PushTF (Nil, Address)
+ ELSE
+ PushTF (Adr, Address) ;
+ PushTtok (MakeConstLitString (tokno, GetSymName (depModuleSym)), tokno) ;
+ PushT (1) ;
+ BuildAdrFunction
+ END ;
+
+ PushT (2) ;
+ BuildProcedureCall (tokno)
+END callRequestDependant ;
+
+
+(*
+ ForeachImportInDepDo -
+*)
+
+PROCEDURE ForeachImportInDepDo (importStatements: List; moduleSym, requestDep: CARDINAL) ;
+VAR
+ i, j,
+ m, n : CARDINAL ;
+ imported,
+ stmt : CARDINAL ;
+ l : List ;
+BEGIN
+ IF importStatements # NIL
+ THEN
+ i := 1 ;
+ n := NoOfItemsInList (importStatements) ;
+ WHILE i <= n DO
+ stmt := GetItemFromList (importStatements, i) ;
+ Assert (IsImportStatement (stmt)) ;
+ l := GetImportStatementList (stmt) ;
+ j := 1 ;
+ m := NoOfItemsInList (l) ;
+ WHILE j <= m DO
+ imported := GetItemFromList (l, j) ;
+ Assert (IsImport (imported)) ;
+ callRequestDependant (GetImportDeclared (imported),
+ moduleSym, GetImportModule (imported),
+ requestDep) ;
+ INC (j) ;
+ END ;
+ INC (i)
+ END
+ END
+END ForeachImportInDepDo ;
+
+
+(*
+ ForeachImportedModuleDo -
+*)
+
+PROCEDURE ForeachImportedModuleDo (moduleSym, requestDep: CARDINAL) ;
+VAR
+ importStatements: List ;
+BEGIN
+ importStatements := GetModuleModImportStatementList (moduleSym) ;
+ ForeachImportInDepDo (importStatements, moduleSym, requestDep) ;
+ importStatements := GetModuleDefImportStatementList (moduleSym) ;
+ ForeachImportInDepDo (importStatements, moduleSym, requestDep)
+END ForeachImportedModuleDo ;
+
+
+(*
+ BuildM2DepFunction - creates the dependency graph procedure using IR:
+ static void
+ dependencies (void)
+ {
+ M2RTS_RequestDependant (module_name, "b");
+ M2RTS_RequestDependant (module_name, NULL);
+ }
+*)
+
+PROCEDURE BuildM2DepFunction (tokno: CARDINAL; moduleSym: CARDINAL) ;
+VAR
+ requestDep,
+ ctor, init, fini, dep: CARDINAL ;
+BEGIN
+ IF ScaffoldDynamic
+ THEN
+ (* Scaffold required and dynamic dependency graph should be produced. *)
+ GetModuleCtors (moduleSym, ctor, init, fini, dep) ;
+ PushT (dep) ;
+ BuildProcedureStart ;
+ BuildProcedureBegin ;
+ StartScope (dep) ;
+ requestDep := GetQualidentImport (tokno,
+ MakeKey ("RequestDependant"),
+ MakeKey ("M2RTS")) ;
+ IF requestDep # NulSym
+ THEN
+ ForeachImportedModuleDo (moduleSym, requestDep) ;
+ callRequestDependant (tokno, moduleSym, NulSym, requestDep)
+ END ;
+ EndScope ;
+ BuildProcedureEnd ;
+ PopN (1)
+ END
+END BuildM2DepFunction ;
+
+
+(*
+ BuildM2MainFunction - creates the main function with appropriate calls to the scaffold.
+*)
+
+PROCEDURE BuildM2MainFunction (tokno: CARDINAL; modulesym: CARDINAL) ;
+BEGIN
+ IF ScaffoldDynamic OR ScaffoldStatic
+ THEN
+ (* Scaffold required and main should be produced. *)
+ (*
+ int
+ main (int argc, char *argv[], char *envp[])
+ {
+ init (argc, argv, envp);
+ finish ();
+ return 0;
+ }
+ *)
+ PushT (mainFunction) ;
+ BuildProcedureStart ;
+ BuildProcedureBegin ;
+ StartScope (mainFunction) ;
+
+ (* _M2_init (argc, argv, envp); *)
+ PushTtok (initFunction, tokno) ;
+ PushTtok (RequestSym (tokno, MakeKey ("argc")), tokno) ;
+ PushTtok (RequestSym (tokno, MakeKey ("argv")), tokno) ;
+ PushTtok (RequestSym (tokno, MakeKey ("envp")), tokno) ;
+ PushT (3) ;
+ BuildProcedureCall (tokno) ;
+
+ (* _M2_finish (argc, argv, envp); *)
+ PushTtok (finiFunction, tokno) ;
+ PushTtok (RequestSym (tokno, MakeKey ("argc")), tokno) ;
+ PushTtok (RequestSym (tokno, MakeKey ("argv")), tokno) ;
+ PushTtok (RequestSym (tokno, MakeKey ("envp")), tokno) ;
+ PushT (3) ;
+ BuildProcedureCall (tokno) ;
+
+ PushZero (tokno, Integer) ;
+ BuildReturn (tokno) ;
+ EndScope ;
+ BuildProcedureEnd ;
+ PopN (1)
+ END
+END BuildM2MainFunction ;
+
+
+(*
+ BuildM2InitFunction -
+*)
+
+PROCEDURE BuildM2InitFunction (tok: CARDINAL; moduleSym: CARDINAL) ;
+VAR
+ constructModules: CARDINAL ;
+BEGIN
+ IF ScaffoldDynamic OR ScaffoldStatic
+ THEN
+ (* Scaffold required and main should be produced. *)
+ (* int
+ _M2_init (int argc, char *argv[], char *envp[])
+ {
+ M2RTS_ConstructModules (module_name, argc, argv, envp);
+ } *)
+ PushT (initFunction) ;
+ BuildProcedureStart ;
+ BuildProcedureBegin ;
+ StartScope (initFunction) ;
+ IF ScaffoldDynamic
+ THEN
+ constructModules := GetQualidentImport (tok,
+ MakeKey ("ConstructModules"),
+ MakeKey ("M2RTS")) ;
+ IF constructModules # NulSym
+ THEN
+ (* ConstructModules (module_name, argc, argv, envp); *)
+ PushTtok (constructModules, tok) ;
+
+ PushTF(Adr, Address) ;
+ PushTtok (MakeConstLitString (tok, GetSymName (moduleSym)), tok) ;
+ PushT(1) ;
+ BuildAdrFunction ;
+
+ PushTtok (RequestSym (tok, MakeKey ("argc")), tok) ;
+ PushTtok (RequestSym (tok, MakeKey ("argv")), tok) ;
+ PushTtok (RequestSym (tok, MakeKey ("envp")), tok) ;
+ PushT (4) ;
+ BuildProcedureCall (tok) ;
+ END
+ ELSIF ScaffoldStatic
+ THEN
+
+ END ;
+ EndScope ;
+ BuildProcedureEnd ;
+ PopN (1)
+ END
+END BuildM2InitFunction ;
+
+
+(*
+ BuildM2FiniFunction -
+*)
+
+PROCEDURE BuildM2FiniFunction (tok: CARDINAL; moduleSym: CARDINAL) ;
+VAR
+ deconstructModules: CARDINAL ;
+BEGIN
+ IF ScaffoldDynamic OR ScaffoldStatic
+ THEN
+ (* Scaffold required and main should be produced. *)
+ PushT (finiFunction) ;
+ BuildProcedureStart ;
+ BuildProcedureBegin ;
+ StartScope (finiFunction) ;
+ IF ScaffoldDynamic
+ THEN
+ (* static void
+ _M2_finish (int argc, char *argv[], char *envp[])
+ {
+ M2RTS_DeconstructModules (module_name, argc, argv, envp);
+ } *)
+ deconstructModules := GetQualidentImport (tok,
+ MakeKey ("DeconstructModules"),
+ MakeKey ("M2RTS")) ;
+ IF deconstructModules # NulSym
+ THEN
+ (* DeconstructModules (module_name, argc, argv, envp); *)
+ PushTtok (deconstructModules, tok) ;
+
+ PushTF(Adr, Address) ;
+ PushTtok (MakeConstLitString (tok, GetSymName (moduleSym)), tok) ;
+ PushT(1) ;
+ BuildAdrFunction ;
+
+ PushTtok (RequestSym (tok, MakeKey ("argc")), tok) ;
+ PushTtok (RequestSym (tok, MakeKey ("argv")), tok) ;
+ PushTtok (RequestSym (tok, MakeKey ("envp")), tok) ;
+ PushT (4) ;
+ BuildProcedureCall (tok)
+ END
+ ELSIF ScaffoldStatic
+ THEN
+
+ END ;
+ EndScope ;
+ BuildProcedureEnd ;
+ PopN (1)
+ END
+END BuildM2FiniFunction ;
+
+
+(*
+ BuildM2CtorFunction - create a constructor function associated with moduleSym.
+
+ void
+ ctorFunction ()
+ {
+ M2RTS_RegisterModule (GetSymName (moduleSym),
+ init, fini, dependencies);
+ }
+*)
+
+PROCEDURE BuildM2CtorFunction (tok: CARDINAL; moduleSym: CARDINAL) ;
+VAR
+ RegisterModule : CARDINAL ;
+ ctor, init, fini, dep: CARDINAL ;
+BEGIN
+ IF ScaffoldDynamic
+ THEN
+ GetModuleCtors (moduleSym, ctor, init, fini, dep) ;
+ IF ctor # NulSym
+ THEN
+ Assert (IsProcedure (ctor)) ;
+ PushT (ctor) ;
+ BuildProcedureStart ;
+ BuildProcedureBegin ;
+ StartScope (ctor) ;
+ RegisterModule := GetQualidentImport (tok,
+ MakeKey ("RegisterModule"),
+ MakeKey ("M2RTS")) ;
+ IF RegisterModule # NulSym
+ THEN
+ (* RegisterModule (module_name, init, fini, dependencies); *)
+ PushTtok (RegisterModule, tok) ;
+
+ PushTF (Adr, Address) ;
+ PushTtok (MakeConstLitString (tok, GetSymName (moduleSym)), tok) ;
+ PushT (1) ;
+ BuildAdrFunction ;
+
+ PushTtok (init, tok) ;
+ PushTtok (fini, tok) ;
+ PushTtok (dep, tok) ;
+ PushT (4) ;
+ BuildProcedureCall (tok)
+ END ;
+ EndScope ;
+ BuildProcedureEnd ;
+ PopN (1)
+ END
+ END
+END BuildM2CtorFunction ;
+
+
+(*
+ BuildScaffold - generate the main, init, finish functions if
+ no -c and this is the application module.
+*)
+
+PROCEDURE BuildScaffold (tok: CARDINAL; moduleSym: CARDINAL) ;
+BEGIN
+ IF GetMainModule () = moduleSym
+ THEN
+ DeclareScaffold (tok) ;
+ IF (ScaffoldMain OR (NOT cflag))
+ THEN
+ (* There are module init/fini functions and
+ application init/fini functions.
+ Here we create the application pair. *)
+ BuildM2MainFunction (tok, moduleSym) ;
+ BuildM2InitFunction (tok, moduleSym) ; (* Application init. *)
+ BuildM2FiniFunction (tok, moduleSym) ; (* Application fini. *)
+ END ;
+ BuildM2DepFunction (tok, moduleSym) ; (* Per module dependency. *)
+ (* Each module needs a ctor to register the module
+ init/finish/dep with M2RTS. *)
+ BuildM2CtorFunction (tok, moduleSym)
+ END
+END BuildScaffold ;
+
+
(*
BuildModuleStart - starts current module scope.
*)
@@ -7611,12 +7970,12 @@ BEGIN
MetaErrorNT2 (tokno,
'module {%E%a} cannot be found and is needed to import {%E%a}', module, n) ;
FlushErrors ;
- RETURN( NulSym )
+ RETURN NulSym
END ;
Assert(IsDefImp(ModSym)) ;
- IF (GetExported(tokno, ModSym, n)=NulSym) OR IsUnknown (GetExported (tokno, ModSym, n))
+ IF (GetExported (tokno, ModSym, n)=NulSym) OR IsUnknown (GetExported (tokno, ModSym, n))
THEN
- MetaErrorN2 ('module {%E%a} does not export procedure {%E%a} which is a necessary component of the runtime system, hint check the path and library/language variant',
+ MetaErrorN2 ('module {%1a} does not export procedure {%2a} which is a necessary component of the runtime system, hint check the path and library/language variant',
module, n) ;
FlushErrors ;
RETURN NulSym
diff --git a/gcc/m2/gm2-compiler/P1SymBuild.def b/gcc/m2/gm2-compiler/P1SymBuild.def
index 178a02c9aba..d4b31411353 100644
--- a/gcc/m2/gm2-compiler/P1SymBuild.def
+++ b/gcc/m2/gm2-compiler/P1SymBuild.def
@@ -52,7 +52,9 @@ EXPORT QUALIFIED P1StartBuildDefinitionModule,
BuildProcedureHeading,
BuildNulName,
BuildTypeEnd,
- CheckExplicitExported ;
+ CheckExplicitExported,
+ BuildImportStatement,
+ AddImportToImportStatement ;
(*
@@ -527,4 +529,34 @@ PROCEDURE BuildNulName ;
PROCEDURE BuildTypeEnd ;
+(*
+ BuildImportStatement - create a new import statement in the current module.
+ It ignores local modules.
+
+ The quadruple stack is not used.
+*)
+
+PROCEDURE BuildImportStatement (tok: CARDINAL) ;
+
+
+(*
+ AddImportToImportStatement - the top of stack is expected to be a module name.
+ This is looked up from the module universe and
+ wrapped in an import symbol and placed into the
+ current import statement.
+
+ The quadruple stack is unchanged.
+
+ Entry Exit
+
+
+ Ptr -> <- Ptr
+ +---------------------+ +---------------------+
+ | ImportedModuleName | | ImportedModuleName |
+ |---------------------| |---------------------|
+*)
+
+PROCEDURE AddImportToImportStatement (qualified: BOOLEAN) ;
+
+
END P1SymBuild.
diff --git a/gcc/m2/gm2-compiler/P1SymBuild.mod b/gcc/m2/gm2-compiler/P1SymBuild.mod
index 37caebd9bf2..a659c1fc8bd 100644
--- a/gcc/m2/gm2-compiler/P1SymBuild.mod
+++ b/gcc/m2/gm2-compiler/P1SymBuild.mod
@@ -39,6 +39,10 @@ FROM P0SymBuild IMPORT EnterBlock, LeaveBlock ;
FROM SymbolTable IMPORT NulSym,
ModeOfAddr,
+ AppendModuleOnImportStatement,
+ AppendModuleImportStatement,
+ MakeImportStatement, MakeImport,
+
StartScope, EndScope, PseudoScope,
GetScope, GetCurrentScope,
IsDeclaredIn,
@@ -49,7 +53,7 @@ FROM SymbolTable IMPORT NulSym,
MakeHiddenType,
PutMode,
PutFieldEnumeration, PutSubrange, PutVar,
- IsDefImp, IsModule, IsType,
+ IsDefImp, IsModule, IsInnerModule, IsType,
GetCurrentModule,
AddSymToModuleScope,
AddNameToImportList,
@@ -96,6 +100,9 @@ FROM M2Comp IMPORT CompilingDefinitionModule,
CONST
Debugging = FALSE ;
+VAR
+ importStatementCount: CARDINAL ;
+
(*
CheckFileName - checks to see that the module name matches the file name.
@@ -155,6 +162,7 @@ VAR
language,
ModuleSym: CARDINAL ;
BEGIN
+ importStatementCount := 0 ;
PopT(name) ;
(* CheckFileName(name, 'definition') ; *)
ModuleSym := MakeDefinitionSource(GetTokenNo(), name) ;
@@ -242,6 +250,7 @@ VAR
name : Name ;
ModuleSym: CARDINAL ;
BEGIN
+ importStatementCount := 0 ;
PopTtok (name, tok) ;
(* CheckFileName(name, 'implementation') ; *)
ModuleSym := MakeImplementationSource (tok, name) ;
@@ -315,6 +324,7 @@ VAR
name : Name ;
ModuleSym: CARDINAL ;
BEGIN
+ importStatementCount := 0 ;
PopTtok(name, tok) ;
(* CheckFileName(name, 'main') ; *)
ModuleSym := MakeProgramSource(tok, name) ;
@@ -1087,8 +1097,69 @@ VAR
Type: CARDINAL ;
name: Name ;
BEGIN
- PopTF(Type, name)
+ PopTF (Type, name)
END BuildTypeEnd ;
+(*
+ BuildImportStatement - create a new import statement in the current module.
+ It ignores local modules.
+
+ The quadruple stack is not used.
+*)
+
+PROCEDURE BuildImportStatement (tok: CARDINAL) ;
+VAR
+ scope: CARDINAL ;
+BEGIN
+ scope := GetCurrentScope () ;
+ IF IsDefImp (scope) OR (IsModule (scope) AND (NOT IsInnerModule (scope)))
+ THEN
+ IF CompilingDefinitionModule () AND (NOT IsDefImp (scope))
+ THEN
+ MetaError1 ('module scope should be a definition module rather than {%1EDa}', scope)
+ ELSE
+ INC (importStatementCount) ;
+ AppendModuleImportStatement (scope, MakeImportStatement (tok, importStatementCount))
+ END
+ END
+END BuildImportStatement ;
+
+
+(*
+ AddImportToImportStatement - the top of stack is expected to be a module name.
+ This is looked up from the module universe and
+ wrapped in an import symbol and placed into the
+ current import statement.
+
+ The quadruple stack is unchanged.
+
+ Entry Exit
+
+
+ Ptr -> <- Ptr
+ +---------------------+ +---------------------+
+ | ImportedModuleName | | ImportedModuleName |
+ |---------------------| |---------------------|
+*)
+
+PROCEDURE AddImportToImportStatement (qualified: BOOLEAN) ;
+VAR
+ scope: CARDINAL ;
+BEGIN
+ scope := GetCurrentScope () ;
+ IF IsDefImp (scope) OR (IsModule (scope) AND (NOT IsInnerModule (scope)))
+ THEN
+ IF CompilingDefinitionModule () AND (NOT IsDefImp (scope))
+ THEN
+ MetaError1 ('module scope should be a definition module rather than {%1EDa}', scope) ;
+ ELSE
+ AppendModuleOnImportStatement (scope, MakeImport (OperandTok (1),
+ LookupModule (OperandTok (1), OperandT (1)),
+ importStatementCount, qualified))
+ END
+ END
+END AddImportToImportStatement ;
+
+
END P1SymBuild.
diff --git a/gcc/m2/gm2-compiler/P2SymBuild.def b/gcc/m2/gm2-compiler/P2SymBuild.def
index 21ed63eae8b..e7ed35f5545 100644
--- a/gcc/m2/gm2-compiler/P2SymBuild.def
+++ b/gcc/m2/gm2-compiler/P2SymBuild.def
@@ -42,6 +42,7 @@ EXPORT QUALIFIED P2StartBuildDefModule,
BuildExportOuterModule,
BuildImportInnerModule,
BuildExportInnerModule,
+ BlockStart, BlockEnd, BlockBegin, BlockFinally,
BuildNumber,
BuildString,
BuildConst,
@@ -92,6 +93,33 @@ EXPORT QUALIFIED P2StartBuildDefModule,
RememberConstant ;
+(*
+ BlockStart - tokno is the module/procedure/implementation/definition token
+*)
+
+PROCEDURE BlockStart (tokno: CARDINAL) ;
+
+(*
+ BlockEnd - declare module ctor/init/fini/dep procedures.
+*)
+
+PROCEDURE BlockEnd (tokno: CARDINAL) ;
+
+
+(*
+ BlockBegin - assign curBeginTok to tokno.
+*)
+
+PROCEDURE BlockBegin (tokno: CARDINAL) ;
+
+
+(*
+ BlockFinally - assign curFinallyTok to tokno.
+*)
+
+PROCEDURE BlockFinally (tokno: CARDINAL) ;
+
+
(*
StartBuildDefinitionModule - Creates a definition module and starts
a new scope.
diff --git a/gcc/m2/gm2-compiler/P2SymBuild.mod b/gcc/m2/gm2-compiler/P2SymBuild.mod
index 0580da4bf87..97aeb8de0eb 100644
--- a/gcc/m2/gm2-compiler/P2SymBuild.mod
+++ b/gcc/m2/gm2-compiler/P2SymBuild.mod
@@ -58,6 +58,7 @@ FROM SymbolTable IMPORT NulSym,
MakeConstLitString,
MakeSubrange,
MakeVar, MakeType, PutType,
+ MakeModuleCtor,
PutMode, PutDeclared,
PutFieldEnumeration, PutSubrange, PutVar, PutConst,
PutConstSet, PutConstructor,
@@ -153,11 +154,110 @@ VAR
RememberedConstant: CARDINAL ;
RememberStack,
TypeStack : StackOfWord ;
-
+ curModuleSym : CARDINAL ;
+ curBeginTok,
+ curFinallyTok,
+ curStartTok,
+ curEndTok : CARDINAL ;
+ BlockStack : StackOfWord ;
PROCEDURE stop ; BEGIN END stop ;
+
+(*
+ BlockStart - tokno is the module/procedure/implementation/definition token
+*)
+
+PROCEDURE BlockStart (tokno: CARDINAL) ;
+BEGIN
+ PushBlock (tokno) ;
+END BlockStart ;
+
+
+(*
+ propageteTokenPosition - if laterTokPos is unknown then return knownTokPos.
+ else return laterTokPos.
+*)
+
+PROCEDURE propageteTokenPosition (knownTokPos, laterTokPos: CARDINAL) : CARDINAL ;
+BEGIN
+ IF laterTokPos = UnknownTokenNo
+ THEN
+ RETURN knownTokPos
+ ELSE
+ RETURN laterTokPos
+ END
+END propageteTokenPosition ;
+
+
+(*
+ BlockEnd - declare module ctor/init/fini/dep procedures.
+*)
+
+PROCEDURE BlockEnd (tokno: CARDINAL) ;
+BEGIN
+ curBeginTok := propageteTokenPosition (curStartTok, curBeginTok) ;
+ curFinallyTok := propageteTokenPosition (tokno, curFinallyTok) ;
+ MakeModuleCtor (curStartTok, curBeginTok, curFinallyTok,
+ curModuleSym) ;
+ PopBlock
+END BlockEnd ;
+
+
+(*
+ BlockBegin - assign curBeginTok to tokno.
+*)
+
+PROCEDURE BlockBegin (tokno: CARDINAL) ;
+BEGIN
+ curBeginTok := tokno
+END BlockBegin ;
+
+
+(*
+ BlockFinally - assign curFinallyTok to tokno.
+*)
+
+PROCEDURE BlockFinally (tokno: CARDINAL) ;
+BEGIN
+ curFinallyTok := tokno
+END BlockFinally ;
+
+
+(*
+ PushBlock - push the block variables to the block stack.
+*)
+
+PROCEDURE PushBlock (tokno: CARDINAL) ;
+BEGIN
+ PushWord (BlockStack, curStartTok) ; (* module/implementation/definition/procedure token pos. *)
+ PushWord (BlockStack, curBeginTok) ; (* BEGIN keyword pos. *)
+ PushWord (BlockStack, curEndTok) ; (* END keyword pos. *)
+ PushWord (BlockStack, curFinallyTok) ; (* FINALLY keyword pos. *)
+ PushWord (BlockStack, curModuleSym) ; (* current module. *)
+ curStartTok := tokno ;
+ curBeginTok := UnknownTokenNo ;
+ curEndTok := UnknownTokenNo ;
+ curFinallyTok := UnknownTokenNo ;
+ curModuleSym := NulSym
+END PushBlock ;
+
+
+(*
+ PopBlock - pop the block variables from the block stack.
+*)
+
+PROCEDURE PopBlock ;
+BEGIN
+ curFinallyTok := PopWord (BlockStack) ;
+ curEndTok := PopWord (BlockStack) ;
+ curBeginTok := PopWord (BlockStack) ;
+ curStartTok := PopWord (BlockStack) ;
+ curModuleSym := PopWord (BlockStack)
+END PopBlock ;
+
+
(*
StartBuildDefinitionModule - Creates a definition module and starts
a new scope.
@@ -181,6 +281,7 @@ VAR
BEGIN
PopTtok(name, tokno) ;
ModuleSym := MakeDefinitionSource(tokno, name) ;
+ curModuleSym := ModuleSym ;
SetCurrentModule(ModuleSym) ;
SetFileModule(ModuleSym) ;
StartScope(ModuleSym) ;
@@ -254,6 +355,7 @@ VAR
BEGIN
PopTtok(name, tokno) ;
ModuleSym := MakeImplementationSource(tokno, name) ;
+ curModuleSym := ModuleSym ;
SetCurrentModule(ModuleSym) ;
SetFileModule(ModuleSym) ;
StartScope(ModuleSym) ;
@@ -322,6 +424,7 @@ VAR
BEGIN
PopTtok(name, tokno) ;
ModuleSym := MakeProgramSource(tokno, name) ;
+ curModuleSym := ModuleSym ;
SetCurrentModule(ModuleSym) ;
SetFileModule(ModuleSym) ;
StartScope(ModuleSym) ;
@@ -395,6 +498,7 @@ VAR
BEGIN
PopTtok (name, tok) ;
ModuleSym := GetDeclareSym (tok, name) ;
+ curModuleSym := ModuleSym ;
StartScope (ModuleSym) ;
Assert(NOT IsDefImp (ModuleSym)) ;
PushTtok (name, tok) ;
@@ -2993,7 +3097,8 @@ END RememberConstant ;
BEGIN
alignTypeNo := 0 ;
- TypeStack := InitStackWord() ;
- RememberStack := InitStackWord() ;
+ TypeStack := InitStackWord () ;
+ RememberStack := InitStackWord () ;
+ BlockStack := InitStackWord () ;
castType := NulSym
END P2SymBuild.
diff --git a/gcc/m2/gm2-compiler/SymbolTable.def b/gcc/m2/gm2-compiler/SymbolTable.def
index 53c48c31f48..8bea7f1e934 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.def
+++ b/gcc/m2/gm2-compiler/SymbolTable.def
@@ -35,6 +35,7 @@ FROM NameKey IMPORT Name ;
FROM m2tree IMPORT Tree ;
FROM DynamicStrings IMPORT String ;
FROM M2Error IMPORT ErrorScope ;
+FROM Lists IMPORT List ;
EXPORT QUALIFIED NulSym,
FinalSymbol,
@@ -42,6 +43,9 @@ EXPORT QUALIFIED NulSym,
ModeOfAddr,
GetMode, PutMode,
+ AppendModuleOnImportStatement,
+ AppendModuleImportStatement,
+
StartScope, EndScope, PseudoScope,
GetCurrentScope,
IsDeclaredIn,
@@ -51,7 +55,7 @@ EXPORT QUALIFIED NulSym,
SetMainModule,
SetFileModule,
MakeModule, MakeDefImp,
- MakeInnerModule,
+ MakeInnerModule, MakeModuleCtor,
MakeProcedure,
MakeConstLit,
MakeConstVar,
@@ -77,6 +81,7 @@ EXPORT QUALIFIED NulSym,
MakeUnbounded,
MakeOAFamily,
MakeProcType,
+ MakeImport, MakeImportStatement,
Make2Tuple,
MakeGnuAsm,
MakeRegInterface,
@@ -134,6 +139,9 @@ EXPORT QUALIFIED NulSym,
PutDeclaredPacked, IsDeclaredPacked, IsDeclaredPackedResolved,
GetPackedEquivalent, GetNonPackedEquivalent,
GetConstStringM2, GetConstStringC, GetConstStringM2nul, GetConstStringCnul,
+ GetModuleCtors,
+ GetImportModule, GetImportDeclared,
+ GetImportStatementList, GetModuleDefImportStatementList, GetModuleModImportStatementList,
PutVar,
PutLeftValueFrontBackType,
@@ -186,6 +194,7 @@ EXPORT QUALIFIED NulSym,
PutAlignment, PutDefaultRecordFieldAlignment,
PutUnused, IsUnused,
PutVariableSSA, IsVariableSSA,
+ PutPublic, IsPublic, PutCtor, IsCtor,
IsDefImp,
IsModule,
@@ -209,6 +218,8 @@ EXPORT QUALIFIED NulSym,
IsArray,
IsRecordField,
IsProcType,
+ IsImport,
+ IsImportStatement,
IsVar,
IsConst,
IsConstString,
@@ -561,6 +572,52 @@ PROCEDURE MakeInnerModule (tok: CARDINAL; ModuleName: Name) : CARDINAL ;
PROCEDURE MakeProcedure (tok: CARDINAL; ProcedureName: Name) : CARDINAL ;
+(*
+ PutPublic - changes the public boolean inside the procedure.
+*)
+
+PROCEDURE PutPublic (sym: CARDINAL; value: BOOLEAN) ;
+
+
+(*
+ IsPublic - returns the public boolean associated with a procedure.
+*)
+
+PROCEDURE IsPublic (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+ PutCtor - changes the ctor boolean inside the procedure.
+*)
+
+PROCEDURE PutCtor (sym: CARDINAL; value: BOOLEAN) ;
+
+
+(*
+ IsCtor - returns the ctor boolean associated with a procedure.
+*)
+
+PROCEDURE IsCtor (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+ GetModuleCtors - mod can be a DefImp or Module symbol. ctor, init and fini
+ are assigned for this module. An inner module ctor value will
+ be NulSym.
+*)
+
+PROCEDURE GetModuleCtors (mod: CARDINAL; VAR ctor, init, fini, dep: CARDINAL) ;
+
+
+(*
+ MakeModuleCtor - for a defimp or module symbol create all the ctor
+ related procedures.
+*)
+
+PROCEDURE MakeModuleCtor (moduleTok, beginTok, finallyTok: CARDINAL;
+ moduleSym: CARDINAL) ;
+
+
(*
MakeVar - creates a variable sym with VarName. It returns the
symbol index.
@@ -637,8 +694,7 @@ PROCEDURE MakeConstVar (tok: CARDINAL; ConstVarName: Name) : CARDINAL ;
(*
MakeConstLitString - put a constant which has the string described by
- ConstName into the ConstantTree.
- The symbol number is returned.
+ ConstName into the ConstantTree and return a symbol.
This symbol is known as a String Constant rather than a
ConstLit which indicates a number.
If the constant already exits
@@ -646,7 +702,6 @@ PROCEDURE MakeConstVar (tok: CARDINAL; ConstVarName: Name) : CARDINAL ;
All values of constant strings
are ignored in Pass 1 and evaluated in Pass 2 via
character manipulation.
- In this procedure ConstName is the string.
*)
PROCEDURE MakeConstLitString (tok: CARDINAL; ConstName: Name) : CARDINAL ;
@@ -3222,4 +3277,129 @@ PROCEDURE PutErrorScope (sym: CARDINAL; errorScope: ErrorScope) ;
*)
+(*
+ MakeImport - create and return an import symbol.
+ moduleSym is the symbol being imported.
+ isqualified is FALSE if it were IMPORT modulename and
+ TRUE for the qualified FROM modulename IMPORT etc.
+ listno is the import list count for this module.
+ tok should match this modulename position.
+*)
+
+PROCEDURE MakeImport (tok: CARDINAL;
+ moduleSym: CARDINAL;
+ listno: CARDINAL;
+ isqualified: BOOLEAN) : CARDINAL ;
+
+
+(*
+ MakeImportStatement - return a dependent symbol which represents an import statement
+ or a qualified import statement. The tok should either match
+ the FROM token or the IMPORT token. listno is the import list
+ count for the module.
+*)
+
+PROCEDURE MakeImportStatement (tok: CARDINAL; listno: CARDINAL) : CARDINAL ;
+
+
+(*
+ IsImport - returns TRUE if sym is an import symbol.
+*)
+
+PROCEDURE IsImport (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+ IsImportStatement - returns TRUE if sym is a dependent symbol.
+*)
+
+PROCEDURE IsImportStatement (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+ GetImportModule - returns the module associated with the import symbol.
+*)
+
+PROCEDURE GetImportModule (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+ GetImportDeclared - returns the token associated with the import symbol.
+*)
+
+PROCEDURE GetImportDeclared (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+ GetImportStatementList - returns the list of imports for this dependent.
+ Each import symbol corresponds to a module.
+*)
+
+PROCEDURE GetImportStatementList (sym: CARDINAL) : List ;
+
+
+(*
+ GetModuleDefImportStatementList - returns the list of dependents associated with
+ the definition module.
+*)
+
+PROCEDURE GetModuleDefImportStatementList (sym: CARDINAL) : List ;
+
+
+(*
+ GetModuleModImportStatementList - returns the list of dependents associated with
+ the implementation or program module.
+*)
+
+PROCEDURE GetModuleModImportStatementList (sym: CARDINAL) : List ;
+
+
+(*
+ AppendModuleImportStatement - appends the ImportStatement symbol onto the
+ module import list.
+
+ For example:
+
+ FROM x IMPORT y, z ;
+ ^^^^
+
+ also:
+
+ IMPORT p, q, r;
+ ^^^^^^
+ will result in a new ImportStatement symbol added
+ to the current module import list.
+ The ImportStatement symbol is expected to be created
+ by MakeImportStatement using the token positions
+ outlined above.
+*)
+
+PROCEDURE AppendModuleImportStatement (module, statement: CARDINAL) ;
+
+
+(*
+ AppendModuleOnImportStatement - appends the import symbol onto the
+ dependent list (chain).
+
+ For example each:
+
+ FROM x IMPORT y, z ;
+ ^
+ x are added to the dependent list.
+
+ also:
+
+ IMPORT p, q, r;
+ ^ ^ ^
+ will result in p, q and r added to
+ to the dependent list.
+
+ The import symbol is created by MakeImport
+ and the token is expected to match the module
+ name outlined above.
+*)
+
+PROCEDURE AppendModuleOnImportStatement (module, import: CARDINAL) ;
+
+
END SymbolTable.
diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod
index fa2d2f0a083..5c068022ef0 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.mod
+++ b/gcc/m2/gm2-compiler/SymbolTable.mod
@@ -31,7 +31,7 @@ IMPORT Indexing ;
FROM Indexing IMPORT InitIndex, InBounds, LowIndice, HighIndice, PutIndice, GetIndice ;
FROM Sets IMPORT Set, InitSet, IncludeElementIntoSet, IsElementInSet ;
-FROM M2Options IMPORT Pedantic, ExtendedOpaque, DebugFunctionLineNumbers ;
+FROM M2Options IMPORT Pedantic, ExtendedOpaque, DebugFunctionLineNumbers, ScaffoldDynamic ;
FROM M2LexBuf IMPORT UnknownTokenNo, TokenToLineNo, FindFileNameFromToken ;
FROM M2ALU IMPORT InitValue, PtrToValue, PushCard, PopInto,
@@ -82,6 +82,7 @@ FROM M2Comp IMPORT CompilingDefinitionModule,
CompilingImplementationModule ;
FROM FormatStrings IMPORT HandleEscape ;
+FROM M2Scaffold IMPORT DeclareArgEnvParams ;
IMPORT Indexing ;
@@ -115,6 +116,7 @@ TYPE
DefImpSym, ModuleSym, SetSym, ProcedureSym, ProcTypeSym,
SubscriptSym, UnboundedSym, GnuAsmSym, InterfaceSym,
ObjectSym, PartialUnboundedSym, TupleSym, OAFamilySym,
+ ImportSym, ImportStatementSym,
EquivSym, ErrorSym) ;
Where = RECORD
@@ -128,12 +130,34 @@ TYPE
PackedEquiv : CARDINAL ; (* the equivalent packed type *)
END ;
- PtrToAsmConstraint = POINTER TO AsmConstraint ;
- AsmConstraint = RECORD
- name: Name ;
- str : CARDINAL ; (* regnames or constraints *)
- obj : CARDINAL ; (* list of M2 syms *)
- END ;
+ PtrToAsmConstraint = POINTER TO RECORD
+ name: Name ;
+ str : CARDINAL ; (* regnames or constraints *)
+ obj : CARDINAL ; (* list of M2 syms *)
+ END ;
+
+ ModuleCtor = RECORD
+ ctor: CARDINAL ; (* Procedure which will become a ctor. *)
+ init: CARDINAL ; (* Module initialization block proc. *)
+ fini: CARDINAL ; (* Module Finalization block proc. *)
+ dep : CARDINAL ; (* Module dependency proc. *)
+ END ;
+
+ (* Each import list has a import statement symbol. *)
+
+ SymImportStatement = RECORD
+ listNo : CARDINAL ; (* The import list no. *)
+ ListOfImports: List ; (* Vector of SymImports. *)
+ at : Where ; (* The FROM or IMPORT token. *)
+ END ;
+
+ SymImport = RECORD
+ module : CARDINAL ; (* The module imported. *)
+ listNo : CARDINAL ; (* The import list no. *)
+ qualified: BOOLEAN ; (* Is the complete module imported? *)
+ at : Where ; (* token corresponding to the *)
+ (* module name in the import. *)
+ END ;
SymEquiv = RECORD
packedInfo: PackedInfo ;
@@ -332,8 +356,10 @@ TYPE
OptArgInit : CARDINAL ; (* The optarg initial value. *)
IsBuiltin : BOOLEAN ; (* Was it declared __BUILTIN__ ? *)
BuiltinName : Name ; (* name of equivalent builtin *)
- IsInline : BOOLEAN ; (* Was is declared __INLINE__ ? *)
+ IsInline : BOOLEAN ; (* Was it declared __INLINE__ ? *)
ReturnOptional: BOOLEAN ; (* Is the return value optional? *)
+ IsPublic : BOOLEAN ; (* Make this procedure visible. *)
+ IsCtor : BOOLEAN ; (* Is this procedure a ctor? *)
Unresolved : SymbolTree ; (* All symbols currently *)
(* unresolved in this procedure. *)
ScopeQuad : CARDINAL ; (* Index into quads for scope *)
@@ -579,6 +605,9 @@ TYPE
RECORD
name : Name ; (* Index into name array, name *)
(* of record field. *)
+ ctors : ModuleCtor ; (* All the ctor functions. *)
+ DefListOfDep,
+ ModListOfDep : List ; (* Vector of SymDependency. *)
ExportQualifiedTree: SymbolTree ;
(* Holds all the export *)
(* Qualified identifiers. *)
@@ -672,6 +701,8 @@ TYPE
RECORD
name : Name ; (* Index into name array, name *)
(* of record field. *)
+ ctors : ModuleCtor ; (* All the ctor functions. *)
+ ModListOfDep : List ; (* Vector of SymDependency. *)
LocalSymbols : SymbolTree ; (* The LocalSymbols hold all the *)
(* variables declared local to *)
(* the block. It contains the *)
@@ -770,6 +801,8 @@ TYPE
SetSym : Set : SymSet |
ProcedureSym : Procedure : SymProcedure |
ProcTypeSym : ProcType : SymProcType |
+ ImportStatementSym : ImportStatement : SymImportStatement |
+ ImportSym : Import : SymImport |
GnuAsmSym : GnuAsm : SymGnuAsm |
InterfaceSym : Interface : SymInterface |
TupleSym : Tuple : SymTuple |
@@ -883,7 +916,7 @@ END IsNameAnonymous ;
PROCEDURE InitWhereDeclaredTok (tok: CARDINAL; VAR at: Where) ;
BEGIN
WITH at DO
- IF CompilingDefinitionModule()
+ IF CompilingDefinitionModule ()
THEN
DefDeclared := tok ;
ModDeclared := UnknownTokenNo
@@ -947,10 +980,6 @@ VAR
pSym: PtrToSymbol ;
BEGIN
sym := FreeSymbol ;
- IF sym=12066
- THEN
- stop
- END ;
NEW(pSym) ;
WITH pSym^ DO
SymbolType := DummySym
@@ -996,6 +1025,262 @@ BEGIN
END GetPcall ;
+(*
+ MakeImport - create and return an import symbol.
+ moduleSym is the symbol being imported.
+ isqualified is FALSE if it were IMPORT modulename and
+ TRUE for the qualified FROM modulename IMPORT etc.
+ listno is the import list count for this module.
+ tok should match this modulename position.
+*)
+
+PROCEDURE MakeImport (tok: CARDINAL;
+ moduleSym: CARDINAL;
+ listno: CARDINAL;
+ isqualified: BOOLEAN) : CARDINAL ;
+VAR
+ importSym: CARDINAL ;
+ pSym : PtrToSymbol ;
+BEGIN
+ NewSym (importSym) ;
+ pSym := GetPsym (importSym) ;
+ WITH pSym^ DO
+ SymbolType := ImportSym ;
+ WITH Import DO
+ module := moduleSym ;
+ listNo := listno ;
+ qualified := isqualified ;
+ InitWhereDeclaredTok (tok, at)
+ END
+ END ;
+ RETURN importSym
+END MakeImport ;
+
+
+(*
+ MakeImportStatement - return a dependent symbol which represents an import statement
+ or a qualified import statement. The tok should either match
+ the FROM token or the IMPORT token. listno is the import list
+ count for the module.
+*)
+
+PROCEDURE MakeImportStatement (tok: CARDINAL; listno: CARDINAL) : CARDINAL ;
+VAR
+ dependentSym: CARDINAL ;
+ pSym : PtrToSymbol ;
+BEGIN
+ NewSym (dependentSym) ;
+ pSym := GetPsym (dependentSym) ;
+ WITH pSym^ DO
+ SymbolType := ImportStatementSym ;
+ WITH ImportStatement DO
+ listNo := listno ;
+ InitList (ListOfImports) ;
+ InitWhereDeclaredTok (tok, at)
+ END
+ END ;
+ RETURN dependentSym
+END MakeImportStatement ;
+
+
+(*
+ AppendModuleImportStatement - appends the ImportStatement symbol onto the
+ module import list.
+
+ For example:
+
+ FROM x IMPORT y, z ;
+ ^^^^
+
+ also:
+
+ IMPORT p, q, r;
+ ^^^^^^
+ will result in a new ImportStatement symbol added
+ to the current module import list.
+ The statement symbol is expected to be created
+ by MakeImportStatement using the token positions
+ outlined above.
+*)
+
+PROCEDURE AppendModuleImportStatement (module, statement: CARDINAL) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ IF IsDefImp (module)
+ THEN
+ pSym := GetPsym (module) ;
+ IF CompilingDefinitionModule ()
+ THEN
+ IncludeItemIntoList (pSym^.DefImp.DefListOfDep, statement)
+ ELSE
+ IncludeItemIntoList (pSym^.DefImp.ModListOfDep, statement)
+ END
+ ELSIF IsModule (module)
+ THEN
+ pSym := GetPsym (module) ;
+ IncludeItemIntoList (pSym^.Module.ModListOfDep, statement)
+ ELSE
+ InternalError ('expecting DefImp or Module symbol')
+ END
+END AppendModuleImportStatement ;
+
+
+(*
+ AppendModuleOnImportStatement - appends the import symbol onto the
+ dependent list (chain).
+
+ For example each:
+
+ FROM x IMPORT y, z ;
+ ^
+ x are added to the dependent list.
+
+ also:
+
+ IMPORT p, q, r;
+ ^ ^ ^
+ will result in p, q and r added to
+ to the dependent list.
+
+ The import symbol is created by MakeImport
+ and the token is expected to match the module
+ name position outlined above.
+*)
+
+PROCEDURE AppendModuleOnImportStatement (module, import: CARDINAL) ;
+VAR
+ l : List ;
+ lastImportStatement: CARDINAL ;
+BEGIN
+ Assert (IsImport (import)) ;
+ IF CompilingDefinitionModule ()
+ THEN
+ l := GetModuleDefImportStatementList (module)
+ ELSE
+ l := GetModuleModImportStatementList (module)
+ END ;
+ Assert (l # NIL) ;
+ Assert (NoOfItemsInList (l) > 0) ; (* There should always be one on the list. *)
+ lastImportStatement := GetItemFromList (l, NoOfItemsInList (l)) ;
+ Assert (IsImportStatement (lastImportStatement)) ;
+ l := GetImportStatementList (lastImportStatement) ;
+ IncludeItemIntoList (l, import)
+END AppendModuleOnImportStatement ;
+
+
+(*
+ IsImport - returns TRUE if sym is an import symbol.
+*)
+
+PROCEDURE IsImport (sym: CARDINAL) : BOOLEAN ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (sym) ;
+ RETURN pSym^.SymbolType=ImportSym
+END IsImport ;
+
+
+(*
+ IsImportStatement - returns TRUE if sym is a dependent symbol.
+*)
+
+PROCEDURE IsImportStatement (sym: CARDINAL) : BOOLEAN ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (sym) ;
+ RETURN pSym^.SymbolType=ImportStatementSym
+END IsImportStatement ;
+
+
+(*
+ GetImportModule - returns the module associated with the import symbol.
+*)
+
+PROCEDURE GetImportModule (sym: CARDINAL) : CARDINAL ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ Assert (IsImport (sym)) ;
+ pSym := GetPsym (sym) ;
+ RETURN pSym^.Import.module
+END GetImportModule ;
+
+
+(*
+ GetImportDeclared - returns the token associated with the import symbol.
+*)
+
+PROCEDURE GetImportDeclared (sym: CARDINAL) : CARDINAL ;
+VAR
+ tok : CARDINAL ;
+BEGIN
+ Assert (IsImport (sym)) ;
+ tok := GetDeclaredDefinition (sym) ;
+ IF tok = UnknownTokenNo
+ THEN
+ RETURN GetDeclaredModule (sym)
+ END ;
+ RETURN tok
+END GetImportDeclared ;
+
+
+(*
+ GetImportStatementList - returns the list of imports for this dependent.
+ Each import symbol corresponds to a module.
+*)
+
+PROCEDURE GetImportStatementList (sym: CARDINAL) : List ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ Assert (IsImportStatement (sym)) ;
+ pSym := GetPsym (sym) ;
+ RETURN pSym^.ImportStatement.ListOfImports
+END GetImportStatementList ;
+
+
+(*
+ GetModuleDefImportStatementList - returns the list of dependents associated with
+ the definition module.
+*)
+
+PROCEDURE GetModuleDefImportStatementList (sym: CARDINAL) : List ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ Assert (IsModule (sym) OR IsDefImp (sym)) ;
+ IF IsDefImp (sym)
+ THEN
+ pSym := GetPsym (sym) ;
+ RETURN pSym^.DefImp.DefListOfDep
+ END ;
+ RETURN NIL
+END GetModuleDefImportStatementList ;
+
+
+(*
+ GetModuleModImportStatementList - returns the list of dependents associated with
+ the implementation or program module.
+*)
+
+PROCEDURE GetModuleModImportStatementList (sym: CARDINAL) : List ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ Assert (IsModule (sym) OR IsDefImp (sym)) ;
+ pSym := GetPsym (sym) ;
+ IF IsDefImp (sym)
+ THEN
+ RETURN pSym^.DefImp.ModListOfDep
+ ELSE
+ RETURN pSym^.Module.ModListOfDep
+ END
+END GetModuleModImportStatementList ;
+
+
(*
DebugProcedureLineNumber -
*)
@@ -2727,6 +3012,121 @@ BEGIN
END IsImplicityExported ;
+(*
+ GenName - returns a new name consisting of pre, name, post concatenation.
+*)
+
+PROCEDURE GenName (pre: ARRAY OF CHAR; name: Name; post: ARRAY OF CHAR) : Name ;
+VAR
+ str : String ;
+ result: Name ;
+BEGIN
+ str := InitString (pre) ;
+ str := ConCat (str, Mark (InitStringCharStar (KeyToCharStar (name)))) ;
+ str := ConCat (str, InitString (post)) ;
+ result := makekey (string (str)) ;
+ str := KillString (str) ;
+ RETURN result
+END GenName ;
+
+
+(*
+ InitCtor - initialize the ModuleCtor fields to NulSym.
+*)
+
+PROCEDURE InitCtor (VAR ctor: ModuleCtor) ;
+BEGIN
+ ctor.ctor := NulSym ;
+ ctor.dep := NulSym ;
+ ctor.init := NulSym ;
+ ctor.fini := NulSym
+END InitCtor ;
+
+
+(*
+ MakeModuleCtor - for a defimp or module symbol create all the ctor
+ related procedures.
+*)
+
+PROCEDURE MakeModuleCtor (moduleTok, beginTok, finallyTok: CARDINAL;
+ moduleSym: CARDINAL) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ Assert (IsDefImp (moduleSym) OR IsModule (moduleSym)) ;
+ pSym := GetPsym (moduleSym) ;
+ IF IsDefImp (moduleSym)
+ THEN
+ InitCtorFields (moduleTok, beginTok, finallyTok,
+ pSym^.DefImp.ctors, GetSymName (moduleSym), FALSE)
+ ELSE
+ InitCtorFields (moduleTok, beginTok, finallyTok,
+ pSym^.Module.ctors, GetSymName (moduleSym),
+ IsInnerModule (moduleSym))
+ END
+END MakeModuleCtor ;
+
+
+(*
+ InitCtorFields - initialize the ModuleCtor fields. An inner module has no
+ ctor procedure.
+*)
+
+PROCEDURE InitCtorFields (moduleTok, beginTok, finallyTok: CARDINAL;
+ VAR ctor: ModuleCtor; name: Name; inner: BOOLEAN) ;
+BEGIN
+ IF ScaffoldDynamic AND (NOT inner)
+ THEN
+ (* The ctor procedure must be public. *)
+ ctor.ctor := MakeProcedure (moduleTok, GenName ("_M2_", name, "_ctor")) ;
+ PutCtor (ctor.ctor, TRUE) ;
+ PutPublic (ctor.ctor, TRUE) ;
+ (* The dep procedure is local to the module. *)
+ ctor.dep := MakeProcedure (moduleTok, GenName ("_M2_", name, "_dep")) ;
+ ELSE
+ ctor.ctor := NulSym ;
+ ctor.dep := NulSym
+ END ;
+ (* The init/fini procedures must be public. *)
+ ctor.init := MakeProcedure (beginTok, GenName ("_M2_", name, "_init")) ;
+ PutPublic (ctor.init, TRUE) ;
+ DeclareArgEnvParams (beginTok, ctor.init) ;
+ ctor.fini := MakeProcedure (finallyTok, GenName ("_M2_", name, "_fini")) ;
+ PutPublic (ctor.fini, TRUE) ;
+ DeclareArgEnvParams (beginTok, ctor.fini)
+END InitCtorFields ;
+
+
+(*
+ GetModuleCtors - mod can be a DefImp or Module symbol. ctor, init and fini
+ are assigned for this module. An inner module ctor value will
+ be NulSym.
+*)
+
+PROCEDURE GetModuleCtors (mod: CARDINAL; VAR ctor, init, fini, dep: CARDINAL) ;
+VAR
+ pSym : PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (mod) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ModuleSym: ctor := Module.ctors.ctor ;
+ init := Module.ctors.init ;
+ fini := Module.ctors.fini ;
+ dep := Module.ctors.dep |
+ DefImpSym: ctor := DefImp.ctors.ctor ;
+ init := DefImp.ctors.init ;
+ fini := DefImp.ctors.fini ;
+ dep := DefImp.ctors.dep
+
+ ELSE
+ InternalError ('expecting Module or DefImp symbol')
+ END
+ END
+END GetModCtors ;
+
+
(*
MakeModule - creates a module sym with ModuleName. It returns the
symbol index.
@@ -2752,6 +3152,8 @@ BEGIN
WITH Module DO
name := ModuleName ; (* Index into name array, name *)
(* of record field. *)
+ InitCtor (ctors) ; (* Init all ctor functions. *)
+ InitList(ModListOfDep) ; (* Vector of SymDependency. *)
InitTree(LocalSymbols) ; (* The LocalSymbols hold all the *)
(* variables declared local to *)
(* the block. It contains the *)
@@ -2865,6 +3267,7 @@ BEGIN
WITH Module DO
name := ModuleName ; (* Index into name array, name *)
(* of record field. *)
+ InitCtor (ctors) ; (* Init all ctor functions. *)
InitTree(LocalSymbols) ; (* The LocalSymbols hold all the *)
(* variables declared local to *)
(* the block. It contains the *)
@@ -2938,7 +3341,7 @@ END MakeInnerModule ;
(*
MakeDefImp - creates a definition and implementation module sym
- with name DefImpName. It returns the symbol index.
+ with name DefImpName. It returns the symbol index.
*)
PROCEDURE MakeDefImp (tok: CARDINAL; DefImpName: Name) : CARDINAL ;
@@ -2946,13 +3349,11 @@ VAR
pSym: PtrToSymbol ;
Sym : CARDINAL ;
BEGIN
- (*
- Make a new symbol since we are at the outer scope level.
- DeclareSym examines the current scope level for any symbols
- that have the correct name, but are yet undefined.
- Therefore we must not call DeclareSym but create a symbol
- directly.
- *)
+ (* Make a new symbol since we are at the outer scope level. *)
+ (* We cannot use DeclareSym as it examines the current scope *)
+ (* for any symbols which have the correct name, but are yet *)
+ (* undefined. *)
+
NewSym(Sym) ;
pSym := GetPsym(Sym) ;
WITH pSym^ DO
@@ -2960,6 +3361,10 @@ BEGIN
WITH DefImp DO
name := DefImpName ; (* Index into name array, name *)
(* of record field. *)
+ InitCtor (ctors) ;
+ (* Init all ctor functions. *)
+ InitList(DefListOfDep) ; (* Vector of SymDependency. *)
+ InitList(ModListOfDep) ; (* Vector of SymDependency. *)
InitTree(ExportQualifiedTree) ;
(* Holds all the EXPORT *)
(* QUALIFIED identifiers. *)
@@ -3098,6 +3503,8 @@ BEGIN
BuiltinName := NulName ; (* name of equivalent builtin *)
IsInline := FALSE ; (* Was is declared __INLINE__ ? *)
ReturnOptional := FALSE ; (* Is the return value optional? *)
+ IsPublic := FALSE ; (* Make this procedure visible. *)
+ IsCtor := FALSE ; (* Is this procedure a ctor? *)
Scope := GetCurrentScope() ; (* Scope of procedure. *)
InitTree(Unresolved) ; (* All symbols currently *)
(* unresolved in this procedure. *)
@@ -3142,6 +3549,90 @@ BEGIN
END MakeProcedure ;
+(*
+ PutPublic - changes the public boolean inside the procedure.
+*)
+
+PROCEDURE PutPublic (sym: CARDINAL; value: BOOLEAN) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ProcedureSym : Procedure.IsPublic := value
+
+ ELSE
+ InternalError ('expecting ProcedureSym symbol')
+ END
+ END
+END PutPublic ;
+
+
+(*
+ IsPublic - returns the public boolean associated with a procedure.
+*)
+
+PROCEDURE IsPublic (sym: CARDINAL) : BOOLEAN ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ProcedureSym : RETURN Procedure.IsPublic
+
+ ELSE
+ InternalError ('expecting ProcedureSym symbol')
+ END
+ END
+END IsPublic ;
+
+
+(*
+ PutCtor - changes the ctor boolean inside the procedure.
+*)
+
+PROCEDURE PutCtor (sym: CARDINAL; value: BOOLEAN) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ProcedureSym : Procedure.IsCtor := value
+
+ ELSE
+ InternalError ('expecting ProcedureSym symbol')
+ END
+ END
+END PutCtor ;
+
+
+(*
+ IsCtor - returns the ctor boolean associated with a procedure.
+*)
+
+PROCEDURE IsCtor (sym: CARDINAL) : BOOLEAN ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ProcedureSym : RETURN Procedure.IsCtor
+
+ ELSE
+ InternalError ('expecting ProcedureSym symbol')
+ END
+ END
+END IsCtor ;
+
+
(*
AddProcedureToList - adds a procedure, Proc, to the list of procedures
in module, Mod.
@@ -11970,6 +12461,8 @@ BEGIN
DefImpSym : RETURN( DefImp.At.DefDeclared ) |
ModuleSym : RETURN( Module.At.DefDeclared ) |
UndefinedSym : RETURN( GetFirstUsed(Sym) ) |
+ ImportSym : RETURN( Import.at.DefDeclared ) |
+ ImportStatementSym : RETURN( ImportStatement.at.DefDeclared ) |
PartialUnboundedSym: RETURN( GetDeclaredDefinition(PartialUnbounded.Type) )
ELSE
@@ -12018,6 +12511,8 @@ BEGIN
DefImpSym : RETURN( DefImp.At.ModDeclared ) |
ModuleSym : RETURN( Module.At.ModDeclared ) |
UndefinedSym : RETURN( GetFirstUsed(Sym) ) |
+ ImportSym : RETURN( Import.at.ModDeclared ) |
+ ImportStatementSym : RETURN( ImportStatement.at.ModDeclared ) |
PartialUnboundedSym: RETURN( GetDeclaredModule(PartialUnbounded.Type) )
ELSE
diff --git a/gcc/m2/gm2-gcc/m2decl.cc b/gcc/m2/gm2-gcc/m2decl.cc
index 9b6470e38b9..dd23c6ce0a3 100644
--- a/gcc/m2/gm2-gcc/m2decl.cc
+++ b/gcc/m2/gm2-gcc/m2decl.cc
@@ -32,6 +32,7 @@ along with GNU Modula-2; see the file COPYING3. If not see
#include "m2tree.h"
#include "m2treelib.h"
#include "m2type.h"
+#include "m2convert.h"
extern GTY (()) tree current_function_decl;
@@ -40,9 +41,39 @@ static GTY (()) tree param_type_list;
static GTY (()) tree param_list = NULL_TREE; /* Ready for the next time we
call/define a function. */
-/* DeclareKnownVariable - declares a variable in scope, funcscope.
- Note that the global variable, current_function_decl, is altered
- if isglobal is TRUE. */
+/* DeclareM2linkGlobals creates the following code in the application
+ module globals:
+
+ int StaticInitialization = ScaffoldStatic;
+ const char *ForcedModuleInitOrder = RuntimeOverride; */
+
+void
+m2decl_DeclareM2linkGlobals (location_t location,
+ int ScaffoldStatic, const char *RuntimeOverride)
+{
+ m2block_pushGlobalScope ();
+ /* Generate: int StaticInitialization = ScaffoldStatic; */
+ tree static_init = m2decl_DeclareKnownVariable (location, "StaticInitialization",
+ integer_type_node,
+ TRUE, FALSE, FALSE, TRUE, NULL_TREE);
+ DECL_INITIAL (static_init) = m2decl_BuildIntegerConstant (ScaffoldStatic);
+ /* Generate: const char *ForcedModuleInitOrder = RuntimeOverride; */
+ tree ptr_to_char = build_pointer_type (char_type_node);
+ TYPE_READONLY (ptr_to_char) = TRUE;
+ tree forced_order = m2decl_DeclareKnownVariable (location, "ForcedModuleInitOrder",
+ ptr_to_char,
+ TRUE, FALSE, FALSE, TRUE, NULL_TREE);
+ if (RuntimeOverride == NULL || (strlen (RuntimeOverride) == 0))
+ DECL_INITIAL (forced_order) = m2convert_BuildConvert (location, ptr_to_char,
+ m2decl_BuildIntegerConstant (0),
+ FALSE);
+ else
+ DECL_INITIAL (forced_order) = build_string_literal (strlen (RuntimeOverride), RuntimeOverride);
+ m2block_popGlobalScope ();
+}
+
+
+/* DeclareKnownVariable declares a variable to GCC. */
tree
m2decl_DeclareKnownVariable (location_t location, char *name, tree type,
@@ -225,6 +256,30 @@ m2decl_BuildEndFunctionDeclaration (location_t location_begin,
return fndecl;
}
+/* BuildModuleCtor creates the per module constructor used as part of
+ the dynamic linking scaffold. */
+
+void
+m2decl_BuildModuleCtor (tree module_ctor)
+{
+ decl_init_priority_insert (module_ctor, DEFAULT_INIT_PRIORITY);
+}
+
+/* DeclareModuleCtor configures the function to be used as a ctor. */
+
+tree
+m2decl_DeclareModuleCtor (tree decl)
+{
+ /* Declare module_ctor (). */
+ TREE_PUBLIC (decl) = 1;
+ DECL_ARTIFICIAL (decl) = 1;
+ DECL_VISIBILITY (decl) = VISIBILITY_HIDDEN;
+ DECL_VISIBILITY_SPECIFIED (decl) = 1;
+ DECL_STATIC_CONSTRUCTOR (decl) = 1;
+ return decl;
+}
+
+
/* DetermineSizeOfConstant - given, str, and, base, fill in needsLong
and needsUnsigned appropriately. */
diff --git a/gcc/m2/gm2-gcc/m2decl.def b/gcc/m2/gm2-gcc/m2decl.def
index 5db08a71663..3f4a1613fe9 100644
--- a/gcc/m2/gm2-gcc/m2decl.def
+++ b/gcc/m2/gm2-gcc/m2decl.def
@@ -26,6 +26,34 @@ FROM m2tree IMPORT Tree ;
FROM m2linemap IMPORT location_t ;
+(*
+ BuildModuleCtor creates the per module constructor used as part of
+ the dynamic linking scaffold.
+*)
+
+PROCEDURE BuildModuleCtor (moduleCtor: Tree) ;
+
+
+(*
+ DeclareModuleCtor configures the function to be used as a ctor.
+*)
+
+PROCEDURE DeclareModuleCtor (decl: Tree) : Tree ;
+
+
+(*
+ DeclareM2linkGlobals creates the following code in the application
+ module globals:
+
+ int StaticInitialization = ScaffoldStatic;
+ const char *ForcedModuleInitOrder = RuntimeOverride;
+*)
+
+PROCEDURE DeclareM2linkGlobals (location: location_t;
+ ScaffoldStatic: INTEGER;
+ RuntimeOverride: ADDRESS) ;
+
+
(*
GetBitsPerBitset - returns the number of bits in a BITSET.
*)
diff --git a/gcc/m2/gm2-gcc/m2decl.h b/gcc/m2/gm2-gcc/m2decl.h
index d6696a02203..f651042fef2 100644
--- a/gcc/m2/gm2-gcc/m2decl.h
+++ b/gcc/m2/gm2-gcc/m2decl.h
@@ -36,6 +36,10 @@ along with GNU Modula-2; see the file COPYING3. If not see
#endif /* !__GNUG__. */
#endif /* !m2decl_c. */
+EXTERN void m2decl_DeclareM2linkGlobals (location_t location,
+ int ScaffoldStatic, const char *RuntimeOverride);
+EXTERN void m2decl_BuildModuleCtor (tree module_ctor);
+EXTERN tree m2decl_DeclareModuleCtor (tree decl);
EXTERN tree m2decl_GetDeclContext (tree t);
EXTERN tree m2decl_BuildStringConstant (location_t location, const char *string, int length);
EXTERN tree m2decl_BuildCStringConstant (const char *string, int length);
diff --git a/gcc/m2/gm2-gcc/m2options.h b/gcc/m2/gm2-gcc/m2options.h
index 5a9b1db2139..2e79328be50 100644
--- a/gcc/m2/gm2-gcc/m2options.h
+++ b/gcc/m2/gm2-gcc/m2options.h
@@ -113,6 +113,10 @@ EXTERN void M2Options_SetSaveTemps (int value);
EXTERN void M2Options_SetSaveTempsDir (const char *arg);
EXTERN int M2Options_GetSaveTemps (void);
EXTERN void M2Options_DisplayVersion (int mustExit);
+EXTERN void M2Options_SetScaffoldStatic (int value);
+EXTERN void M2Options_SetScaffoldDynamic (int value);
+EXTERN void M2Options_SetScaffoldMain (int value);
+EXTERN void M2Options_SetRuntimeModuleOverride (const char *override);
#undef EXTERN
#endif /* m2options_h. */
diff --git a/gcc/m2/gm2-gcc/m2statement.cc b/gcc/m2/gm2-gcc/m2statement.cc
index 6943fef55bd..f05fe7f44e7 100644
--- a/gcc/m2/gm2-gcc/m2statement.cc
+++ b/gcc/m2/gm2-gcc/m2statement.cc
@@ -29,13 +29,13 @@ along with GNU Modula-2; see the file COPYING3. If not see
#define m2statement_c
#include "m2assert.h"
#include "m2block.h"
-#include "m2convert.h"
#include "m2decl.h"
#include "m2expr.h"
#include "m2statement.h"
#include "m2tree.h"
#include "m2treelib.h"
#include "m2type.h"
+#include "m2convert.h"
static GTY (()) tree param_list = NULL_TREE; /* Ready for the next time we
call/define a function. */
@@ -78,7 +78,9 @@ m2statement_BuildStartFunctionCode (location_t location, tree fndecl,
`static' in the C sense!) */
TREE_STATIC (fndecl) = 1;
TREE_PUBLIC (fndecl) = isexported;
- TREE_ADDRESSABLE (fndecl) = 1; /* (--fixme-- not sure about this). */
+ /* We could do better here by detecting ADR
+ or type PROC used on this function. --fixme-- */
+ TREE_ADDRESSABLE (fndecl) = 1;
DECL_DECLARED_INLINE_P (fndecl) = 0; /* isinline; */
}
@@ -126,8 +128,8 @@ m2statement_BuildEndFunctionCode (location_t location, tree fndecl, int nested)
m2block_popFunctionScope ();
/* We're leaving the context of this function, so zap cfun. It's
- still in DECL_STRUCT_FUNCTION, and we'll restore it in
- tree_rest_of_compilation. */
+ still in DECL_STRUCT_FUNCTION, and we'll restore it in
+ tree_rest_of_compilation. */
set_cfun (NULL);
current_function_decl = NULL;
}
@@ -843,7 +845,7 @@ m2statement_BuildStart (location_t location, char *name, int inner_module)
return fndecl;
}
-/* BuildEnd - complete the initialisation function for this module. */
+/* BuildEnd - complete the initialization function for this module. */
void
m2statement_BuildEnd (location_t location, tree fndecl, int nested)
@@ -865,23 +867,6 @@ m2statement_BuildCallInner (location_t location, tree fndecl)
m2statement_BuildProcedureCallTree (location, fndecl, NULL_TREE));
}
-/* BuildStartMainModule - expands all the global variables ready for
- the main module. */
-
-void
-m2statement_BuildStartMainModule (void)
-{
- /* Nothing to do here. */
-}
-
-/* BuildEndMainModule - tidies up the end of the main module. It
- moves back to global scope. */
-
-void
-m2statement_BuildEndMainModule (void)
-{
- /* Nothing to do here. */
-}
/* BuildIfThenDoEnd - returns a tree which will only execute
statement, s, if, condition, is true. */
diff --git a/gcc/m2/gm2-gcc/m2statement.def b/gcc/m2/gm2-gcc/m2statement.def
index 0fdbc01a02f..9138d826dac 100644
--- a/gcc/m2/gm2-gcc/m2statement.def
+++ b/gcc/m2/gm2-gcc/m2statement.def
@@ -295,21 +295,6 @@ PROCEDURE BuildEnd (location: location_t; fndecl: Tree; nested: BOOLEAN) ;
PROCEDURE BuildCallInner (location: location_t; fndecl: Tree) ;
-(*
- BuildStartMainModule - expands all the global variables ready for the main module.
-*)
-
-PROCEDURE BuildStartMainModule ;
-
-
-(*
- BuildEndMainModule - tidies up the end of the main module. It moves
- back to global scope.
-*)
-
-PROCEDURE BuildEndMainModule ;
-
-
(*
SetBeginLocation - sets the begin location for the function to obtain good debugging info.
*)
diff --git a/gcc/m2/gm2-gcc/m2statement.h b/gcc/m2/gm2-gcc/m2statement.h
index 4d99941794c..48240768bf5 100644
--- a/gcc/m2/gm2-gcc/m2statement.h
+++ b/gcc/m2/gm2-gcc/m2statement.h
@@ -35,8 +35,6 @@ along with GNU Modula-2; see the file COPYING3. If not see
#endif /* !__GNUG__. */
#endif /* !m2statement_c. */
-EXTERN void m2statement_BuildEndMainModule (void);
-EXTERN void m2statement_BuildStartMainModule (void);
EXTERN void m2statement_BuildCallInner (location_t location, tree fndecl);
EXTERN void m2statement_BuildEnd (location_t location, tree fndecl,
int nested);
diff --git a/gcc/m2/gm2-lang.cc b/gcc/m2/gm2-lang.cc
index 45781eaade9..8c1efd74d89 100644
--- a/gcc/m2/gm2-lang.cc
+++ b/gcc/m2/gm2-lang.cc
@@ -330,7 +330,7 @@ gm2_langhook_handle_option (
/* handled in the driver. */
return 1;
case OPT_fruntime_modules_:
- /* handled in the driver. */
+ M2Options_SetRuntimeModuleOverride (arg);
return 1;
case OPT_fno_pthread:
/* handled in the driver. */
@@ -338,12 +338,23 @@ gm2_langhook_handle_option (
case OPT_fno_m2_plugin:
/* handled in the driver. */
return 1;
+#if 0
case OPT_ftarget_ar_:
/* handled in the driver. */
return 1;
case OPT_ftarget_ranlib_:
/* handled in the driver. */
return 1;
+#endif
+ case OPT_fscaffold_dynamic:
+ M2Options_SetScaffoldDynamic (value);
+ return 1;
+ case OPT_fscaffold_static:
+ M2Options_SetScaffoldStatic (value);
+ return 1;
+ case OPT_fscaffold_main:
+ M2Options_SetScaffoldMain (value);
+ return 1;
case OPT_fcpp:
M2Options_SetCpp (value);
return 1;
@@ -392,9 +403,11 @@ gm2_langhook_handle_option (
case OPT_fobject_path_:
/* handled by the linker. */
return 1;
+#if 0
case OPT_fonlylink:
/* handled by the driver. */
return 1;
+#endif
case OPT_version:
M2Options_DisplayVersion (FALSE);
return 1;
diff --git a/gcc/m2/gm2-libs-iso/M2RTS.def b/gcc/m2/gm2-libs-iso/M2RTS.def
index c5964ac0eec..929e4eb81a9 100644
--- a/gcc/m2/gm2-libs-iso/M2RTS.def
+++ b/gcc/m2/gm2-libs-iso/M2RTS.def
@@ -26,14 +26,37 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
DEFINITION MODULE M2RTS ;
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+TYPE
+ ArgCVEnvP = PROCEDURE (INTEGER, ADDRESS, ADDRESS) ;
+
+
+PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+ argc: INTEGER; argv, envp: ADDRESS) ;
+
+PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+ argc: INTEGER; argv, envp: ADDRESS) ;
+
+
(*
- Author : Gaius Mulley
- Title : M2RTS
- Date : Mon Apr 26 09:54:33 BST 2004
- Description: Implements the run time system facilities of Modula-2.
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
*)
-FROM SYSTEM IMPORT ADDRESS ;
+PROCEDURE RegisterModule (name: ADDRESS;
+ init, fini: ArgCVEnvP;
+ dependencies: PROC) ;
+
+
+(*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule.
+*)
+
+PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
(*
diff --git a/gcc/m2/gm2-libs-iso/M2RTS.mod b/gcc/m2/gm2-libs-iso/M2RTS.mod
index ef4b51e3311..c76f8431441 100644
--- a/gcc/m2/gm2-libs-iso/M2RTS.mod
+++ b/gcc/m2/gm2-libs-iso/M2RTS.mod
@@ -27,67 +27,115 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
IMPLEMENTATION MODULE M2RTS ;
-FROM libc IMPORT abort, exit, write ;
+FROM libc IMPORT abort, exit, write, getenv, printf ;
+(* FROM Builtins IMPORT strncmp, strcmp ; not available during bootstrap. *)
FROM NumberIO IMPORT CardToStr ;
FROM StrLib IMPORT StrCopy, StrLen, StrEqual ;
FROM SYSTEM IMPORT ADDRESS, ADR ;
FROM ASCII IMPORT nl, nul ;
+FROM Storage IMPORT ALLOCATE ;
IMPORT RTExceptions ;
IMPORT M2EXCEPTION ;
+IMPORT M2Dependent ;
+TYPE
+ PtrToChar = POINTER TO CHAR ;
-CONST
- MaxProcedures = 1024 ;
- MaxLength = 4096 ;
+ ProcedureChain = POINTER TO RECORD
+ p : PROC ;
+ prev,
+ next: ProcedureChain ;
+ END ;
+
+ ProcedureList = RECORD
+ head, tail: ProcedureChain
+ END ;
VAR
- iPtr, tPtr : CARDINAL ;
InitialProc,
- TerminateProc: ARRAY [0..MaxProcedures] OF PROC ;
- ExitValue : INTEGER ;
- CallExit : BOOLEAN ;
+ TerminateProc : ProcedureList ;
+ ExitValue : INTEGER ;
isTerminating,
- isHalting : BOOLEAN ;
+ isHalting,
+ Initialized,
+ CallExit : BOOLEAN ;
(*
- ExecuteTerminationProcedures - calls each installed termination procedure
- in reverse order.
+ ConstructModules - resolve dependencies and then call each
+ module constructor in turn.
*)
-PROCEDURE ExecuteTerminationProcedures ;
-VAR
- i: CARDINAL ;
+PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+ argc: INTEGER; argv, envp: ADDRESS) ;
BEGIN
- i := tPtr ;
- WHILE i>0 DO
- DEC(i) ;
- TerminateProc[i]
- END
-END ExecuteTerminationProcedures ;
+ M2Dependent.ConstructModules (applicationmodule, argc, argv, envp)
+END ConstructModules ;
(*
- InstallTerminationProcedure - installs a procedure, p, which will
- be called when the procedure
- ExecuteTerminationProcedures
- is invoked. It returns TRUE is the
- procedure is installed.
+ DeconstructModules - resolve dependencies and then call each
+ module constructor in turn.
*)
-PROCEDURE InstallTerminationProcedure (p: PROC) : BOOLEAN ;
+PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+ argc: INTEGER; argv, envp: ADDRESS) ;
BEGIN
- IF tPtr>MaxProcedures
- THEN
- RETURN( FALSE )
- ELSE
- TerminateProc[tPtr] := p ;
- INC(tPtr) ;
- RETURN( TRUE )
+ M2Dependent.DeconstructModules (applicationmodule, argc, argv, envp)
+END DeconstructModules ;
+
+
+(*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*)
+
+PROCEDURE RegisterModule (name: ADDRESS;
+ init, fini: ArgCVEnvP;
+ dependencies: PROC) ;
+BEGIN
+ M2Dependent.RegisterModule (name, init, fini, dependencies)
+END RegisterModule ;
+
+
+(*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule.
+*)
+
+PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+BEGIN
+ M2Dependent.RequestDependant (modulename, dependantmodule)
+END RequestDependant ;
+
+
+(*
+ ExecuteReverse - execute the procedure associated with procptr
+ and then proceed to try and execute all previous
+ procedures in the chain.
+*)
+
+PROCEDURE ExecuteReverse (procptr: ProcedureChain) ;
+BEGIN
+ WHILE procptr # NIL DO
+ procptr^.p ; (* Invoke the procedure. *)
+ procptr := procptr^.prev
END
-END InstallTerminationProcedure ;
+END ExecuteReverse ;
+
+
+(*
+ ExecuteTerminationProcedures - calls each installed termination procedure
+ in reverse order.
+*)
+
+PROCEDURE ExecuteTerminationProcedures ;
+BEGIN
+ ExecuteReverse (TerminateProc.tail)
+END ExecuteTerminationProcedures ;
(*
@@ -96,47 +144,73 @@ END InstallTerminationProcedure ;
*)
PROCEDURE ExecuteInitialProcedures ;
-VAR
- i: CARDINAL ;
BEGIN
- i := iPtr ;
- WHILE i>0 DO
- DEC(i) ;
- InitialProc[i]
- END
+ ExecuteReverse (InitialProc.tail)
END ExecuteInitialProcedures ;
(*
- InstallInitialProcedure - installs a procedure to be executed just before the
- BEGIN code section of the main program module.
+ AppendProc - append proc to the end of the procedure list
+ defined by proclist.
*)
-PROCEDURE InstallInitialProcedure (p: PROC) : BOOLEAN ;
+PROCEDURE AppendProc (VAR proclist: ProcedureList; proc: PROC) : BOOLEAN ;
+VAR
+ pdes: ProcedureChain ;
BEGIN
- IF iPtr>MaxProcedures
+ NEW (pdes) ;
+ WITH pdes^ DO
+ p := proc ;
+ prev := proclist.tail ;
+ next := NIL
+ END ;
+ IF proclist.head = NIL
THEN
- RETURN( FALSE )
- ELSE
- InitialProc[iPtr] := p ;
- INC(iPtr) ;
- RETURN( TRUE )
- END
+ proclist.head := pdes
+ END ;
+ proclist.tail := pdes ;
+ RETURN TRUE
+END AppendProc ;
+
+
+(*
+ InstallTerminationProcedure - installs a procedure, p, which will
+ be called when the procedure
+ ExecuteTerminationProcedures
+ is invoked. It returns TRUE if the
+ procedure is installed.
+*)
+
+PROCEDURE InstallTerminationProcedure (p: PROC) : BOOLEAN ;
+BEGIN
+ RETURN AppendProc (TerminateProc, p)
+END InstallTerminationProcedure ;
+
+
+(*
+ InstallInitialProcedure - installs a procedure to be executed just
+ before the BEGIN code section of the
+ main program module.
+*)
+
+PROCEDURE InstallInitialProcedure (p: PROC) : BOOLEAN ;
+BEGIN
+ RETURN AppendProc (InitialProc, p)
END InstallInitialProcedure ;
(*
HALT - terminate the current program. The procedure
- ExecuteTerminationProcedures is called before the program
- is stopped. The parameter exitcode is optional.
- If the parameter is not supplied
+ ExecuteTerminationProcedures
+ is called before the program is stopped. The parameter
+ exitcode is optional. If the parameter is not supplied
HALT will call libc 'abort', otherwise it will exit with
the code supplied. Supplying a parameter to HALT has the
same effect as calling ExitOnHalt with the same code and
then calling HALT with no parameter.
*)
-PROCEDURE HALT ([exitcode: INTEGER = -1]) ;
+PROCEDURE HALT ([exitcode: INTEGER = -1]) <* noreturn *> ;
BEGIN
IF exitcode#-1
THEN
@@ -161,25 +235,16 @@ END HALT ;
(*
- IsTerminating - Returns true if any coroutine has started program termination
- and false otherwise.
+ Terminate - provides compatibility for pim. It call exit with
+ the exitcode provided in a prior call to ExitOnHalt
+ (or zero if ExitOnHalt was never called). It does
+ not call ExecuteTerminationProcedures.
*)
-PROCEDURE IsTerminating () : BOOLEAN ;
+PROCEDURE Terminate <* noreturn *> ;
BEGIN
- RETURN isTerminating
-END IsTerminating ;
-
-
-(*
- HasHalted - Returns true if a call to HALT has been made and false
- otherwise.
-*)
-
-PROCEDURE HasHalted () : BOOLEAN ;
-BEGIN
- RETURN isHalting
-END HasHalted ;
+ exit (ExitValue)
+END Terminate ;
(*
@@ -188,41 +253,74 @@ END HasHalted ;
PROCEDURE ErrorString (a: ARRAY OF CHAR) ;
VAR
- buf: ARRAY [0..MaxLength] OF CHAR ;
- n : INTEGER ;
+ n: INTEGER ;
BEGIN
- StrCopy(a, buf) ;
- n := write(2, ADR(buf), StrLen(buf))
+ n := write (2, ADR (a), StrLen (a))
END ErrorString ;
(*
- ErrorMessage - emits an error message to the stderr
+ ErrorMessage - emits an error message to stderr and then calls exit (1).
*)
PROCEDURE ErrorMessage (message: ARRAY OF CHAR;
file: ARRAY OF CHAR;
line: CARDINAL;
- function: ARRAY OF CHAR) ;
+ function: ARRAY OF CHAR) <* noreturn *> ;
VAR
LineNo: ARRAY [0..10] OF CHAR ;
BEGIN
- ErrorString(file) ; ErrorString(':') ;
- CardToStr(line, 0, LineNo) ;
- ErrorString(LineNo) ; ErrorString(':') ;
- IF NOT StrEqual(function, '')
+ ErrorString (file) ; ErrorString(':') ;
+ CardToStr (line, 0, LineNo) ;
+ ErrorString (LineNo) ; ErrorString(':') ;
+ IF NOT StrEqual (function, '')
THEN
- ErrorString('in ') ;
- ErrorString(function) ;
- ErrorString(' has caused ') ;
+ ErrorString ('in ') ;
+ ErrorString (function) ;
+ ErrorString (' has caused ') ;
END ;
- ErrorString(message) ;
+ ErrorString (message) ;
LineNo[0] := nl ; LineNo[1] := nul ;
- ErrorString(LineNo) ;
- exit(1)
+ ErrorString (LineNo) ;
+ exit (1)
END ErrorMessage ;
+(*
+ Halt - provides a more user friendly version of HALT, which takes
+ four parameters to aid debugging.
+*)
+
+PROCEDURE Halt (file: ARRAY OF CHAR; line: CARDINAL;
+ function: ARRAY OF CHAR; description: ARRAY OF CHAR) ;
+BEGIN
+ ErrorMessage (description, file, line, function) ;
+ HALT
+END Halt ;
+
+
+(*
+ IsTerminating - Returns true if any coroutine has started program termination
+ and false otherwise.
+*)
+
+PROCEDURE IsTerminating () : BOOLEAN ;
+BEGIN
+ RETURN isTerminating
+END IsTerminating ;
+
+
+(*
+ HasHalted - Returns true if a call to HALT has been made and false
+ otherwise.
+*)
+
+PROCEDURE HasHalted () : BOOLEAN ;
+BEGIN
+ RETURN isHalting
+END HasHalted ;
+
+
(*
ErrorCharStar -
*)
@@ -267,19 +365,6 @@ BEGIN
END ErrorMessageColumn ;
-(*
- Halt - provides a more user friendly version of HALT, which takes
- four parameters to aid debugging.
-*)
-
-PROCEDURE Halt (file: ARRAY OF CHAR; line: CARDINAL;
- function: ARRAY OF CHAR; description: ARRAY OF CHAR) ;
-BEGIN
- ErrorMessage(description, file, line, function) ;
- HALT
-END Halt ;
-
-
(*
ExitOnHalt - if HALT is executed then call exit with the exit code, e.
*)
@@ -482,11 +567,50 @@ BEGIN
END NoException ;
+(*
+ InitProcList - initialize the head and tail pointers to NIL.
+*)
+
+PROCEDURE InitProcList (VAR p: ProcedureList) ;
BEGIN
- isTerminating := FALSE ;
- isHalting := FALSE ;
- iPtr := 0 ;
- tPtr := 0 ;
+ p.head := NIL ;
+ p.tail := NIL
+END InitProcList ;
+
+
+(*
+ Init -
+*)
+
+PROCEDURE Init ;
+BEGIN
+ InitProcList (InitialProc) ;
+ InitProcList (TerminateProc) ;
ExitValue := 0 ;
- CallExit := FALSE (* default by calling abort *)
+ isHalting := FALSE ;
+ CallExit := FALSE ; (* default by calling abort *)
+ isTerminating := FALSE
+END Init ;
+
+
+(*
+ CheckInitialized - checks to see if this module has been initialized
+ and if it has not it calls Init. We need this
+ approach as this module is called by module ctors
+ before we reach main.
+*)
+
+PROCEDURE CheckInitialized ;
+BEGIN
+ IF NOT Initialized
+ THEN
+ Initialized := TRUE ;
+ Init
+ END
+END CheckInitialized ;
+
+
+BEGIN
+ (* Initialized := FALSE ; is achieved though setting the bss section to zero. *)
+ CheckInitialized
END M2RTS.
diff --git a/gcc/m2/gm2-libs/M2RTS.def b/gcc/m2/gm2-libs/M2RTS.def
index ba7f1818830..1ae183b3e48 100644
--- a/gcc/m2/gm2-libs/M2RTS.def
+++ b/gcc/m2/gm2-libs/M2RTS.def
@@ -27,28 +27,36 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
DEFINITION MODULE M2RTS ;
FROM SYSTEM IMPORT ADDRESS ;
-EXPORT QUALIFIED HALT, Halt,
- InstallTerminationProcedure, ExecuteTerminationProcedures,
- InstallInitialProcedure, ExecuteInitialProcedures,
- ExitOnHalt, Terminate, Length, ErrorMessage,
- AssignmentException, ReturnException,
- IncException, DecException, InclException, ExclException,
- ShiftException, RotateException,
- StaticArraySubscriptException, DynamicArraySubscriptException,
- ForLoopBeginException, ForLoopToException, ForLoopEndException,
- PointerNilException, NoReturnException,
- WholeNonPosDivException, WholeNonPosModException,
- WholeZeroDivException, WholeZeroRemException,
- WholeValueException, RealValueException,
- CaseException, ParameterException, NoException ;
+
+
+TYPE
+ ArgCVEnvP = PROCEDURE (INTEGER, ADDRESS, ADDRESS) ;
+
+
+PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+ argc: INTEGER; argv, envp: ADDRESS) ;
+
+PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+ argc: INTEGER; argv, envp: ADDRESS) ;
(*
- ExecuteTerminationProcedures - calls each installed termination
- procedure in reverse order.
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
*)
-PROCEDURE ExecuteTerminationProcedures ;
+PROCEDURE RegisterModule (name: ADDRESS;
+ init, fini: ArgCVEnvP;
+ dependencies: PROC) ;
+
+
+(*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule.
+*)
+
+PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
(*
@@ -79,6 +87,14 @@ PROCEDURE ExecuteInitialProcedures ;
PROCEDURE InstallInitialProcedure (p: PROC) : BOOLEAN ;
+(*
+ ExecuteTerminationProcedures - calls each installed termination procedure
+ in reverse order.
+*)
+
+PROCEDURE ExecuteTerminationProcedures ;
+
+
(*
Terminate - provides compatibility for pim. It call exit with
the exitcode provided in a prior call to ExitOnHalt
diff --git a/gcc/m2/gm2-libs/M2RTS.mod b/gcc/m2/gm2-libs/M2RTS.mod
index 60981a0a025..6ce97f97ab1 100644
--- a/gcc/m2/gm2-libs/M2RTS.mod
+++ b/gcc/m2/gm2-libs/M2RTS.mod
@@ -27,63 +27,114 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
IMPLEMENTATION MODULE M2RTS ;
-FROM libc IMPORT abort, exit, write ;
+FROM libc IMPORT abort, exit, write, getenv, printf ;
+(* FROM Builtins IMPORT strncmp, strcmp ; not available during bootstrap. *)
FROM NumberIO IMPORT CardToStr ;
FROM StrLib IMPORT StrCopy, StrLen, StrEqual ;
FROM SYSTEM IMPORT ADDRESS, ADR ;
FROM ASCII IMPORT nl, nul ;
+FROM Storage IMPORT ALLOCATE ;
+
IMPORT RTExceptions ;
IMPORT M2EXCEPTION ;
+IMPORT M2Dependent ;
+
+TYPE
+ PtrToChar = POINTER TO CHAR ;
+
+ ProcedureList = RECORD
+ head, tail: ProcedureChain
+ END ;
-CONST
- MaxProcedures = 1024 ;
+ ProcedureChain = POINTER TO RECORD
+ p : PROC ;
+ prev,
+ next: ProcedureChain ;
+ END ;
VAR
- iPtr, tPtr : CARDINAL ;
InitialProc,
- TerminateProc: ARRAY [0..MaxProcedures] OF PROC ;
+ TerminateProc: ProcedureList ;
ExitValue : INTEGER ;
isHalting,
CallExit : BOOLEAN ;
+ Initialized : BOOLEAN ;
(*
- ExecuteTerminationProcedures - calls each installed termination procedure
- in reverse order.
+ ConstructModules - resolve dependencies and then call each
+ module constructor in turn.
*)
-PROCEDURE ExecuteTerminationProcedures ;
-VAR
- i: CARDINAL ;
+PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+ argc: INTEGER; argv, envp: ADDRESS) ;
BEGIN
- i := tPtr ;
- WHILE i>0 DO
- DEC(i) ;
- TerminateProc[i]
- END
-END ExecuteTerminationProcedures ;
+ M2Dependent.ConstructModules (applicationmodule, argc, argv, envp)
+END ConstructModules ;
(*
- InstallTerminationProcedure - installs a procedure, p, which will
- be called when the procedure
- ExecuteTerminationProcedures
- is invoked. It returns TRUE is the
- procedure is installed.
+ DeconstructModules - resolve dependencies and then call each
+ module constructor in turn.
*)
-PROCEDURE InstallTerminationProcedure (p: PROC) : BOOLEAN ;
+PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+ argc: INTEGER; argv, envp: ADDRESS) ;
BEGIN
- IF tPtr>MaxProcedures
- THEN
- RETURN( FALSE )
- ELSE
- TerminateProc[tPtr] := p ;
- INC(tPtr) ;
- RETURN( TRUE )
+ M2Dependent.DeconstructModules (applicationmodule, argc, argv, envp)
+END DeconstructModules ;
+
+
+(*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*)
+
+PROCEDURE RegisterModule (name: ADDRESS;
+ init, fini: ArgCVEnvP;
+ dependencies: PROC) ;
+BEGIN
+ M2Dependent.RegisterModule (name, init, fini, dependencies)
+END RegisterModule ;
+
+
+(*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule.
+*)
+
+PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+BEGIN
+ M2Dependent.RequestDependant (modulename, dependantmodule)
+END RequestDependant ;
+
+
+(*
+ ExecuteReverse - execute the procedure associated with procptr
+ and then proceed to try and execute all previous
+ procedures in the chain.
+*)
+
+PROCEDURE ExecuteReverse (procptr: ProcedureChain) ;
+BEGIN
+ WHILE procptr # NIL DO
+ procptr^.p ; (* Invoke the procedure. *)
+ procptr := procptr^.prev
END
-END InstallTerminationProcedure ;
+END ExecuteReverse ;
+
+
+(*
+ ExecuteTerminationProcedures - calls each installed termination procedure
+ in reverse order.
+*)
+
+PROCEDURE ExecuteTerminationProcedures ;
+BEGIN
+ ExecuteReverse (TerminateProc.tail)
+END ExecuteTerminationProcedures ;
(*
@@ -92,32 +143,58 @@ END InstallTerminationProcedure ;
*)
PROCEDURE ExecuteInitialProcedures ;
-VAR
- i: CARDINAL ;
BEGIN
- i := iPtr ;
- WHILE i>0 DO
- DEC(i) ;
- InitialProc[i]
- END
+ ExecuteReverse (InitialProc.tail)
END ExecuteInitialProcedures ;
(*
- InstallInitialProcedure - installs a procedure to be executed just before the
- BEGIN code section of the main program module.
+ AppendProc - append proc to the end of the procedure list
+ defined by proclist.
*)
-PROCEDURE InstallInitialProcedure (p: PROC) : BOOLEAN ;
+PROCEDURE AppendProc (VAR proclist: ProcedureList; proc: PROC) : BOOLEAN ;
+VAR
+ pdes: ProcedureChain ;
BEGIN
- IF iPtr>MaxProcedures
+ NEW (pdes) ;
+ WITH pdes^ DO
+ p := proc ;
+ prev := proclist.tail ;
+ next := NIL
+ END ;
+ IF proclist.head = NIL
THEN
- RETURN( FALSE )
- ELSE
- InitialProc[iPtr] := p ;
- INC(iPtr) ;
- RETURN( TRUE )
- END
+ proclist.head := pdes
+ END ;
+ proclist.tail := pdes ;
+ RETURN TRUE
+END AppendProc ;
+
+
+(*
+ InstallTerminationProcedure - installs a procedure, p, which will
+ be called when the procedure
+ ExecuteTerminationProcedures
+ is invoked. It returns TRUE if the
+ procedure is installed.
+*)
+
+PROCEDURE InstallTerminationProcedure (p: PROC) : BOOLEAN ;
+BEGIN
+ RETURN AppendProc (TerminateProc, p)
+END InstallTerminationProcedure ;
+
+
+(*
+ InstallInitialProcedure - installs a procedure to be executed just
+ before the BEGIN code section of the
+ main program module.
+*)
+
+PROCEDURE InstallInitialProcedure (p: PROC) : BOOLEAN ;
+BEGIN
+ RETURN AppendProc (InitialProc, p)
END InstallInitialProcedure ;
@@ -157,7 +234,7 @@ END HALT ;
(*
- Terminate - provides compatibility for pim. It call exit with
+ Terminate - provides compatibility for pim. It calls exit with
the exitcode provided in a prior call to ExitOnHalt
(or zero if ExitOnHalt was never called). It does
not call ExecuteTerminationProcedures.
@@ -165,7 +242,7 @@ END HALT ;
PROCEDURE Terminate <* noreturn *> ;
BEGIN
- exit(ExitValue)
+ exit (ExitValue)
END Terminate ;
@@ -177,7 +254,7 @@ PROCEDURE ErrorString (a: ARRAY OF CHAR) ;
VAR
n: INTEGER ;
BEGIN
- n := write(2, ADR(a), StrLen(a))
+ n := write (2, ADR (a), StrLen (a))
END ErrorString ;
@@ -192,19 +269,19 @@ PROCEDURE ErrorMessage (message: ARRAY OF CHAR;
VAR
LineNo: ARRAY [0..10] OF CHAR ;
BEGIN
- ErrorString(file) ; ErrorString(':') ;
- CardToStr(line, 0, LineNo) ;
- ErrorString(LineNo) ; ErrorString(':') ;
- IF NOT StrEqual(function, '')
+ ErrorString (file) ; ErrorString(':') ;
+ CardToStr (line, 0, LineNo) ;
+ ErrorString (LineNo) ; ErrorString(':') ;
+ IF NOT StrEqual (function, '')
THEN
- ErrorString('in ') ;
- ErrorString(function) ;
- ErrorString(' has caused ') ;
+ ErrorString ('in ') ;
+ ErrorString (function) ;
+ ErrorString (' has caused ') ;
END ;
- ErrorString(message) ;
+ ErrorString (message) ;
LineNo[0] := nl ; LineNo[1] := nul ;
- ErrorString(LineNo) ;
- exit(1)
+ ErrorString (LineNo) ;
+ exit (1)
END ErrorMessage ;
@@ -216,7 +293,7 @@ END ErrorMessage ;
PROCEDURE Halt (file: ARRAY OF CHAR; line: CARDINAL;
function: ARRAY OF CHAR; description: ARRAY OF CHAR) ;
BEGIN
- ErrorMessage(description, file, line, function) ;
+ ErrorMessage (description, file, line, function) ;
HALT
END Halt ;
@@ -423,10 +500,48 @@ BEGIN
END Length ;
+(*
+ InitProcList - initialize the head and tail pointers to NIL.
+*)
+
+PROCEDURE InitProcList (VAR p: ProcedureList) ;
+BEGIN
+ p.head := NIL ;
+ p.tail := NIL
+END InitProcList ;
+
+
+(*
+ Init - initialize the initial, terminate procedure lists and booleans.
+*)
+
+PROCEDURE Init ;
BEGIN
- iPtr := 0 ;
- tPtr := 0 ;
+ InitProcList (InitialProc) ;
+ InitProcList (TerminateProc) ;
ExitValue := 0 ;
isHalting := FALSE ;
CallExit := FALSE (* default by calling abort *)
+END Init ;
+
+
+(*
+ CheckInitialized - checks to see if this module has been initialized
+ and if it has not it calls Init. We need this
+ approach as this module is called by module ctors
+ before we reach main.
+*)
+
+PROCEDURE CheckInitialized ;
+BEGIN
+ IF NOT Initialized
+ THEN
+ Initialized := TRUE ;
+ Init
+ END
+END CheckInitialized ;
+
+
+BEGIN
+ CheckInitialized
END M2RTS.
diff --git a/gcc/m2/gm2spec.cc b/gcc/m2/gm2spec.cc
index 2a61e4497bc..94c4f5cd7cc 100644
--- a/gcc/m2/gm2spec.cc
+++ b/gcc/m2/gm2spec.cc
@@ -267,6 +267,8 @@ add_B_prefix (unsigned int *in_decoded_options_count ATTRIBUTE_UNUSED,
}
#endif
+
+#if 0
/* add_exec_prefix, adds the -ftarget-ar= option so that we can tell
gm2lcc where to pick up the `ar' utility. */
@@ -279,6 +281,7 @@ add_exec_prefix (void)
fe_generate_option (OPT_ftarget_ar_, ar, true);
fe_generate_option (OPT_ftarget_ranlib_, ranlib, true);
}
+#endif
static const char *
get_libexec (void)
@@ -1155,10 +1158,10 @@ lang_specific_driver (struct cl_decoded_option **in_decoded_options,
case OPT_fexceptions:
seen_fexceptions = ((*in_decoded_options)[i].value);
break;
+#if 0
case OPT_fonlylink:
seen_fonlylink = true;
break;
-#if 0
case OPT_fmakeall:
seen_fmakeall = true;
break;
@@ -1185,6 +1188,7 @@ lang_specific_driver (struct cl_decoded_option **in_decoded_options,
}
}
+#if 0
/* -fmakeall implies that the first invoked driver only does the link
and should leave all compiles to the makefile otherwise we will try
and link two main applications. */
@@ -1192,6 +1196,7 @@ lang_specific_driver (struct cl_decoded_option **in_decoded_options,
fe_generate_option (OPT_fonlylink, NULL, false);
check_gm2_root ();
+#endif
libpath = fe_getenv (LIBRARY_PATH_ENV);
if (libpath == NULL || (strcmp (libpath, "") == 0))
libpath = LIBSUBDIR;
@@ -1286,7 +1291,9 @@ lang_specific_driver (struct cl_decoded_option **in_decoded_options,
}
add_env_option (gm2ipath, OPT_I);
add_default_includes (libpath, libraries);
+#if 0
add_exec_prefix ();
+#endif
#if defined(LOCAL_DEBUGGING)
if (!seen_B)
@@ -1501,6 +1508,7 @@ exit_callback (int argc ATTRIBUTE_UNUSED, const char *argv[] ATTRIBUTE_UNUSED)
void
lang_register_spec_functions (void)
{
+#if 0
fe_add_spec_function ("objects", get_objects);
fe_add_spec_function ("nolink", no_link);
fe_add_spec_function ("noobjects", remove_objects);
@@ -1508,4 +1516,5 @@ lang_register_spec_functions (void)
fe_add_spec_function ("exec_prefix", add_exec_dir);
fe_add_spec_function ("exec_name", add_exec_name);
fe_add_spec_function ("exit", exit_callback);
+#endif
}
diff --git a/gcc/m2/lang-specs.h b/gcc/m2/lang-specs.h
index 0ef2f2456bd..d7f1e696e8d 100644
--- a/gcc/m2/lang-specs.h
+++ b/gcc/m2/lang-specs.h
@@ -21,11 +21,12 @@ along with GCC; see the file COPYING3. If not see
/* This is the contribution to the `default_compilers' array in gcc.c for
GNU Modula-2. */
-#include "m2-link-support.h"
+/* Pass the preprocessor options on the command line together with
+ the exec prefix. */
-#if !defined(M2CPP)
-# define M2CPP " "
-#endif
+#define M2CPP "%{fcpp:-fcppbegin %:exec_prefix(cc1)" \
+ " -E -lang-asm -traditional-cpp " \
+ " %(cpp_unique_options) -fcppend}"
{".mod", "@modula-2", 0, 0, 0},
{"@modula-2",
diff --git a/gcc/m2/lang.opt b/gcc/m2/lang.opt
index 8831af688b2..59e14912627 100644
--- a/gcc/m2/lang.opt
+++ b/gcc/m2/lang.opt
@@ -132,11 +132,11 @@ allows opaque types to be implemented as any type (a GNU Modula-2 extension)
fuselist
Modula-2
-use ordered list of modules when linking
+use the ordered list of modules to order the initialization/finalialization (--unimplemented--)
fmakelist
Modula-2
-create a topologically ordered list of modules
+create a topologically ordered list of modules called modulename.lst (--unimplemented--)
fmodules
Modula-2
@@ -154,17 +154,25 @@ fno-m2-plugin
Modula-2
do not insert plugin to identify runtime errors at compiletime
-fonlylink
+fscaffold-static
Modula-2
-only link the module and do not compile module
+generate static scaffold initialization and finalization for every module inside main
-ftarget-ar=
-Modula-2 Joined
-full path to target archiver
+fscaffold-dynamic
+Modula-2
+the modules initialization order is dynamically determined by M2RTS and application dependancies
-ftarget-ranlib=
-Modula-2 Joined
-full path to target ranlib
+fscaffold-c
+Modula-2
+generate a C source scaffold for the current module being compiled
+
+fscaffold-c++
+Modula-2
+generate a C++ source scaffold for the current module being compiled
+
+fscaffold-main
+Modula-2
+generate the main function
fruntime-modules=
Modula-2 Joined
diff --git a/gcc/m2/mc-boot/GAssertion.h b/gcc/m2/mc-boot/GAssertion.h
index bd8c53c6ca0..c84cd7cb400 100644
--- a/gcc/m2/mc-boot/GAssertion.h
+++ b/gcc/m2/mc-boot/GAssertion.h
@@ -49,7 +49,8 @@ extern "C" {
/*
- Assert - tests the boolean Condition, if it fails then HALT is called.
+ Assert - tests the boolean Condition, if it fails then HALT
+ is called.
*/
EXTERN void Assertion_Assert (unsigned int Condition);
diff --git a/gcc/m2/mc-boot/GDynamicStrings.c b/gcc/m2/mc-boot/GDynamicStrings.c
index 3c4946e33b9..45cfd5c7b3e 100644
--- a/gcc/m2/mc-boot/GDynamicStrings.c
+++ b/gcc/m2/mc-boot/GDynamicStrings.c
@@ -1214,7 +1214,7 @@ static void ConcatContents (Contents *c, const char *a_, unsigned int _a_high, u
(*c).next->contents.next = NULL;
ConcatContents (&(*c).next->contents, (const char *) a, _a_high, h, o);
AddDebugInfo ((*c).next);
- (*c).next = AssignDebug ((*c).next, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 86, 722, (const char *) "ConcatContents", 14);
+ (*c).next = AssignDebug ((*c).next, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/DynamicStrings.mod", 85, 722, (const char *) "ConcatContents", 14);
}
else
{
@@ -1312,7 +1312,7 @@ static void ConcatContentsAddress (Contents *c, void * a, unsigned int h)
AddDebugInfo ((*c).next);
if (TraceOn)
{
- (*c).next = AssignDebug ((*c).next, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 86, 917, (const char *) "ConcatContentsAddress", 21);
+ (*c).next = AssignDebug ((*c).next, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/DynamicStrings.mod", 85, 917, (const char *) "ConcatContentsAddress", 21);
}
}
else
@@ -1537,7 +1537,7 @@ extern "C" DynamicStrings_String DynamicStrings_InitString (const char *a_, unsi
AddDebugInfo (s);
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 86, 758, (const char *) "InitString", 10);
+ s = AssignDebug (s, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/DynamicStrings.mod", 85, 758, (const char *) "InitString", 10);
}
return s;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -1640,7 +1640,7 @@ extern "C" DynamicStrings_String DynamicStrings_InitStringCharStar (void * a)
AddDebugInfo (s);
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 86, 957, (const char *) "InitStringCharStar", 18);
+ s = AssignDebug (s, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/DynamicStrings.mod", 85, 957, (const char *) "InitStringCharStar", 18);
}
return s;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -1665,7 +1665,7 @@ extern "C" DynamicStrings_String DynamicStrings_InitStringChar (char ch)
s = DynamicStrings_InitString ((const char *) &a.array[0], 1);
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 86, 977, (const char *) "InitStringChar", 14);
+ s = AssignDebug (s, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/DynamicStrings.mod", 85, 977, (const char *) "InitStringChar", 14);
}
return s;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -1823,7 +1823,7 @@ extern "C" DynamicStrings_String DynamicStrings_Dup (DynamicStrings_String s)
s = DynamicStrings_Assign (DynamicStrings_InitString ((const char *) "", 0), s);
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 86, 1173, (const char *) "Dup", 3);
+ s = AssignDebug (s, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/DynamicStrings.mod", 85, 1173, (const char *) "Dup", 3);
}
return s;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -1845,7 +1845,7 @@ extern "C" DynamicStrings_String DynamicStrings_Add (DynamicStrings_String a, Dy
a = DynamicStrings_ConCat (DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "", 0), a), b);
if (TraceOn)
{
- a = AssignDebug (a, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 86, 1193, (const char *) "Add", 3);
+ a = AssignDebug (a, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/DynamicStrings.mod", 85, 1193, (const char *) "Add", 3);
}
return a;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -1920,7 +1920,7 @@ extern "C" unsigned int DynamicStrings_EqualCharStar (DynamicStrings_String s, v
t = DynamicStrings_InitStringCharStar (a);
if (TraceOn)
{
- t = AssignDebug (t, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 86, 1258, (const char *) "EqualCharStar", 13);
+ t = AssignDebug (t, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/DynamicStrings.mod", 85, 1258, (const char *) "EqualCharStar", 13);
}
t = AddToGarbage (t, s);
if (DynamicStrings_Equal (t, s))
@@ -1958,7 +1958,7 @@ extern "C" unsigned int DynamicStrings_EqualArray (DynamicStrings_String s, cons
t = DynamicStrings_InitString ((const char *) a, _a_high);
if (TraceOn)
{
- t = AssignDebug (t, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 86, 1288, (const char *) "EqualArray", 10);
+ t = AssignDebug (t, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/DynamicStrings.mod", 85, 1288, (const char *) "EqualArray", 10);
}
t = AddToGarbage (t, s);
if (DynamicStrings_Equal (t, s))
@@ -1996,7 +1996,7 @@ extern "C" DynamicStrings_String DynamicStrings_Mult (DynamicStrings_String s, u
}
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 86, 1320, (const char *) "Mult", 4);
+ s = AssignDebug (s, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/DynamicStrings.mod", 85, 1320, (const char *) "Mult", 4);
}
return s;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -2075,7 +2075,7 @@ extern "C" DynamicStrings_String DynamicStrings_Slice (DynamicStrings_String s,
AddDebugInfo (t->contents.next);
if (TraceOn)
{
- t->contents.next = AssignDebug (t->contents.next, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 86, 1388, (const char *) "Slice", 5);
+ t->contents.next = AssignDebug (t->contents.next, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/DynamicStrings.mod", 85, 1388, (const char *) "Slice", 5);
}
}
t = t->contents.next;
@@ -2093,7 +2093,7 @@ extern "C" DynamicStrings_String DynamicStrings_Slice (DynamicStrings_String s,
}
if (TraceOn)
{
- d = AssignDebug (d, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 86, 1405, (const char *) "Slice", 5);
+ d = AssignDebug (d, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/DynamicStrings.mod", 85, 1405, (const char *) "Slice", 5);
}
return d;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -2221,7 +2221,7 @@ extern "C" DynamicStrings_String DynamicStrings_RemoveComment (DynamicStrings_St
}
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 86, 1517, (const char *) "RemoveComment", 13);
+ s = AssignDebug (s, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/DynamicStrings.mod", 85, 1517, (const char *) "RemoveComment", 13);
}
return s;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -2246,7 +2246,7 @@ extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePrefix (DynamicString
s = DynamicStrings_Slice (s, (int ) (i), 0);
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 86, 1629, (const char *) "RemoveWhitePrefix", 17);
+ s = AssignDebug (s, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/DynamicStrings.mod", 85, 1629, (const char *) "RemoveWhitePrefix", 17);
}
return s;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -2271,7 +2271,7 @@ extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePostfix (DynamicStrin
s = DynamicStrings_Slice (s, 0, i+1);
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 86, 1651, (const char *) "RemoveWhitePostfix", 18);
+ s = AssignDebug (s, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/DynamicStrings.mod", 85, 1651, (const char *) "RemoveWhitePostfix", 18);
}
return s;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -2640,7 +2640,7 @@ extern "C" DynamicStrings_String DynamicStrings_PopAllocationExemption (unsigned
{
stop ();
/* writeString ("mismatched number of PopAllocation's compared to PushAllocation's") */
- M2RTS_Halt ((const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 86, 176, (const char *) "PopAllocationExemption", 22, (const char *) "mismatched number of PopAllocation's compared to PushAllocation's", 65);
+ M2RTS_Halt ((const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/DynamicStrings.mod", 85, 176, (const char *) "PopAllocationExemption", 22, (const char *) "mismatched number of PopAllocation's compared to PushAllocation's", 65);
}
else
{
diff --git a/gcc/m2/mc-boot/GDynamicStrings.h b/gcc/m2/mc-boot/GDynamicStrings.h
index d09e847df08..c0f3d5d995d 100644
--- a/gcc/m2/mc-boot/GDynamicStrings.h
+++ b/gcc/m2/mc-boot/GDynamicStrings.h
@@ -77,13 +77,15 @@ EXTERN DynamicStrings_String DynamicStrings_KillString (DynamicStrings_String s)
EXTERN void DynamicStrings_Fin (DynamicStrings_String s);
/*
- InitStringCharStar - initializes and returns a String to contain the C string.
+ InitStringCharStar - initializes and returns a String to contain
+ the C string.
*/
EXTERN DynamicStrings_String DynamicStrings_InitStringCharStar (void * a);
/*
- InitStringChar - initializes and returns a String to contain the single character, ch.
+ InitStringChar - initializes and returns a String to contain the
+ single character, ch.
*/
EXTERN DynamicStrings_String DynamicStrings_InitStringChar (char ch);
@@ -101,13 +103,15 @@ EXTERN DynamicStrings_String DynamicStrings_Mark (DynamicStrings_String s);
EXTERN unsigned int DynamicStrings_Length (DynamicStrings_String s);
/*
- ConCat - returns String, a, after the contents of, b, have been appended.
+ ConCat - returns String, a, after the contents of, b,
+ have been appended.
*/
EXTERN DynamicStrings_String DynamicStrings_ConCat (DynamicStrings_String a, DynamicStrings_String b);
/*
- ConCatChar - returns String, a, after character, ch, has been appended.
+ ConCatChar - returns String, a, after character, ch,
+ has been appended.
*/
EXTERN DynamicStrings_String DynamicStrings_ConCatChar (DynamicStrings_String a, char ch);
@@ -138,15 +142,15 @@ EXTERN DynamicStrings_String DynamicStrings_Add (DynamicStrings_String a, Dynami
EXTERN unsigned int DynamicStrings_Equal (DynamicStrings_String a, DynamicStrings_String b);
/*
- EqualCharStar - returns TRUE if contents of String, s, is the same as the
- string, a.
+ EqualCharStar - returns TRUE if contents of String, s, is
+ the same as the string, a.
*/
EXTERN unsigned int DynamicStrings_EqualCharStar (DynamicStrings_String s, void * a);
/*
- EqualArray - returns TRUE if contents of String, s, is the same as the
- string, a.
+ EqualArray - returns TRUE if contents of String, s, is the
+ same as the string, a.
*/
EXTERN unsigned int DynamicStrings_EqualArray (DynamicStrings_String s, const char *a_, unsigned int _a_high);
@@ -193,7 +197,8 @@ EXTERN int DynamicStrings_RIndex (DynamicStrings_String s, char ch, unsigned int
which indicates anything to its right is a comment
then strip off the comment and also any white space
on the remaining right hand side.
- It leaves any white space on the left hand side alone.
+ It leaves any white space on the left hand side
+ alone.
*/
EXTERN DynamicStrings_String DynamicStrings_RemoveComment (DynamicStrings_String s, char comment);
@@ -213,16 +218,16 @@ EXTERN DynamicStrings_String DynamicStrings_RemoveWhitePrefix (DynamicStrings_St
EXTERN DynamicStrings_String DynamicStrings_RemoveWhitePostfix (DynamicStrings_String s);
/*
- ToUpper - returns string, s, after it has had its lower case characters
- replaced by upper case characters.
+ ToUpper - returns string, s, after it has had its lower case
+ characters replaced by upper case characters.
The string, s, is not duplicated.
*/
EXTERN DynamicStrings_String DynamicStrings_ToUpper (DynamicStrings_String s);
/*
- ToLower - returns string, s, after it has had its upper case characters
- replaced by lower case characters.
+ ToLower - returns string, s, after it has had its upper case
+ characters replaced by lower case characters.
The string, s, is not duplicated.
*/
@@ -308,13 +313,14 @@ EXTERN void DynamicStrings_PushAllocation (void);
EXTERN void DynamicStrings_PopAllocation (unsigned int halt);
/*
- PopAllocationExemption - test to see that all strings are deallocated, except
- string, e, since the last push.
- Then it pops to the previous allocation/deallocation
- lists.
+ PopAllocationExemption - test to see that all strings are
+ deallocated, except string, e, since
+ the last push.
+ Then it pops to the previous
+ allocation/deallocation lists.
- If halt is true then the application terminates
- with an exit code of 1.
+ If halt is true then the application
+ terminates with an exit code of 1.
The string, e, is returned unmodified,
*/
diff --git a/gcc/m2/mc-boot/GEnvironment.h b/gcc/m2/mc-boot/GEnvironment.h
index 16701450da5..0a3c4653557 100644
--- a/gcc/m2/mc-boot/GEnvironment.h
+++ b/gcc/m2/mc-boot/GEnvironment.h
@@ -58,7 +58,8 @@ extern "C" {
EXTERN unsigned int Environment_GetEnvironment (const char *Env_, unsigned int _Env_high, char *dest, unsigned int _dest_high);
/*
- PutEnvironment - change or add an environment variable definition EnvDef.
+ PutEnvironment - change or add an environment variable definition
+ EnvDef.
TRUE is returned if the environment variable was
set or changed successfully.
*/
diff --git a/gcc/m2/mc-boot/GFIO.c b/gcc/m2/mc-boot/GFIO.c
index b59b6bb0a74..b9f9af23719 100644
--- a/gcc/m2/mc-boot/GFIO.c
+++ b/gcc/m2/mc-boot/GFIO.c
@@ -1,7 +1,7 @@
/* do not edit automatically generated by mc from FIO. */
/* FIO.mod provides a simple buffered file input/output library.
-Copyright (C) 2001-2021 Free Software Foundation, Inc.
+Copyright (C) 2001-2022 Free Software Foundation, Inc.
Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
This file is part of GNU Modula-2.
@@ -185,13 +185,13 @@ extern "C" FIO_File FIO_openForRandom (void * fname, unsigned int flength, unsig
extern "C" void FIO_FlushBuffer (FIO_File f);
/*
- ReadNBytes - reads nBytes of a file into memory area, a, returning
+ ReadNBytes - reads nBytes of a file into memory area, dest, returning
the number of bytes actually read.
This function will consume from the buffer and then
perform direct libc reads. It is ideal for large reads.
*/
-extern "C" unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void * a);
+extern "C" unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void * dest);
/*
ReadAny - reads HIGH(a) bytes into, a. All input
@@ -202,14 +202,14 @@ extern "C" unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void *
extern "C" void FIO_ReadAny (FIO_File f, unsigned char *a, unsigned int _a_high);
/*
- WriteNBytes - writes nBytes of a file into memory area, a, returning
- the number of bytes actually written.
+ WriteNBytes - writes nBytes from memory area src to a file
+ returning the number of bytes actually written.
This function will flush the buffer and then
write the nBytes using a direct write from libc.
It is ideal for large writes.
*/
-extern "C" unsigned int FIO_WriteNBytes (FIO_File f, unsigned int nBytes, void * a);
+extern "C" unsigned int FIO_WriteNBytes (FIO_File f, unsigned int nBytes, void * src);
/*
WriteAny - writes HIGH(a) bytes onto, file, f. All output
@@ -553,7 +553,7 @@ static FIO_File GetNextFreeDescriptor (void)
return f; /* create new slot */
}
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/FIO.def", 25, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/FIO.def", 25, 1);
__builtin_unreachable ();
}
@@ -1650,13 +1650,13 @@ extern "C" void FIO_FlushBuffer (FIO_File f)
/*
- ReadNBytes - reads nBytes of a file into memory area, a, returning
+ ReadNBytes - reads nBytes of a file into memory area, dest, returning
the number of bytes actually read.
This function will consume from the buffer and then
perform direct libc reads. It is ideal for large reads.
*/
-extern "C" unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void * a)
+extern "C" unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void * dest)
{
typedef char *_T2;
@@ -1666,14 +1666,14 @@ extern "C" unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void *
if (f != Error)
{
CheckAccess (f, openedforread, FALSE);
- n = ReadFromBuffer (f, a, nBytes);
+ n = ReadFromBuffer (f, dest, nBytes);
if (n <= 0)
{
return 0;
}
else
{
- p = static_cast<_T2> (a);
+ p = static_cast<_T2> (dest);
p += n-1;
SetEndOfLine (f, (*p));
return n;
@@ -1705,14 +1705,14 @@ extern "C" void FIO_ReadAny (FIO_File f, unsigned char *a, unsigned int _a_high)
/*
- WriteNBytes - writes nBytes of a file into memory area, a, returning
- the number of bytes actually written.
+ WriteNBytes - writes nBytes from memory area src to a file
+ returning the number of bytes actually written.
This function will flush the buffer and then
write the nBytes using a direct write from libc.
It is ideal for large writes.
*/
-extern "C" unsigned int FIO_WriteNBytes (FIO_File f, unsigned int nBytes, void * a)
+extern "C" unsigned int FIO_WriteNBytes (FIO_File f, unsigned int nBytes, void * src)
{
int total;
FileDescriptor fd;
@@ -1724,7 +1724,7 @@ extern "C" unsigned int FIO_WriteNBytes (FIO_File f, unsigned int nBytes, void *
fd = static_cast<FileDescriptor> (Indexing_GetIndice (FileInfo, f));
if (fd != NULL)
{
- total = static_cast<int> (libc_write (fd->unixfd, a, static_cast<size_t> ((int ) (nBytes))));
+ total = static_cast<int> (libc_write (fd->unixfd, src, static_cast<size_t> ((int ) (nBytes))));
if (total < 0)
{
fd->state = failed;
@@ -2260,7 +2260,7 @@ extern "C" void * FIO_getFileName (FIO_File f)
return fd->name.address;
}
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/FIO.def", 25, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/FIO.def", 25, 1);
__builtin_unreachable ();
}
@@ -2287,7 +2287,7 @@ extern "C" unsigned int FIO_getFileNameLength (FIO_File f)
return fd->name.size;
}
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/FIO.def", 25, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/FIO.def", 25, 1);
__builtin_unreachable ();
}
diff --git a/gcc/m2/mc-boot/GFIO.h b/gcc/m2/mc-boot/GFIO.h
index 027d7053259..5f24a4c6762 100644
--- a/gcc/m2/mc-boot/GFIO.h
+++ b/gcc/m2/mc-boot/GFIO.h
@@ -97,9 +97,10 @@ EXTERN FIO_File FIO_OpenToWrite (const char *fname_, unsigned int _fname_high);
calling IsNoError.
towrite, determines whether the file should be
opened for writing or reading.
- newfile, determines whether a file should be created
- if towrite is TRUE or whether the previous file should
- be left alone, allowing this descriptor to seek
+ newfile, determines whether a file should be
+ created if towrite is TRUE or whether the
+ previous file should be left alone,
+ allowing this descriptor to seek
and modify an existing file.
*/
@@ -124,13 +125,13 @@ EXTERN FIO_File FIO_openForRandom (void * fname, unsigned int flength, unsigned
EXTERN void FIO_FlushBuffer (FIO_File f);
/*
- ReadNBytes - reads nBytes of a file into memory area, a, returning
+ ReadNBytes - reads nBytes of a file into memory area, dest, returning
the number of bytes actually read.
This function will consume from the buffer and then
perform direct libc reads. It is ideal for large reads.
*/
-EXTERN unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void * a);
+EXTERN unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void * dest);
/*
ReadAny - reads HIGH(a) bytes into, a. All input
@@ -141,14 +142,14 @@ EXTERN unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void * a);
EXTERN void FIO_ReadAny (FIO_File f, unsigned char *a, unsigned int _a_high);
/*
- WriteNBytes - writes nBytes of a file into memory area, a, returning
- the number of bytes actually written.
+ WriteNBytes - writes nBytes from memory area src to a file
+ returning the number of bytes actually written.
This function will flush the buffer and then
write the nBytes using a direct write from libc.
It is ideal for large writes.
*/
-EXTERN unsigned int FIO_WriteNBytes (FIO_File f, unsigned int nBytes, void * a);
+EXTERN unsigned int FIO_WriteNBytes (FIO_File f, unsigned int nBytes, void * src);
/*
WriteAny - writes HIGH(a) bytes onto, file, f. All output
@@ -249,7 +250,8 @@ EXTERN unsigned int FIO_ReadCardinal (FIO_File f);
EXTERN int FIO_GetUnixFileDescriptor (FIO_File f);
/*
- SetPositionFromBeginning - sets the position from the beginning of the file.
+ SetPositionFromBeginning - sets the position from the beginning
+ of the file.
*/
EXTERN void FIO_SetPositionFromBeginning (FIO_File f, long int pos);
@@ -279,7 +281,8 @@ EXTERN void FIO_GetFileName (FIO_File f, char *a, unsigned int _a_high);
EXTERN void * FIO_getFileName (FIO_File f);
/*
- getFileNameLength - returns the number of characters associated with filename, f.
+ getFileNameLength - returns the number of characters associated with
+ filename, f.
*/
EXTERN unsigned int FIO_getFileNameLength (FIO_File f);
diff --git a/gcc/m2/mc-boot/GFormatStrings.h b/gcc/m2/mc-boot/GFormatStrings.h
index 82ce715ea2f..668a2fdb955 100644
--- a/gcc/m2/mc-boot/GFormatStrings.h
+++ b/gcc/m2/mc-boot/GFormatStrings.h
@@ -58,8 +58,9 @@ extern "C" {
EXTERN DynamicStrings_String FormatStrings_Sprintf0 (DynamicStrings_String fmt);
/*
- Sprintf1 - returns a String containing, fmt, together with encapsulated
- entity, w. It only formats the first %s or %d with n.
+ Sprintf1 - returns a String containing, fmt, together with
+ encapsulated entity, w. It only formats the
+ first %s or %d with n.
*/
EXTERN DynamicStrings_String FormatStrings_Sprintf1 (DynamicStrings_String fmt, const unsigned char *w_, unsigned int _w_high);
@@ -84,9 +85,9 @@ EXTERN DynamicStrings_String FormatStrings_Sprintf4 (DynamicStrings_String fmt,
/*
HandleEscape - translates \a, \b, \e, \f,
-, \r, \x[hex] \[octal] into
- their respective ascii codes. It also converts \[any] into
- a single [any] character.
+, \r, \x[hex] \[octal]
+ into their respective ascii codes. It also converts
+ \[any] into a single [any] character.
*/
EXTERN DynamicStrings_String FormatStrings_HandleEscape (DynamicStrings_String s);
diff --git a/gcc/m2/mc-boot/GIndexing.c b/gcc/m2/mc-boot/GIndexing.c
index 5fd740cb11d..24f62927dc2 100644
--- a/gcc/m2/mc-boot/GIndexing.c
+++ b/gcc/m2/mc-boot/GIndexing.c
@@ -222,7 +222,7 @@ extern "C" unsigned int Indexing_InBounds (Indexing_Index i, unsigned int n)
{
return (n >= i->Low) && (n <= i->High);
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/Indexing.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/Indexing.def", 20, 1);
__builtin_unreachable ();
}
@@ -242,7 +242,7 @@ extern "C" unsigned int Indexing_HighIndice (Indexing_Index i)
{
return i->High;
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/Indexing.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/Indexing.def", 20, 1);
__builtin_unreachable ();
}
@@ -262,7 +262,7 @@ extern "C" unsigned int Indexing_LowIndice (Indexing_Index i)
{
return i->Low;
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/Indexing.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/Indexing.def", 20, 1);
__builtin_unreachable ();
}
diff --git a/gcc/m2/mc-boot/GM2EXCEPTION.c b/gcc/m2/mc-boot/GM2EXCEPTION.c
index e00c7c8942c..04a1af58a58 100644
--- a/gcc/m2/mc-boot/GM2EXCEPTION.c
+++ b/gcc/m2/mc-boot/GM2EXCEPTION.c
@@ -57,13 +57,13 @@ extern "C" M2EXCEPTION_M2Exceptions M2EXCEPTION_M2Exception (void)
n = RTExceptions_GetNumber (e);
if (n == (UINT_MAX))
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/M2EXCEPTION.mod")), 47, 6, const_cast<void*> (reinterpret_cast<const void*>("M2Exception")), const_cast<void*> (reinterpret_cast<const void*>("current coroutine is not in the exceptional execution state")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/M2EXCEPTION.mod")), 47, 6, const_cast<void*> (reinterpret_cast<const void*>("M2Exception")), const_cast<void*> (reinterpret_cast<const void*>("current coroutine is not in the exceptional execution state")));
}
else
{
return (M2EXCEPTION_M2Exceptions) (n);
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/M2EXCEPTION.def", 25, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/M2EXCEPTION.def", 25, 1);
__builtin_unreachable ();
}
diff --git a/gcc/m2/mc-boot/GM2RTS.c b/gcc/m2/mc-boot/GM2RTS.c
index a21dc6a30c0..4c4dc74bc22 100644
--- a/gcc/m2/mc-boot/GM2RTS.c
+++ b/gcc/m2/mc-boot/GM2RTS.c
@@ -41,28 +41,116 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
# define FALSE (1==0)
# endif
+# include "GStorage.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
#define _M2RTS_H
#define _M2RTS_C
# include "Glibc.h"
+# include "GM2LINK.h"
# include "GNumberIO.h"
# include "GStrLib.h"
# include "GSYSTEM.h"
# include "GASCII.h"
+# include "GStorage.h"
# include "GRTExceptions.h"
# include "GM2EXCEPTION.h"
-# define MaxProcedures 1024
-typedef struct _T1_a _T1;
+typedef struct M2RTS_ArgCVEnvP_p M2RTS_ArgCVEnvP;
-struct _T1_a { PROC array[MaxProcedures+1]; };
-static unsigned int iPtr;
-static unsigned int tPtr;
-static _T1 InitialProc;
-static _T1 TerminateProc;
+typedef struct ProcedureList_r ProcedureList;
+
+typedef char *PtrToChar;
+
+typedef struct DependencyList_r DependencyList;
+
+typedef struct _T2_r _T2;
+
+typedef _T2 *ProcedureChain;
+
+typedef struct _T3_r _T3;
+
+typedef _T3 *ModuleChain;
+
+typedef struct _T4_a _T4;
+
+typedef enum {unregistered, unordered, started, ordered} DependencyState;
+
+typedef void (*M2RTS_ArgCVEnvP_t) (int, void *, void *);
+struct M2RTS_ArgCVEnvP_p { M2RTS_ArgCVEnvP_t proc; };
+
+struct ProcedureList_r {
+ ProcedureChain head;
+ ProcedureChain tail;
+ };
+
+struct DependencyList_r {
+ PROC proc;
+ unsigned int forced;
+ unsigned int forc;
+ DependencyState state;
+ };
+
+struct _T2_r {
+ PROC p;
+ ProcedureChain prev;
+ ProcedureChain next;
+ };
+
+struct _T4_a { ModuleChain array[ordered-unregistered+1]; };
+struct _T3_r {
+ void *name;
+ M2RTS_ArgCVEnvP init;
+ M2RTS_ArgCVEnvP fini;
+ DependencyList dependency;
+ ModuleChain prev;
+ ModuleChain next;
+ };
+
+static ProcedureList InitialProc;
+static ProcedureList TerminateProc;
static int ExitValue;
+static _T4 Modules;
static unsigned int isHalting;
static unsigned int CallExit;
+static unsigned int ModuleTrace;
+static unsigned int DependencyTrace;
+static unsigned int PreTrace;
+static unsigned int PostTrace;
+static unsigned int ForceTrace;
+
+/*
+ ConstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2RTS_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+
+/*
+ DeconstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2RTS_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+
+/*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*/
+
+extern "C" void M2RTS_RegisterModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
+
+/*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule. It only takes effect
+ if we are not using StaticInitialization.
+*/
+
+extern "C" void M2RTS_RequestDependant (void * modulename, void * dependantmodule);
/*
ExecuteTerminationProcedures - calls each installed termination procedure
@@ -75,7 +163,7 @@ extern "C" void M2RTS_ExecuteTerminationProcedures (void);
InstallTerminationProcedure - installs a procedure, p, which will
be called when the procedure
ExecuteTerminationProcedures
- is invoked. It returns TRUE is the
+ is invoked. It returns TRUE if the
procedure is installed.
*/
@@ -89,8 +177,9 @@ extern "C" unsigned int M2RTS_InstallTerminationProcedure (PROC p);
extern "C" void M2RTS_ExecuteInitialProcedures (void);
/*
- InstallInitialProcedure - installs a procedure to be executed just before the
- BEGIN code section of the main program module.
+ InstallInitialProcedure - installs a procedure to be executed just
+ before the BEGIN code section of the
+ main program module.
*/
extern "C" unsigned int M2RTS_InstallInitialProcedure (PROC p);
@@ -168,12 +257,644 @@ extern "C" void M2RTS_RealValueException (void * filename, unsigned int line, un
extern "C" void M2RTS_ParameterException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
extern "C" void M2RTS_NoException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+/*
+ CreateModule - creates a new module entry and returns the
+ ModuleChain.
+*/
+
+static ModuleChain CreateModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
+
+/*
+ AppendModule - append chain to head.
+*/
+
+static void AppendModule (ModuleChain *head, ModuleChain chain);
+
+/*
+ RemoveModule - remove chain from double linked list head.
+*/
+
+static void RemoveModule (ModuleChain *head, ModuleChain chain);
+
+/*
+ onChain - returns TRUE if mptr is on the Modules[state] list.
+*/
+
+static unsigned int onChain (DependencyState state, ModuleChain mptr);
+
+/*
+ LookupModule - lookup and return the ModuleChain pointer containing
+ module name from a particular list.
+*/
+
+static ModuleChain LookupModule (DependencyState state, void * name);
+
+/*
+ toCString - replace any character sequence
+ into a newline.
+*/
+
+static void toCString (char *str, unsigned int _str_high);
+
+/*
+ strcmp - return 1 if both strings are equal.
+ We cannot use Builtins.def during bootstrap.
+*/
+
+static int strcmp (PtrToChar a, PtrToChar b);
+
+/*
+ strncmp - return 1 if both strings are equal.
+ We cannot use Builtins.def during bootstrap.
+*/
+
+static int strncmp (PtrToChar a, PtrToChar b, unsigned int n);
+
+/*
+ traceprintf - wrap printf with a boolean flag.
+*/
+
+static void traceprintf (unsigned int flag, const char *str_, unsigned int _str_high);
+
+/*
+ traceprintf2 - wrap printf with a boolean flag.
+*/
+
+static void traceprintf2 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg);
+
+/*
+ moveTo - moves mptr to the new list determined by newstate.
+ It updates the mptr state appropriately.
+*/
+
+static void moveTo (DependencyState newstate, ModuleChain mptr);
+
+/*
+ ResolveDependant -
+*/
+
+static void ResolveDependant (ModuleChain mptr, void * currentmodule);
+
+/*
+ PerformRequestDependant - the current modulename has a dependancy upon
+ dependantmodule. If dependantmodule is NIL then
+ modulename has no further dependants and it can be
+ resolved.
+*/
+
+static void PerformRequestDependant (void * modulename, void * dependantmodule);
+
+/*
+ ResolveDependencies -
+*/
+
+static void ResolveDependencies (void * currentmodule);
+
+/*
+ DisplayModuleInfo - displays all module in the state.
+*/
+
+static void DisplayModuleInfo (DependencyState state, const char *name_, unsigned int _name_high);
+
+/*
+ DumpModuleData -
+*/
+
+static void DumpModuleData (unsigned int flag);
+
+/*
+ ForceDependencies -
+*/
+
+static void ForceDependencies (void);
+
+/*
+ ExecuteReverse - execute the procedure associated with procptr
+ and then proceed to try and execute all previous
+ procedures in the chain.
+*/
+
+static void ExecuteReverse (ProcedureChain procptr);
+
+/*
+ AppendProc - append proc to the end of the procedure list
+ defined by proclist.
+*/
+
+static unsigned int AppendProc (ProcedureList *proclist, PROC proc);
+
/*
ErrorString - writes a string to stderr.
*/
static void ErrorString (const char *a_, unsigned int _a_high);
+/*
+ InitProcList - initialize the head and tail pointers to NIL.
+*/
+
+static void InitProcList (ProcedureList *p);
+
+/*
+ equal - return TRUE if C string cstr is equal to str.
+*/
+
+static unsigned int equal (void * cstr, const char *str_, unsigned int _str_high);
+
+/*
+ SetupDebugFlags - By default assigns ModuleTrace, DependencyTrace,
+ DumpPostInit to FALSE. It checks the environment
+ GCC_M2LINK_RTFLAG which can contain
+ "all,module,pre,post,dep,force". all turns them all on.
+ The flag meanings are as follows and flags the are in
+ execution order.
+
+ module generate trace info as the modules are registered.
+ pre generate a list of all modules seen prior to having
+ their dependancies resolved.
+ dep display a trace as the modules are resolved.
+ post generate a list of all modules seen after having
+ their dependancies resolved.
+ force generate a list of all modules seen after having
+ their dependancies resolved and forced.
+*/
+
+static void SetupDebugFlags (void);
+
+
+/*
+ CreateModule - creates a new module entry and returns the
+ ModuleChain.
+*/
+
+static ModuleChain CreateModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies)
+{
+ ModuleChain mptr;
+
+ Storage_ALLOCATE ((void **) &mptr, sizeof (_T3));
+ mptr->name = name;
+ mptr->init = init;
+ mptr->fini = fini;
+ mptr->dependency.proc = dependencies;
+ mptr->dependency.state = unregistered;
+ mptr->prev = NULL;
+ mptr->next = NULL;
+ return mptr;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ AppendModule - append chain to head.
+*/
+
+static void AppendModule (ModuleChain *head, ModuleChain chain)
+{
+ if ((*head) == NULL)
+ {
+ (*head) = chain;
+ chain->prev = chain;
+ chain->next = chain;
+ }
+ else
+ {
+ chain->next = (*head); /* Add Item to the end of queue */
+ chain->prev = (*head)->prev; /* Add Item to the end of queue */
+ (*head)->prev->next = chain;
+ (*head)->prev = chain;
+ }
+}
+
+
+/*
+ RemoveModule - remove chain from double linked list head.
+*/
+
+static void RemoveModule (ModuleChain *head, ModuleChain chain)
+{
+ if ((chain->next == (*head)) && (chain == (*head)))
+ {
+ (*head) = NULL;
+ }
+ else
+ {
+ if ((*head) == chain)
+ {
+ (*head) = (*head)->next;
+ }
+ chain->prev->next = chain->next;
+ chain->next->prev = chain->prev;
+ }
+}
+
+
+/*
+ onChain - returns TRUE if mptr is on the Modules[state] list.
+*/
+
+static unsigned int onChain (DependencyState state, ModuleChain mptr)
+{
+ ModuleChain ptr;
+
+ if (Modules.array[state-unregistered] != NULL)
+ {
+ ptr = Modules.array[state-unregistered];
+ do {
+ if (ptr == mptr)
+ {
+ return TRUE;
+ }
+ ptr = ptr->next;
+ } while (! (ptr == Modules.array[state-unregistered]));
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ LookupModule - lookup and return the ModuleChain pointer containing
+ module name from a particular list.
+*/
+
+static ModuleChain LookupModule (DependencyState state, void * name)
+{
+ ModuleChain ptr;
+
+ if (Modules.array[state-unregistered] != NULL)
+ {
+ ptr = Modules.array[state-unregistered];
+ do {
+ if ((strcmp (reinterpret_cast<PtrToChar> (ptr->name), reinterpret_cast<PtrToChar> (name))) == 0)
+ {
+ return ptr;
+ }
+ ptr = ptr->next;
+ } while (! (ptr == Modules.array[state-unregistered]));
+ }
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ toCString - replace any character sequence
+ into a newline.
+*/
+
+static void toCString (char *str, unsigned int _str_high)
+{
+ unsigned int high;
+ unsigned int i;
+ unsigned int j;
+
+ i = 0;
+ high = _str_high;
+ while (i < high)
+ {
+ if ((str[i] == '\\') && (i < high))
+ {
+ if (str[i+1] == 'n')
+ {
+ str[i] = ASCII_nl;
+ j = i+1;
+ while (j < high)
+ {
+ str[j] = str[j+1];
+ j += 1;
+ }
+ }
+ }
+ i += 1;
+ }
+}
+
+
+/*
+ strcmp - return 1 if both strings are equal.
+ We cannot use Builtins.def during bootstrap.
+*/
+
+static int strcmp (PtrToChar a, PtrToChar b)
+{
+ if ((a != NULL) && (b != NULL))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (a == b)
+ {
+ return 1;
+ }
+ else
+ {
+ while ((*a) == (*b))
+ {
+ if ((*a) == ASCII_nul)
+ {
+ return 1;
+ }
+ a += 1;
+ b += 1;
+ }
+ }
+ }
+ return 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ strncmp - return 1 if both strings are equal.
+ We cannot use Builtins.def during bootstrap.
+*/
+
+static int strncmp (PtrToChar a, PtrToChar b, unsigned int n)
+{
+ if (((a != NULL) && (b != NULL)) && (n > 0))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (a == b)
+ {
+ return 1;
+ }
+ else
+ {
+ while (((*a) == (*b)) && (n > 0))
+ {
+ if ((*a) == ASCII_nul)
+ {
+ return 1;
+ }
+ a += 1;
+ b += 1;
+ n -= 1;
+ }
+ }
+ }
+ return 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ traceprintf - wrap printf with a boolean flag.
+*/
+
+static void traceprintf (unsigned int flag, const char *str_, unsigned int _str_high)
+{
+ char str[_str_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (str, str_, _str_high+1);
+
+ if (flag)
+ {
+ toCString ((char *) str, _str_high);
+ libc_printf ((const char *) str, _str_high);
+ }
+}
+
+
+/*
+ traceprintf2 - wrap printf with a boolean flag.
+*/
+
+static void traceprintf2 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg)
+{
+ char str[_str_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (str, str_, _str_high+1);
+
+ if (flag)
+ {
+ toCString ((char *) str, _str_high);
+ libc_printf ((const char *) str, _str_high, arg);
+ }
+}
+
+
+/*
+ moveTo - moves mptr to the new list determined by newstate.
+ It updates the mptr state appropriately.
+*/
+
+static void moveTo (DependencyState newstate, ModuleChain mptr)
+{
+ if (onChain (mptr->dependency.state, mptr))
+ {
+ RemoveModule (&Modules.array[mptr->dependency.state-unregistered], mptr);
+ }
+ mptr->dependency.state = newstate;
+ AppendModule (&Modules.array[mptr->dependency.state-unregistered], mptr);
+}
+
+
+/*
+ ResolveDependant -
+*/
+
+static void ResolveDependant (ModuleChain mptr, void * currentmodule)
+{
+ if (mptr == NULL)
+ {
+ traceprintf (DependencyTrace, (const char *) " module has not been registered via a global constructor\\n", 60);
+ }
+ else
+ {
+ if (onChain (started, mptr))
+ {
+ traceprintf (DependencyTrace, (const char *) " processing...\\n", 18);
+ }
+ else
+ {
+ moveTo (started, mptr);
+ traceprintf2 (DependencyTrace, (const char *) " starting: %s\\n", 17, currentmodule);
+ (*mptr->dependency.proc.proc) (); /* Invoke and process the dependency graph. */
+ traceprintf2 (DependencyTrace, (const char *) " finished: %s\\n", 17, currentmodule); /* Invoke and process the dependency graph. */
+ }
+ }
+}
+
+
+/*
+ PerformRequestDependant - the current modulename has a dependancy upon
+ dependantmodule. If dependantmodule is NIL then
+ modulename has no further dependants and it can be
+ resolved.
+*/
+
+static void PerformRequestDependant (void * modulename, void * dependantmodule)
+{
+ ModuleChain mptr;
+
+ if (dependantmodule == NULL)
+ {
+ mptr = LookupModule (unordered, modulename);
+ if (mptr == NULL)
+ {
+ traceprintf2 (DependencyTrace, (const char *) "internal error module %s is not in the list of unordered modules\\n", 66, modulename);
+ }
+ else
+ {
+ traceprintf2 (DependencyTrace, (const char *) " module %s dependants all complete\\n", 37, modulename);
+ moveTo (ordered, mptr);
+ }
+ }
+ else
+ {
+ mptr = LookupModule (ordered, dependantmodule);
+ if (mptr == NULL)
+ {
+ traceprintf2 (DependencyTrace, (const char *) " module %s ", 13, dependantmodule);
+ mptr = LookupModule (unordered, dependantmodule);
+ if (mptr == NULL)
+ {
+ mptr = LookupModule (started, dependantmodule);
+ if (mptr == NULL)
+ {
+ traceprintf2 (DependencyTrace, (const char *) " unknown dependancies in module %s ", 37, modulename);
+ }
+ else
+ {
+ traceprintf2 (DependencyTrace, (const char *) " dependant %s started\\n", 25, dependantmodule);
+ }
+ }
+ else
+ {
+ ResolveDependant (mptr, dependantmodule);
+ }
+ }
+ else
+ {
+ traceprintf2 (DependencyTrace, (const char *) " module %s ", 13, modulename);
+ traceprintf2 (DependencyTrace, (const char *) " dependant upon %s completed\\n", 30, dependantmodule);
+ }
+ }
+}
+
+
+/*
+ ResolveDependencies -
+*/
+
+static void ResolveDependencies (void * currentmodule)
+{
+ ModuleChain mptr;
+
+ mptr = LookupModule (unordered, currentmodule);
+ while (mptr != NULL)
+ {
+ traceprintf2 (DependencyTrace, (const char *) " attempting to resolve the dependants for %s\\n", 48, currentmodule);
+ ResolveDependant (mptr, currentmodule);
+ mptr = Modules.array[unordered-unregistered];
+ }
+}
+
+
+/*
+ DisplayModuleInfo - displays all module in the state.
+*/
+
+static void DisplayModuleInfo (DependencyState state, const char *name_, unsigned int _name_high)
+{
+ ModuleChain mptr;
+ char name[_name_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (name, name_, _name_high+1);
+
+ if (Modules.array[state-unregistered] != NULL)
+ {
+ libc_printf ((const char *) "%s modules\\n", 12, &name);
+ mptr = Modules.array[state-unregistered];
+ do {
+ libc_printf ((const char *) " %s", 4, mptr->name);
+ if (mptr->dependency.forc)
+ {
+ libc_printf ((const char *) " for C", 6);
+ }
+ if (mptr->dependency.forced)
+ {
+ libc_printf ((const char *) " forced ordering", 16);
+ }
+ libc_printf ((const char *) "\\n", 2);
+ mptr = mptr->next;
+ } while (! (mptr == Modules.array[state-unregistered]));
+ }
+}
+
+
+/*
+ DumpModuleData -
+*/
+
+static void DumpModuleData (unsigned int flag)
+{
+ ModuleChain mptr;
+
+ if (flag)
+ {
+ DisplayModuleInfo (unregistered, (const char *) "unregistered", 12);
+ DisplayModuleInfo (unordered, (const char *) "unordered", 9);
+ DisplayModuleInfo (started, (const char *) "started", 7);
+ DisplayModuleInfo (ordered, (const char *) "ordered", 7);
+ }
+}
+
+
+/*
+ ForceDependencies -
+*/
+
+static void ForceDependencies (void)
+{
+}
+
+
+/*
+ ExecuteReverse - execute the procedure associated with procptr
+ and then proceed to try and execute all previous
+ procedures in the chain.
+*/
+
+static void ExecuteReverse (ProcedureChain procptr)
+{
+ while (procptr != NULL)
+ {
+ (*procptr->p.proc) (); /* Invoke the procedure. */
+ procptr = procptr->prev; /* Invoke the procedure. */
+ }
+}
+
+
+/*
+ AppendProc - append proc to the end of the procedure list
+ defined by proclist.
+*/
+
+static unsigned int AppendProc (ProcedureList *proclist, PROC proc)
+{
+ ProcedureChain pdes;
+
+ Storage_ALLOCATE ((void **) &pdes, sizeof (_T2));
+ pdes->p = proc;
+ pdes->prev = (*proclist).tail;
+ pdes->next = NULL;
+ if ((*proclist).head == NULL)
+ {
+ (*proclist).head = pdes;
+ }
+ (*proclist).tail = pdes;
+ return TRUE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
/*
ErrorString - writes a string to stderr.
@@ -192,43 +913,227 @@ static void ErrorString (const char *a_, unsigned int _a_high)
/*
- ExecuteTerminationProcedures - calls each installed termination procedure
- in reverse order.
+ InitProcList - initialize the head and tail pointers to NIL.
*/
-extern "C" void M2RTS_ExecuteTerminationProcedures (void)
+static void InitProcList (ProcedureList *p)
{
- unsigned int i;
+ (*p).head = NULL;
+ (*p).tail = NULL;
+}
+
+
+/*
+ equal - return TRUE if C string cstr is equal to str.
+*/
+
+static unsigned int equal (void * cstr, const char *str_, unsigned int _str_high)
+{
+ char str[_str_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (str, str_, _str_high+1);
+
+ return (strncmp (reinterpret_cast<PtrToChar> (cstr), reinterpret_cast<PtrToChar> (&str), StrLib_StrLen ((const char *) str, _str_high))) == 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SetupDebugFlags - By default assigns ModuleTrace, DependencyTrace,
+ DumpPostInit to FALSE. It checks the environment
+ GCC_M2LINK_RTFLAG which can contain
+ "all,module,pre,post,dep,force". all turns them all on.
+ The flag meanings are as follows and flags the are in
+ execution order.
+
+ module generate trace info as the modules are registered.
+ pre generate a list of all modules seen prior to having
+ their dependancies resolved.
+ dep display a trace as the modules are resolved.
+ post generate a list of all modules seen after having
+ their dependancies resolved.
+ force generate a list of all modules seen after having
+ their dependancies resolved and forced.
+*/
+
+static void SetupDebugFlags (void)
+{
+ typedef char *_T1;
- i = tPtr;
- while (i > 0)
+ _T1 pc;
+
+ ModuleTrace = FALSE;
+ DependencyTrace = FALSE;
+ PostTrace = FALSE;
+ PreTrace = FALSE;
+ pc = static_cast<_T1> (libc_getenv (const_cast<void*> (reinterpret_cast<const void*>("GCC_M2LINK_RTFLAG"))));
+ while ((pc != NULL) && ((*pc) != ASCII_nul))
{
- i -= 1;
- (*TerminateProc.array[i].proc) ();
+ if (equal (reinterpret_cast<void *> (pc), (const char *) "all", 3))
+ {
+ ModuleTrace = TRUE;
+ DependencyTrace = TRUE;
+ PreTrace = TRUE;
+ PostTrace = TRUE;
+ pc += 3;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "module", 6))
+ {
+ /* avoid dangling else. */
+ ModuleTrace = TRUE;
+ pc += 6;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "dep", 3))
+ {
+ /* avoid dangling else. */
+ DependencyTrace = TRUE;
+ pc += 3;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "pre", 3))
+ {
+ /* avoid dangling else. */
+ PreTrace = TRUE;
+ pc += 3;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "post", 4))
+ {
+ /* avoid dangling else. */
+ PostTrace = TRUE;
+ pc += 4;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "force", 5))
+ {
+ /* avoid dangling else. */
+ ForceTrace = TRUE;
+ pc += 5;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ pc += 1;
+ }
}
}
/*
- InstallTerminationProcedure - installs a procedure, p, which will
- be called when the procedure
- ExecuteTerminationProcedures
- is invoked. It returns TRUE is the
- procedure is installed.
+ ConstructModules - resolve dependencies and then call each
+ module constructor in turn.
*/
-extern "C" unsigned int M2RTS_InstallTerminationProcedure (PROC p)
+extern "C" void M2RTS_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp)
{
- if (tPtr > MaxProcedures)
+ ModuleChain mptr;
+ M2RTS_ArgCVEnvP nulp;
+
+ SetupDebugFlags ();
+ traceprintf2 (ModuleTrace, (const char *) "application module: %s\\n", 24, applicationmodule);
+ DumpModuleData (PreTrace);
+ ResolveDependencies (applicationmodule);
+ DumpModuleData (PostTrace);
+ ForceDependencies ();
+ DumpModuleData (ForceTrace);
+ if (Modules.array[ordered-unregistered] == NULL)
{
- return FALSE;
+ traceprintf2 (ModuleTrace, (const char *) " module: %s has not registered itself using a global constructor\\n", 67, applicationmodule);
+ traceprintf2 (ModuleTrace, (const char *) " hint try compile and linking using: gm2 %s.mod\\n", 50, applicationmodule);
+ traceprintf2 (ModuleTrace, (const char *) " or try using: gm2 -fscaffold-static %s.mod\\n", 46, applicationmodule);
}
else
{
- TerminateProc.array[tPtr] = p;
- tPtr += 1;
- return TRUE;
+ mptr = Modules.array[ordered-unregistered];
+ do {
+ if (mptr->dependency.forc)
+ {
+ traceprintf2 (ModuleTrace, (const char *) "initializing module: %s for C\\n", 31, mptr->name);
+ }
+ else
+ {
+ traceprintf2 (ModuleTrace, (const char *) "initializing module: %s\\n", 25, mptr->name);
+ }
+ /*
+ nulp := NIL ;
+ IF mptr^.init = nulp
+ THEN
+ traceprintf (ModuleTrace, " no initialization section, skipping...
+ ")
+ ELSE
+ */
+ (*mptr->init.proc) (argc, argv, envp);
+ /*
+ END ;
+ */
+ mptr = mptr->prev;
+ } while (! (mptr == Modules.array[ordered-unregistered]));
}
+}
+
+
+/*
+ DeconstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2RTS_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp)
+{
+}
+
+
+/*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*/
+
+extern "C" void M2RTS_RegisterModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies)
+{
+ if (! M2LINK_StaticInitialization)
+ {
+ traceprintf2 (ModuleTrace, (const char *) "module: %s registering\\n", 24, name);
+ moveTo (unordered, CreateModule (name, init, fini, dependencies));
+ }
+}
+
+
+/*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule. It only takes effect
+ if we are not using StaticInitialization.
+*/
+
+extern "C" void M2RTS_RequestDependant (void * modulename, void * dependantmodule)
+{
+ if (! M2LINK_StaticInitialization)
+ {
+ PerformRequestDependant (modulename, dependantmodule);
+ }
+}
+
+
+/*
+ ExecuteTerminationProcedures - calls each installed termination procedure
+ in reverse order.
+*/
+
+extern "C" void M2RTS_ExecuteTerminationProcedures (void)
+{
+ ExecuteReverse (TerminateProc.tail);
+}
+
+
+/*
+ InstallTerminationProcedure - installs a procedure, p, which will
+ be called when the procedure
+ ExecuteTerminationProcedures
+ is invoked. It returns TRUE if the
+ procedure is installed.
+*/
+
+extern "C" unsigned int M2RTS_InstallTerminationProcedure (PROC p)
+{
+ return AppendProc (&TerminateProc, p);
/* static analysis guarentees a RETURN statement will be used before here. */
__builtin_unreachable ();
}
@@ -241,34 +1146,19 @@ extern "C" unsigned int M2RTS_InstallTerminationProcedure (PROC p)
extern "C" void M2RTS_ExecuteInitialProcedures (void)
{
- unsigned int i;
-
- i = iPtr;
- while (i > 0)
- {
- i -= 1;
- (*InitialProc.array[i].proc) ();
- }
+ ExecuteReverse (InitialProc.tail);
}
/*
- InstallInitialProcedure - installs a procedure to be executed just before the
- BEGIN code section of the main program module.
+ InstallInitialProcedure - installs a procedure to be executed just
+ before the BEGIN code section of the
+ main program module.
*/
extern "C" unsigned int M2RTS_InstallInitialProcedure (PROC p)
{
- if (iPtr > MaxProcedures)
- {
- return FALSE;
- }
- else
- {
- InitialProc.array[iPtr] = p;
- iPtr += 1;
- return TRUE;
- }
+ return AppendProc (&InitialProc, p);
/* static analysis guarentees a RETURN statement will be used before here. */
__builtin_unreachable ();
}
@@ -365,10 +1255,10 @@ extern "C" void M2RTS_ExitOnHalt (int e)
extern "C" void M2RTS_ErrorMessage (const char *message_, unsigned int _message_high, const char *file_, unsigned int _file_high, unsigned int line, const char *function_, unsigned int _function_high)
{
- typedef struct _T2_a _T2;
+ typedef struct _T5_a _T5;
- struct _T2_a { char array[10+1]; };
- _T2 LineNo;
+ struct _T5_a { char array[10+1]; };
+ _T5 LineNo;
char message[_message_high+1];
char file[_file_high+1];
char function[_function_high+1];
@@ -548,8 +1438,8 @@ extern "C" void M2RTS_NoException (void * filename, unsigned int line, unsigned
extern "C" void _M2_M2RTS_init (__attribute__((unused)) int argc, __attribute__((unused)) char *argv[])
{
- iPtr = 0;
- tPtr = 0;
+ InitProcList (&InitialProc);
+ InitProcList (&TerminateProc);
ExitValue = 0;
isHalting = FALSE;
CallExit = FALSE; /* default by calling abort */
diff --git a/gcc/m2/mc-boot/GM2RTS.h b/gcc/m2/mc-boot/GM2RTS.h
index 53428b8fdec..b8c950ad198 100644
--- a/gcc/m2/mc-boot/GM2RTS.h
+++ b/gcc/m2/mc-boot/GM2RTS.h
@@ -48,6 +48,28 @@ extern "C" {
# define EXTERN extern
# endif
+typedef struct M2RTS_ArgCVEnvP_p M2RTS_ArgCVEnvP;
+
+typedef void (*M2RTS_ArgCVEnvP_t) (int, void *, void *);
+struct M2RTS_ArgCVEnvP_p { M2RTS_ArgCVEnvP_t proc; };
+
+EXTERN void M2RTS_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+EXTERN void M2RTS_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+
+/*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*/
+
+EXTERN void M2RTS_RegisterModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
+
+/*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule.
+*/
+
+EXTERN void M2RTS_RequestDependant (void * modulename, void * dependantmodule);
/*
ExecuteTerminationProcedures - calls each installed termination
diff --git a/gcc/m2/mc-boot/GPushBackInput.c b/gcc/m2/mc-boot/GPushBackInput.c
index f5e348b3867..d6334d12867 100644
--- a/gcc/m2/mc-boot/GPushBackInput.c
+++ b/gcc/m2/mc-boot/GPushBackInput.c
@@ -274,7 +274,7 @@ extern "C" char PushBackInput_PutCh (char ch)
}
else
{
- Debug_Halt ((const char *) "max push back stack exceeded, increase MaxPushBackStack", 55, 150, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/PushBackInput.mod", 85);
+ Debug_Halt ((const char *) "max push back stack exceeded, increase MaxPushBackStack", 55, 150, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/PushBackInput.mod", 84);
}
return ch;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -300,7 +300,7 @@ extern "C" void PushBackInput_PutString (const char *a_, unsigned int _a_high)
l -= 1;
if ((PushBackInput_PutCh (a[l])) != a[l])
{
- Debug_Halt ((const char *) "assert failed", 13, 132, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/PushBackInput.mod", 85);
+ Debug_Halt ((const char *) "assert failed", 13, 132, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/PushBackInput.mod", 84);
}
}
}
@@ -321,7 +321,7 @@ extern "C" void PushBackInput_PutStr (DynamicStrings_String s)
i -= 1;
if ((PushBackInput_PutCh (DynamicStrings_char (s, static_cast<int> (i)))) != (DynamicStrings_char (s, static_cast<int> (i))))
{
- Debug_Halt ((const char *) "assert failed", 13, 113, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/PushBackInput.mod", 85);
+ Debug_Halt ((const char *) "assert failed", 13, 113, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/PushBackInput.mod", 84);
}
}
}
diff --git a/gcc/m2/mc-boot/GRTExceptions.c b/gcc/m2/mc-boot/GRTExceptions.c
index f64a6707a5c..d4124e12e04 100644
--- a/gcc/m2/mc-boot/GRTExceptions.c
+++ b/gcc/m2/mc-boot/GRTExceptions.c
@@ -719,7 +719,7 @@ static void AddHandler (RTExceptions_EHBlock e, Handler h)
static void indexf (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_indexException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 612, 9, const_cast<void*> (reinterpret_cast<const void*>("indexf")), const_cast<void*> (reinterpret_cast<const void*>("array index out of bounds")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_indexException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 612, 9, const_cast<void*> (reinterpret_cast<const void*>("indexf")), const_cast<void*> (reinterpret_cast<const void*>("array index out of bounds")));
}
@@ -729,7 +729,7 @@ static void indexf (void * a)
static void range (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 624, 9, const_cast<void*> (reinterpret_cast<const void*>("range")), const_cast<void*> (reinterpret_cast<const void*>("assignment out of range")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 624, 9, const_cast<void*> (reinterpret_cast<const void*>("range")), const_cast<void*> (reinterpret_cast<const void*>("assignment out of range")));
}
@@ -739,7 +739,7 @@ static void range (void * a)
static void casef (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_caseSelectException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 636, 9, const_cast<void*> (reinterpret_cast<const void*>("casef")), const_cast<void*> (reinterpret_cast<const void*>("case selector out of range")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_caseSelectException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 636, 9, const_cast<void*> (reinterpret_cast<const void*>("casef")), const_cast<void*> (reinterpret_cast<const void*>("case selector out of range")));
}
@@ -749,7 +749,7 @@ static void casef (void * a)
static void invalidloc (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_invalidLocation)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 648, 9, const_cast<void*> (reinterpret_cast<const void*>("invalidloc")), const_cast<void*> (reinterpret_cast<const void*>("invalid address referenced")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_invalidLocation)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 648, 9, const_cast<void*> (reinterpret_cast<const void*>("invalidloc")), const_cast<void*> (reinterpret_cast<const void*>("invalid address referenced")));
}
@@ -759,7 +759,7 @@ static void invalidloc (void * a)
static void function (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_functionException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 660, 9, const_cast<void*> (reinterpret_cast<const void*>("function")), const_cast<void*> (reinterpret_cast<const void*>("... function ... "))); /* --fixme-- what has happened ? */
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_functionException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 660, 9, const_cast<void*> (reinterpret_cast<const void*>("function")), const_cast<void*> (reinterpret_cast<const void*>("... function ... "))); /* --fixme-- what has happened ? */
}
@@ -769,7 +769,7 @@ static void function (void * a)
static void wholevalue (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeValueException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 672, 9, const_cast<void*> (reinterpret_cast<const void*>("wholevalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal whole value exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeValueException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 672, 9, const_cast<void*> (reinterpret_cast<const void*>("wholevalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal whole value exception")));
}
@@ -779,7 +779,7 @@ static void wholevalue (void * a)
static void wholediv (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 684, 9, const_cast<void*> (reinterpret_cast<const void*>("wholediv")), const_cast<void*> (reinterpret_cast<const void*>("illegal whole value exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 684, 9, const_cast<void*> (reinterpret_cast<const void*>("wholediv")), const_cast<void*> (reinterpret_cast<const void*>("illegal whole value exception")));
}
@@ -789,7 +789,7 @@ static void wholediv (void * a)
static void realvalue (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realValueException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 696, 9, const_cast<void*> (reinterpret_cast<const void*>("realvalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal real value exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realValueException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 696, 9, const_cast<void*> (reinterpret_cast<const void*>("realvalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal real value exception")));
}
@@ -799,7 +799,7 @@ static void realvalue (void * a)
static void realdiv (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realDivException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 708, 9, const_cast<void*> (reinterpret_cast<const void*>("realdiv")), const_cast<void*> (reinterpret_cast<const void*>("real number division by zero exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realDivException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 708, 9, const_cast<void*> (reinterpret_cast<const void*>("realdiv")), const_cast<void*> (reinterpret_cast<const void*>("real number division by zero exception")));
}
@@ -809,7 +809,7 @@ static void realdiv (void * a)
static void complexvalue (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexValueException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 720, 9, const_cast<void*> (reinterpret_cast<const void*>("complexvalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal complex value exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexValueException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 720, 9, const_cast<void*> (reinterpret_cast<const void*>("complexvalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal complex value exception")));
}
@@ -819,7 +819,7 @@ static void complexvalue (void * a)
static void complexdiv (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexDivException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 732, 9, const_cast<void*> (reinterpret_cast<const void*>("complexdiv")), const_cast<void*> (reinterpret_cast<const void*>("complex number division by zero exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexDivException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 732, 9, const_cast<void*> (reinterpret_cast<const void*>("complexdiv")), const_cast<void*> (reinterpret_cast<const void*>("complex number division by zero exception")));
}
@@ -829,7 +829,7 @@ static void complexdiv (void * a)
static void protection (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_protException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 744, 9, const_cast<void*> (reinterpret_cast<const void*>("protection")), const_cast<void*> (reinterpret_cast<const void*>("protection exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_protException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 744, 9, const_cast<void*> (reinterpret_cast<const void*>("protection")), const_cast<void*> (reinterpret_cast<const void*>("protection exception")));
}
@@ -839,7 +839,7 @@ static void protection (void * a)
static void systemf (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_sysException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 756, 9, const_cast<void*> (reinterpret_cast<const void*>("systemf")), const_cast<void*> (reinterpret_cast<const void*>("system exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_sysException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 756, 9, const_cast<void*> (reinterpret_cast<const void*>("systemf")), const_cast<void*> (reinterpret_cast<const void*>("system exception")));
}
@@ -849,7 +849,7 @@ static void systemf (void * a)
static void coroutine (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_coException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 768, 9, const_cast<void*> (reinterpret_cast<const void*>("coroutine")), const_cast<void*> (reinterpret_cast<const void*>("coroutine exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_coException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 768, 9, const_cast<void*> (reinterpret_cast<const void*>("coroutine")), const_cast<void*> (reinterpret_cast<const void*>("coroutine exception")));
}
@@ -859,7 +859,7 @@ static void coroutine (void * a)
static void exception (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 780, 9, const_cast<void*> (reinterpret_cast<const void*>("exception")), const_cast<void*> (reinterpret_cast<const void*>("exception exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), const_cast<void*> (reinterpret_cast<const void*>("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod")), 780, 9, const_cast<void*> (reinterpret_cast<const void*>("exception")), const_cast<void*> (reinterpret_cast<const void*>("exception exception")));
}
@@ -1178,13 +1178,13 @@ extern "C" RTExceptions_EHBlock RTExceptions_GetBaseExceptionBlock (void)
{
if (currentEHB == NULL)
{
- M2RTS_Halt ((const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 84, 598, (const char *) "GetBaseExceptionBlock", 21, (const char *) "currentEHB has not been initialized yet", 39);
+ M2RTS_Halt ((const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.mod", 83, 598, (const char *) "GetBaseExceptionBlock", 21, (const char *) "currentEHB has not been initialized yet", 39);
}
else
{
return currentEHB;
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.def", 25, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTExceptions.def", 25, 1);
__builtin_unreachable ();
}
diff --git a/gcc/m2/mc-boot/GRTint.c b/gcc/m2/mc-boot/GRTint.c
index 8f1920c5a00..f080fd47de3 100644
--- a/gcc/m2/mc-boot/GRTint.c
+++ b/gcc/m2/mc-boot/GRTint.c
@@ -595,7 +595,7 @@ static unsigned int activatePending (unsigned int untilInterrupt, RTint_Dispatch
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTint.def", 25, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTint.def", 25, 1);
__builtin_unreachable ();
}
v = v->pending;
@@ -708,7 +708,7 @@ extern "C" unsigned int RTint_InitOutputVector (int fd, unsigned int pri)
RTco_signal (lock);
return v->no;
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTint.def", 25, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTint.def", 25, 1);
__builtin_unreachable ();
}
@@ -765,7 +765,7 @@ extern "C" void RTint_ReArmTimeVector (unsigned int vec, unsigned int micro, uns
v = FindVectorNo (vec);
if (v == NULL)
{
- M2RTS_Halt ((const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTint.mod", 77, 286, (const char *) "ReArmTimeVector", 15, (const char *) "cannot find vector supplied", 27);
+ M2RTS_Halt ((const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTint.mod", 76, 286, (const char *) "ReArmTimeVector", 15, (const char *) "cannot find vector supplied", 27);
}
else
{
@@ -790,7 +790,7 @@ extern "C" void RTint_GetTimeVector (unsigned int vec, unsigned int *micro, unsi
v = FindVectorNo (vec);
if (v == NULL)
{
- M2RTS_Halt ((const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTint.mod", 77, 312, (const char *) "GetTimeVector", 13, (const char *) "cannot find vector supplied", 27);
+ M2RTS_Halt ((const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTint.mod", 76, 312, (const char *) "GetTimeVector", 13, (const char *) "cannot find vector supplied", 27);
}
else
{
@@ -816,7 +816,7 @@ extern "C" void * RTint_AttachVector (unsigned int vec, void * p)
v = FindVectorNo (vec);
if (v == NULL)
{
- M2RTS_Halt ((const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTint.mod", 77, 339, (const char *) "AttachVector", 12, (const char *) "cannot find vector supplied", 27);
+ M2RTS_Halt ((const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTint.mod", 76, 339, (const char *) "AttachVector", 12, (const char *) "cannot find vector supplied", 27);
}
else
{
@@ -830,7 +830,7 @@ extern "C" void * RTint_AttachVector (unsigned int vec, void * p)
RTco_signal (lock);
return l;
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTint.def", 25, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTint.def", 25, 1);
__builtin_unreachable ();
}
@@ -855,7 +855,7 @@ extern "C" void RTint_IncludeVector (unsigned int vec)
v = FindVectorNo (vec);
if (v == NULL)
{
- M2RTS_Halt ((const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTint.mod", 77, 372, (const char *) "IncludeVector", 13, (const char *) "cannot find vector supplied", 27);
+ M2RTS_Halt ((const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTint.mod", 76, 372, (const char *) "IncludeVector", 13, (const char *) "cannot find vector supplied", 27);
}
else
{
@@ -902,7 +902,7 @@ extern "C" void RTint_ExcludeVector (unsigned int vec)
v = FindPendingVector (vec);
if (v == NULL)
{
- M2RTS_Halt ((const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTint.mod", 77, 415, (const char *) "ExcludeVector", 13, (const char *) "cannot find pending vector supplied", 35);
+ M2RTS_Halt ((const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTint.mod", 76, 415, (const char *) "ExcludeVector", 13, (const char *) "cannot find pending vector supplied", 35);
}
else
{
@@ -1003,7 +1003,7 @@ extern "C" void RTint_Listen (unsigned int untilInterrupt, RTint_DispatchVector
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTint.def", 25, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTint.def", 25, 1);
__builtin_unreachable ();
}
v = v->pending;
@@ -1016,7 +1016,7 @@ extern "C" void RTint_Listen (unsigned int untilInterrupt, RTint_DispatchVector
}
if (((untilInterrupt && (i == NULL)) && (o == NULL)) && ! found)
{
- M2RTS_Halt ((const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/RTint.mod", 77, 731, (const char *) "Listen", 6, (const char *) "deadlock found, no more processes to run and no interrupts active", 65);
+ M2RTS_Halt ((const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/RTint.mod", 76, 731, (const char *) "Listen", 6, (const char *) "deadlock found, no more processes to run and no interrupts active", 65);
}
/* printf('}
') ; */
diff --git a/gcc/m2/mc-boot/GSYSTEM.h b/gcc/m2/mc-boot/GSYSTEM.h
index 98968dabfae..9f6b1f70461 100644
--- a/gcc/m2/mc-boot/GSYSTEM.h
+++ b/gcc/m2/mc-boot/GSYSTEM.h
@@ -62,8 +62,8 @@ EXTERN void SYSTEM_ShiftVal (unsigned int *s, unsigned int _s_high, unsigned int
/*
ShiftLeft - performs the shift left for a multi word set.
This procedure might be called by the back end of
- GNU Modula-2 depending whether amount is known at compile
- time.
+ GNU Modula-2 depending whether amount is known at
+ compile time.
*/
EXTERN void SYSTEM_ShiftLeft (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int ShiftCount);
@@ -71,8 +71,8 @@ EXTERN void SYSTEM_ShiftLeft (unsigned int *s, unsigned int _s_high, unsigned in
/*
ShiftRight - performs the shift left for a multi word set.
This procedure might be called by the back end of
- GNU Modula-2 depending whether amount is known at compile
- time.
+ GNU Modula-2 depending whether amount is known at
+ compile time.
*/
EXTERN void SYSTEM_ShiftRight (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int ShiftCount);
@@ -81,7 +81,8 @@ EXTERN void SYSTEM_ShiftRight (unsigned int *s, unsigned int _s_high, unsigned i
RotateVal - is a runtime procedure whose job is to implement
the ROTATE procedure of ISO SYSTEM. GNU Modula-2 will
inline a ROTATE of a single WORD (or less)
- sized set and will only call this routine for larger sets.
+ sized set and will only call this routine for larger
+ sets.
*/
EXTERN void SYSTEM_RotateVal (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, int RotateCount);
@@ -89,8 +90,8 @@ EXTERN void SYSTEM_RotateVal (unsigned int *s, unsigned int _s_high, unsigned in
/*
RotateLeft - performs the rotate left for a multi word set.
This procedure might be called by the back end of
- GNU Modula-2 depending whether amount is known at compile
- time.
+ GNU Modula-2 depending whether amount is known at
+ compile time.
*/
EXTERN void SYSTEM_RotateLeft (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int RotateCount);
@@ -98,8 +99,8 @@ EXTERN void SYSTEM_RotateLeft (unsigned int *s, unsigned int _s_high, unsigned i
/*
RotateRight - performs the rotate right for a multi word set.
This procedure might be called by the back end of
- GNU Modula-2 depending whether amount is known at compile
- time.
+ GNU Modula-2 depending whether amount is known at
+ compile time.
*/
EXTERN void SYSTEM_RotateRight (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int RotateCount);
diff --git a/gcc/m2/mc-boot/GStdIO.c b/gcc/m2/mc-boot/GStdIO.c
index f8ed55323d7..4e512c0be1c 100644
--- a/gcc/m2/mc-boot/GStdIO.c
+++ b/gcc/m2/mc-boot/GStdIO.c
@@ -193,7 +193,7 @@ extern "C" StdIO_ProcWrite StdIO_GetCurrentOutput (void)
M2RTS_HALT (-1);
__builtin_unreachable ();
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/StdIO.def", 25, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/StdIO.def", 25, 1);
__builtin_unreachable ();
}
@@ -252,7 +252,7 @@ extern "C" StdIO_ProcRead StdIO_GetCurrentInput (void)
M2RTS_HALT (-1);
__builtin_unreachable ();
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/StdIO.def", 25, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/StdIO.def", 25, 1);
__builtin_unreachable ();
}
diff --git a/gcc/m2/mc-boot/GStringConvert.c b/gcc/m2/mc-boot/GStringConvert.c
index e5d7c963db3..fda34c7144f 100644
--- a/gcc/m2/mc-boot/GStringConvert.c
+++ b/gcc/m2/mc-boot/GStringConvert.c
@@ -1916,7 +1916,7 @@ extern "C" DynamicStrings_String StringConvert_ToSigFig (DynamicStrings_String s
int point;
unsigned int poTen;
- Assert ((IsDigit (DynamicStrings_char (s, 0))) || ((DynamicStrings_char (s, 0)) == '.'), (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/StringConvert.mod", 85, 1222, (const char *) "ToSigFig", 8);
+ Assert ((IsDigit (DynamicStrings_char (s, 0))) || ((DynamicStrings_char (s, 0)) == '.'), (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/StringConvert.mod", 84, 1222, (const char *) "ToSigFig", 8);
point = DynamicStrings_Index (s, '.', 0);
if (point < 0)
{
@@ -1968,7 +1968,7 @@ extern "C" DynamicStrings_String StringConvert_ToDecimalPlaces (DynamicStrings_S
{
int point;
- Assert ((IsDigit (DynamicStrings_char (s, 0))) || ((DynamicStrings_char (s, 0)) == '.'), (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/StringConvert.mod", 85, 1069, (const char *) "ToDecimalPlaces", 15);
+ Assert ((IsDigit (DynamicStrings_char (s, 0))) || ((DynamicStrings_char (s, 0)) == '.'), (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/StringConvert.mod", 84, 1069, (const char *) "ToDecimalPlaces", 15);
point = DynamicStrings_Index (s, '.', 0);
if (point < 0)
{
diff --git a/gcc/m2/mc-boot/GSysStorage.c b/gcc/m2/mc-boot/GSysStorage.c
index cfca91b61d8..bee49c417e9 100644
--- a/gcc/m2/mc-boot/GSysStorage.c
+++ b/gcc/m2/mc-boot/GSysStorage.c
@@ -93,7 +93,7 @@ extern "C" void SysStorage_ALLOCATE (void * *a, unsigned int size)
(*a) = libc_malloc (static_cast<size_t> (size));
if ((*a) == NULL)
{
- Debug_Halt ((const char *) "out of memory error", 19, 50, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/SysStorage.mod", 82);
+ Debug_Halt ((const char *) "out of memory error", 19, 50, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/SysStorage.mod", 81);
}
if (enableTrace && trace)
{
@@ -118,7 +118,7 @@ extern "C" void SysStorage_DEALLOCATE (void * *a, unsigned int size)
}
if ((libc_memset ((*a), 0, static_cast<size_t> (size))) != (*a))
{
- Debug_Halt ((const char *) "memset should have returned the first parameter", 47, 76, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/SysStorage.mod", 82);
+ Debug_Halt ((const char *) "memset should have returned the first parameter", 47, 76, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/SysStorage.mod", 81);
}
}
if (enableDeallocation)
@@ -163,7 +163,7 @@ extern "C" void SysStorage_REALLOCATE (void * *a, unsigned int size)
(*a) = libc_realloc ((*a), static_cast<size_t> (size));
if ((*a) == NULL)
{
- Debug_Halt ((const char *) "out of memory error", 19, 119, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/gm2-libs/SysStorage.mod", 82);
+ Debug_Halt ((const char *) "out of memory error", 19, 119, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/gm2-libs/SysStorage.mod", 81);
}
if (enableTrace && trace)
{
diff --git a/gcc/m2/mc-boot/Gdecl.c b/gcc/m2/mc-boot/Gdecl.c
index 5c24956d1e8..9ce86b01cf8 100644
--- a/gcc/m2/mc-boot/Gdecl.c
+++ b/gcc/m2/mc-boot/Gdecl.c
@@ -74,6 +74,8 @@ typedef struct decl_isNodeF_p decl_isNodeF;
# define SYSTEM_BITSPERBYTE 8
# define SYSTEM_BYTESPERWORD 4
+typedef struct M2RTS_ArgCVEnvP_p M2RTS_ArgCVEnvP;
+
# define symbolKey_NulKey NULL
typedef struct symbolKey_isSymbol_p symbolKey_isSymbol;
@@ -334,6 +336,9 @@ struct Indexing_IndexProcedure_p { Indexing_IndexProcedure_t proc; };
typedef unsigned int (*decl_isNodeF_t) (decl_node);
struct decl_isNodeF_p { decl_isNodeF_t proc; };
+typedef void (*M2RTS_ArgCVEnvP_t) (int, void *, void *);
+struct M2RTS_ArgCVEnvP_p { M2RTS_ArgCVEnvP_t proc; };
+
typedef unsigned int (*symbolKey_isSymbol_t) (void *);
struct symbolKey_isSymbol_p { symbolKey_isSymbol_t proc; };
@@ -1017,6 +1022,10 @@ extern "C" void SYSTEM_ShiftRight (unsigned int *s, unsigned int _s_high, unsign
extern "C" void SYSTEM_RotateVal (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, int RotateCount);
extern "C" void SYSTEM_RotateLeft (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int RotateCount);
extern "C" void SYSTEM_RotateRight (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int RotateCount);
+extern "C" void M2RTS_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+extern "C" void M2RTS_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+extern "C" void M2RTS_RegisterModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
+extern "C" void M2RTS_RequestDependant (void * modulename, void * dependantmodule);
extern "C" void M2RTS_ExecuteTerminationProcedures (void);
extern "C" unsigned int M2RTS_InstallTerminationProcedure (PROC p);
extern "C" void M2RTS_ExecuteInitialProcedures (void);
@@ -2411,9 +2420,9 @@ extern "C" FIO_File FIO_openToRead (void * fname, unsigned int flength);
extern "C" FIO_File FIO_openToWrite (void * fname, unsigned int flength);
extern "C" FIO_File FIO_openForRandom (void * fname, unsigned int flength, unsigned int towrite, unsigned int newfile);
extern "C" void FIO_FlushBuffer (FIO_File f);
-extern "C" unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void * a);
+extern "C" unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void * dest);
extern "C" void FIO_ReadAny (FIO_File f, unsigned char *a, unsigned int _a_high);
-extern "C" unsigned int FIO_WriteNBytes (FIO_File f, unsigned int nBytes, void * a);
+extern "C" unsigned int FIO_WriteNBytes (FIO_File f, unsigned int nBytes, void * src);
extern "C" void FIO_WriteAny (FIO_File f, unsigned char *a, unsigned int _a_high);
extern "C" void FIO_WriteChar (FIO_File f, char ch);
extern "C" unsigned int FIO_EOF (FIO_File f);
@@ -6621,7 +6630,7 @@ static decl_node newNode (nodeT k)
d->at.firstUsed = 0;
return d;
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -6981,7 +6990,7 @@ static decl_node addToScope (decl_node n)
}
M2RTS_HALT (-1);
__builtin_unreachable ();
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -7059,7 +7068,7 @@ static void setUnary (decl_node u, nodeT k, decl_node a, decl_node t)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -7341,7 +7350,7 @@ static void putFieldVarient (decl_node f, decl_node v)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
switch (f->kind)
@@ -7352,7 +7361,7 @@ static void putFieldVarient (decl_node f, decl_node v)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -7403,7 +7412,7 @@ static decl_node putFieldRecord (decl_node r, nameKey_Name tag, decl_node type,
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* fill in, n. */
@@ -7461,7 +7470,7 @@ static void putVarientTag (decl_node v, decl_node tag)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -7485,7 +7494,7 @@ static decl_node getParent (decl_node n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -7513,7 +7522,7 @@ static decl_node getRecord (decl_node n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -7693,7 +7702,7 @@ static unsigned int getConstExpComplete (decl_node n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -7798,7 +7807,7 @@ static decl_node makeVal (decl_node params)
M2RTS_HALT (-1);
__builtin_unreachable ();
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -7819,7 +7828,7 @@ static decl_node makeCast (decl_node c, decl_node p)
M2RTS_HALT (-1);
__builtin_unreachable ();
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -8330,7 +8339,7 @@ static decl_node makeUnary (nodeT k, decl_node e, decl_node res)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -8424,7 +8433,7 @@ static DynamicStrings_String getStringContents (decl_node n)
}
M2RTS_HALT (-1);
__builtin_unreachable ();
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -8561,7 +8570,7 @@ static decl_node doMakeBinary (nodeT k, decl_node l, decl_node r, decl_node res)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
return n;
@@ -9162,12 +9171,12 @@ static decl_node doGetExprType (decl_node n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
M2RTS_HALT (-1);
__builtin_unreachable ();
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -9306,12 +9315,12 @@ static decl_node getSymScope (decl_node n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
M2RTS_HALT (-1);
__builtin_unreachable ();
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -9584,7 +9593,7 @@ static unsigned int needsParen (decl_node n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
return TRUE;
@@ -9693,7 +9702,7 @@ static void doPolyBinary (mcPretty_pretty p, nodeT op, decl_node left, decl_node
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -9719,7 +9728,7 @@ static void doPolyBinary (mcPretty_pretty p, nodeT op, decl_node left, decl_node
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -9997,7 +10006,7 @@ static decl_node doGetLastOp (decl_node a, decl_node b)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -10637,7 +10646,7 @@ static void doExprC (mcPretty_pretty p, decl_node n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -10842,7 +10851,7 @@ static void doExprM2 (mcPretty_pretty p, decl_node n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -11014,7 +11023,7 @@ static DynamicStrings_String replaceChar (DynamicStrings_String s, char ch, cons
return s;
}
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -11074,7 +11083,7 @@ static unsigned int countChar (DynamicStrings_String s, char ch)
return c;
}
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -12112,7 +12121,7 @@ static decl_node doMin (decl_node n)
M2RTS_HALT (-1); /* finish the cacading elsif statement. */
__builtin_unreachable ();
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -12193,7 +12202,7 @@ static decl_node doMax (decl_node n)
M2RTS_HALT (-1); /* finish the cacading elsif statement. */
__builtin_unreachable ();
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -12482,7 +12491,7 @@ static void doBaseC (mcPretty_pretty p, decl_node n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
mcPretty_setNeedSpace (p);
@@ -12572,7 +12581,7 @@ static void doSystemC (mcPretty_pretty p, decl_node n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -15926,7 +15935,7 @@ static void doCreal (mcPretty_pretty p, decl_node t)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -15957,7 +15966,7 @@ static void doCimag (mcPretty_pretty p, decl_node t)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -16088,7 +16097,7 @@ static void doIntrinsicC (mcPretty_pretty p, decl_node n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
outText (p, (const char *) ";", 1);
@@ -16987,8 +16996,13 @@ static unsigned int isLastStatement (decl_node n, decl_isNodeF q)
{
unsigned int ret;
- if (decl_isStatementSequence (n))
+ if (n == NULL)
{
+ return FALSE;
+ }
+ else if (decl_isStatementSequence (n))
+ {
+ /* avoid dangling else. */
return isLastStatementSequence (n, q);
}
else if (decl_isProcedure (n))
@@ -17246,7 +17260,7 @@ static void dbs (dependentState s, decl_node n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
if (n != NULL)
@@ -18139,10 +18153,10 @@ static dependentState doDependants (alists_alist l, decl_node n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -19207,7 +19221,7 @@ static void visitDependants (alists_alist v, decl_node n, nodeProcedure p)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -19554,12 +19568,12 @@ static DynamicStrings_String genKind (decl_node n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
M2RTS_HALT (-1);
__builtin_unreachable ();
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -20593,7 +20607,7 @@ static void doBaseM2 (mcPretty_pretty p, decl_node n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
mcPretty_setNeedSpace (p);
@@ -20619,7 +20633,7 @@ static void doSystemM2 (mcPretty_pretty p, decl_node n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -21830,10 +21844,10 @@ static decl_node doDupExpr (decl_node n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -22163,7 +22177,7 @@ extern "C" unsigned int decl_isVisited (decl_node n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -22193,7 +22207,7 @@ extern "C" void decl_unsetVisited (decl_node n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -22221,7 +22235,7 @@ extern "C" void decl_setVisited (decl_node n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -22249,7 +22263,7 @@ extern "C" void decl_setEnumsComplete (decl_node n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -22277,7 +22291,7 @@ extern "C" unsigned int decl_getEnumsComplete (decl_node n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -22498,7 +22512,7 @@ extern "C" decl_node decl_lookupInScope (decl_node scope, nameKey_Name n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -22873,12 +22887,12 @@ extern "C" decl_node decl_getType (decl_node n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
M2RTS_HALT (-1);
__builtin_unreachable ();
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -23272,7 +23286,7 @@ extern "C" decl_node decl_getScope (decl_node n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -23927,7 +23941,7 @@ extern "C" decl_node decl_makeVarient (decl_node r)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
return n;
@@ -24394,7 +24408,7 @@ extern "C" nameKey_Name decl_getSymName (decl_node n)
__builtin_unreachable ();
break;
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -24432,7 +24446,7 @@ extern "C" decl_node decl_import (decl_node m, decl_node n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
importEnumFields (m, n);
@@ -24561,7 +24575,7 @@ extern "C" void decl_setSource (decl_node n, nameKey_Name s)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -24589,7 +24603,7 @@ extern "C" nameKey_Name decl_getSource (decl_node n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -25030,7 +25044,7 @@ extern "C" void decl_addParameter (decl_node proc, decl_node param)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -25123,7 +25137,7 @@ extern "C" decl_node decl_makeBinaryTok (mcReserved_toktype op, decl_node l, dec
M2RTS_HALT (-1); /* most likely op needs a clause as above. */
__builtin_unreachable ();
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -25155,7 +25169,7 @@ extern "C" decl_node decl_makeUnaryTok (mcReserved_toktype op, decl_node e)
M2RTS_HALT (-1); /* most likely op needs a clause as above. */
__builtin_unreachable ();
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -25593,7 +25607,7 @@ extern "C" void decl_setConstExpComplete (decl_node n)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -25958,7 +25972,7 @@ extern "C" void decl_putBegin (decl_node b, decl_node s)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -25985,7 +25999,7 @@ extern "C" void decl_putFinally (decl_node b, decl_node s)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -26613,7 +26627,7 @@ extern "C" void decl_out (void)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
closeOutput ();
diff --git a/gcc/m2/mc-boot/Gkeyc.c b/gcc/m2/mc-boot/Gkeyc.c
index 319c4dd520d..9284872c94e 100644
--- a/gcc/m2/mc-boot/Gkeyc.c
+++ b/gcc/m2/mc-boot/Gkeyc.c
@@ -908,7 +908,7 @@ static unsigned int mangleN (nameKey_Name n, DynamicStrings_String *m, unsigned
return TRUE;
}
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/keyc.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/keyc.def", 20, 1);
__builtin_unreachable ();
}
--git a/gcc/m2/mc-boot/GmcComment.c b/gcc/m2/mc-boot/GmcComment.c
index af08a6e595b..32e311bdab8 100644
--- a/gcc/m2/mc-boot/GmcComment.c
+++ b/gcc/m2/mc-boot/GmcComment.c
@@ -257,7 +257,7 @@ static void dumpComment (mcComment_commentDesc cd)
default:
- CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/mcComment.def", 20, 1);
+ CaseException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/mcComment.def", 20, 1);
__builtin_unreachable ();
}
if (cd->used)
diff --git a/gcc/m2/mc-boot/GmcComp.c b/gcc/m2/mc-boot/GmcComp.c
index c896a52662b..dc3de85dca0 100644
--- a/gcc/m2/mc-boot/GmcComp.c
+++ b/gcc/m2/mc-boot/GmcComp.c
@@ -211,12 +211,12 @@ static void doCompile (DynamicStrings_String s)
if (decl_isImp (n))
{
mcQuiet_qprintf0 ((const char *) "Parse implementation module\\n", 29);
- doPass (FALSE, TRUE, 5, (symbolKey_performOperation) {(symbolKey_performOperation_t) p5}, (const char *) "[implementation module] build code tree for all procedures and module initialisations", 85);
+ doPass (FALSE, TRUE, 5, (symbolKey_performOperation) {(symbolKey_performOperation_t) p5}, (const char *) "[implementation module] build code tree for all procedures and module initializations", 85);
}
else
{
mcQuiet_qprintf0 ((const char *) "Parse program module\\n", 22);
- doPass (FALSE, TRUE, 5, (symbolKey_performOperation) {(symbolKey_performOperation_t) p5}, (const char *) "[program module] build code tree for all procedures and module initialisations", 78);
+ doPass (FALSE, TRUE, 5, (symbolKey_performOperation) {(symbolKey_performOperation_t) p5}, (const char *) "[program module] build code tree for all procedures and module initializations", 78);
}
}
mcQuiet_qprintf0 ((const char *) "walk tree converting it to C/C++\\n", 34);
@@ -294,7 +294,7 @@ static decl_node examineCompilationUnit (void)
}
mcflex_mcError (DynamicStrings_string (DynamicStrings_InitString ((const char *) "failed to find module name", 26)));
libc_exit (1);
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/mcComp.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/mcComp.def", 20, 1);
__builtin_unreachable ();
}
@@ -324,7 +324,7 @@ static decl_node peepInto (DynamicStrings_String s)
mcPrintf_fprintf1 (FIO_StdErr, (const char *) "failed to open %s\\n", 19, (const unsigned char *) &s, (sizeof (s)-1));
libc_exit (1);
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/mcComp.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/mcComp.def", 20, 1);
__builtin_unreachable ();
}
diff --git a/gcc/m2/mc-boot/GmcDebug.c b/gcc/m2/mc-boot/GmcDebug.c
index 21802402120..026c767b3e8 100644
--- a/gcc/m2/mc-boot/GmcDebug.c
+++ b/gcc/m2/mc-boot/GmcDebug.c
@@ -54,7 +54,7 @@ extern "C" void mcDebug_assert (unsigned int q)
{
if (! q)
{
- mcError_internalError ((const char *) "assert failed", 13, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/mcDebug.mod", 73, 35);
+ mcError_internalError ((const char *) "assert failed", 13, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/mcDebug.mod", 72, 35);
}
}
diff --git a/gcc/m2/mc-boot/GmcMetaError.c b/gcc/m2/mc-boot/GmcMetaError.c
index 4c0f0ffd5a6..4fc5fa2fb95 100644
--- a/gcc/m2/mc-boot/GmcMetaError.c
+++ b/gcc/m2/mc-boot/GmcMetaError.c
@@ -408,7 +408,7 @@ static void internalFormat (DynamicStrings_String s, int i, const char *m_, unsi
s = DynamicStrings_ConCatChar (s, '^');
s = SFIO_WriteS (FIO_StdOut, s);
FIO_WriteLine (FIO_StdOut);
- mcError_internalError ((const char *) m, _m_high, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/mcMetaError.mod", 77, 97);
+ mcError_internalError ((const char *) m, _m_high, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/mcMetaError.mod", 76, 97);
}
@@ -420,7 +420,7 @@ static DynamicStrings_String x (DynamicStrings_String a, DynamicStrings_String b
{
if (a != b)
{
- mcError_internalError ((const char *) "different string returned", 25, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/mcMetaError.mod", 77, 109);
+ mcError_internalError ((const char *) "different string returned", 25, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/mcMetaError.mod", 76, 109);
}
return a;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -734,7 +734,7 @@ static mcError_error doError (mcError_error e, errorType t, unsigned int tok)
case chained:
if (e == NULL)
{
- mcError_internalError ((const char *) "should not be chaining an error onto an empty error note", 56, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/mcMetaError.mod", 77, 355);
+ mcError_internalError ((const char *) "should not be chaining an error onto an empty error note", 56, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/mcMetaError.mod", 76, 355);
}
else
{
@@ -758,7 +758,7 @@ static mcError_error doError (mcError_error e, errorType t, unsigned int tok)
default:
- mcError_internalError ((const char *) "unexpected enumeration value", 28, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/mcMetaError.mod", 77, 369);
+ mcError_internalError ((const char *) "unexpected enumeration value", 28, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/mcMetaError.mod", 76, 369);
break;
}
return e;
diff --git a/gcc/m2/mc-boot/GmcStack.c b/gcc/m2/mc-boot/GmcStack.c
index ce1820d98f4..81e5ff76ba1 100644
--- a/gcc/m2/mc-boot/GmcStack.c
+++ b/gcc/m2/mc-boot/GmcStack.c
@@ -165,7 +165,7 @@ extern "C" void * mcStack_pop (mcStack_stack s)
Indexing_DeleteIndice (s->list, Indexing_HighIndice (s->list));
return a;
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/mcStack.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/mcStack.def", 20, 1);
__builtin_unreachable ();
}
@@ -215,7 +215,7 @@ extern "C" void * mcStack_access (mcStack_stack s, unsigned int i)
{
return Indexing_GetIndice (s->list, i);
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/mcStack.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/mcStack.def", 20, 1);
__builtin_unreachable ();
}
diff --git a/gcc/m2/mc-boot/GnameKey.c b/gcc/m2/mc-boot/GnameKey.c
index 115bbd011a5..64558e92441 100644
--- a/gcc/m2/mc-boot/GnameKey.c
+++ b/gcc/m2/mc-boot/GnameKey.c
@@ -323,7 +323,7 @@ extern "C" nameKey_Name nameKey_makeKey (const char *a_, unsigned int _a_high)
(*p) = ASCII_nul;
return doMakeKey (n, higha);
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/nameKey.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/nameKey.def", 20, 1);
__builtin_unreachable ();
}
@@ -373,7 +373,7 @@ extern "C" nameKey_Name nameKey_makekey (void * a)
return doMakeKey (n, higha);
}
}
- ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/nameKey.def", 20, 1);
+ ReturnException ("/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/nameKey.def", 20, 1);
__builtin_unreachable ();
}
diff --git a/gcc/m2/mc-boot/GsymbolKey.c b/gcc/m2/mc-boot/GsymbolKey.c
index 7d5cd20fb6b..d6f335d3501 100644
--- a/gcc/m2/mc-boot/GsymbolKey.c
+++ b/gcc/m2/mc-boot/GsymbolKey.c
@@ -142,7 +142,7 @@ static void findNodeAndParentInTree (symbolKey_symbolTree t, nameKey_Name n, sym
(*father) = t;
if (t == NULL)
{
- Debug_Halt ((const char *) "parameter t should never be NIL", 31, 203, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/symbolKey.mod", 75);
+ Debug_Halt ((const char *) "parameter t should never be NIL", 31, 203, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/symbolKey.mod", 74);
}
(*child) = t->left;
if ((*child) != NULL)
@@ -285,7 +285,7 @@ extern "C" void symbolKey_putSymKey (symbolKey_symbolTree t, nameKey_Name name,
}
else
{
- Debug_Halt ((const char *) "symbol already stored", 21, 119, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/symbolKey.mod", 75);
+ Debug_Halt ((const char *) "symbol already stored", 21, 119, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/symbolKey.mod", 74);
}
}
@@ -352,7 +352,7 @@ extern "C" void symbolKey_delSymKey (symbolKey_symbolTree t, nameKey_Name name)
}
else
{
- Debug_Halt ((const char *) "trying to delete a symbol that is not in the tree - the compiler never expects this to occur", 92, 186, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-modula2/gcc/m2/mc/symbolKey.mod", 75);
+ Debug_Halt ((const char *) "trying to delete a symbol that is not in the tree - the compiler never expects this to occur", 92, 186, (const char *) "/home/gaius/GM2/graft-combine/gcc-git-devel-m2link/gcc/m2/mc/symbolKey.mod", 74);
}
}
diff --git a/gcc/m2/mc/decl.mod b/gcc/m2/mc/decl.mod
index 4d68d3c323b..efc8ae9664e 100644
--- a/gcc/m2/mc/decl.mod
+++ b/gcc/m2/mc/decl.mod
@@ -11700,7 +11700,10 @@ PROCEDURE isLastStatement (n: node; q: isNodeF) : BOOLEAN ;
VAR
ret: BOOLEAN ;
BEGIN
- IF isStatementSequence (n)
+ IF n = NIL
+ THEN
+ RETURN FALSE
+ ELSIF isStatementSequence (n)
THEN
RETURN isLastStatementSequence (n, q)
ELSIF isProcedure (n)
diff --git a/gcc/m2/mc/mcComp.mod b/gcc/m2/mc/mcComp.mod
index 89eb4670e93..b1cfb364652 100644
--- a/gcc/m2/mc/mcComp.mod
+++ b/gcc/m2/mc/mcComp.mod
@@ -85,10 +85,10 @@ BEGIN
IF isImp (n)
THEN
qprintf0 ('Parse implementation module\n') ;
- doPass (FALSE, TRUE, 5, p5, '[implementation module] build code tree for all procedures and module initialisations')
+ doPass (FALSE, TRUE, 5, p5, '[implementation module] build code tree for all procedures and module initializations')
ELSE
qprintf0 ('Parse program module\n') ;
- doPass (FALSE, TRUE, 5, p5, '[program module] build code tree for all procedures and module initialisations')
+ doPass (FALSE, TRUE, 5, p5, '[program module] build code tree for all procedures and module initializations')
END ;
END ;
diff --git a/gcc/m2/tools-src/makeSystem b/gcc/m2/tools-src/makeSystem
index a9032ec6944..2ff23336d8b 100755
--- a/gcc/m2/tools-src/makeSystem
+++ b/gcc/m2/tools-src/makeSystem
@@ -89,8 +89,11 @@ displayEnd () {
sed -e "1,/@SYSTEM_TYPES@/d" < ${SYSTEMDEF} >> ${OUTPUTFILE}
}
+MINIMAL="-fno-scaffold-main -fno-scaffold-dynamic -fno-scaffold-static -fno-m2-plugin"
+
rm -f ${OUTPUTFILE}
-if ${COMPILER} ${DIALECT} ${LIBRARY} -fno-m2-plugin -c -fdump-system-exports ${SYSTEMMOD} -o /dev/null 2>&1 > /dev/null ; then
+if ${COMPILER} ${DIALECT} ${LIBRARY} ${MINIMAL} \
+ -c -fdump-system-exports ${SYSTEMMOD} -o /dev/null 2>&1 > /dev/null ; then
types=`${COMPILER} ${DIALECT} ${LIBRARY} -fno-m2-plugin -c -fdump-system-exports ${SYSTEMMOD} -o /dev/null | cut -f5 -d' '`
touch ${OUTPUTFILE}
displayStart
@@ -99,6 +102,7 @@ if ${COMPILER} ${DIALECT} ${LIBRARY} -fno-m2-plugin -c -fdump-system-exports ${S
displayBuiltinTypes
displayEnd
else
- ${COMPILER} ${DIALECT} ${LIBRARY} -fno-m2-plugin -c -fdump-system-exports ${SYSTEMMOD} -o /dev/null
+ ${COMPILER} ${DIALECT} ${LIBRARY} ${MINIMAL} \
+ -c -fdump-system-exports ${SYSTEMMOD} -o /dev/null
exit $?
fi
diff --git a/libgm2/libm2min/Makefile.am b/libgm2/libm2min/Makefile.am
index c15cdbe9f8e..410ac5d226d 100644
--- a/libgm2/libm2min/Makefile.am
+++ b/libgm2/libm2min/Makefile.am
@@ -106,7 +106,8 @@ toolexeclib_LTLIBRARIES = libm2min.la
libm2min_la_SOURCES = $(M2MODS) libc.c
libm2min_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2min_la_SOURCES)))
libm2min_la_CFLAGS = -I. -I$(GM2_SRC)/gm2-libs-min -I$(GM2_SRC)/gm2-libs
-libm2min_la_M2FLAGS = -I. -I$(GM2_SRC)/gm2-libs-min -I$(GM2_SRC)/gm2-libs -fno-exceptions -fno-m2-plugin
+libm2min_la_M2FLAGS = -I. -I$(GM2_SRC)/gm2-libs-min -I$(GM2_SRC)/gm2-libs -fno-exceptions \
+ -fno-m2-plugin -fno-scaffold-dynamic -fno-scaffold-main
libm2min_la_LINK = $(LINK) -version-info $(libtool_VERSION)
BUILT_SOURCES = SYSTEM.def
CLEANFILES = SYSTEM.def
diff --git a/libgm2/libm2pim/Makefile.am b/libgm2/libm2pim/Makefile.am
index e8dc508033a..ab54c17af01 100644
--- a/libgm2/libm2pim/Makefile.am
+++ b/libgm2/libm2pim/Makefile.am
@@ -135,7 +135,8 @@ M2DEFS = Args.def ASCII.def \
IO.def ldtoa.def \
LegacyReal.def libc.def \
libm.def LMathLib0.def \
- M2EXCEPTION.def M2RTS.def \
+ M2EXCEPTION.def M2LINK.def \
+ M2RTS.def \
MathLib0.def MemUtils.def \
NumberIO.def PushBackInput.def \
RTExceptions.def RTint.def \
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-07-07 16:02 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-07-07 16:02 [gcc/devel/modula-2] First working commit of the new scaffold implementation 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).