OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

First working commit of the new scaffold implementation.

Browse Source 
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>
This commit is contained in:
Gaius Mulley 2022-06-20 23:30:19 +01:00
parent 5eb238ce0b
commit 22340e87ca
67 changed files with 3607 additions and 895 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
gcc/doc/gm2.texi
View File

@ -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}.

114
gcc/m2/Make-lang.in
View File

@ -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-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 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-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

34
gcc/m2/bnf/m2-1.bnf
View File

@ -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 %

15
gcc/m2/bnf/m2-2.bnf
View File

@ -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 %
=:

8
gcc/m2/bnf/m2-3.bnf
View File

@ -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 %

14
gcc/m2/gm2-compiler/M2Base.mod
View File

@ -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 ;

77
gcc/m2/gm2-compiler/M2GCCDeclare.mod
View File

@ -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:
*)

293
gcc/m2/gm2-compiler/M2GenGCC.mod
View File

@ -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.

1
gcc/m2/gm2-compiler/M2MetaError.mod
View File

@ -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 ;

92
gcc/m2/gm2-compiler/M2Options.def
View File

@ -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).
*)

89
gcc/m2/gm2-compiler/M2Options.mod
View File

@ -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.

10
gcc/m2/gm2-compiler/M2Quads.def
View File

@ -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.

371
gcc/m2/gm2-compiler/M2Quads.mod
View File

@ -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

34
gcc/m2/gm2-compiler/P1SymBuild.def
View File

@ -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.

75
gcc/m2/gm2-compiler/P1SymBuild.mod
View File

@ -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.

28
gcc/m2/gm2-compiler/P2SymBuild.def
View File

@ -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.

111
gcc/m2/gm2-compiler/P2SymBuild.mod
View File

@ -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.

188
gcc/m2/gm2-compiler/SymbolTable.def
View File

@ -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.

537
gcc/m2/gm2-compiler/SymbolTable.mod
View File

@ -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

61
gcc/m2/gm2-gcc/m2decl.cc
View File

@ -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. */

28
gcc/m2/gm2-gcc/m2decl.def
View File

@ -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.
*)

4
gcc/m2/gm2-gcc/m2decl.h
View File

@ -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);

4
gcc/m2/gm2-gcc/m2options.h
View File

@ -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. */

29
gcc/m2/gm2-gcc/m2statement.cc
View File

@ -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. */

15
gcc/m2/gm2-gcc/m2statement.def
View File

@ -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.
*)

2
gcc/m2/gm2-gcc/m2statement.h
View File

@ -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);

15
gcc/m2/gm2-lang.cc
View File

@ -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;

33
gcc/m2/gm2-libs-iso/M2RTS.def
View File

@ -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) ;
(*

358
gcc/m2/gm2-libs-iso/M2RTS.mod
View File

@ -27,29 +27,104 @@ 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 ;
(*
ConstructModules - resolve dependencies and then call each
module constructor in turn.
*)
PROCEDURE ConstructModules (applicationmodule: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
BEGIN
M2Dependent.ConstructModules (applicationmodule, argc, argv, envp)
END ConstructModules ;
(*
DeconstructModules - resolve dependencies and then call each
module constructor in turn.
*)
PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
BEGIN
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 ExecuteReverse ;
(*
@ -58,85 +133,84 @@ VAR
*)
PROCEDURE ExecuteTerminationProcedures ;
VAR
i: CARDINAL ;
BEGIN
i := tPtr ;
WHILE i>0 DO
DEC(i) ;
TerminateProc[i]
END
ExecuteReverse (TerminateProc.tail)
END ExecuteTerminationProcedures ;
(*
InstallTerminationProcedure - installs a procedure, p, which will
be called when the procedure
ExecuteTerminationProcedures
is invoked. It returns TRUE is the
procedure is installed.
*)
PROCEDURE InstallTerminationProcedure (p: PROC) : BOOLEAN ;
BEGIN
IF tPtr>MaxProcedures
THEN
RETURN( FALSE )
ELSE
TerminateProc[tPtr] := p ;
INC(tPtr) ;
RETURN( TRUE )
END
END InstallTerminationProcedure ;
(*
ExecuteInitialProcedures - executes the initial procedures installed by
InstallInitialProcedure.
*)
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 AppendProc (VAR proclist: ProcedureList; proc: PROC) : BOOLEAN ;
VAR
pdes: ProcedureChain ;
BEGIN
NEW (pdes) ;
WITH pdes^ DO
p := proc ;
prev := proclist.tail ;
next := NIL
END ;
IF proclist.head = NIL
THEN
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
IF iPtr>MaxProcedures
THEN
RETURN( FALSE )
ELSE
InitialProc[iPtr] := p ;
INC(iPtr) ;
RETURN( TRUE )
END
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
@ -160,6 +234,71 @@ BEGIN
END HALT ;
(*
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 Terminate <* noreturn *> ;
BEGIN
exit (ExitValue)
END Terminate ;
(*
ErrorString - writes a string to stderr.
*)
PROCEDURE ErrorString (a: ARRAY OF CHAR) ;
VAR
n: INTEGER ;
BEGIN
n := write (2, ADR (a), StrLen (a))
END ErrorString ;
(*
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) <* noreturn *> ;
VAR
LineNo: ARRAY [0..10] OF CHAR ;
BEGIN
ErrorString (file) ; ErrorString(':') ;
CardToStr (line, 0, LineNo) ;
ErrorString (LineNo) ; ErrorString(':') ;
IF NOT StrEqual (function, '')
THEN
ErrorString ('in ') ;
ErrorString (function) ;
ErrorString (' has caused ') ;
END ;
ErrorString (message) ;
LineNo[0] := nl ; LineNo[1] := nul ;
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.
@ -182,47 +321,6 @@ BEGIN
END HasHalted ;
(*
ErrorString - writes a string to stderr.
*)
PROCEDURE ErrorString (a: ARRAY OF CHAR) ;
VAR
buf: ARRAY [0..MaxLength] OF CHAR ;
n : INTEGER ;
BEGIN
StrCopy(a, buf) ;
n := write(2, ADR(buf), StrLen(buf))
END ErrorString ;
(*
ErrorMessage - emits an error message to the stderr
*)
PROCEDURE ErrorMessage (message: ARRAY OF CHAR;
file: ARRAY OF CHAR;
line: CARDINAL;
function: 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, '')
THEN
ErrorString('in ') ;
ErrorString(function) ;
ErrorString(' has caused ') ;
END ;
ErrorString(message) ;
LineNo[0] := nl ; LineNo[1] := nul ;
ErrorString(LineNo) ;
exit(1)
END ErrorMessage ;
(*
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.

50
gcc/m2/gm2-libs/M2RTS.def
View File

@ -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

247
gcc/m2/gm2-libs/M2RTS.mod
View File

@ -27,25 +27,103 @@ 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 ;
CONST
MaxProcedures = 1024 ;
TYPE
PtrToChar = POINTER TO CHAR ;
ProcedureList = RECORD
head, tail: ProcedureChain
END ;
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 ;
(*
ConstructModules - resolve dependencies and then call each
module constructor in turn.
*)
PROCEDURE ConstructModules (applicationmodule: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
BEGIN
M2Dependent.ConstructModules (applicationmodule, argc, argv, envp)
END ConstructModules ;
(*
DeconstructModules - resolve dependencies and then call each
module constructor in turn.
*)
PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
BEGIN
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 ExecuteReverse ;
(*
@ -54,70 +132,69 @@ VAR
*)
PROCEDURE ExecuteTerminationProcedures ;
VAR
i: CARDINAL ;
BEGIN
i := tPtr ;
WHILE i>0 DO
DEC(i) ;
TerminateProc[i]
END
ExecuteReverse (TerminateProc.tail)
END ExecuteTerminationProcedures ;
(*
InstallTerminationProcedure - installs a procedure, p, which will
be called when the procedure
ExecuteTerminationProcedures
is invoked. It returns TRUE is the
procedure is installed.
*)
PROCEDURE InstallTerminationProcedure (p: PROC) : BOOLEAN ;
BEGIN
IF tPtr>MaxProcedures
THEN
RETURN( FALSE )
ELSE
TerminateProc[tPtr] := p ;
INC(tPtr) ;
RETURN( TRUE )
END
END InstallTerminationProcedure ;
(*
ExecuteInitialProcedures - executes the initial procedures installed by
InstallInitialProcedure.
*)
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 AppendProc (VAR proclist: ProcedureList; proc: PROC) : BOOLEAN ;
VAR
pdes: ProcedureChain ;
BEGIN
NEW (pdes) ;
WITH pdes^ DO
p := proc ;
prev := proclist.tail ;
next := NIL
END ;
IF proclist.head = NIL
THEN
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
IF iPtr>MaxProcedures
THEN
RETURN( FALSE )
ELSE
InitialProc[iPtr] := p ;
INC(iPtr) ;
RETURN( TRUE )
END
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
iPtr := 0 ;
tPtr := 0 ;
p.head := NIL ;
p.tail := NIL
END InitProcList ;
(*
Init - initialize the initial, terminate procedure lists and booleans.
*)
PROCEDURE Init ;
BEGIN
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.

11
gcc/m2/gm2spec.cc
View File

@ -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
}

9
gcc/m2/lang-specs.h
View File

@ -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",

28
gcc/m2/lang.opt
View File

@ -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

3
gcc/m2/mc-boot/GAssertion.h
View File

@ -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);

32
gcc/m2/mc-boot/GDynamicStrings.c
View File

@ -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
{

44
gcc/m2/mc-boot/GDynamicStrings.h
View File

@ -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,
*/

3
gcc/m2/mc-boot/GEnvironment.h
View File

@ -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.
*/

34
gcc/m2/mc-boot/GFIO.c
View File

@ -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 ();
}

23
gcc/m2/mc-boot/GFIO.h
View File

@ -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);

11
gcc/m2/mc-boot/GFormatStrings.h
View File

@ -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);

6
gcc/m2/mc-boot/GIndexing.c
View File

@ -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 ();
}

4
gcc/m2/mc-boot/GM2EXCEPTION.c
View File

@ -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 ();
}

998
gcc/m2/mc-boot/GM2RTS.c
View File

File diff suppressed because it is too large Load Diff

22
gcc/m2/mc-boot/GM2RTS.h
View File

@ -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

6
gcc/m2/mc-boot/GPushBackInput.c
View File

@ -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);
}
}
}

34
gcc/m2/mc-boot/GRTExceptions.c
View File

@ -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 ();
}

20
gcc/m2/mc-boot/GRTint.c
View File

@ -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('}
') ; */

19
gcc/m2/mc-boot/GSYSTEM.h
View File

@ -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);

4
gcc/m2/mc-boot/GStdIO.c
View File

@ -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 ();
}

4
gcc/m2/mc-boot/GStringConvert.c
View File

@ -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)
{

6
gcc/m2/mc-boot/GSysStorage.c
View File

@ -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)
{

150
gcc/m2/mc-boot/Gdecl.c
View File

@ -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 ();

2
gcc/m2/mc-boot/Gkeyc.c
View File

@ -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 ();
}

2
gcc/m2/mc-boot/GmcComment.c
View File

@ -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)

8
gcc/m2/mc-boot/GmcComp.c
View File

@ -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 ();
}

2
gcc/m2/mc-boot/GmcDebug.c
View File

@ -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);
}
}

8
gcc/m2/mc-boot/GmcMetaError.c
View File

@ -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;

4
gcc/m2/mc-boot/GmcStack.c
View File

@ -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 ();
}

4
gcc/m2/mc-boot/GnameKey.c
View File

@ -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 ();
}

6
gcc/m2/mc-boot/GsymbolKey.c
View File

@ -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);
}
}

5
gcc/m2/mc/decl.mod
View File

@ -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)

4
gcc/m2/mc/mcComp.mod
View File

@ -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 ;

8
gcc/m2/tools-src/makeSystem
View File

@ -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

4
gcc/testsuite/gm2/link/externalscaffold/pass/scaffold.c
View File

@ -1,4 +1,4 @@
extern void exit(int);
extern void exit (int);
extern void _M2_SYSTEM_init (int argc, char *argv[]);
extern void _M2_SYSTEM_finish (void);
@ -9,7 +9,7 @@ extern void _M2_RTExceptions_finish (void);
extern void _M2_hello_init (int argc, char *argv[]);
extern void _M2_hello_finish (void);
extern void M2RTS_Terminate(void);
extern void M2RTS_Terminate (void);
static void init (int argc, char *argv[])
{

3
libgm2/libm2min/Makefile.am
View File

@ -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

3
libgm2/libm2pim/Makefile.am
View File

@ -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 \