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
@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}.
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)
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 \
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 \
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 \
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 \
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 \
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 \
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 \
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
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 $@
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
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): \
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
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): \
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
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): \
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
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): \
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
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
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 \
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)
PPG-MODS = SymbolKey.mod NameKey.mod Lists.mod bnflex.mod Output.mod
-PPG-LIB-DEFS = ASCII.def Args.def Indexing.def FIO.def \
- StrIO.def StrLib.def M2RTS.def Indexing.def FIO.def SFIO.def \
- Storage.def Debug.def IO.def StdIO.def M2EXCEPTION.def \
- StrCase.def NumberIO.def Assertion.def PushBackInput.def \
- SysStorage.def DynamicStrings.def M2RTS.def RTExceptions.def
-
-PPG-LIB-MODS = ASCII.mod Args.mod FIO.mod SFIO.mod StrIO.mod StrLib.mod \
- Indexing.mod Storage.mod Debug.mod IO.mod \
- StdIO.mod M2EXCEPTION.mod StrCase.mod NumberIO.mod \
- Assertion.mod PushBackInput.mod SysStorage.mod \
- DynamicStrings.mod M2RTS.mod RTExceptions.mod
+PPG-LIB-DEFS = Args.def Assertion.def ASCII.def Debug.def \
+ DynamicStrings.def FIO.def Indexing.def IO.def \
+ NumberIO.def PushBackInput.def \
+ M2Dependent.def \
+ M2EXCEPTION.def M2LINK.def M2RTS.def \
+ RTExceptions.def \
+ StdIO.def SFIO.def StrIO.def StrLib.def \
+ Storage.def StrCase.def SysStorage.def
+
+PPG-LIB-MODS = ASCII.mod \
+ Args.mod \
+ Assertion.mod \
+ Debug.mod \
+ DynamicStrings.mod \
+ FIO.mod \
+ IO.mod \
+ Indexing.mod \
+ M2Dependent.mod \
+ M2EXCEPTION.mod \
+ M2RTS.mod \
+ NumberIO.mod \
+ PushBackInput.mod \
+ RTExceptions.mod \
+ SFIO.mod \
+ StdIO.mod \
+ Storage.mod \
+ StrCase.mod \
+ StrIO.mod \
+ StrLib.mod \
+ SysStorage.mod
PPG-SRC = ppg.mod
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)
-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
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)
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:
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)
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
BuildProcedureHeading,
StartBuildProcedure,
- EndBuildProcedure ;
+ EndBuildProcedure,
+ AddImportToImportStatement,
+ BuildImportStatement ;
+
FROM SymbolTable IMPORT MakeGnuAsm, PutGnuAsmVolatile, PutGnuAsm, PutGnuAsmInput,
PutGnuAsmOutput, PutGnuAsmTrash, PutGnuAsmVolatile,
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 %
BuildExportOuterModule,
BuildExportInnerModule,
+ BlockStart, BlockEnd, BlockBegin, BlockFinally,
BuildString, BuildNumber,
BuildConst,
BuildVariable,
=:
ProgramModule := "MODULE" % M2Error.DefaultProgramModule %
+ % BlockStart (GetTokenNo () -1) %
Ident % P2StartBuildProgramModule ; %
}
Block
-
+ % BlockEnd (GetTokenNo () -1) %
Ident % P2EndBuildProgramModule ; %
"."
=:
ImplementationModule := "IMPLEMENTATION" % M2Error.DefaultImplementationModule %
+ % BlockStart (GetTokenNo () -1) %
"MODULE"
Ident % P2StartBuildImplementationModule ; %
{ Import % BuildImportOuterModule %
}
Block
-
+ % BlockEnd (GetTokenNo () -1) %
Ident % P2EndBuildImplementationModule ; %
"." =:
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 ] =:
=:
ModuleDeclaration := "MODULE" % M2Error.DefaultInnerModule %
+ % BlockStart (GetTokenNo () -1) %
Ident % StartBuildInnerModule %
[ Priority
] ";"
} [ Export % BuildExportInnerModule %
]
Block
+ % BlockEnd (GetTokenNo () -1) %
Ident % EndBuildInnerModule %
=:
BuildProcedureStart,
BuildProcedureBegin,
BuildProcedureEnd,
+ BuildScaffold,
BuildStmtNote,
BuildFunctionCall, BuildConstFunctionCall,
BuildBinaryOp, BuildUnaryOp, BuildRelOp, BuildNot,
MakeRegInterface,
PutRegInterface,
IsRegInterface, IsGnuAsmVolatile, IsGnuAsm,
+ GetCurrentModule,
GetSymName, GetType, SkipType,
NulSym,
StartScope, EndScope,
% PushAutoOff %
[ Priority
]
- ";"
+ ";" % BuildScaffold (GetTokenNo () -1,
+ GetCurrentModule ()) %
{ Import }
Block % PushAutoOn %
Ident % EndBuildFile %
% BuildModuleStart %
% PushAutoOff %
[ Priority
- ] ";"
+ ] ";" % BuildScaffold (GetTokenNo () -1,
+ GetCurrentModule ()) %
{ Import }
Block % PushAutoOn %
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')
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 ;
(*
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 ;
GetPackedEquivalent,
GetParameterShadowVar,
GetUnboundedRecordType,
+ GetModuleCtors,
ForeachOAFamily, GetOAFamily,
IsModuleWithinProcedure, IsVariableSSA,
IsVariableAtAddress, IsConstructorConstant,
(*
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 ;
WatchIncludeList(sym, finishedalignment) ;
IF AllDependantsFullyDeclared(sym)
THEN
- (* ready to be solved.. *)
+ (* All good and ready to be solved. *)
END
END DeclareRecordKind ;
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 ;
finished := TRUE
END
UNTIL finished ;
- IF MustHaveCompleted
+ IF ForceComplete
THEN
IF ForeachTryDeclare (todolist, ToDoList,
circulartodo,
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 ;
(*
- 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 ;
ForeachProcedureDo(scope, DeclareProcedure) ;
ForeachInnerModuleDo(scope, WalkTypesInModule) ;
ForeachInnerModuleDo(scope, DeclareTypesConstantsProcedures) ;
- ForeachInnerModuleDo(scope, StartDeclareScope)
+ ForeachInnerModuleDo(scope, StartDeclareScope) ;
+ DeclareModuleInit(scope)
ELSE
DeclareTypesConstantsProcedures(scope) ;
AssertAllTypesDeclared(scope) ;
HaveInitDefaultTypes := FALSE ;
recursionCaught := FALSE
END M2GCCDeclare.
-(*
- * Local variables:
- * compile-command: "gm2 -c -g -I.:../gm2-libs:../gm2-libs-ch:../gm2-libiberty/ M2GCCDeclare.mod"
- * End:
- *)
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,
IsParameter, IsParameterVar,
IsValueSolved, IsSizeSolved,
IsProcedureNested, IsInnerModule, IsArrayLarge,
- IsComposite, IsVariableSSA,
+ IsComposite, IsVariableSSA, IsPublic, IsCtor,
ForeachExportedDo,
ForeachImportedDo,
ForeachProcedureDo,
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,
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,
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) ;
END ;
Assert (FALSE)
ELSE
+ (* Otherwise it is public if it were exported. *)
RETURN IsExported (GetMainModule (), sym)
END
END IsExportedGcc ;
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) |
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
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) ;
(*
- 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) ;
(*
- 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 ;
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 ;
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 ;
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.
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
*)
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 ;
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 ;
(*
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
*)
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 ;
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
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.
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 ;
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
BEGIN
UnboundedLabelNo := 0 ;
CurrentQuadToken := 0 ;
- ScopeStack := InitStackWord()
+ ScopeStack := InitStackWord ()
END M2GenGCC.
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 ;
Setc, Getc,
Iso, Pim, Pim2, Pim3, Pim4,
+ cflag,
PositiveModFloorDiv,
Pedantic, Verbose, Statistics,
UnboundedByReference, VerboseUnbounded,
SaveTemps,
CppProg, CppArg, CppCommandLine, CppRemember,
SetDebugFunctionLineNumbers, DebugFunctionLineNumbers,
- SetGenerateStatementNote, GenerateStatementNote ;
+ SetGenerateStatementNote, GenerateStatementNote,
+ ScaffoldDynamic, ScaffoldStatic,
+ SetScaffoldDynamic, SetScaffoldStatic,
+ SetScaffoldMain, ScaffoldMain,
+ SetRuntimeModuleOverride, GetRuntimeModuleOverride ;
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 *)
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. *)
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 ;
(*
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).
*)
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.
PROCEDURE SetReturnCheck (value: BOOLEAN) : BOOLEAN ;
BEGIN
ReturnChecking := value ;
- RETURN( TRUE )
+ RETURN TRUE
END SetReturnCheck ;
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 ;
UnusedParameterChecking := FALSE ;
StrictTypeChecking := TRUE ;
AutoInit := FALSE ;
- SaveTemps := FALSE
+ SaveTemps := FALSE ;
+ ScaffoldDynamic := TRUE ;
+ ScaffoldStatic := FALSE ;
+ ScaffoldMain := FALSE
END M2Options.
FROM DynamicStrings IMPORT String ;
EXPORT QUALIFIED StartBuildDefFile, StartBuildModFile, EndBuildFile,
- BuildModuleStart,
+ BuildModuleStart, BuildScaffold,
StartBuildInit, EndBuildInit,
StartBuildFinally, EndBuildFinally,
BuildExceptInitial, BuildExceptFinally,
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.
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,
GetWriteLimitQuads, GetReadLimitQuads,
GetVarScope,
GetModuleQuads, GetProcedureQuads,
+ GetModuleCtors,
MakeProcedure,
MakeConstStringCnul, MakeConstStringM2nul,
PutConstString,
GetVariableAtAddress, IsVariableAtAddress,
MakeError, UnknownReported,
IsInnerModule,
+ IsImportStatement, IsImport, GetImportModule, GetImportDeclared,
+ GetImportStatementList,
+ GetModuleDefImportStatementList, GetModuleModImportStatementList,
GetUnboundedRecordType,
GetUnboundedAddressOffset,
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 ;
'{%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.
*)
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
BuildProcedureHeading,
BuildNulName,
BuildTypeEnd,
- CheckExplicitExported ;
+ CheckExplicitExported,
+ BuildImportStatement,
+ AddImportToImportStatement ;
(*
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.
FROM SymbolTable IMPORT NulSym,
ModeOfAddr,
+ AppendModuleOnImportStatement,
+ AppendModuleImportStatement,
+ MakeImportStatement, MakeImport,
+
StartScope, EndScope, PseudoScope,
GetScope, GetCurrentScope,
IsDeclaredIn,
MakeHiddenType,
PutMode,
PutFieldEnumeration, PutSubrange, PutVar,
- IsDefImp, IsModule, IsType,
+ IsDefImp, IsModule, IsInnerModule, IsType,
GetCurrentModule,
AddSymToModuleScope,
AddNameToImportList,
CONST
Debugging = FALSE ;
+VAR
+ importStatementCount: CARDINAL ;
+
(*
CheckFileName - checks to see that the module name matches the file name.
language,
ModuleSym: CARDINAL ;
BEGIN
+ importStatementCount := 0 ;
PopT(name) ;
(* CheckFileName(name, 'definition') ; *)
ModuleSym := MakeDefinitionSource(GetTokenNo(), name) ;
name : Name ;
ModuleSym: CARDINAL ;
BEGIN
+ importStatementCount := 0 ;
PopTtok (name, tok) ;
(* CheckFileName(name, 'implementation') ; *)
ModuleSym := MakeImplementationSource (tok, name) ;
name : Name ;
ModuleSym: CARDINAL ;
BEGIN
+ importStatementCount := 0 ;
PopTtok(name, tok) ;
(* CheckFileName(name, 'main') ; *)
ModuleSym := MakeProgramSource(tok, name) ;
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.
BuildExportOuterModule,
BuildImportInnerModule,
BuildExportInnerModule,
+ BlockStart, BlockEnd, BlockBegin, BlockFinally,
BuildNumber,
BuildString,
BuildConst,
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.
MakeConstLitString,
MakeSubrange,
MakeVar, MakeType, PutType,
+ MakeModuleCtor,
PutMode, PutDeclared,
PutFieldEnumeration, PutSubrange, PutVar, PutConst,
PutConstSet, PutConstructor,
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.
BEGIN
PopTtok(name, tokno) ;
ModuleSym := MakeDefinitionSource(tokno, name) ;
+ curModuleSym := ModuleSym ;
SetCurrentModule(ModuleSym) ;
SetFileModule(ModuleSym) ;
StartScope(ModuleSym) ;
BEGIN
PopTtok(name, tokno) ;
ModuleSym := MakeImplementationSource(tokno, name) ;
+ curModuleSym := ModuleSym ;
SetCurrentModule(ModuleSym) ;
SetFileModule(ModuleSym) ;
StartScope(ModuleSym) ;
BEGIN
PopTtok(name, tokno) ;
ModuleSym := MakeProgramSource(tokno, name) ;
+ curModuleSym := ModuleSym ;
SetCurrentModule(ModuleSym) ;
SetFileModule(ModuleSym) ;
StartScope(ModuleSym) ;
BEGIN
PopTtok (name, tok) ;
ModuleSym := GetDeclareSym (tok, name) ;
+ curModuleSym := ModuleSym ;
StartScope (ModuleSym) ;
Assert(NOT IsDefImp (ModuleSym)) ;
PushTtok (name, tok) ;
BEGIN
alignTypeNo := 0 ;
- TypeStack := InitStackWord() ;
- RememberStack := InitStackWord() ;
+ TypeStack := InitStackWord () ;
+ RememberStack := InitStackWord () ;
+ BlockStack := InitStackWord () ;
castType := NulSym
END P2SymBuild.
FROM m2tree IMPORT Tree ;
FROM DynamicStrings IMPORT String ;
FROM M2Error IMPORT ErrorScope ;
+FROM Lists IMPORT List ;
EXPORT QUALIFIED NulSym,
FinalSymbol,
ModeOfAddr,
GetMode, PutMode,
+ AppendModuleOnImportStatement,
+ AppendModuleImportStatement,
+
StartScope, EndScope, PseudoScope,
GetCurrentScope,
IsDeclaredIn,
SetMainModule,
SetFileModule,
MakeModule, MakeDefImp,
- MakeInnerModule,
+ MakeInnerModule, MakeModuleCtor,
MakeProcedure,
MakeConstLit,
MakeConstVar,
MakeUnbounded,
MakeOAFamily,
MakeProcType,
+ MakeImport, MakeImportStatement,
Make2Tuple,
MakeGnuAsm,
MakeRegInterface,
PutDeclaredPacked, IsDeclaredPacked, IsDeclaredPackedResolved,
GetPackedEquivalent, GetNonPackedEquivalent,
GetConstStringM2, GetConstStringC, GetConstStringM2nul, GetConstStringCnul,
+ GetModuleCtors,
+ GetImportModule, GetImportDeclared,
+ GetImportStatementList, GetModuleDefImportStatementList, GetModuleModImportStatementList,
PutVar,
PutLeftValueFrontBackType,
PutAlignment, PutDefaultRecordFieldAlignment,
PutUnused, IsUnused,
PutVariableSSA, IsVariableSSA,
+ PutPublic, IsPublic, PutCtor, IsCtor,
IsDefImp,
IsModule,
IsArray,
IsRecordField,
IsProcType,
+ IsImport,
+ IsImportStatement,
IsVar,
IsConst,
IsConstString,
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.
(*
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
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 ;
*)
+(*
+ 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.
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,
CompilingImplementationModule ;
FROM FormatStrings IMPORT HandleEscape ;
+FROM M2Scaffold IMPORT DeclareArgEnvParams ;
IMPORT Indexing ;
DefImpSym, ModuleSym, SetSym, ProcedureSym, ProcTypeSym,
SubscriptSym, UnboundedSym, GnuAsmSym, InterfaceSym,
ObjectSym, PartialUnboundedSym, TupleSym, OAFamilySym,
+ ImportSym, ImportStatementSym,
EquivSym, ErrorSym) ;
Where = RECORD
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 ;
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 *)
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. *)
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 *)
SetSym : Set : SymSet |
ProcedureSym : Procedure : SymProcedure |
ProcTypeSym : ProcType : SymProcType |
+ ImportStatementSym : ImportStatement : SymImportStatement |
+ ImportSym : Import : SymImport |
GnuAsmSym : GnuAsm : SymGnuAsm |
InterfaceSym : Interface : SymInterface |
TupleSym : Tuple : SymTuple |
PROCEDURE InitWhereDeclaredTok (tok: CARDINAL; VAR at: Where) ;
BEGIN
WITH at DO
- IF CompilingDefinitionModule()
+ IF CompilingDefinitionModule ()
THEN
DefDeclared := tok ;
ModDeclared := UnknownTokenNo
pSym: PtrToSymbol ;
BEGIN
sym := FreeSymbol ;
- IF sym=12066
- THEN
- stop
- END ;
NEW(pSym) ;
WITH pSym^ DO
SymbolType := DummySym
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 -
*)
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.
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 *)
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 *)
(*
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 ;
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
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. *)
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. *)
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.
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
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
#include "m2tree.h"
#include "m2treelib.h"
#include "m2type.h"
+#include "m2convert.h"
extern GTY (()) tree current_function_decl;
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,
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. */
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.
*)
#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);
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. */
#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. */
`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; */
}
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;
}
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)
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. */
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.
*)
#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);
/* 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. */
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;
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;
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) ;
(*
IMPLEMENTATION MODULE M2RTS ;
-FROM libc IMPORT abort, exit, write ;
+FROM libc IMPORT abort, exit, write, getenv, printf ;
+(* FROM Builtins IMPORT strncmp, strcmp ; not available during bootstrap. *)
FROM NumberIO IMPORT CardToStr ;
FROM StrLib IMPORT StrCopy, StrLen, StrEqual ;
FROM SYSTEM IMPORT ADDRESS, ADR ;
FROM ASCII IMPORT nl, nul ;
+FROM Storage IMPORT ALLOCATE ;
IMPORT RTExceptions ;
IMPORT M2EXCEPTION ;
+IMPORT M2Dependent ;
+TYPE
+ PtrToChar = POINTER TO CHAR ;
-CONST
- MaxProcedures = 1024 ;
- MaxLength = 4096 ;
+ ProcedureChain = POINTER TO RECORD
+ p : PROC ;
+ prev,
+ next: ProcedureChain ;
+ END ;
+
+ ProcedureList = RECORD
+ head, tail: ProcedureChain
+ END ;
VAR
- iPtr, tPtr : CARDINAL ;
InitialProc,
- TerminateProc: ARRAY [0..MaxProcedures] OF PROC ;
- ExitValue : INTEGER ;
- CallExit : BOOLEAN ;
+ TerminateProc : ProcedureList ;
+ ExitValue : INTEGER ;
isTerminating,
- isHalting : BOOLEAN ;
+ isHalting,
+ Initialized,
+ CallExit : BOOLEAN ;
(*
- ExecuteTerminationProcedures - calls each installed termination procedure
- in reverse order.
+ ConstructModules - resolve dependencies and then call each
+ module constructor in turn.
*)
-PROCEDURE ExecuteTerminationProcedures ;
-VAR
- i: CARDINAL ;
+PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+ argc: INTEGER; argv, envp: ADDRESS) ;
BEGIN
- i := tPtr ;
- WHILE i>0 DO
- DEC(i) ;
- TerminateProc[i]
- END
-END ExecuteTerminationProcedures ;
+ M2Dependent.ConstructModules (applicationmodule, argc, argv, envp)
+END ConstructModules ;
(*
- InstallTerminationProcedure - installs a procedure, p, which will
- be called when the procedure
- ExecuteTerminationProcedures
- is invoked. It returns TRUE is the
- procedure is installed.
+ DeconstructModules - resolve dependencies and then call each
+ module constructor in turn.
*)
-PROCEDURE InstallTerminationProcedure (p: PROC) : BOOLEAN ;
+PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+ argc: INTEGER; argv, envp: ADDRESS) ;
BEGIN
- IF tPtr>MaxProcedures
- THEN
- RETURN( FALSE )
- ELSE
- TerminateProc[tPtr] := p ;
- INC(tPtr) ;
- RETURN( TRUE )
+ M2Dependent.DeconstructModules (applicationmodule, argc, argv, envp)
+END DeconstructModules ;
+
+
+(*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*)
+
+PROCEDURE RegisterModule (name: ADDRESS;
+ init, fini: ArgCVEnvP;
+ dependencies: PROC) ;
+BEGIN
+ M2Dependent.RegisterModule (name, init, fini, dependencies)
+END RegisterModule ;
+
+
+(*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule.
+*)
+
+PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+BEGIN
+ M2Dependent.RequestDependant (modulename, dependantmodule)
+END RequestDependant ;
+
+
+(*
+ ExecuteReverse - execute the procedure associated with procptr
+ and then proceed to try and execute all previous
+ procedures in the chain.
+*)
+
+PROCEDURE ExecuteReverse (procptr: ProcedureChain) ;
+BEGIN
+ WHILE procptr # NIL DO
+ procptr^.p ; (* Invoke the procedure. *)
+ procptr := procptr^.prev
END
-END InstallTerminationProcedure ;
+END ExecuteReverse ;
+
+
+(*
+ ExecuteTerminationProcedures - calls each installed termination procedure
+ in reverse order.
+*)
+
+PROCEDURE ExecuteTerminationProcedures ;
+BEGIN
+ ExecuteReverse (TerminateProc.tail)
+END ExecuteTerminationProcedures ;
(*
*)
PROCEDURE ExecuteInitialProcedures ;
-VAR
- i: CARDINAL ;
BEGIN
- i := iPtr ;
- WHILE i>0 DO
- DEC(i) ;
- InitialProc[i]
- END
+ ExecuteReverse (InitialProc.tail)
END ExecuteInitialProcedures ;
(*
- InstallInitialProcedure - installs a procedure to be executed just before the
- BEGIN code section of the main program module.
+ AppendProc - append proc to the end of the procedure list
+ defined by proclist.
*)
-PROCEDURE InstallInitialProcedure (p: PROC) : BOOLEAN ;
+PROCEDURE AppendProc (VAR proclist: ProcedureList; proc: PROC) : BOOLEAN ;
+VAR
+ pdes: ProcedureChain ;
BEGIN
- IF iPtr>MaxProcedures
+ NEW (pdes) ;
+ WITH pdes^ DO
+ p := proc ;
+ prev := proclist.tail ;
+ next := NIL
+ END ;
+ IF proclist.head = NIL
THEN
- RETURN( FALSE )
- ELSE
- InitialProc[iPtr] := p ;
- INC(iPtr) ;
- RETURN( TRUE )
- END
+ proclist.head := pdes
+ END ;
+ proclist.tail := pdes ;
+ RETURN TRUE
+END AppendProc ;
+
+
+(*
+ InstallTerminationProcedure - installs a procedure, p, which will
+ be called when the procedure
+ ExecuteTerminationProcedures
+ is invoked. It returns TRUE if the
+ procedure is installed.
+*)
+
+PROCEDURE InstallTerminationProcedure (p: PROC) : BOOLEAN ;
+BEGIN
+ RETURN AppendProc (TerminateProc, p)
+END InstallTerminationProcedure ;
+
+
+(*
+ InstallInitialProcedure - installs a procedure to be executed just
+ before the BEGIN code section of the
+ main program module.
+*)
+
+PROCEDURE InstallInitialProcedure (p: PROC) : BOOLEAN ;
+BEGIN
+ RETURN AppendProc (InitialProc, p)
END InstallInitialProcedure ;
(*
HALT - terminate the current program. The procedure
- ExecuteTerminationProcedures is called before the program
- is stopped. The parameter exitcode is optional.
- If the parameter is not supplied
+ ExecuteTerminationProcedures
+ is called before the program is stopped. The parameter
+ exitcode is optional. If the parameter is not supplied
HALT will call libc 'abort', otherwise it will exit with
the code supplied. Supplying a parameter to HALT has the
same effect as calling ExitOnHalt with the same code and
then calling HALT with no parameter.
*)
-PROCEDURE HALT ([exitcode: INTEGER = -1]) ;
+PROCEDURE HALT ([exitcode: INTEGER = -1]) <* noreturn *> ;
BEGIN
IF exitcode#-1
THEN
(*
- IsTerminating - Returns true if any coroutine has started program termination
- and false otherwise.
+ Terminate - provides compatibility for pim. It call exit with
+ the exitcode provided in a prior call to ExitOnHalt
+ (or zero if ExitOnHalt was never called). It does
+ not call ExecuteTerminationProcedures.
*)
-PROCEDURE IsTerminating () : BOOLEAN ;
+PROCEDURE Terminate <* noreturn *> ;
BEGIN
- RETURN isTerminating
-END IsTerminating ;
-
-
-(*
- HasHalted - Returns true if a call to HALT has been made and false
- otherwise.
-*)
-
-PROCEDURE HasHalted () : BOOLEAN ;
-BEGIN
- RETURN isHalting
-END HasHalted ;
+ exit (ExitValue)
+END Terminate ;
(*
PROCEDURE ErrorString (a: ARRAY OF CHAR) ;
VAR
- buf: ARRAY [0..MaxLength] OF CHAR ;
- n : INTEGER ;
+ n: INTEGER ;
BEGIN
- StrCopy(a, buf) ;
- n := write(2, ADR(buf), StrLen(buf))
+ n := write (2, ADR (a), StrLen (a))
END ErrorString ;
(*
- ErrorMessage - emits an error message to the stderr
+ ErrorMessage - emits an error message to stderr and then calls exit (1).
*)
PROCEDURE ErrorMessage (message: ARRAY OF CHAR;
file: ARRAY OF CHAR;
line: CARDINAL;
- function: ARRAY OF CHAR) ;
+ function: ARRAY OF CHAR) <* noreturn *> ;
VAR
LineNo: ARRAY [0..10] OF CHAR ;
BEGIN
- ErrorString(file) ; ErrorString(':') ;
- CardToStr(line, 0, LineNo) ;
- ErrorString(LineNo) ; ErrorString(':') ;
- IF NOT StrEqual(function, '')
+ ErrorString (file) ; ErrorString(':') ;
+ CardToStr (line, 0, LineNo) ;
+ ErrorString (LineNo) ; ErrorString(':') ;
+ IF NOT StrEqual (function, '')
THEN
- ErrorString('in ') ;
- ErrorString(function) ;
- ErrorString(' has caused ') ;
+ ErrorString ('in ') ;
+ ErrorString (function) ;
+ ErrorString (' has caused ') ;
END ;
- ErrorString(message) ;
+ ErrorString (message) ;
LineNo[0] := nl ; LineNo[1] := nul ;
- ErrorString(LineNo) ;
- exit(1)
+ ErrorString (LineNo) ;
+ exit (1)
END ErrorMessage ;
+(*
+ Halt - provides a more user friendly version of HALT, which takes
+ four parameters to aid debugging.
+*)
+
+PROCEDURE Halt (file: ARRAY OF CHAR; line: CARDINAL;
+ function: ARRAY OF CHAR; description: ARRAY OF CHAR) ;
+BEGIN
+ ErrorMessage (description, file, line, function) ;
+ HALT
+END Halt ;
+
+
+(*
+ IsTerminating - Returns true if any coroutine has started program termination
+ and false otherwise.
+*)
+
+PROCEDURE IsTerminating () : BOOLEAN ;
+BEGIN
+ RETURN isTerminating
+END IsTerminating ;
+
+
+(*
+ HasHalted - Returns true if a call to HALT has been made and false
+ otherwise.
+*)
+
+PROCEDURE HasHalted () : BOOLEAN ;
+BEGIN
+ RETURN isHalting
+END HasHalted ;
+
+
(*
ErrorCharStar -
*)
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.
*)
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.
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) ;
(*
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
IMPLEMENTATION MODULE M2RTS ;
-FROM libc IMPORT abort, exit, write ;
+FROM libc IMPORT abort, exit, write, getenv, printf ;
+(* FROM Builtins IMPORT strncmp, strcmp ; not available during bootstrap. *)
FROM NumberIO IMPORT CardToStr ;
FROM StrLib IMPORT StrCopy, StrLen, StrEqual ;
FROM SYSTEM IMPORT ADDRESS, ADR ;
FROM ASCII IMPORT nl, nul ;
+FROM Storage IMPORT ALLOCATE ;
+
IMPORT RTExceptions ;
IMPORT M2EXCEPTION ;
+IMPORT M2Dependent ;
+
+TYPE
+ PtrToChar = POINTER TO CHAR ;
+
+ ProcedureList = RECORD
+ head, tail: ProcedureChain
+ END ;
-CONST
- MaxProcedures = 1024 ;
+ ProcedureChain = POINTER TO RECORD
+ p : PROC ;
+ prev,
+ next: ProcedureChain ;
+ END ;
VAR
- iPtr, tPtr : CARDINAL ;
InitialProc,
- TerminateProc: ARRAY [0..MaxProcedures] OF PROC ;
+ TerminateProc: ProcedureList ;
ExitValue : INTEGER ;
isHalting,
CallExit : BOOLEAN ;
+ Initialized : BOOLEAN ;
(*
- ExecuteTerminationProcedures - calls each installed termination procedure
- in reverse order.
+ ConstructModules - resolve dependencies and then call each
+ module constructor in turn.
*)
-PROCEDURE ExecuteTerminationProcedures ;
-VAR
- i: CARDINAL ;
+PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+ argc: INTEGER; argv, envp: ADDRESS) ;
BEGIN
- i := tPtr ;
- WHILE i>0 DO
- DEC(i) ;
- TerminateProc[i]
- END
-END ExecuteTerminationProcedures ;
+ M2Dependent.ConstructModules (applicationmodule, argc, argv, envp)
+END ConstructModules ;
(*
- InstallTerminationProcedure - installs a procedure, p, which will
- be called when the procedure
- ExecuteTerminationProcedures
- is invoked. It returns TRUE is the
- procedure is installed.
+ DeconstructModules - resolve dependencies and then call each
+ module constructor in turn.
*)
-PROCEDURE InstallTerminationProcedure (p: PROC) : BOOLEAN ;
+PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+ argc: INTEGER; argv, envp: ADDRESS) ;
BEGIN
- IF tPtr>MaxProcedures
- THEN
- RETURN( FALSE )
- ELSE
- TerminateProc[tPtr] := p ;
- INC(tPtr) ;
- RETURN( TRUE )
+ M2Dependent.DeconstructModules (applicationmodule, argc, argv, envp)
+END DeconstructModules ;
+
+
+(*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*)
+
+PROCEDURE RegisterModule (name: ADDRESS;
+ init, fini: ArgCVEnvP;
+ dependencies: PROC) ;
+BEGIN
+ M2Dependent.RegisterModule (name, init, fini, dependencies)
+END RegisterModule ;
+
+
+(*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule.
+*)
+
+PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+BEGIN
+ M2Dependent.RequestDependant (modulename, dependantmodule)
+END RequestDependant ;
+
+
+(*
+ ExecuteReverse - execute the procedure associated with procptr
+ and then proceed to try and execute all previous
+ procedures in the chain.
+*)
+
+PROCEDURE ExecuteReverse (procptr: ProcedureChain) ;
+BEGIN
+ WHILE procptr # NIL DO
+ procptr^.p ; (* Invoke the procedure. *)
+ procptr := procptr^.prev
END
-END InstallTerminationProcedure ;
+END ExecuteReverse ;
+
+
+(*
+ ExecuteTerminationProcedures - calls each installed termination procedure
+ in reverse order.
+*)
+
+PROCEDURE ExecuteTerminationProcedures ;
+BEGIN
+ ExecuteReverse (TerminateProc.tail)
+END ExecuteTerminationProcedures ;
(*
*)
PROCEDURE ExecuteInitialProcedures ;
-VAR
- i: CARDINAL ;
BEGIN
- i := iPtr ;
- WHILE i>0 DO
- DEC(i) ;
- InitialProc[i]
- END
+ ExecuteReverse (InitialProc.tail)
END ExecuteInitialProcedures ;
(*
- InstallInitialProcedure - installs a procedure to be executed just before the
- BEGIN code section of the main program module.
+ AppendProc - append proc to the end of the procedure list
+ defined by proclist.
*)
-PROCEDURE InstallInitialProcedure (p: PROC) : BOOLEAN ;
+PROCEDURE AppendProc (VAR proclist: ProcedureList; proc: PROC) : BOOLEAN ;
+VAR
+ pdes: ProcedureChain ;
BEGIN
- IF iPtr>MaxProcedures
+ NEW (pdes) ;
+ WITH pdes^ DO
+ p := proc ;
+ prev := proclist.tail ;
+ next := NIL
+ END ;
+ IF proclist.head = NIL
THEN
- RETURN( FALSE )
- ELSE
- InitialProc[iPtr] := p ;
- INC(iPtr) ;
- RETURN( TRUE )
- END
+ proclist.head := pdes
+ END ;
+ proclist.tail := pdes ;
+ RETURN TRUE
+END AppendProc ;
+
+
+(*
+ InstallTerminationProcedure - installs a procedure, p, which will
+ be called when the procedure
+ ExecuteTerminationProcedures
+ is invoked. It returns TRUE if the
+ procedure is installed.
+*)
+
+PROCEDURE InstallTerminationProcedure (p: PROC) : BOOLEAN ;
+BEGIN
+ RETURN AppendProc (TerminateProc, p)
+END InstallTerminationProcedure ;
+
+
+(*
+ InstallInitialProcedure - installs a procedure to be executed just
+ before the BEGIN code section of the
+ main program module.
+*)
+
+PROCEDURE InstallInitialProcedure (p: PROC) : BOOLEAN ;
+BEGIN
+ RETURN AppendProc (InitialProc, p)
END InstallInitialProcedure ;
(*
- 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.
PROCEDURE Terminate <* noreturn *> ;
BEGIN
- exit(ExitValue)
+ exit (ExitValue)
END Terminate ;
VAR
n: INTEGER ;
BEGIN
- n := write(2, ADR(a), StrLen(a))
+ n := write (2, ADR (a), StrLen (a))
END ErrorString ;
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 ;
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 ;
END Length ;
+(*
+ InitProcList - initialize the head and tail pointers to NIL.
+*)
+
+PROCEDURE InitProcList (VAR p: ProcedureList) ;
+BEGIN
+ p.head := NIL ;
+ p.tail := NIL
+END InitProcList ;
+
+
+(*
+ Init - initialize the initial, terminate procedure lists and booleans.
+*)
+
+PROCEDURE Init ;
BEGIN
- iPtr := 0 ;
- tPtr := 0 ;
+ InitProcList (InitialProc) ;
+ InitProcList (TerminateProc) ;
ExitValue := 0 ;
isHalting := FALSE ;
CallExit := FALSE (* default by calling abort *)
+END Init ;
+
+
+(*
+ CheckInitialized - checks to see if this module has been initialized
+ and if it has not it calls Init. We need this
+ approach as this module is called by module ctors
+ before we reach main.
+*)
+
+PROCEDURE CheckInitialized ;
+BEGIN
+ IF NOT Initialized
+ THEN
+ Initialized := TRUE ;
+ Init
+ END
+END CheckInitialized ;
+
+
+BEGIN
+ CheckInitialized
END M2RTS.
}
#endif
+
+#if 0
/* add_exec_prefix, adds the -ftarget-ar= option so that we can tell
gm2lcc where to pick up the `ar' utility. */
fe_generate_option (OPT_ftarget_ar_, ar, true);
fe_generate_option (OPT_ftarget_ranlib_, ranlib, true);
}
+#endif
static const char *
get_libexec (void)
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;
}
}
+#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. */
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;
}
add_env_option (gm2ipath, OPT_I);
add_default_includes (libpath, libraries);
+#if 0
add_exec_prefix ();
+#endif
#if defined(LOCAL_DEBUGGING)
if (!seen_B)
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);
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
}
/* 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",
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
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
/*
- 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);
(*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
{
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
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. */
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. */
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. */
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. */
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. */
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))
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))
}
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. */
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;
}
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. */
}
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. */
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. */
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. */
{
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
{
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);
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);
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);
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);
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.
*/
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,
*/
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.
*/
/* 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.
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
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
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 ();
}
/*
- 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;
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;
/*
- 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;
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;
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 ();
}
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 ();
}
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.
*/
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
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
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);
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);
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);
/*
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);
{
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 ();
}
{
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 ();
}
{
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 ();
}
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 ();
}
# define FALSE (1==0)
# endif
+# include "GStorage.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
#define _M2RTS_H
#define _M2RTS_C
# include "Glibc.h"
+# include "GM2LINK.h"
# include "GNumberIO.h"
# include "GStrLib.h"
# include "GSYSTEM.h"
# include "GASCII.h"
+# include "GStorage.h"
# include "GRTExceptions.h"
# include "GM2EXCEPTION.h"
-# define MaxProcedures 1024
-typedef struct _T1_a _T1;
+typedef struct M2RTS_ArgCVEnvP_p M2RTS_ArgCVEnvP;
-struct _T1_a { PROC array[MaxProcedures+1]; };
-static unsigned int iPtr;
-static unsigned int tPtr;
-static _T1 InitialProc;
-static _T1 TerminateProc;
+typedef struct ProcedureList_r ProcedureList;
+
+typedef char *PtrToChar;
+
+typedef struct DependencyList_r DependencyList;
+
+typedef struct _T2_r _T2;
+
+typedef _T2 *ProcedureChain;
+
+typedef struct _T3_r _T3;
+
+typedef _T3 *ModuleChain;
+
+typedef struct _T4_a _T4;
+
+typedef enum {unregistered, unordered, started, ordered} DependencyState;
+
+typedef void (*M2RTS_ArgCVEnvP_t) (int, void *, void *);
+struct M2RTS_ArgCVEnvP_p { M2RTS_ArgCVEnvP_t proc; };
+
+struct ProcedureList_r {
+ ProcedureChain head;
+ ProcedureChain tail;
+ };
+
+struct DependencyList_r {
+ PROC proc;
+ unsigned int forced;
+ unsigned int forc;
+ DependencyState state;
+ };
+
+struct _T2_r {
+ PROC p;
+ ProcedureChain prev;
+ ProcedureChain next;
+ };
+
+struct _T4_a { ModuleChain array[ordered-unregistered+1]; };
+struct _T3_r {
+ void *name;
+ M2RTS_ArgCVEnvP init;
+ M2RTS_ArgCVEnvP fini;
+ DependencyList dependency;
+ ModuleChain prev;
+ ModuleChain next;
+ };
+
+static ProcedureList InitialProc;
+static ProcedureList TerminateProc;
static int ExitValue;
+static _T4 Modules;
static unsigned int isHalting;
static unsigned int CallExit;
+static unsigned int ModuleTrace;
+static unsigned int DependencyTrace;
+static unsigned int PreTrace;
+static unsigned int PostTrace;
+static unsigned int ForceTrace;
+
+/*
+ ConstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2RTS_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+
+/*
+ DeconstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2RTS_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+
+/*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*/
+
+extern "C" void M2RTS_RegisterModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
+
+/*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule. It only takes effect
+ if we are not using StaticInitialization.
+*/
+
+extern "C" void M2RTS_RequestDependant (void * modulename, void * dependantmodule);
/*
ExecuteTerminationProcedures - calls each installed termination procedure
InstallTerminationProcedure - installs a procedure, p, which will
be called when the procedure
ExecuteTerminationProcedures
- is invoked. It returns TRUE is the
+ is invoked. It returns TRUE if the
procedure is installed.
*/
extern "C" void M2RTS_ExecuteInitialProcedures (void);
/*
- InstallInitialProcedure - installs a procedure to be executed just before the
- BEGIN code section of the main program module.
+ InstallInitialProcedure - installs a procedure to be executed just
+ before the BEGIN code section of the
+ main program module.
*/
extern "C" unsigned int M2RTS_InstallInitialProcedure (PROC p);
extern "C" void M2RTS_ParameterException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
extern "C" void M2RTS_NoException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+/*
+ CreateModule - creates a new module entry and returns the
+ ModuleChain.
+*/
+
+static ModuleChain CreateModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
+
+/*
+ AppendModule - append chain to head.
+*/
+
+static void AppendModule (ModuleChain *head, ModuleChain chain);
+
+/*
+ RemoveModule - remove chain from double linked list head.
+*/
+
+static void RemoveModule (ModuleChain *head, ModuleChain chain);
+
+/*
+ onChain - returns TRUE if mptr is on the Modules[state] list.
+*/
+
+static unsigned int onChain (DependencyState state, ModuleChain mptr);
+
+/*
+ LookupModule - lookup and return the ModuleChain pointer containing
+ module name from a particular list.
+*/
+
+static ModuleChain LookupModule (DependencyState state, void * name);
+
+/*
+ toCString - replace any character sequence
+ into a newline.
+*/
+
+static void toCString (char *str, unsigned int _str_high);
+
+/*
+ strcmp - return 1 if both strings are equal.
+ We cannot use Builtins.def during bootstrap.
+*/
+
+static int strcmp (PtrToChar a, PtrToChar b);
+
+/*
+ strncmp - return 1 if both strings are equal.
+ We cannot use Builtins.def during bootstrap.
+*/
+
+static int strncmp (PtrToChar a, PtrToChar b, unsigned int n);
+
+/*
+ traceprintf - wrap printf with a boolean flag.
+*/
+
+static void traceprintf (unsigned int flag, const char *str_, unsigned int _str_high);
+
+/*
+ traceprintf2 - wrap printf with a boolean flag.
+*/
+
+static void traceprintf2 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg);
+
+/*
+ moveTo - moves mptr to the new list determined by newstate.
+ It updates the mptr state appropriately.
+*/
+
+static void moveTo (DependencyState newstate, ModuleChain mptr);
+
+/*
+ ResolveDependant -
+*/
+
+static void ResolveDependant (ModuleChain mptr, void * currentmodule);
+
+/*
+ PerformRequestDependant - the current modulename has a dependancy upon
+ dependantmodule. If dependantmodule is NIL then
+ modulename has no further dependants and it can be
+ resolved.
+*/
+
+static void PerformRequestDependant (void * modulename, void * dependantmodule);
+
+/*
+ ResolveDependencies -
+*/
+
+static void ResolveDependencies (void * currentmodule);
+
+/*
+ DisplayModuleInfo - displays all module in the state.
+*/
+
+static void DisplayModuleInfo (DependencyState state, const char *name_, unsigned int _name_high);
+
+/*
+ DumpModuleData -
+*/
+
+static void DumpModuleData (unsigned int flag);
+
+/*
+ ForceDependencies -
+*/
+
+static void ForceDependencies (void);
+
+/*
+ ExecuteReverse - execute the procedure associated with procptr
+ and then proceed to try and execute all previous
+ procedures in the chain.
+*/
+
+static void ExecuteReverse (ProcedureChain procptr);
+
+/*
+ AppendProc - append proc to the end of the procedure list
+ defined by proclist.
+*/
+
+static unsigned int AppendProc (ProcedureList *proclist, PROC proc);
+
/*
ErrorString - writes a string to stderr.
*/
static void ErrorString (const char *a_, unsigned int _a_high);
+/*
+ InitProcList - initialize the head and tail pointers to NIL.
+*/
+
+static void InitProcList (ProcedureList *p);
+
+/*
+ equal - return TRUE if C string cstr is equal to str.
+*/
+
+static unsigned int equal (void * cstr, const char *str_, unsigned int _str_high);
+
+/*
+ SetupDebugFlags - By default assigns ModuleTrace, DependencyTrace,
+ DumpPostInit to FALSE. It checks the environment
+ GCC_M2LINK_RTFLAG which can contain
+ "all,module,pre,post,dep,force". all turns them all on.
+ The flag meanings are as follows and flags the are in
+ execution order.
+
+ module generate trace info as the modules are registered.
+ pre generate a list of all modules seen prior to having
+ their dependancies resolved.
+ dep display a trace as the modules are resolved.
+ post generate a list of all modules seen after having
+ their dependancies resolved.
+ force generate a list of all modules seen after having
+ their dependancies resolved and forced.
+*/
+
+static void SetupDebugFlags (void);
+
+
+/*
+ CreateModule - creates a new module entry and returns the
+ ModuleChain.
+*/
+
+static ModuleChain CreateModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies)
+{
+ ModuleChain mptr;
+
+ Storage_ALLOCATE ((void **) &mptr, sizeof (_T3));
+ mptr->name = name;
+ mptr->init = init;
+ mptr->fini = fini;
+ mptr->dependency.proc = dependencies;
+ mptr->dependency.state = unregistered;
+ mptr->prev = NULL;
+ mptr->next = NULL;
+ return mptr;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ AppendModule - append chain to head.
+*/
+
+static void AppendModule (ModuleChain *head, ModuleChain chain)
+{
+ if ((*head) == NULL)
+ {
+ (*head) = chain;
+ chain->prev = chain;
+ chain->next = chain;
+ }
+ else
+ {
+ chain->next = (*head); /* Add Item to the end of queue */
+ chain->prev = (*head)->prev; /* Add Item to the end of queue */
+ (*head)->prev->next = chain;
+ (*head)->prev = chain;
+ }
+}
+
+
+/*
+ RemoveModule - remove chain from double linked list head.
+*/
+
+static void RemoveModule (ModuleChain *head, ModuleChain chain)
+{
+ if ((chain->next == (*head)) && (chain == (*head)))
+ {
+ (*head) = NULL;
+ }
+ else
+ {
+ if ((*head) == chain)
+ {
+ (*head) = (*head)->next;
+ }
+ chain->prev->next = chain->next;
+ chain->next->prev = chain->prev;
+ }
+}
+
+
+/*
+ onChain - returns TRUE if mptr is on the Modules[state] list.
+*/
+
+static unsigned int onChain (DependencyState state, ModuleChain mptr)
+{
+ ModuleChain ptr;
+
+ if (Modules.array[state-unregistered] != NULL)
+ {
+ ptr = Modules.array[state-unregistered];
+ do {
+ if (ptr == mptr)
+ {
+ return TRUE;
+ }
+ ptr = ptr->next;
+ } while (! (ptr == Modules.array[state-unregistered]));
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ LookupModule - lookup and return the ModuleChain pointer containing
+ module name from a particular list.
+*/
+
+static ModuleChain LookupModule (DependencyState state, void * name)
+{
+ ModuleChain ptr;
+
+ if (Modules.array[state-unregistered] != NULL)
+ {
+ ptr = Modules.array[state-unregistered];
+ do {
+ if ((strcmp (reinterpret_cast<PtrToChar> (ptr->name), reinterpret_cast<PtrToChar> (name))) == 0)
+ {
+ return ptr;
+ }
+ ptr = ptr->next;
+ } while (! (ptr == Modules.array[state-unregistered]));
+ }
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ toCString - replace any character sequence
+ into a newline.
+*/
+
+static void toCString (char *str, unsigned int _str_high)
+{
+ unsigned int high;
+ unsigned int i;
+ unsigned int j;
+
+ i = 0;
+ high = _str_high;
+ while (i < high)
+ {
+ if ((str[i] == '\\') && (i < high))
+ {
+ if (str[i+1] == 'n')
+ {
+ str[i] = ASCII_nl;
+ j = i+1;
+ while (j < high)
+ {
+ str[j] = str[j+1];
+ j += 1;
+ }
+ }
+ }
+ i += 1;
+ }
+}
+
+
+/*
+ strcmp - return 1 if both strings are equal.
+ We cannot use Builtins.def during bootstrap.
+*/
+
+static int strcmp (PtrToChar a, PtrToChar b)
+{
+ if ((a != NULL) && (b != NULL))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (a == b)
+ {
+ return 1;
+ }
+ else
+ {
+ while ((*a) == (*b))
+ {
+ if ((*a) == ASCII_nul)
+ {
+ return 1;
+ }
+ a += 1;
+ b += 1;
+ }
+ }
+ }
+ return 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ strncmp - return 1 if both strings are equal.
+ We cannot use Builtins.def during bootstrap.
+*/
+
+static int strncmp (PtrToChar a, PtrToChar b, unsigned int n)
+{
+ if (((a != NULL) && (b != NULL)) && (n > 0))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (a == b)
+ {
+ return 1;
+ }
+ else
+ {
+ while (((*a) == (*b)) && (n > 0))
+ {
+ if ((*a) == ASCII_nul)
+ {
+ return 1;
+ }
+ a += 1;
+ b += 1;
+ n -= 1;
+ }
+ }
+ }
+ return 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ traceprintf - wrap printf with a boolean flag.
+*/
+
+static void traceprintf (unsigned int flag, const char *str_, unsigned int _str_high)
+{
+ char str[_str_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (str, str_, _str_high+1);
+
+ if (flag)
+ {
+ toCString ((char *) str, _str_high);
+ libc_printf ((const char *) str, _str_high);
+ }
+}
+
+
+/*
+ traceprintf2 - wrap printf with a boolean flag.
+*/
+
+static void traceprintf2 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg)
+{
+ char str[_str_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (str, str_, _str_high+1);
+
+ if (flag)
+ {
+ toCString ((char *) str, _str_high);
+ libc_printf ((const char *) str, _str_high, arg);
+ }
+}
+
+
+/*
+ moveTo - moves mptr to the new list determined by newstate.
+ It updates the mptr state appropriately.
+*/
+
+static void moveTo (DependencyState newstate, ModuleChain mptr)
+{
+ if (onChain (mptr->dependency.state, mptr))
+ {
+ RemoveModule (&Modules.array[mptr->dependency.state-unregistered], mptr);
+ }
+ mptr->dependency.state = newstate;
+ AppendModule (&Modules.array[mptr->dependency.state-unregistered], mptr);
+}
+
+
+/*
+ ResolveDependant -
+*/
+
+static void ResolveDependant (ModuleChain mptr, void * currentmodule)
+{
+ if (mptr == NULL)
+ {
+ traceprintf (DependencyTrace, (const char *) " module has not been registered via a global constructor\\n", 60);
+ }
+ else
+ {
+ if (onChain (started, mptr))
+ {
+ traceprintf (DependencyTrace, (const char *) " processing...\\n", 18);
+ }
+ else
+ {
+ moveTo (started, mptr);
+ traceprintf2 (DependencyTrace, (const char *) " starting: %s\\n", 17, currentmodule);
+ (*mptr->dependency.proc.proc) (); /* Invoke and process the dependency graph. */
+ traceprintf2 (DependencyTrace, (const char *) " finished: %s\\n", 17, currentmodule); /* Invoke and process the dependency graph. */
+ }
+ }
+}
+
+
+/*
+ PerformRequestDependant - the current modulename has a dependancy upon
+ dependantmodule. If dependantmodule is NIL then
+ modulename has no further dependants and it can be
+ resolved.
+*/
+
+static void PerformRequestDependant (void * modulename, void * dependantmodule)
+{
+ ModuleChain mptr;
+
+ if (dependantmodule == NULL)
+ {
+ mptr = LookupModule (unordered, modulename);
+ if (mptr == NULL)
+ {
+ traceprintf2 (DependencyTrace, (const char *) "internal error module %s is not in the list of unordered modules\\n", 66, modulename);
+ }
+ else
+ {
+ traceprintf2 (DependencyTrace, (const char *) " module %s dependants all complete\\n", 37, modulename);
+ moveTo (ordered, mptr);
+ }
+ }
+ else
+ {
+ mptr = LookupModule (ordered, dependantmodule);
+ if (mptr == NULL)
+ {
+ traceprintf2 (DependencyTrace, (const char *) " module %s ", 13, dependantmodule);
+ mptr = LookupModule (unordered, dependantmodule);
+ if (mptr == NULL)
+ {
+ mptr = LookupModule (started, dependantmodule);
+ if (mptr == NULL)
+ {
+ traceprintf2 (DependencyTrace, (const char *) " unknown dependancies in module %s ", 37, modulename);
+ }
+ else
+ {
+ traceprintf2 (DependencyTrace, (const char *) " dependant %s started\\n", 25, dependantmodule);
+ }
+ }
+ else
+ {
+ ResolveDependant (mptr, dependantmodule);
+ }
+ }
+ else
+ {
+ traceprintf2 (DependencyTrace, (const char *) " module %s ", 13, modulename);
+ traceprintf2 (DependencyTrace, (const char *) " dependant upon %s completed\\n", 30, dependantmodule);
+ }
+ }
+}
+
+
+/*
+ ResolveDependencies -
+*/
+
+static void ResolveDependencies (void * currentmodule)
+{
+ ModuleChain mptr;
+
+ mptr = LookupModule (unordered, currentmodule);
+ while (mptr != NULL)
+ {
+ traceprintf2 (DependencyTrace, (const char *) " attempting to resolve the dependants for %s\\n", 48, currentmodule);
+ ResolveDependant (mptr, currentmodule);
+ mptr = Modules.array[unordered-unregistered];
+ }
+}
+
+
+/*
+ DisplayModuleInfo - displays all module in the state.
+*/
+
+static void DisplayModuleInfo (DependencyState state, const char *name_, unsigned int _name_high)
+{
+ ModuleChain mptr;
+ char name[_name_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (name, name_, _name_high+1);
+
+ if (Modules.array[state-unregistered] != NULL)
+ {
+ libc_printf ((const char *) "%s modules\\n", 12, &name);
+ mptr = Modules.array[state-unregistered];
+ do {
+ libc_printf ((const char *) " %s", 4, mptr->name);
+ if (mptr->dependency.forc)
+ {
+ libc_printf ((const char *) " for C", 6);
+ }
+ if (mptr->dependency.forced)
+ {
+ libc_printf ((const char *) " forced ordering", 16);
+ }
+ libc_printf ((const char *) "\\n", 2);
+ mptr = mptr->next;
+ } while (! (mptr == Modules.array[state-unregistered]));
+ }
+}
+
+
+/*
+ DumpModuleData -
+*/
+
+static void DumpModuleData (unsigned int flag)
+{
+ ModuleChain mptr;
+
+ if (flag)
+ {
+ DisplayModuleInfo (unregistered, (const char *) "unregistered", 12);
+ DisplayModuleInfo (unordered, (const char *) "unordered", 9);
+ DisplayModuleInfo (started, (const char *) "started", 7);
+ DisplayModuleInfo (ordered, (const char *) "ordered", 7);
+ }
+}
+
+
+/*
+ ForceDependencies -
+*/
+
+static void ForceDependencies (void)
+{
+}
+
+
+/*
+ ExecuteReverse - execute the procedure associated with procptr
+ and then proceed to try and execute all previous
+ procedures in the chain.
+*/
+
+static void ExecuteReverse (ProcedureChain procptr)
+{
+ while (procptr != NULL)
+ {
+ (*procptr->p.proc) (); /* Invoke the procedure. */
+ procptr = procptr->prev; /* Invoke the procedure. */
+ }
+}
+
+
+/*
+ AppendProc - append proc to the end of the procedure list
+ defined by proclist.
+*/
+
+static unsigned int AppendProc (ProcedureList *proclist, PROC proc)
+{
+ ProcedureChain pdes;
+
+ Storage_ALLOCATE ((void **) &pdes, sizeof (_T2));
+ pdes->p = proc;
+ pdes->prev = (*proclist).tail;
+ pdes->next = NULL;
+ if ((*proclist).head == NULL)
+ {
+ (*proclist).head = pdes;
+ }
+ (*proclist).tail = pdes;
+ return TRUE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
/*
ErrorString - writes a string to stderr.
/*
- ExecuteTerminationProcedures - calls each installed termination procedure
- in reverse order.
+ InitProcList - initialize the head and tail pointers to NIL.
*/
-extern "C" void M2RTS_ExecuteTerminationProcedures (void)
+static void InitProcList (ProcedureList *p)
{
- unsigned int i;
+ (*p).head = NULL;
+ (*p).tail = NULL;
+}
+
+
+/*
+ equal - return TRUE if C string cstr is equal to str.
+*/
+
+static unsigned int equal (void * cstr, const char *str_, unsigned int _str_high)
+{
+ char str[_str_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (str, str_, _str_high+1);
+
+ return (strncmp (reinterpret_cast<PtrToChar> (cstr), reinterpret_cast<PtrToChar> (&str), StrLib_StrLen ((const char *) str, _str_high))) == 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SetupDebugFlags - By default assigns ModuleTrace, DependencyTrace,
+ DumpPostInit to FALSE. It checks the environment
+ GCC_M2LINK_RTFLAG which can contain
+ "all,module,pre,post,dep,force". all turns them all on.
+ The flag meanings are as follows and flags the are in
+ execution order.
+
+ module generate trace info as the modules are registered.
+ pre generate a list of all modules seen prior to having
+ their dependancies resolved.
+ dep display a trace as the modules are resolved.
+ post generate a list of all modules seen after having
+ their dependancies resolved.
+ force generate a list of all modules seen after having
+ their dependancies resolved and forced.
+*/
+
+static void SetupDebugFlags (void)
+{
+ typedef char *_T1;
- i = tPtr;
- while (i > 0)
+ _T1 pc;
+
+ ModuleTrace = FALSE;
+ DependencyTrace = FALSE;
+ PostTrace = FALSE;
+ PreTrace = FALSE;
+ pc = static_cast<_T1> (libc_getenv (const_cast<void*> (reinterpret_cast<const void*>("GCC_M2LINK_RTFLAG"))));
+ while ((pc != NULL) && ((*pc) != ASCII_nul))
{
- i -= 1;
- (*TerminateProc.array[i].proc) ();
+ if (equal (reinterpret_cast<void *> (pc), (const char *) "all", 3))
+ {
+ ModuleTrace = TRUE;
+ DependencyTrace = TRUE;
+ PreTrace = TRUE;
+ PostTrace = TRUE;
+ pc += 3;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "module", 6))
+ {
+ /* avoid dangling else. */
+ ModuleTrace = TRUE;
+ pc += 6;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "dep", 3))
+ {
+ /* avoid dangling else. */
+ DependencyTrace = TRUE;
+ pc += 3;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "pre", 3))
+ {
+ /* avoid dangling else. */
+ PreTrace = TRUE;
+ pc += 3;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "post", 4))
+ {
+ /* avoid dangling else. */
+ PostTrace = TRUE;
+ pc += 4;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "force", 5))
+ {
+ /* avoid dangling else. */
+ ForceTrace = TRUE;
+ pc += 5;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ pc += 1;
+ }
}
}
/*
- InstallTerminationProcedure - installs a procedure, p, which will
- be called when the procedure
- ExecuteTerminationProcedures
- is invoked. It returns TRUE is the
- procedure is installed.
+ ConstructModules - resolve dependencies and then call each
+ module constructor in turn.
*/
-extern "C" unsigned int M2RTS_InstallTerminationProcedure (PROC p)
+extern "C" void M2RTS_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp)
{
- if (tPtr > MaxProcedures)
+ ModuleChain mptr;
+ M2RTS_ArgCVEnvP nulp;
+
+ SetupDebugFlags ();
+ traceprintf2 (ModuleTrace, (const char *) "application module: %s\\n", 24, applicationmodule);
+ DumpModuleData (PreTrace);
+ ResolveDependencies (applicationmodule);
+ DumpModuleData (PostTrace);
+ ForceDependencies ();
+ DumpModuleData (ForceTrace);
+ if (Modules.array[ordered-unregistered] == NULL)
{
- return FALSE;
+ traceprintf2 (ModuleTrace, (const char *) " module: %s has not registered itself using a global constructor\\n", 67, applicationmodule);
+ traceprintf2 (ModuleTrace, (const char *) " hint try compile and linking using: gm2 %s.mod\\n", 50, applicationmodule);
+ traceprintf2 (ModuleTrace, (const char *) " or try using: gm2 -fscaffold-static %s.mod\\n", 46, applicationmodule);
}
else
{
- TerminateProc.array[tPtr] = p;
- tPtr += 1;
- return TRUE;
+ mptr = Modules.array[ordered-unregistered];
+ do {
+ if (mptr->dependency.forc)
+ {
+ traceprintf2 (ModuleTrace, (const char *) "initializing module: %s for C\\n", 31, mptr->name);
+ }
+ else
+ {
+ traceprintf2 (ModuleTrace, (const char *) "initializing module: %s\\n", 25, mptr->name);
+ }
+ /*
+ nulp := NIL ;
+ IF mptr^.init = nulp
+ THEN
+ traceprintf (ModuleTrace, " no initialization section, skipping...
+ ")
+ ELSE
+ */
+ (*mptr->init.proc) (argc, argv, envp);
+ /*
+ END ;
+ */
+ mptr = mptr->prev;
+ } while (! (mptr == Modules.array[ordered-unregistered]));
}
+}
+
+
+/*
+ DeconstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2RTS_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp)
+{
+}
+
+
+/*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*/
+
+extern "C" void M2RTS_RegisterModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies)
+{
+ if (! M2LINK_StaticInitialization)
+ {
+ traceprintf2 (ModuleTrace, (const char *) "module: %s registering\\n", 24, name);
+ moveTo (unordered, CreateModule (name, init, fini, dependencies));
+ }
+}
+
+
+/*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule. It only takes effect
+ if we are not using StaticInitialization.
+*/
+
+extern "C" void M2RTS_RequestDependant (void * modulename, void * dependantmodule)
+{
+ if (! M2LINK_StaticInitialization)
+ {
+ PerformRequestDependant (modulename, dependantmodule);
+ }
+}
+
+
+/*
+ ExecuteTerminationProcedures - calls each installed termination procedure
+ in reverse order.
+*/
+
+extern "C" void M2RTS_ExecuteTerminationProcedures (void)
+{
+ ExecuteReverse (TerminateProc.tail);
+}
+
+
+/*
+ InstallTerminationProcedure - installs a procedure, p, which will
+ be called when the procedure
+ ExecuteTerminationProcedures
+ is invoked. It returns TRUE if the
+ procedure is installed.
+*/
+
+extern "C" unsigned int M2RTS_InstallTerminationProcedure (PROC p)
+{
+ return AppendProc (&TerminateProc, p);
/* static analysis guarentees a RETURN statement will be used before here. */
__builtin_unreachable ();
}
extern "C" void M2RTS_ExecuteInitialProcedures (void)
{
- unsigned int i;
-
- i = iPtr;
- while (i > 0)
- {
- i -= 1;
- (*InitialProc.array[i].proc) ();
- }
+ ExecuteReverse (InitialProc.tail);
}
/*
- InstallInitialProcedure - installs a procedure to be executed just before the
- BEGIN code section of the main program module.
+ InstallInitialProcedure - installs a procedure to be executed just
+ before the BEGIN code section of the
+ main program module.
*/
extern "C" unsigned int M2RTS_InstallInitialProcedure (PROC p)
{
- if (iPtr > MaxProcedures)
- {
- return FALSE;
- }
- else
- {
- InitialProc.array[iPtr] = p;
- iPtr += 1;
- return TRUE;
- }
+ return AppendProc (&InitialProc, p);
/* static analysis guarentees a RETURN statement will be used before here. */
__builtin_unreachable ();
}
extern "C" void M2RTS_ErrorMessage (const char *message_, unsigned int _message_high, const char *file_, unsigned int _file_high, unsigned int line, const char *function_, unsigned int _function_high)
{
- typedef struct _T2_a _T2;
+ typedef struct _T5_a _T5;
- struct _T2_a { char array[10+1]; };
- _T2 LineNo;
+ struct _T5_a { char array[10+1]; };
+ _T5 LineNo;
char message[_message_high+1];
char file[_file_high+1];
char function[_function_high+1];
extern "C" void _M2_M2RTS_init (__attribute__((unused)) int argc, __attribute__((unused)) char *argv[])
{
- iPtr = 0;
- tPtr = 0;
+ InitProcList (&InitialProc);
+ InitProcList (&TerminateProc);
ExitValue = 0;
isHalting = FALSE;
CallExit = FALSE; /* default by calling abort */
# 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
}
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. */
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);
}
}
}
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);
}
}
}
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")));
}
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")));
}
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")));
}
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")));
}
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 ? */
}
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")));
}
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")));
}
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")));
}
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")));
}
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")));
}
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")));
}
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")));
}
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")));
}
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")));
}
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")));
}
{
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 ();
}
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;
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 ();
}
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
{
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
{
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
{
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 ();
}
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
{
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
{
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;
}
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('}
') ; */
/*
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);
/*
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);
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);
/*
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);
/*
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);
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 ();
}
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 ();
}
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)
{
{
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)
{
(*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)
{
}
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)
(*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)
{
# 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;
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; };
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);
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);
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 ();
}
}
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 ();
}
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 ();
}
}
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)
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 ();
}
}
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. */
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 ();
}
}
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. */
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. */
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. */
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 ();
}
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 ();
}
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 ();
}
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;
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 ();
}
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 ();
}
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;
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 ();
}
}
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 ();
}
}
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. */
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 ();
}
}
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 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 ();
}
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 ();
}
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 ();
}
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 ();
}
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);
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 ();
}
}
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 ();
}
}
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 ();
}
}
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);
{
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))
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)
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 ();
}
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 ();
}
}
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 ();
}
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);
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 ();
}
}
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 ();
}
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. */
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 ();
}
}
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 ();
}
}
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 ();
}
}
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. */
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. */
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 ();
}
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. */
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;
__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 ();
}
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);
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 ();
}
}
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. */
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); /* 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 ();
}
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 ();
}
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 ();
}
}
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 ();
}
}
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 ();
}
}
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 ();
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 ();
}
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)
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);
}
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 ();
}
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 ();
}
{
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);
}
}
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);
}
{
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. */
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
{
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;
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 ();
}
{
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 ();
}
(*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 ();
}
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 ();
}
(*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)
}
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);
}
}
}
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);
}
}
VAR
ret: BOOLEAN ;
BEGIN
- IF isStatementSequence (n)
+ IF n = NIL
+ THEN
+ RETURN FALSE
+ ELSIF isStatementSequence (n)
THEN
RETURN isLastStatementSequence (n, q)
ELSIF isProcedure (n)
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 ;
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
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
-extern void exit(int);
+extern void exit (int);
extern void _M2_SYSTEM_init (int argc, char *argv[]);
extern void _M2_SYSTEM_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[])
{
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
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 \
projects / thirdparty / gcc.git / commitdiff
