@item -fm2-lower-case
render keywords in error messages using lower case.
+@item -fm2-pathname=
+specify the module mangled prefix name for all modules in the
+following include paths.
+
+@item -fm2-pathnameI
+for internal use only: used by the driver to copy the user facing -I
+option.
+
@item -fm2-plugin
insert plugin to identify run time errors at compile time (default on).
+@item -fm2-prefix=
+specify the module mangled prefix name. All exported symbols from a
+definition module will have the prefix name.
+
@item -fm2-statistics
generates quadruple information: number of quadruples generated,
number of quadruples remaining after optimization and number of source
@item -fruntime-modules=
specify, using a comma separated list, the run time modules and their
order. These modules will initialized first before any other modules
-in the application dependency. By default the run time modules list is
-set to @code{Storage,SYSTEM,M2RTS,RTExceptions,IOLink}. Note that
-these modules will only be linked into your executable if they are
-required. So adding a long list of dependent modules will not effect
-the size of the executable it merely states the initialization order
-should they be required.
+in the application dependency. By default the run time modules list
+is set to @code{m2iso:RTentity,m2iso:Storage,m2iso:SYSTEM,}
+@code{m2iso:M2RTS,m2iso:RTExceptions,m2iso:IOLink}. Note that these
+modules will only be linked into your executable if they are required.
+Adding a long list of dependent modules will not effect the size of
+the executable it merely states the initialization order should they
+be required.
@item -fscaffold-dynamic
the option ensures that @samp{gm2} will generate a dynamic scaffold
=================
all | turn on all flags below
module | trace modules as they register themselves
+hex | display the hex address of the init/fini functions
+warning | show any warnings
pre | generate module list prior to dependency resolution
dep | trace module dependency resolution
post | generate module list after dependency resolution
M2DebugStack.def \
M2Defaults.def \
M2DriverOptions.def \
- DynamicStringPath.def \
+ DynamicPath.def \
+ PathName.def \
M2Emit.def \
M2Error.def \
M2EvalSym.def \
M2DebugStack.mod \
M2Defaults.mod \
M2DriverOptions.mod \
- DynamicStringPath.mod \
+ DynamicPath.mod \
+ PathName.mod \
M2Emit.mod \
M2Error.mod \
M2FileName.mod \
M2DebugStack.def \
M2Defaults.def \
M2DriverOptions.def \
- DynamicStringPath.def \
+ DynamicPath.def \
+ PathName.def \
M2Emit.def \
M2Error.def \
M2FileName.def \
M2DebugStack.mod \
M2Defaults.mod \
M2DriverOptions.mod \
- DynamicStringPath.mod \
+ DynamicPath.mod \
+ PathName.mod \
M2Emit.mod \
M2Error.mod \
M2FileName.mod \
BUILD-PPG-H = m2/boot-bin/mc$(exeext) $(BUILD-PPG-LIBS-H)
+BUILD-BOOT-PPG-H: $(BUILD-BOOT-H) \
+ m2/gm2-ppg-boot/$(SRC_PREFIX)M2RTS.h \
+ m2/gm2-ppg-boot/$(SRC_PREFIX)M2Dependent.h
+
m2/gm2-ppg-boot/$(SRC_PREFIX)%.h: $(srcdir)/m2/gm2-libs/%.def $(MCDEPS)
-test -d m2/gm2-ppg-boot || $(mkinstalldirs) m2/gm2-ppg-boot
$(MCC) -o=$@ $(srcdir)/m2/gm2-libs/$*.def
-m2/gm2-ppg-boot/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.c m2/gm2-libs/gm2-libs-host.h
+m2/gm2-ppg-boot/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.c m2/gm2-libs/gm2-libs-host.h $(BUILD-BOOT-PPG-H)
-test -d m2/gm2-ppg-boot || $(mkinstalldirs) m2/gm2-ppg-boot
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch -Im2/gm2-libs $(INCLUDES) -g -c $< -o $@
-m2/gm2-ppg-boot/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.cc m2/gm2-libs/gm2-libs-host.h
+m2/gm2-ppg-boot/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.cc m2/gm2-libs/gm2-libs-host.h $(BUILD-BOOT-PPG-H)
-test -d m2/gm2-ppg-boot || $(mkinstalldirs) m2/gm2-ppg-boot
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch -Im2/gm2-libs $(INCLUDES) -g -c $< -o $@
-m2/gm2-ppg-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-libs/%.mod $(MCDEPS) $(BUILD-BOOT-H)
+m2/gm2-ppg-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-libs/%.mod $(MCDEPS) $(BUILD-BOOT-PPG-H)
-test -d m2/gm2-ppg-boot || $(mkinstalldirs) m2/gm2-ppg-boot
$(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-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)
+m2/gm2-ppg-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-compiler/%.mod $(MCDEPS) $(BUILD-BOOT-PPG-H)
-test -d m2/gm2-ppg-boot || $(mkinstalldirs) m2/gm2-ppg-boot
$(MCC) -o=m2/gm2-ppg-boot/$(SRC_PREFIX)$*.c $(srcdir)/m2/gm2-compiler/$*.mod
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) \
# without error recovery
PG-SRC = pg.mod
+PGE-DEF = ASCII.def \
+ Args.def \
+ Assertion.def \
+ Break.def \
+ COROUTINES.def \
+ CmdArgs.def \
+ Debug.def \
+ DynamicStrings.def \
+ Environment.def \
+ FIO.def \
+ FormatStrings.def \
+ FpuIO.def \
+ IO.def \
+ M2Dependent.def \
+ M2EXCEPTION.def \
+ M2LINK.def \
+ M2RTS.def \
+ MemUtils.def \
+ NumberIO.def \
+ PushBackInput.def \
+ RTExceptions.def \
+ RTco.def \
+ RTentity.def \
+ RTint.def \
+ SArgs.def \
+ SFIO.def \
+ SYSTEM.def \
+ Selective.def \
+ StdIO.def \
+ Storage.def \
+ StrCase.def \
+ StrIO.def \
+ StrLib.def \
+ StringConvert.def \
+ SysExceptions.def \
+ SysStorage.def \
+ TimeString.def \
+ UnixArgs.def \
+ dtoa.def \
+ errno.def \
+ ldtoa.def \
+ libc.def \
+ libm.def \
+ termios.def \
+ wrapc.def \
BUILD-PG-O = $(PPG-INTERFACE-C:%.c=m2/gm2-pg-boot/$(SRC_PREFIX)%.o) \
$(PPG-INTERFACE-CC:%.cc=m2/gm2-pg-boot/$(SRC_PREFIX)%.o) \
$(PPG-LIB-MODS:%.mod=m2/gm2-pg-boot/$(SRC_PREFIX)%.o) \
$(PG-SRC:%.mod=m2/gm2-pg-boot/$(SRC_PREFIX)%.o)
+BUILD-BOOT-PG-H: $(BUILD-BOOT-H) \
+ m2/gm2-pg-boot/$(SRC_PREFIX)M2RTS.h \
+ m2/gm2-pg-boot/$(SRC_PREFIX)M2Dependent.h
+
m2/gm2-pg-boot/$(SRC_PREFIX)%.h: $(srcdir)/m2/gm2-libs/%.def $(MCDEPS)
-test -d m2/gm2-pg-boot || $(mkinstalldirs) m2/gm2-pg-boot
$(MCC) -o=$@ $(srcdir)/m2/gm2-libs/$*.def
-m2/gm2-pg-boot/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.c m2/gm2-libs/gm2-libs-host.h
+m2/gm2-pg-boot/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.c m2/gm2-libs/gm2-libs-host.h $(BUILD-BOOT-PG-H)
-test -d m2/gm2-pg-boot || $(mkinstalldirs) m2/gm2-pg-boot
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch -Im2/gm2-libs $(INCLUDES) -g -c $< -o $@
-m2/gm2-pg-boot/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.cc m2/gm2-libs/gm2-libs-host.h
+m2/gm2-pg-boot/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.cc m2/gm2-libs/gm2-libs-host.h $(BUILD-BOOT-PG-H)
-test -d m2/gm2-pg-boot || $(mkinstalldirs) m2/gm2-pg-boot
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch -Im2/gm2-libs $(INCLUDES) -g -c $< -o $@
-m2/gm2-pg-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-libs/%.mod $(MCDEPS) $(BUILD-BOOT-H)
+m2/gm2-pg-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-libs/%.mod $(MCDEPS) $(BUILD-BOOT-PG-H)
-test -d m2/gm2-pg-boot || $(mkinstalldirs) m2/gm2-pg-boot
$(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 \
-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/gm2-pg-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-compiler/%.mod $(MCDEPS) $(BUILD-BOOT-PG-H)
-test -d m2/gm2-pg-boot || $(mkinstalldirs) m2/gm2-pg-boot
$(MCC) -o=m2/gm2-pg-boot/$(SRC_PREFIX)$*.c $(srcdir)/m2/gm2-compiler/$*.mod
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -Im2/mc-boot -Im2/gm2-compiler-boot -Im2/gm2-libs-boot \
-I$(srcdir)/m2/mc-boot-ch $(INCLUDES) -g -c m2/gm2-pg-boot/$(SRC_PREFIX)$*.c -o $@
-m2/gm2-pg-boot/$(SRC_PREFIX)pg.o: m2/gm2-auto/pg.mod $(MCDEPS) $(BUILD-BOOT-H)
+m2/gm2-pg-boot/$(SRC_PREFIX)pg.o: m2/gm2-auto/pg.mod $(MCDEPS) $(BUILD-BOOT-PG-H)
-test -d m2/gm2-pg-boot || $(mkinstalldirs) m2/gm2-pg-boot
$(MCC) -o=m2/gm2-pg-boot/$(SRC_PREFIX)pg.c m2/gm2-auto/pg.mod
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -Im2/mc-boot -Im2/gm2-compiler-boot -Im2/gm2-libs-boot \
$(PPG-LIB-MODS:%.mod=m2/gm2-pge-boot/$(SRC_PREFIX)%.o) \
$(PGE-SRC:%.mod=m2/gm2-pge-boot/$(SRC_PREFIX)%.o)
+BUILD-BOOT-PGE-H: $(BUILD-BOOT-H) $(PGE-DEF:%.def=m2/gm2-pge-boot/$(SRC_PREFIX)%.h) \
+ m2/gm2-pge-boot/GM2RTS.h m2/gm2-pge-boot/GM2Dependent.h
+
m2/gm2-auto/pge.mod: m2/pg$(exeext)
-test -d m2/gm2-auto || $(mkinstalldirs) m2/gm2-auto
$(SHELL) $(srcdir)/m2/tools-src/buildpg $(srcdir)/m2/gm2-compiler/ppg.mod pge > m2/gm2-auto/pge.bnf
-test -d m2/gm2-pge-boot || $(mkinstalldirs) m2/gm2-pge-boot
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch -Im2/gm2-libs $(INCLUDES) -g -c $< -o $@
-m2/gm2-pge-boot/$(SRC_PREFIX)SYSTEM.o: $(srcdir)/m2/mc-boot-ch/GSYSTEM.c
+m2/gm2-pge-boot/$(SRC_PREFIX)SYSTEM.o: $(srcdir)/m2/mc-boot-ch/GSYSTEM.c $(BUILD-BOOT-PGE-H)
-test -d m2/gm2-pge-boot || $(mkinstalldirs) m2/gm2-pge-boot
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch $(INCLUDES) -g -c $< -o $@
-test -d m2/gm2-pge-boot || $(mkinstalldirs) m2/gm2-pge-boot
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch $(INCLUDES) -g -c $< -o $@
-m2/gm2-pge-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-libs/%.mod $(MCDEPS) $(BUILD-BOOT-H)
+m2/gm2-pge-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-libs/%.mod $(MCDEPS) $(BUILD-BOOT-PGE-H)
-test -d m2/gm2-pge-boot || $(mkinstalldirs) m2/gm2-pge-boot
$(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 -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/gm2-pge-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-compiler/%.mod $(MCDEPS) $(BUILD-BOOT-PGE-H)
-test -d m2/gm2-pge-boot || $(mkinstalldirs) m2/gm2-pge-boot
$(MCC) -o=m2/gm2-pge-boot/$(SRC_PREFIX)$*.c $(srcdir)/m2/gm2-compiler/$*.mod
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -Im2/mc-boot -Im2/gm2-compiler-boot \
-Im2/gm2-libs-boot \
-I$(srcdir)/m2/mc-boot-ch $(INCLUDES) -g -c m2/gm2-pge-boot/$(SRC_PREFIX)$*.c -o $@
-m2/gm2-pge-boot/$(SRC_PREFIX)pge.o: m2/gm2-auto/pge.mod $(MCDEPS) $(BUILD-BOOT-H)
+m2/gm2-pge-boot/$(SRC_PREFIX)pge.o: m2/gm2-auto/pge.mod $(MCDEPS) $(BUILD-BOOT-PGE-H)
-test -d m2/gm2-pge-boot || $(mkinstalldirs) m2/gm2-pge-boot
$(MCC) -o=m2/gm2-pge-boot/$(SRC_PREFIX)pge.c m2/gm2-auto/pge.mod
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) \
# This is only needed in maintainer mode by 'make mc-maintainer' when regenerating the C
# version of mc. We need a working Modula-2 compiler to run mc-maintainer.
-GM2SYS=${HOME}/opt/lib/gcc/x86_64-pc-linux-gnu/12.0.0/m2/m2pim
-GM2PATH=-I$(srcdir)/m2/mc -I$(GM2SYS) -I$(srcdir)/m2 -Im2/gm2-auto -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/gm2-libs-iso
+# GM2SYS=${HOME}/opt/lib/gcc/x86_64-pc-linux-gnu/13.0.0/m2/m2pim
+GM2PATH=-I$(srcdir)/m2/mc \
+ -I$(srcdir)/m2 -Im2/gm2-auto \
+ -fm2-pathname=m2pim -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/gm2-libs-ch \
+ -fm2-pathname=m2iso -I$(srcdir)/m2/gm2-libs-iso -fm2-pathname=-
mc: mc-clean mc-devel
m2/mc-obj/mcp4.mod \
m2/mc-obj/mcp5.mod \
mcflex.c \
- m2/mc-boot-ch/Gabort.o
+ m2/mc-boot-ch/Gabort.o \
+ m2/mc-boot-ch/Gm2rtsdummy.o
$(RM) -rf mc-obj
$(mkinstalldirs) mc-obj
$(CC) -I$(srcdir)/m2/mc -c -g mcflex.c -o mc-obj/mcflex.o
$(BOOTGM2) $(MCLINK) -I. -fscaffold-static -fscaffold-main $(GM2PATH) \
-fuse-list=$(srcdir)/m2/init/mcinit $(srcdir)/m2/mc/top.mod -o mc \
m2/gm2-libs-boot/RTcodummy.o \
- m2/gm2-libs-boot/dtoa.o m2/gm2-libs-boot/ldtoa.o mc-obj/*o m2/mc-boot-ch/Gabort.o
+ m2/gm2-libs-boot/dtoa.o m2/gm2-libs-boot/ldtoa.o mc-obj/*o \
+ m2/mc-boot-ch/Gabort.o m2/mc-boot-ch/Gm2rtsdummy.o
m2/boot-bin/mc-opt$(exeext): m2/mc-obj/mcp1.mod \
m2/mc-obj/mcp2.mod \
mcflex.c
-test -d m2/boot-bin || $(mkinstalldirs) m2/boot-bin
g++ -I$(srcdir)/m2/mc -c -g mcflex.c
- $(BOOTGM2) -fsources -fm2-whole-program -g -I$(srcdir)/m2/mc:$(objdir)/m2/mc-obj -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/mc $(srcdir)/m2/mc/top.mod
+ $(BOOTGM2) -fsources -fm2-whole-program -g -I$(srcdir)/m2/mc -I$(objdir)/m2/mc-obj -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/mc $(srcdir)/m2/mc/top.mod
m2/mc/decl.o: $(srcdir)/m2/mc/decl.mod
-test -d m2/mc || $(mkinstalldirs) m2/mc
-(* DynamicStringPath.def implements a path for DynamicStrings.
+(* DynamicPath.def implements a path for DynamicStrings.
Copyright (C) 2001-2023 Free Software Foundation, Inc.
Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. *)
-DEFINITION MODULE DynamicStringPath ; (*!m2iso+gm2*)
+DEFINITION MODULE DynamicPath ; (*!m2iso+gm2*)
FROM DynamicStrings IMPORT String ;
PathList ;
-(*
- GetUserPath - returns the current UserPath.
-*)
-
-PROCEDURE GetUserPath () : PathList ;
-
-
-(*
- GetSystemPath - returns the current SystemPath.
-*)
-
-PROCEDURE GetSystemPath () : PathList ;
-
-
-(*
- SetUserPath - assigns UserPath to pl.
-*)
-
-PROCEDURE SetUserPath (pl: PathList) ;
-
-
-(*
- SetSystemPath - assigns SystemPath to pl.
-*)
-
-PROCEDURE SetSystemPath (pl: PathList) ;
-
-
(*
InitPathList - creates a new empty path list.
*)
(*
ConsList - concatenates path list left and right together.
- It always returns NIL which should be assigned
- to the callers right parameter after ConsList
- has been completed signifying that right should
- no longer be accessed.
*)
PROCEDURE ConsList (left, right: PathList) : PathList ;
PROCEDURE FindFileName (filename: String; pl: PathList) : String ;
-END DynamicStringPath.
+(*
+ DumpPath - debugging dump of the pathlist.
+*)
+
+PROCEDURE DumpPath (name: String; pl: PathList) ;
+
+
+END DynamicPath.
-(* DynamicStringPath.def implements a path for DynamicStrings.
+(* DynamicPath.mod implements a path for DynamicStrings.
Copyright (C) 2001-2023 Free Software Foundation, Inc.
Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. *)
-IMPLEMENTATION MODULE DynamicStringPath ; (*!m2iso+gm2*)
+IMPLEMENTATION MODULE DynamicPath ; (*!m2iso+gm2*)
FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
FROM DynamicStrings IMPORT InitString, ConCat, ConCatChar, char, Dup,
- KillString, Length ;
+ KillString, Length, EqualArray ;
FROM SFIO IMPORT Exists ;
FROM FIO IMPORT StdErr ;
FROM M2Printf IMPORT fprintf0, fprintf1 ;
VAR
- FreeList,
- DefaultUserPath,
- DefaultSystemPath: PathList ;
-
-
-(*
- GetUserPath - returns the current UserPath.
-*)
-
-PROCEDURE GetUserPath () : PathList ;
-BEGIN
- RETURN DefaultUserPath
-END GetUserPath ;
-
-
-(*
- GetSystemPath - returns the current SystemPath.
-*)
-
-PROCEDURE GetSystemPath () : PathList ;
-BEGIN
- RETURN DefaultSystemPath
-END GetSystemPath ;
-
-
-(*
- SetUserPath - assigns UserPath to pl.
-*)
-
-PROCEDURE SetUserPath (pl: PathList) ;
-BEGIN
- DefaultUserPath := pl ;
- DumpPath ('DefaultUserPath', DefaultUserPath)
-END SetUserPath ;
-
-
-(*
- SetSystemPath - assigns SystemPath to pl.
-*)
-
-PROCEDURE SetSystemPath (pl: PathList) ;
-BEGIN
- DefaultSystemPath := pl ;
- DumpPath ('DefaultSystemPath', DefaultSystemPath)
-END SetSystemPath ;
+ FreeList: PathList ;
(*
(*
ConsList - concatenates path list left and right together.
- It always returns NIL which should be assigned
- to the callers right parameter after ConsList
- has been completed signifying that right should
- no longer be accessed.
*)
PROCEDURE ConsList (left, right: PathList) : PathList ;
DumpPath - debugging dump of the pathlist.
*)
-PROCEDURE DumpPath (name: ARRAY OF CHAR; pl: PathList) ;
+PROCEDURE DumpPath (name: String; pl: PathList) ;
BEGIN
- IF Debugging
- THEN
- fprintf0 (StdErr, name) ;
- fprintf0 (StdErr, ":") ;
- WHILE pl # NIL DO
- fprintf0 (StdErr, " {") ;
- fprintf1 (StdErr, "%s", pl^.entry) ;
- fprintf0 (StdErr, "}") ;
- pl := pl^.next
- END ;
- fprintf0 (StdErr, "\n")
- END
+ fprintf1 (StdErr, "%s:", name) ;
+ WHILE pl # NIL DO
+ fprintf0 (StdErr, " {") ;
+ fprintf1 (StdErr, "%s", pl^.entry) ;
+ fprintf0 (StdErr, "}") ;
+ pl := pl^.next
+ END ;
+ fprintf0 (StdErr, "\n")
END DumpPath ;
BEGIN
- DefaultSystemPath := NIL ;
- DefaultUserPath := NIL ;
FreeList := NIL
-END DynamicStringPath.
+END DynamicPath.
FROM SFIO IMPORT WriteS ;
FROM FIO IMPORT StdOut ;
-FROM DynamicStrings IMPORT String, string, ConCat, KillString, InitString, Mark, InitStringCharStar, ConCatChar ;
+FROM DynamicStrings IMPORT String, string, ConCat, KillString, InitString, Mark, InitStringCharStar, ConCatChar, EqualArray ;
FROM StdIO IMPORT Write ;
FROM StrIO IMPORT WriteString ;
-FROM NameKey IMPORT WriteKey, GetKey, MakeKey, makekey, KeyToCharStar ;
+FROM NameKey IMPORT WriteKey, GetKey, MakeKey, makekey, KeyToCharStar, NulName ;
FROM M2Options IMPORT WholeProgram ;
+FROM M2Printf IMPORT printf1 ;
FROM SymbolTable IMPORT NulSym,
- GetSymName,
+ GetSymName, GetLibName,
GetScope,
GetBaseModule,
IsInnerModule,
FROM m2configure IMPORT UseUnderscoreForC ;
+CONST
+ Debugging = FALSE ;
+
+
(*
StringToKey - returns a Name, from a string and destroys the string.
*)
PROCEDURE GetFullSymName (sym: CARDINAL) : Name ;
VAR
- module: String ;
- scope : CARDINAL ;
+ libname,
+ fullsymname,
+ module : String ;
+ scope : CARDINAL ;
BEGIN
IF IsProcedure (sym) AND IsMonoName (sym)
THEN
ELSE
scope := GetScope (sym) ;
module := GetModulePrefix (InitString (''), sym, scope) ;
- RETURN StringToKey (ConCat (module, InitStringCharStar (KeyToCharStar (GetSymName (sym)))))
+ fullsymname := ConCat (module, InitStringCharStar (KeyToCharStar (GetSymName (sym)))) ;
+ IF (IsVar (sym) OR IsProcedure (sym)) AND IsExportQualified (sym)
+ THEN
+ WHILE NOT IsDefImp (scope) DO
+ scope := GetScope (scope)
+ END ;
+ IF GetLibName (scope) # NulName
+ THEN
+ IF Debugging
+ THEN
+ printf1 ("before sym = %s , ", fullsymname)
+ END ;
+ libname := InitStringCharStar (KeyToCharStar (GetLibName (scope))) ;
+ IF NOT EqualArray (libname, '')
+ THEN
+ IF Debugging
+ THEN
+ printf1 ("libname = %s , ", libname)
+ END ;
+ fullsymname := ConCat (ConCatChar (libname, '_'), fullsymname) ;
+ END ;
+ IF Debugging
+ THEN
+ printf1 ("after sym = %s\n", fullsymname)
+ END
+ END
+ END ;
+ RETURN StringToKey (fullsymname)
END
END GetFullSymName ;
FROM SymbolTable IMPORT GetSymName, IsDefImp, NulSym,
IsHiddenTypeDeclared, GetFirstUsed, GetMainModule, SetMainModule,
ResolveConstructorTypes, SanityCheckConstants, IsDefinitionForC,
- IsBuiltinInModule, PutModLink, IsDefLink, IsModLink ;
+ IsBuiltinInModule, PutModLink, IsDefLink, IsModLink,
+ PutLibName ;
FROM FIO IMPORT StdErr, StdOut ;
FROM NameKey IMPORT Name, GetKey, KeyToCharStar, makekey ;
FROM M2Printf IMPORT fprintf1 ;
FROM M2Quiet IMPORT qprintf0, qprintf1, qprintf2 ;
-FROM DynamicStrings IMPORT String, InitString, KillString, InitStringCharStar, Dup, Mark, string ;
-FROM M2Options IMPORT Verbose ;
+FROM DynamicStrings IMPORT String, InitString, KillString, InitStringCharStar, Dup, Mark, EqualArray, string ;
+FROM M2Options IMPORT Verbose, GetM2Prefix ;
+FROM PathName IMPORT DumpPathName ;
+
CONST
Debugging = FALSE ;
END PeepInto ;
+(*
+ qprintLibName - print the libname
+*)
+
+PROCEDURE qprintLibName (LibName: String) ;
+BEGIN
+ IF (LibName # NIL) AND (NOT EqualArray (LibName, ''))
+ THEN
+ qprintf1 (' [%s]', LibName)
+ END
+END qprintLibName ;
+
+
(*
DoPass0 -
*)
i : CARDINAL ;
SymName,
FileName,
+ LibName,
PPSource: String ;
BEGIN
P0Init ;
i := 1 ;
Sym := GetModuleNo(i) ;
qprintf1('Compiling: %s\n', PPSource) ;
+ IF Debugging
+ THEN
+ DumpPathName ('DoPass0')
+ END ;
IF Verbose
THEN
- fprintf1(StdOut, 'Compiling: %s\n', PPSource) ;
+ fprintf1 (StdOut, 'Compiling: %s\n', PPSource)
END ;
qprintf0('Pass 0: lexical analysis, parsing, modules and associated filenames\n') ;
WHILE Sym#NulSym DO
- SymName := InitStringCharStar(KeyToCharStar(GetSymName(Sym))) ;
- IF IsDefImp(Sym)
+ SymName := InitStringCharStar (KeyToCharStar (GetSymName (Sym))) ;
+ IF IsDefImp (Sym)
THEN
- IF FindSourceDefFile(SymName, FileName)
+ LibName := NIL ;
+ IF FindSourceDefFile (SymName, FileName, LibName)
THEN
ModuleType := Definition ;
- IF OpenSource(AssociateDefinition(PreprocessModule(FileName, FALSE), Sym))
+ IF OpenSource (AssociateDefinition (PreprocessModule (FileName, FALSE), Sym))
THEN
- IF NOT P0SyntaxCheck.CompilationUnit()
+ IF NOT P0SyntaxCheck.CompilationUnit ()
THEN
- WriteFormat0('compilation failed') ;
+ WriteFormat0 ('compilation failed') ;
CloseSource ;
RETURN
END ;
qprintf2 (' Module %-20s : %s', SymName, FileName) ;
+ qprintLibName (LibName) ;
+ PutLibName (Sym, makekey (string (LibName))) ;
IF IsDefinitionForC (Sym)
THEN
qprintf0 (' (for C)')
IF (Main=Sym) OR NeedToParseImplementation(Sym)
THEN
(* only need to read implementation module if hidden types are declared or it is the main module *)
+ LibName := NIL ;
IF Main=Sym
THEN
- FileName := Dup (PPSource)
+ FileName := Dup (PPSource) ;
+ LibName := InitStringCharStar (GetM2Prefix ()) ;
+ PutLibName (Sym, makekey (string (LibName)))
ELSE
- IF FindSourceModFile (SymName, FileName)
+ IF FindSourceModFile (SymName, FileName, LibName)
THEN
- FileName := PreprocessModule (FileName, FALSE)
+ FileName := PreprocessModule (FileName, FALSE) ;
+ PutLibName (Sym, makekey (string (LibName)))
END
END ;
IF FileName#NIL
RETURN
END ;
qprintf2 (' Module %-20s : %s', SymName, FileName) ;
+ qprintLibName (LibName) ;
IF IsModLink (Sym)
THEN
qprintf0 (' (linking)')
THEN
(* The implementation is only useful if -fgen-module-list= is
used and we do not insist upon it. *)
- IF FindSourceModFile (SymName, FileName)
+ LibName := NIL ;
+ IF FindSourceModFile (SymName, FileName, LibName)
THEN
- qprintf2 (' Module %-20s : %s (linking)\n', SymName, FileName) ;
+ PutLibName (Sym, makekey (string (LibName))) ;
+ qprintf2 (' Module %-20s : %s' , SymName, FileName) ;
+ qprintLibName (LibName) ;
+ qprintf0 (' (linking)\n') ;
IF OpenSource (AssociateModule (PreprocessModule (FileName, FALSE), Sym))
THEN
PutModLink (Sym, TRUE) ; (* This source is only used to determine link time info. *)
END ;
SymName := KillString (SymName) ;
FileName := KillString (FileName) ;
+ LibName := KillString (LibName) ;
INC (i) ;
Sym := GetModuleNo (i)
END ;
FROM NameKey IMPORT Name, WriteKey ;
FROM Lists IMPORT InitList, KillList, IncludeItemIntoList, RemoveItemFromList ;
FROM Indexing IMPORT Index, HighIndice, IncludeIndiceIntoIndex, InitIndex, KillIndex, GetIndice ;
-FROM M2Printf IMPORT printf0, printf1, printf2 ;
-FROM SymbolTable IMPORT GetSymName, IsDefinitionForC, IsModule ;
+FROM M2Printf IMPORT printf0, printf1, printf2, printf3 ;
+FROM SymbolTable IMPORT GetSymName, GetLibName, IsDefinitionForC, IsModule ;
CONST
PROCEDURE resolveImports (sorted: List; nptr: node) ;
VAR
- i, n: CARDINAL ;
- name: Name ;
+ i, n: CARDINAL ;
+ libname,
+ name : Name ;
BEGIN
IF nptr^.nstate = initial
THEN
nptr^.nstate := started ;
name := GetSymName (nptr^.moduleSym) ;
+ libname := GetLibName (nptr^.moduleSym) ;
i := 1 ;
n := HighIndice (nptr^.deps) ;
IF Debugging
THEN
- printf2 ("resolving %a %d dependents\n", name, n)
+ printf3 ("resolving %a [%a] %d dependents\n", name, libname, n)
END ;
WHILE i <= n DO
resolveImports (sorted, GetIndice (nptr^.deps, i)) ;
SetRuntimeModuleOverride, GetRuntimeModuleOverride,
SetGenModuleList, GetGenModuleFilename, SharedFlag,
SetB, GetB, SetMD, GetMD, SetMMD, GetMMD, SetObj, GetObj,
- GetMQ, SetMQ ;
+ GetMQ, SetMQ, SetM2Prefix, GetM2Prefix,
+ SetM2PathName, GetM2PathName ;
VAR
Coding,
Profiling : BOOLEAN ;
+
+(*
+ SetM2Prefix - assign arg to M2Prefix.
+*)
+
+PROCEDURE SetM2Prefix (arg: ADDRESS) ;
+
+
+(*
+ GetM2Prefix - return M2Prefix as a C string.
+*)
+
+PROCEDURE GetM2Prefix () : ADDRESS ;
+
+
+(*
+ SetM2PathName - assign arg to M2PathName.
+*)
+
+PROCEDURE SetM2PathName (arg: ADDRESS) ;
+
+
+(*
+ GetM2PathName - return M2PathName as a C string.
+*)
+
+PROCEDURE GetM2PathName () : ADDRESS ;
+
+
(*
SetPPOnly - set the PPonly to value (on E, M, MM).
*)
IMPORT CmdArgs ;
FROM SArgs IMPORT GetArg, Narg ;
FROM M2Search IMPORT SetDefExtension, SetModExtension ;
-FROM DynamicStringPath IMPORT Cons, GetUserPath, SetUserPath, Cons ;
+FROM PathName IMPORT DumpPathName, AddInclude ;
FROM M2Printf IMPORT printf0, printf1, fprintf1 ;
FROM FIO IMPORT StdErr ;
FROM libc IMPORT exit ;
FROM m2linemap IMPORT location_t ;
FROM m2configure IMPORT FullPathCPP ;
+
FROM DynamicStrings IMPORT String, Length, InitString, Mark, Slice, EqualArray,
InitStringCharStar, ConCatChar, ConCat, KillString,
Dup, string,
CONST
Debugging = FALSE ;
+ DefaultRuntimeModuleOverride = "m2iso:RTentity,m2iso:Storage,m2iso:SYSTEM,m2iso:M2RTS,m2iso:RTExceptions,m2iso:IOLink" ;
VAR
+ M2Prefix,
+ M2PathName,
Barg,
MDarg,
MMDarg,
*)
+(*
+ SetM2Prefix - assign arg to M2Prefix.
+*)
+
+PROCEDURE SetM2Prefix (arg: ADDRESS) ;
+BEGIN
+ M2Prefix := KillString (M2Prefix) ;
+ M2Prefix := InitStringCharStar (arg)
+END SetM2Prefix ;
+
+
+(*
+ GetM2Prefix - return M2Prefix as a C string.
+*)
+
+PROCEDURE GetM2Prefix () : ADDRESS ;
+BEGIN
+ RETURN string (M2Prefix)
+END GetM2Prefix ;
+
+
+(*
+ SetM2PathName - assign arg to M2PathName.
+*)
+
+PROCEDURE SetM2PathName (arg: ADDRESS) ;
+BEGIN
+ M2PathName := KillString (M2PathName) ;
+ M2PathName := InitStringCharStar (arg) ;
+ (* fprintf1 (StdErr, "M2PathName = %s\n", M2PathName) *)
+END SetM2PathName ;
+
+
+(*
+ GetM2PathName - return M2PathName as a C string.
+*)
+
+PROCEDURE GetM2PathName () : ADDRESS ;
+BEGIN
+ RETURN string (M2PathName)
+END GetM2PathName ;
+
+
(*
SetB - assigns Barg to arg.
*)
VAR
s: String ;
BEGIN
- s := InitStringCharStar(arg) ;
+ s := InitStringCharStar (arg) ;
+ AddInclude (M2PathName, s) ;
IF Debugging
THEN
- fprintf1 (StdErr, "M2Search.SetSearchPath setting search path to: %s\n", s)
+ DumpPathName ("path name entries: ")
END ;
- SetUserPath (Cons (GetUserPath (), s)) ;
s := KillString (s)
END SetSearchPath ;
BEGIN
cflag := FALSE ; (* -c. *)
- RuntimeModuleOverride := NIL ;
+ RuntimeModuleOverride := InitString (DefaultRuntimeModuleOverride) ;
CppArgs := InitString ('') ;
Pim := TRUE ;
Pim2 := FALSE ;
MMDarg := NIL ;
MQarg := NIL ;
SaveTempsDir := NIL ;
- DumpDir := NIL
+ DumpDir := NIL ;
+ M2Prefix := InitString ('') ;
+ M2PathName := InitString ('')
END M2Options.
GetUnboundedHighOffset,
ForeachFieldEnumerationDo, ForeachLocalSymDo,
- GetExported, PutImported, GetSym,
+ GetExported, PutImported, GetSym, GetLibName,
IsUnused,
NulSym ;
(*
callRequestDependant - create a call:
- RequestDependant (GetSymName (modulesym), GetSymName (depModuleSym));
+ RequestDependant (GetSymName (modulesym), GetLibName (modulesym),
+ GetSymName (depModuleSym), GetLibName (depModuleSym));
*)
PROCEDURE callRequestDependant (tokno: CARDINAL;
PushT (1) ;
BuildAdrFunction ;
+ PushTF (Adr, Address) ;
+ PushTtok (MakeConstLitString (tokno, GetLibName (moduleSym)), tokno) ;
+ PushT (1) ;
+ BuildAdrFunction ;
+
IF depModuleSym = NulSym
THEN
+ PushTF (Nil, Address) ;
PushTF (Nil, Address)
ELSE
PushTF (Adr, Address) ;
PushTtok (MakeConstLitString (tokno, GetSymName (depModuleSym)), tokno) ;
PushT (1) ;
+ BuildAdrFunction ;
+
+ PushTF (Adr, Address) ;
+ PushTtok (MakeConstLitString (tokno, GetLibName (depModuleSym)), tokno) ;
+ PushT (1) ;
BuildAdrFunction
END ;
- PushT (2) ;
+ PushT (4) ;
BuildProcedureCall (tokno)
END callRequestDependant ;
static void
dependencies (void)
{
- M2RTS_RequestDependant (module_name, "b");
- M2RTS_RequestDependant (module_name, NULL);
+ M2RTS_RequestDependant (module_name, libname, "b", "b libname");
+ M2RTS_RequestDependant (module_name, libname, NULL, NULL);
}
*)
(* int
_M2_init (int argc, char *argv[], char *envp[])
{
- M2RTS_ConstructModules (module_name, argc, argv, envp);
+ M2RTS_ConstructModules (module_name, libname, argc, argv, envp);
} *)
PushT (initFunction) ;
BuildProcedureStart ;
PushT(1) ;
BuildAdrFunction ;
+ PushTF(Adr, Address) ;
+ PushTtok (MakeConstLitString (tok, GetLibName (moduleSym)), tok) ;
+ PushT(1) ;
+ BuildAdrFunction ;
+
PushTtok (SafeRequestSym (tok, MakeKey ("argc")), tok) ;
PushTtok (SafeRequestSym (tok, MakeKey ("argv")), tok) ;
PushTtok (SafeRequestSym (tok, MakeKey ("envp")), tok) ;
- PushT (4) ;
+ PushT (5) ;
BuildProcedureCall (tok) ;
END
ELSIF ScaffoldStatic
PushT(1) ;
BuildAdrFunction ;
+ PushTF(Adr, Address) ;
+ PushTtok (MakeConstLitString (tok, GetLibName (moduleSym)), tok) ;
+ PushT(1) ;
+ BuildAdrFunction ;
+
PushTtok (SafeRequestSym (tok, MakeKey ("argc")), tok) ;
PushTtok (SafeRequestSym (tok, MakeKey ("argv")), tok) ;
PushTtok (SafeRequestSym (tok, MakeKey ("envp")), tok) ;
- PushT (4) ;
+ PushT (5) ;
BuildProcedureCall (tok)
END
ELSIF ScaffoldStatic
void
ctorFunction ()
{
- M2RTS_RegisterModule (GetSymName (moduleSym),
+ M2RTS_RegisterModule (GetSymName (moduleSym), GetLibName (moduleSym),
init, fini, dependencies);
}
*)
PushT (1) ;
BuildAdrFunction ;
+ PushTF (Adr, Address) ;
+ PushTtok (MakeConstLitString (tok, GetLibName (moduleSym)), tok) ;
+ PushT (1) ;
+ BuildAdrFunction ;
+
PushTtok (init, tok) ;
PushTtok (fini, tok) ;
PushTtok (dep, tok) ;
- PushT (4) ;
+ PushT (5) ;
BuildProcedureCall (tok)
END ;
EndScope ;
GetSymName, StartScope, EndScope,
GetModuleDefImportStatementList,
GetModuleModImportStatementList,
- GetImportModule, GetImportStatementList ;
+ GetImportModule, GetImportStatementList,
+ PutLibName ;
FROM NameKey IMPORT NulName, Name, MakeKey, makekey, KeyToCharStar ;
FROM M2Base IMPORT Integer, Cardinal ;
FROM Assertion IMPORT Assert ;
FROM Lists IMPORT List, InitList, IncludeItemIntoList, NoOfItemsInList, GetItemFromList, KillList, IsItemInList ;
FROM M2MetaError IMPORT MetaErrorT0, MetaErrorStringT0 ;
+FROM M2Search IMPORT FindSourceDefFile ;
FROM SFIO IMPORT OpenToWrite, WriteS, ReadS, OpenToRead, Exists ;
FROM FIO IMPORT File, EOF, IsNoError, Close ;
+FROM FormatStrings IMPORT Sprintf1 ;
FROM M2Options IMPORT GetUselist, ScaffoldStatic, ScaffoldDynamic, GenModuleList,
GetGenModuleFilename, GetUselistFilename, GetUselist, cflag,
static void _M2_init (int argc, char *argv[], char *envp[])
{
- M2RTS_ConstructModules (module_name, argc, argv, envp);
+ M2RTS_ConstructModules (module_name, libname, argc, argv, envp);
}
static void _M2_fini (int argc, char *argv[], char *envp[])
{
M2RTS_Terminate ();
- M2RTS_DeconstructModules (module_name, argc, argv, envp);
+ M2RTS_DeconstructModules (module_name, libname, argc, argv, envp);
}
PROCEDURE LookupModuleSym (tok: CARDINAL; name: Name) : CARDINAL ;
VAR
- sym: CARDINAL ;
+ sym : CARDINAL ;
+ FileName,
+ LibName : String ;
BEGIN
sym := Get (name) ;
IF sym = NulSym
THEN
- sym := MakeDefImp (tok, name)
- END ;
- IF sym # GetMainModule ()
- THEN
- PutModuleCtorExtern (tok, sym, NOT WholeProgram)
+ LibName := NIL ;
+ FileName := NIL ;
+ IF FindSourceDefFile (InitStringCharStar (KeyToCharStar (name)),
+ FileName, LibName)
+ THEN
+ sym := MakeDefImp (tok, name) ;
+ PutLibName (sym, makekey (string (LibName))) ;
+ IF sym # GetMainModule ()
+ THEN
+ PutModuleCtorExtern (tok, sym, NOT WholeProgram)
+ END
+ ELSE
+ MetaErrorStringT0 (tok,
+ Sprintf1 (InitString ('the definition module file for {%%1a} cannot be found'),
+ name))
+ END
END ;
RETURN sym
END LookupModuleSym ;
FullPath will be totally overwritten and should
not be initialized by InitString before this function
is called.
+ FullPath is set to NIL if this function returns FALSE.
FindSourceFile sets FullPath to a new string if successful.
+ The string FileName is not altered.
*)
PROCEDURE FindSourceFile (FileName: String;
- VAR FullPath: String) : BOOLEAN ;
+ VAR FullPath, named: String) : BOOLEAN ;
(*
then FALSE is returned and FullPath is set to NIL.
*)
-PROCEDURE FindSourceDefFile (Stem: String; VAR FullPath: String) : BOOLEAN ;
+PROCEDURE FindSourceDefFile (Stem: String; VAR FullPath, named: String) : BOOLEAN ;
(*
then FALSE is returned and FullPath is set to NIL.
*)
-PROCEDURE FindSourceModFile (Stem: String; VAR FullPath: String) : BOOLEAN ;
+PROCEDURE FindSourceModFile (Stem: String; VAR FullPath, named: String) : BOOLEAN ;
(*
PROCEDURE SetModExtension (ext: String) ;
+
+
END M2Search.
FROM M2FileName IMPORT CalculateFileName ;
FROM Assertion IMPORT Assert ;
-FROM DynamicStringPath IMPORT GetUserPath, GetSystemPath, FindFileName ;
+FROM PathName IMPORT FindNamedPathFile ;
FROM DynamicStrings IMPORT InitString, InitStringChar,
KillString, ConCat, ConCatChar, Index, Slice,
(*
doDSdbEnter - called when compiled with -fcpp to enable runtime garbage
collection debugging.
+*)
+(*
PROCEDURE doDSdbEnter ;
BEGIN
PushAllocation
doDSdbExit - called when compiled with -fcpp to enable runtime garbage
collection debugging. The parameter string s is exempt from
garbage collection analysis.
+*)
+(*
PROCEDURE doDSdbExit (s: String) ;
BEGIN
(* Check to see whether no strings have been lost since the PushAllocation. *)
is called.
FullPath is set to NIL if this function returns FALSE.
FindSourceFile sets FullPath to a new string if successful.
- The string, FileName, is not altered.
+ The string FileName is not altered.
*)
PROCEDURE FindSourceFile (FileName: String;
- VAR FullPath: String) : BOOLEAN ;
+ VAR FullPath, named: String) : BOOLEAN ;
BEGIN
- FullPath := FindFileName (FileName, GetUserPath ()) ;
- IF FullPath = NIL
- THEN
- FullPath := FindFileName (FileName, GetSystemPath ())
- END ;
+ FullPath := FindNamedPathFile (FileName, named) ;
RETURN FullPath # NIL
END FindSourceFile ;
then FALSE is returned and FullPath is set to NIL.
*)
-PROCEDURE FindSourceDefFile (Stem: String; VAR FullPath: String) : BOOLEAN ;
+PROCEDURE FindSourceDefFile (Stem: String; VAR FullPath, named: String) : BOOLEAN ;
VAR
f: String ;
BEGIN
IF Def # NIL
THEN
f := CalculateFileName (Stem, Def) ;
- IF FindSourceFile (f, FullPath)
+ IF FindSourceFile (f, FullPath, named)
THEN
RETURN TRUE
END ;
f := KillString (f)
END ;
(* Try the GNU Modula-2 default extension. *)
- f := CalculateFileName (Stem, Mark(InitString ('def'))) ;
- RETURN FindSourceFile (f, FullPath)
+ f := CalculateFileName (Stem, Mark (InitString ('def'))) ;
+ RETURN FindSourceFile (f, FullPath, named)
END FindSourceDefFile ;
then FALSE is returned and FullPath is set to NIL.
*)
-PROCEDURE FindSourceModFile (Stem: String; VAR FullPath: String) : BOOLEAN ;
+PROCEDURE FindSourceModFile (Stem: String; VAR FullPath, named: String) : BOOLEAN ;
VAR
f: String ;
BEGIN
IF Mod#NIL
THEN
f := CalculateFileName (Stem, Mod) ;
- IF FindSourceFile (f, FullPath)
+ IF FindSourceFile (f, FullPath, named)
THEN
RETURN TRUE
END ;
f := KillString (f)
END ;
(* Try the GNU Modula-2 default extension. *)
- f := CalculateFileName (Stem, Mark(InitString ('mod'))) ;
- RETURN FindSourceFile (f, FullPath)
+ f := CalculateFileName (Stem, Mark (InitString ('mod'))) ;
+ RETURN FindSourceFile (f, FullPath, named)
END FindSourceModFile ;
PROCEDURE SetDefExtension (ext: String) ;
BEGIN
- Def := KillString(Def) ;
- Def := Dup(ext)
+ Def := KillString (Def) ;
+ Def := Dup (ext)
END SetDefExtension ;
PROCEDURE SetModExtension (ext: String) ;
BEGIN
- Mod := KillString(Mod) ;
- Mod := Dup(ext)
+ Mod := KillString (Mod) ;
+ Mod := Dup (ext)
END SetModExtension ;
--- /dev/null
+DEFINITION MODULE PathName ;
+
+(*
+ Title : PathName
+ Author : Gaius Mulley
+ System : GNU Modula-2
+ Date : Wed Feb 8 09:59:46 2023
+ Revision : $Version$
+ Description: maintains a dictionary of named paths.
+*)
+
+FROM DynamicStrings IMPORT String ;
+FROM DynamicPath IMPORT PathList ;
+
+
+TYPE
+ NamedPath ;
+
+
+(*
+ FindNamedPathFile - returns NIL if a file cannot be found otherwise
+ it returns the path including the filename.
+ It also returns the name of the path.
+*)
+
+PROCEDURE FindNamedPathFile (filename: String; VAR name: String) : String ;
+
+
+(*
+ AddInclude - adds include path to the named path. If named path
+ is the same as the previous call then the include path
+ is appended to the named path PathList otherwise a new
+ named path is created and placed at the end of the
+ named path list.
+
+ However if named is NIL or empty string then this is treated
+ as a user path and it will be appended to the first user
+ named list entry. The user entry will always be the
+ first node in the dictionary of named paths.
+*)
+
+PROCEDURE AddInclude (named, directory: String) ;
+
+
+(*
+ InitNamedPath - creates a new path name with an associated pathlist.
+*)
+
+PROCEDURE InitNamedPath (name: String; pl: PathList) : NamedPath ;
+
+
+(*
+ KillNamedPath - places list np onto the freelist.
+ Postcondition: np will be NIL.
+*)
+
+PROCEDURE KillNamedPath (VAR np: NamedPath) ;
+
+
+(*
+ Cons - appends pl to the end of a named path.
+ If np is NIL a new list is created and returned
+ containing named and pl.
+*)
+
+PROCEDURE Cons (np: NamedPath; named: String; pl: PathList) : NamedPath ;
+
+
+(*
+ ConsList - concatenates named path left and right together.
+*)
+
+PROCEDURE ConsList (left, right: NamedPath) : NamedPath ;
+
+
+(*
+ Stash - returns np before setting np to NIL.
+*)
+
+PROCEDURE Stash (VAR np: NamedPath) : NamedPath ;
+
+
+(*
+ SetNamedPath - assigns the named path to the default path.
+*)
+
+PROCEDURE SetNamedPath (named: NamedPath) ;
+
+
+(*
+ GetNamedPath - returns the default named path.
+*)
+
+PROCEDURE GetNamedPath () : NamedPath ;
+
+
+(*
+ DumpPathName - display the dictionary of names and all path entries.
+*)
+
+PROCEDURE DumpPathName (name: ARRAY OF CHAR) ;
+
+
+END PathName.
--- /dev/null
+IMPLEMENTATION MODULE PathName ;
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM DynamicStrings IMPORT InitString, ConCat, ConCatChar, char, Dup,
+ KillString, Length, EqualArray, Equal, Mark ;
+FROM SFIO IMPORT Exists ;
+FROM FIO IMPORT StdErr ;
+FROM M2Printf IMPORT fprintf0, fprintf1, fprintf2 ;
+FROM FormatStrings IMPORT Sprintf1 ;
+
+FROM DynamicPath IMPORT InitPathList, FindFileName ;
+
+IMPORT DynamicPath ;
+
+
+CONST
+ Debugging = FALSE ;
+
+TYPE
+ NamedPath = POINTER TO RECORD
+ pathList: PathList ;
+ name : String ;
+ tail,
+ next : NamedPath ;
+ END ;
+
+
+VAR
+ FreeList,
+ NamedPathHead: NamedPath ;
+
+
+
+(*
+ AddSystem -
+*)
+
+PROCEDURE AddSystem (named, directory: String) ;
+BEGIN
+ IF NamedPathHead = NIL
+ THEN
+ (* Empty dictionary add single entry. *)
+ SetNamedPath (InitNamedPath (named, InitPathList (directory)))
+ ELSIF Equal (NamedPathHead^.tail^.name, named)
+ THEN
+ NamedPathHead^.tail^.pathList := DynamicPath.Cons (NamedPathHead^.tail^.pathList,
+ directory)
+ ELSE
+ SetNamedPath (ConsList (NamedPathHead,
+ InitNamedPath (named, InitPathList (directory))))
+ END
+END AddSystem ;
+
+
+(*
+ AddUser -
+*)
+
+PROCEDURE AddUser (named, directory: String) ;
+BEGIN
+ IF NamedPathHead = NIL
+ THEN
+ (* Empty dictionary add single entry. *)
+ SetNamedPath (InitNamedPath (named, InitPathList (directory)))
+ ELSIF EqualArray (NamedPathHead^.name, '')
+ THEN
+ (* Found user node. *)
+ NamedPathHead^.pathList := DynamicPath.Cons (NamedPathHead^.pathList,
+ directory)
+ ELSE
+ (* No user node yet, so we will create one. *)
+ NamedPathHead := ConsList (InitNamedPath (named, InitPathList (directory)),
+ NamedPathHead) ;
+ SetNamedPath (NamedPathHead)
+ END
+END AddUser ;
+
+
+(*
+ AddInclude - adds include path to the named path. If named path
+ is the same as the previous call then the include path
+ is appended to the named path PathList otherwise a new
+ named path is created and placed at the end of the
+ named path list.
+*)
+
+PROCEDURE AddInclude (named, directory: String) ;
+BEGIN
+ IF Debugging
+ THEN
+ fprintf2 (StdErr, "named = %s, directory =%s\n",
+ named, directory)
+ END ;
+ IF (named = NIL) OR EqualArray (named, '')
+ THEN
+ AddUser (named, directory) ;
+ IF Debugging
+ THEN
+ DumpPathName ('User pathname')
+ END
+ ELSE
+ AddSystem (named, directory) ;
+ IF Debugging
+ THEN
+ DumpPathName ('System pathname')
+ END
+ END
+END AddInclude ;
+
+
+(*
+ SetNamedPath - assigns the named path to the default path.
+*)
+
+PROCEDURE SetNamedPath (named: NamedPath) ;
+BEGIN
+ NamedPathHead := named
+END SetNamedPath ;
+
+
+(*
+ GetNamedPath - returns the default named path.
+*)
+
+PROCEDURE GetNamedPath () : NamedPath ;
+BEGIN
+ RETURN NamedPathHead
+END GetNamedPath ;
+
+
+(*
+ KillNamedPath - places list np onto the freelist.
+ Postcondition: np will be NIL.
+*)
+
+PROCEDURE KillNamedPath (VAR np: NamedPath) ;
+BEGIN
+ IF np # NIL
+ THEN
+ np^.tail^.next := FreeList ;
+ FreeList := np ;
+ np := NIL
+ END
+END KillNamedPath ;
+
+
+(*
+ ConsList - concatenates named path left and right together.
+*)
+
+PROCEDURE ConsList (left, right: NamedPath) : NamedPath ;
+BEGIN
+ IF right # NIL
+ THEN
+ left^.tail^.next := right ;
+ left^.tail := right^.tail
+ END ;
+ RETURN left
+END ConsList ;
+
+
+(*
+ Cons - appends pl to the end of a named path.
+ If np is NIL a new list is created and returned
+ containing named and pl.
+*)
+
+PROCEDURE Cons (np: NamedPath; named: String; pl: PathList) : NamedPath ;
+BEGIN
+ IF np = NIL
+ THEN
+ np := InitNamedPath (named, pl)
+ ELSE
+ np := ConsList (np, InitNamedPath (named, pl))
+ END ;
+ RETURN np
+END Cons ;
+
+
+(*
+ Stash - returns np before setting np to NIL.
+*)
+
+PROCEDURE Stash (VAR np: NamedPath) : NamedPath ;
+VAR
+ old: NamedPath ;
+BEGIN
+ old := np ;
+ np := NIL ;
+ RETURN old
+END Stash ;
+
+
+(*
+ InitNamedPath - creates a new path name with an associated pathlist.
+*)
+
+PROCEDURE InitNamedPath (name: String; pl: PathList) : NamedPath ;
+VAR
+ np: NamedPath ;
+BEGIN
+ NEW (np) ;
+ IF np = NIL
+ THEN
+ HALT
+ ELSE
+ np^.pathList := pl ;
+ np^.name := Dup (name) ;
+ np^.next := NIL ;
+ np^.tail := np
+ END ;
+ RETURN np
+END InitNamedPath ;
+
+
+(*
+ FindNamedPathFile - Post-condition: returns NIL if a file cannot be found otherwise
+ it returns the path including the filename.
+ It also returns a new string the name of the path.
+ Pre-condition: if name = NIL then it searches
+ user path first, followed by any
+ named path.
+ elsif name = ''
+ then
+ search user path
+ else
+ search named path
+ fi
+*)
+
+PROCEDURE FindNamedPathFile (filename: String; VAR name: String) : String ;
+VAR
+ foundFile: String ;
+ np : NamedPath ;
+BEGIN
+ np := NamedPathHead ;
+ WHILE np # NIL DO
+ IF (name = NIL) OR Equal (np^.name, name)
+ THEN
+ foundFile := FindFileName (filename, np^.pathList) ;
+ IF foundFile # NIL
+ THEN
+ name := Dup (np^.name) ;
+ RETURN foundFile
+ END
+ END ;
+ np := np^.next
+ END ;
+ name := NIL ;
+ RETURN NIL
+END FindNamedPathFile ;
+
+
+(*
+ DumpPathName - display the dictionary of names and all path entries.
+*)
+
+PROCEDURE DumpPathName (name: ARRAY OF CHAR) ;
+VAR
+ np : NamedPath ;
+ leader: String ;
+BEGIN
+ fprintf0 (StdErr, name) ;
+ fprintf0 (StdErr, " = {\n") ;
+ np := NamedPathHead ;
+ WHILE np # NIL DO
+ leader := Sprintf1 (Mark (InitString (" %s")), np^.name) ;
+ DynamicPath.DumpPath (leader, np^.pathList) ;
+ leader := KillString (leader) ;
+ np := np^.next
+ END ;
+ fprintf0 (StdErr, "}\n")
+END DumpPathName ;
+
+
+BEGIN
+ NamedPathHead := NIL ;
+ FreeList := NIL
+END PathName.
PutModuleContainsBuiltin, IsBuiltinInModule,
HasVarParameters,
GetErrorScope,
+ GetLibName, PutLibName,
IsSizeSolved,
IsOffsetSolved,
MakeProcedureCtorExtern - creates an extern ctor procedure
*)
-PROCEDURE MakeProcedureCtorExtern (tokenno: CARDINAL; modulename: Name) : CARDINAL ;
+PROCEDURE MakeProcedureCtorExtern (tokenno: CARDINAL; libname, modulename: Name) : CARDINAL ;
+
+
+(*
+ PutLibName - places libname into defimp or module sym.
+*)
+
+PROCEDURE PutLibName (sym: CARDINAL; libname: Name) ;
+
+
+(*
+ GetLibName - returns libname associated with a defimp or module sym.
+*)
+
+PROCEDURE GetLibName (sym: CARDINAL) : Name ;
(*
RECORD
name : Name ; (* Index into name array, name *)
(* of record field. *)
+ libname : Name ; (* Library (dialect) with module *)
ctors : ModuleCtor ; (* All the ctor functions. *)
DefListOfDep,
ModListOfDep : List ; (* Vector of SymDependency. *)
RECORD
name : Name ; (* Index into name array, name *)
(* of record field. *)
+ libname : Name ; (* Library (dialect) with module *)
ctors : ModuleCtor ; (* All the ctor functions. *)
ModListOfDep : List ; (* Vector of SymDependency. *)
LocalSymbols : SymbolTree ; (* The LocalSymbols hold all the *)
MakeProcedureCtorExtern - creates an extern ctor procedure
*)
-PROCEDURE MakeProcedureCtorExtern (tokenno: CARDINAL; modulename: Name) : CARDINAL ;
+PROCEDURE MakeProcedureCtorExtern (tokenno: CARDINAL; libname, modulename: Name) : CARDINAL ;
VAR
ctor: CARDINAL ;
BEGIN
- ctor := MakeProcedure (tokenno, GenName ('_M2_', modulename, '_ctor')) ;
+ ctor := MakeProcedure (tokenno, GenName (libname, '_M2_', modulename, '_ctor')) ;
PutExtern (ctor, TRUE) ;
RETURN ctor
END MakeProcedureCtorExtern ;
GenName - returns a new name consisting of pre, name, post concatenation.
*)
-PROCEDURE GenName (pre: ARRAY OF CHAR; name: Name; post: ARRAY OF CHAR) : Name ;
+PROCEDURE GenName (libname: Name; pre: ARRAY OF CHAR; name: Name; post: ARRAY OF CHAR) : Name ;
VAR
str : String ;
result: Name ;
BEGIN
- str := InitString (pre) ;
+ str := InitStringCharStar (KeyToCharStar (libname)) ;
+ str := ConCat (str, Mark (InitString (pre))) ;
str := ConCat (str, Mark (InitStringCharStar (KeyToCharStar (name)))) ;
str := ConCat (str, InitString (post)) ;
result := makekey (string (str)) ;
IF IsDefImp (moduleSym)
THEN
InitCtorFields (moduleTok, beginTok, finallyTok,
+ moduleSym,
pSym^.DefImp.ctors, GetSymName (moduleSym),
FALSE, TRUE)
ELSE
InitCtorFields (moduleTok, beginTok, finallyTok,
+ moduleSym,
pSym^.Module.ctors, GetSymName (moduleSym),
IsInnerModule (moduleSym), TRUE)
END
*)
PROCEDURE InitCtorFields (moduleTok, beginTok, finallyTok: CARDINAL;
+ moduleSym: CARDINAL;
VAR ctor: ModuleCtor; name: Name;
inner, pub: BOOLEAN) ;
BEGIN
IF ScaffoldDynamic AND (NOT inner)
THEN
(* The ctor procedure must be public. *)
- ctor.ctor := MakeProcedure (moduleTok, GenName ("_M2_", name, "_ctor")) ;
+ ctor.ctor := MakeProcedure (moduleTok,
+ GenName (GetLibName (moduleSym),
+ "_M2_", name, "_ctor")) ;
PutCtor (ctor.ctor, TRUE) ;
Assert (pub) ;
PutPublic (ctor.ctor, pub) ;
PutExtern (ctor.ctor, NOT pub) ;
PutMonoName (ctor.ctor, TRUE) ;
(* The dep procedure is local to the module. *)
- ctor.dep := MakeProcedure (moduleTok, GenName ("_M2_", name, "_dep")) ;
+ ctor.dep := MakeProcedure (moduleTok,
+ GenName (GetLibName (moduleSym),
+ "_M2_", name, "_dep")) ;
PutMonoName (ctor.dep, TRUE)
ELSE
ctor.ctor := NulSym ;
ctor.dep := NulSym
END ;
(* The init/fini procedures must be public. *)
- ctor.init := MakeProcedure (beginTok, GenName ("_M2_", name, "_init")) ;
+ ctor.init := MakeProcedure (beginTok,
+ GenName (GetLibName (moduleSym),
+ "_M2_", name, "_init")) ;
PutPublic (ctor.init, pub) ;
PutExtern (ctor.init, NOT pub) ;
PutMonoName (ctor.init, NOT inner) ;
DeclareArgEnvParams (beginTok, ctor.init) ;
- ctor.fini := MakeProcedure (finallyTok, GenName ("_M2_", name, "_fini")) ;
+ ctor.fini := MakeProcedure (finallyTok,
+ GenName (GetLibName (moduleSym),
+ "_M2_", name, "_fini")) ;
PutPublic (ctor.fini, pub) ;
PutExtern (ctor.fini, NOT pub) ;
PutMonoName (ctor.fini, NOT inner) ;
WITH Module DO
name := ModuleName ; (* Index into name array, name *)
(* of record field. *)
+ libname := NulName ; (* Library association. *)
InitCtor (ctors) ; (* Init all ctor functions. *)
InitList(ModListOfDep) ; (* Vector of SymDependency. *)
InitTree(LocalSymbols) ; (* The LocalSymbols hold all the *)
WITH Module DO
name := ModuleName ; (* Index into name array, name *)
(* of record field. *)
+ libname := NulName ; (* Library association. *)
InitCtor (ctors) ; (* Init all ctor functions. *)
InitTree(LocalSymbols) ; (* The LocalSymbols hold all the *)
(* variables declared local to *)
WITH DefImp DO
name := DefImpName ; (* Index into name array, name *)
(* of record field. *)
+ libname := NulName ; (* Library association. *)
InitCtor (ctors) ;
(* Init all ctor functions. *)
InitList(DefListOfDep) ; (* Vector of SymDependency. *)
END MakeDefImp ;
+(*
+ PutLibName - places libname into defimp or module sym.
+*)
+
+PROCEDURE PutLibName (sym: CARDINAL; libname: Name) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ Assert (IsModule (sym) OR IsDefImp (sym)) ;
+ pSym := GetPsym (sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ DefImpSym: DefImp.libname := libname |
+ ModuleSym: Module.libname := libname
+
+ ELSE
+ InternalError ('expecting DefImp or Module symbol')
+ END
+ END
+END PutLibName ;
+
+
+(*
+ GetLibName - returns libname associated with a defimp or module sym.
+*)
+
+PROCEDURE GetLibName (sym: CARDINAL) : Name ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ Assert (IsModule (sym) OR IsDefImp (sym)) ;
+ pSym := GetPsym (sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ DefImpSym: RETURN DefImp.libname |
+ ModuleSym: RETURN Module.libname
+
+ ELSE
+ InternalError ('expecting DefImp or Module symbol')
+ END
+ END
+END GetLibName ;
+
+
(*
PutProcedureExternPublic - if procedure is not NulSym set extern
and public booleans.
(* If the ctor does not exist then make it extern/ (~extern) public. *)
IF ctor.ctor = NulSym
THEN
- ctor.ctor := MakeProcedure (tok, GenName ("_M2_", GetSymName (sym), "_ctor")) ;
+ ctor.ctor := MakeProcedure (tok, GenName (GetLibName (sym), "_M2_", GetSymName (sym), "_ctor")) ;
PutMonoName (ctor.ctor, TRUE)
END ;
PutProcedureExternPublic (ctor.ctor, extern, NOT extern) ;
(* If the ctor does not exist then make it extern/ (~extern) public. *)
IF ctor.dep = NulSym
THEN
- ctor.dep := MakeProcedure (tok, GenName ("_M2_", GetSymName (sym), "_dep")) ;
+ ctor.dep := MakeProcedure (tok, GenName (GetLibName (sym), "_M2_", GetSymName (sym), "_dep")) ;
PutMonoName (ctor.dep, TRUE)
END ;
PutProcedureExternPublic (ctor.dep, extern, NOT extern) ;
(* If init/fini do not exist then create them. *)
IF ctor.init = NulSym
THEN
- ctor.init := MakeProcedure (tok, GenName ("_M2_", GetSymName (sym), "_init")) ;
+ ctor.init := MakeProcedure (tok, GenName (GetLibName (sym), "_M2_", GetSymName (sym), "_init")) ;
DeclareArgEnvParams (tok, ctor.init) ;
PutMonoName (ctor.init, NOT IsInnerModule (sym))
END ;
PutProcedureExternPublic (ctor.init, extern, NOT extern) ;
IF ctor.fini = NulSym
THEN
- ctor.fini := MakeProcedure (tok, GenName ("_M2_", GetSymName (sym), "_fini")) ;
+ ctor.fini := MakeProcedure (tok, GenName (GetLibName (sym), "_M2_", GetSymName (sym), "_fini")) ;
DeclareArgEnvParams (tok, ctor.fini) ;
PutMonoName (ctor.fini, NOT IsInnerModule (sym))
END ;
EXTERN void _M2_M2Preprocess_init (int argc, char *argv[], char *envp[]);
EXTERN void _M2_M2Error_init (int argc, char *argv[], char *envp[]);
EXTERN void _M2_M2Search_init (int argc, char *argv[], char *envp[]);
-EXTERN void _M2_DynamicStringPath_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_DynamicPath_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_PathName_init (int argc, char *argv[], char *envp[]);
EXTERN void _M2_Indexing_init (int argc, char *argv[], char *envp[]);
EXTERN void _M2_NameKey_init (int argc, char *argv[], char *envp[]);
EXTERN void _M2_NumberIO_init (int argc, char *argv[], char *envp[]);
_M2_StrLib_init (0, NULL, NULL);
_M2_dtoa_init (0, NULL, NULL);
_M2_ldtoa_init (0, NULL, NULL);
- _M2_DynamicStringPath_init (0, NULL, NULL);
+ _M2_DynamicPath_init (0, NULL, NULL);
+ _M2_PathName_init (0, NULL, NULL);
_M2_M2Search_init (0, NULL, NULL);
_M2_M2Options_init (0, NULL, NULL);
}
m2block_pushGlobalScope ();
/* Generate: int M2LINK_StaticInitialization = ScaffoldStatic; */
tree init = m2decl_BuildIntegerConstant (ScaffoldStatic);
- tree static_init = m2decl_DeclareKnownVariable (location, "M2LINK_StaticInitialization",
+ tree static_init = m2decl_DeclareKnownVariable (location, "m2pim_M2LINK_StaticInitialization",
integer_type_node,
TRUE, FALSE, FALSE, TRUE, NULL_TREE, init);
m2block_popGlobalScope ();
tree ptr_to_char = build_pointer_type (char_type_node);
TYPE_READONLY (ptr_to_char) = TRUE;
tree init = m2decl_BuildPtrToTypeString (location, RuntimeOverride, ptr_to_char);
- tree forced_order = m2decl_DeclareKnownVariable (location, "M2LINK_ForcedModuleInitOrder",
+ tree forced_order = m2decl_DeclareKnownVariable (location, "m2pim_M2LINK_ForcedModuleInitOrder",
ptr_to_char,
TRUE, FALSE, FALSE, TRUE, NULL_TREE, init);
m2block_popGlobalScope ();
EXTERN char *M2Options_GetMQ (void);
EXTERN void M2Options_SetObj (const char *arg);
EXTERN char *M2Options_GetObj (void);
+EXTERN void M2Options_SetM2Prefix (const char *arg);
+EXTERN char *M2Options_GetM2Prefix (void);
+EXTERN void M2Options_SetM2PathName (const char *arg);
+EXTERN char *M2Options_GetM2PathName (void);
#undef EXTERN
#endif /* m2options_h. */
/* We default to pim in the absence of fiso. */
static bool iso = false;
+typedef struct named_path_s {
+ std::vector<const char*>path;
+ const char *name;
+} named_path;
+
+
/* The language include paths are based on the libraries in use. */
static bool allow_libraries = true;
static const char *flibs = nullptr;
static const char *iprefix = nullptr;
static const char *imultilib = nullptr;
-static std::vector<const char*>Ipaths;
+static std::vector<named_path>Ipaths;
static std::vector<const char*>isystem;
static std::vector<const char*>iquote;
return filename_cpp[i];
}
+static void
+push_back_Ipath (const char *arg)
+{
+ if (Ipaths.empty ())
+ {
+ named_path np;
+ np.path.push_back (arg);
+ np.name = xstrdup (M2Options_GetM2PathName ());
+ Ipaths.push_back (np);
+ }
+ else
+ {
+ if (strcmp (Ipaths.back ().name,
+ M2Options_GetM2PathName ()) == 0)
+ Ipaths.back ().path.push_back (arg);
+ else
+ {
+ named_path np;
+ np.path.push_back (arg);
+ np.name = xstrdup (M2Options_GetM2PathName ());
+ Ipaths.push_back (np);
+ }
+ }
+}
+
/* Handle gm2 specific options. Return 0 if we didn't do anything. */
bool
switch (code)
{
case OPT_I:
- Ipaths.push_back (arg);
+ push_back_Ipath (arg);
return 1;
case OPT_fiso:
M2Options_SetISO (value);
M2Options_SetM2g (value);
return 1;
break;
+ case OPT_fm2_pathname_:
+ if (strcmp (arg, "-") == 0)
+ M2Options_SetM2PathName ("");
+ else
+ M2Options_SetM2PathName (arg);
+ return 1;
+ break;
+ case OPT_fm2_pathnameI:
+ push_back_Ipath (arg);
+ return 1;
+ break;
+ case OPT_fm2_prefix_:
+ if (strcmp (arg, "-") == 0)
+ M2Options_SetM2Prefix ("");
+ else
+ M2Options_SetM2Prefix (arg);
+ return 1;
+ break;
case OPT_iprefix:
iprefix = arg;
return 1;
strcat (lib, "m2");
strcat (lib, dir_sep);
strcat (lib, libname);
+ M2Options_SetM2PathName (libname);
M2Options_SetSearchPath (lib);
}
for (auto *s : iquote)
M2Options_SetSearchPath (s);
iquote.clear();
- for (auto *s : Ipaths)
- M2Options_SetSearchPath (s);
+ for (auto np : Ipaths)
+ {
+ M2Options_SetM2PathName (np.name);
+ for (auto *s : np.path)
+ M2Options_SetSearchPath (s);
+ }
Ipaths.clear();
for (auto *s : isystem)
M2Options_SetSearchPath (s);
ArgCVEnvP = PROCEDURE (INTEGER, ADDRESS, ADDRESS) ;
-PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+PROCEDURE ConstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
-PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+PROCEDURE DeconstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
explored to determine initialization order.
*)
-PROCEDURE RegisterModule (name: ADDRESS;
+PROCEDURE RegisterModule (name, libname: ADDRESS;
init, fini: ArgCVEnvP;
dependencies: PROC) ;
module dependantmodule.
*)
-PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+PROCEDURE RequestDependant (modulename, libname,
+ dependantmodule, dependantlibname: ADDRESS) ;
(*
module constructor in turn.
*)
-PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+PROCEDURE ConstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
BEGIN
- M2Dependent.ConstructModules (applicationmodule, argc, argv, envp)
+ M2Dependent.ConstructModules (applicationmodule, libname,
+ argc, argv, envp)
END ConstructModules ;
module constructor in turn.
*)
-PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+PROCEDURE DeconstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
BEGIN
- M2Dependent.DeconstructModules (applicationmodule, argc, argv, envp)
+ M2Dependent.DeconstructModules (applicationmodule, libname,
+ argc, argv, envp)
END DeconstructModules ;
explored to determine initialization order.
*)
-PROCEDURE RegisterModule (name: ADDRESS;
+PROCEDURE RegisterModule (name, libname: ADDRESS;
init, fini: ArgCVEnvP;
dependencies: PROC) ;
BEGIN
- M2Dependent.RegisterModule (name, init, fini, dependencies)
+ M2Dependent.RegisterModule (name, libname, init, fini, dependencies)
END RegisterModule ;
module dependantmodule.
*)
-PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+PROCEDURE RequestDependant (modulename, libname,
+ dependantmodule, dependantlibname: ADDRESS) ;
BEGIN
- M2Dependent.RequestDependant (modulename, dependantmodule)
+ M2Dependent.RequestDependant (modulename, libname,
+ dependantmodule, dependantlibname)
END RequestDependant ;
+++ /dev/null
-/* wrapsock.c implements access to low level client socket primitives.
-
-Copyright (C) 2008-2023 Free Software Foundation, Inc.
-Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
-
-This file is part of GNU Modula-2.
-
-GNU Modula-2 is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 3, or (at your option)
-any later version.
-
-GNU Modula-2 is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-General Public License for more details.
-
-Under Section 7 of GPL version 3, you are granted additional
-permissions described in the GCC Runtime Library Exception, version
-3.1, as published by the Free Software Foundation.
-
-You should have received a copy of the GNU General Public License and
-a copy of the GCC Runtime Library Exception along with this program;
-see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
-<http://www.gnu.org/licenses/>. */
-
-#include <p2c/p2c.h>
-
-#if defined(HAVE_SYS_TYPES_H)
-# include <sys/types.h>
-#endif
-
-#if defined(HAVE_SYS_SOCKET_H)
-# include <sys/socket.h>
-#endif
-
-#include <netinet/in.h>
-#include <netdb.h>
-
-#if defined(HAVE_UNISTD_H)
-# include <unistd.h>
-#endif
-
-#if defined(HAVE_SIGNAL_H)
-# include <signal.h>
-#endif
-
-#if defined(HAVE_SYS_ERRNO_H)
-# include <sys/errno.h>
-#endif
-
-#if defined(HAVE_ERRNO_H)
-# include <errno.h>
-#endif
-
-#if defined(HAVE_MALLOC_H)
-# include <malloc.h>
-#endif
-
-#if defined(HAVE_SIGNAL_H)
-# include <signal.h>
-#endif
-
-#if defined(HAVE_STRING_H)
-# include <string.h>
-#endif
-
-#if defined(HAVE_STDLIB_H)
-# include <stdlib.h>
-#endif
-
-#if !defined(TRUE)
-# define TRUE (1==1)
-#endif
-#if !defined(FALSE)
-# define FALSE (1==0)
-#endif
-
-#include "ChanConsts.h"
-
-#define MAXHOSTNAME 1024
-#define MAXPBBUF 1024
-
-
-typedef struct {
- char hostname[MAXHOSTNAME];
- struct hostent *hp;
- struct sockaddr_in sa;
- int sockFd;
- int portNo;
- int hasChar;
- char pbChar[MAXPBBUF];
-} clientInfo;
-
-static openResults clientConnect (clientInfo *c);
-
-
-/*
- * clientOpen - returns an ISO Modula-2 OpenResult.
- * It attempts to connect to: hostname:portNo.
- * If successful then the data structure, c,
- * will have its fields initialized.
- */
-
-openResults wrapsock_clientOpen (clientInfo *c, char *hostname,
- unsigned int length, int portNo)
-{
- /* remove SIGPIPE which is raised on the server if the client is killed */
- signal(SIGPIPE, SIG_IGN);
-
- c->hp = gethostbyname(hostname);
- if (c->hp == NULL)
- return noSuchFile;
-
- memset((void *)&c->sa, 0, sizeof(c->sa));
- c->sa.sin_family = AF_INET;
- memcpy((void *)&c->sa.sin_addr, (void *)c->hp->h_addr, c->hp->h_length);
- c->portNo = portNo;
- c->sa.sin_port = htons(portNo);
- c->hasChar = 0;
- /*
- * Open a TCP socket (an Internet stream socket)
- */
-
- c->sockFd = socket(c->hp->h_addrtype, SOCK_STREAM, 0);
- return clientConnect(c);
-}
-
-/*
- * clientOpenIP - returns an ISO Modula-2 OpenResult.
- * It attempts to connect to: ipaddress:portNo.
- * If successful then the data structure, c,
- * will have its fields initialized.
- */
-
-openResults wrapsock_clientOpenIP (clientInfo *c, unsigned int ip, int portNo)
-{
- /* remove SIGPIPE which is raised on the server if the client is killed */
- signal(SIGPIPE, SIG_IGN);
-
- memset((void *)&c->sa, 0, sizeof(c->sa));
- c->sa.sin_family = AF_INET;
- memcpy((void *)&c->sa.sin_addr, (void *)&ip, sizeof(ip));
- c->portNo = portNo;
- c->sa.sin_port = htons(portNo);
-
- /*
- * Open a TCP socket (an Internet stream socket)
- */
-
- c->sockFd = socket(PF_INET, SOCK_STREAM, 0);
- return clientConnect(c);
-}
-
-/*
- * clientConnect - returns an ISO Modula-2 OpenResult
- * once a connect has been performed.
- * If successful the clientInfo will
- * include the file descriptor ready
- * for read/write operations.
- */
-
-static openResults clientConnect (clientInfo *c)
-{
- if (connect(c->sockFd, (struct sockaddr *)&c->sa, sizeof(c->sa)) < 0)
- return noSuchFile;
-
- return opened;
-}
-
-/*
- * getClientPortNo - returns the portNo from structure, c.
- */
-
-int wrapsock_getClientPortNo (clientInfo *c)
-{
- return c->portNo;
-}
-
-/*
- * getClientHostname - fills in the hostname of the server
- * the to which the client is connecting.
- */
-
-void wrapsock_getClientHostname (clientInfo *c,
- char *hostname, unsigned int high)
-{
- strncpy(hostname, c->hostname, high+1);
-}
-
-/*
- * getClientSocketFd - returns the sockFd from structure, c.
- */
-
-int wrapsock_getClientSocketFd (clientInfo *c)
-{
- return c->sockFd;
-}
-
-/*
- * getClientIP - returns the sockFd from structure, s.
- */
-
-unsigned int wrapsock_getClientIP (clientInfo *c)
-{
-#if 0
- printf("client ip = %s\n", inet_ntoa (c->sa.sin_addr.s_addr));
-#endif
- return c->sa.sin_addr.s_addr;
-}
-
-/*
- * getPushBackChar - returns TRUE if a pushed back character
- * is available.
- */
-
-unsigned int wrapsock_getPushBackChar (clientInfo *c, char *ch)
-{
- if (c->hasChar > 0) {
- c->hasChar--;
- *ch = c->pbChar[c->hasChar];
- return TRUE;
- }
- return FALSE;
-}
-
-/*
- * setPushBackChar - returns TRUE if it is able to push back a
- * character.
- */
-
-unsigned int wrapsock_setPushBackChar (clientInfo *c, char ch)
-{
- if (c->hasChar == MAXPBBUF)
- return FALSE;
- c->pbChar[c->hasChar] = ch;
- c->hasChar++;
- return TRUE;
-}
-
-/*
- * getSizeOfClientInfo - returns the sizeof (opaque data type).
- */
-
-unsigned int wrapsock_getSizeOfClientInfo (void)
-{
- return sizeof (clientInfo);
-}
-
-/*
- * GNU Modula-2 link fodder.
- */
-
-void _M2_wrapsock_init (void)
-{
-}
-
-void _M2_wrapsock_finish (void)
-{
-}
+++ /dev/null
-/* wraptime.c provides access to time functions.
-
-Copyright (C) 2009-2023 Free Software Foundation, Inc.
-Contributed by Gaius Mulley <gaius@glam.ac.uk>.
-
-This file is part of GNU Modula-2.
-
-GNU Modula-2 is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 3, or (at your option)
-any later version.
-
-GNU Modula-2 is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-General Public License for more details.
-
-Under Section 7 of GPL version 3, you are granted additional
-permissions described in the GCC Runtime Library Exception, version
-3.1, as published by the Free Software Foundation.
-
-You should have received a copy of the GNU General Public License and
-a copy of the GCC Runtime Library Exception along with this program;
-see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
-<http://www.gnu.org/licenses/>. */
-
-#include "gm2-libs-host.h"
-
-#if defined(HAVE_SYS_TYPES_H)
-# include <sys/types.h>
-#endif
-
-#if defined(HAVE_SYS_TIME_H)
-# include <sys/time.h>
-#endif
-
-#if defined(HAVE_TIME_H)
-# include <time.h>
-#endif
-
-#if defined(HAVE_MALLOC_H)
-# include <malloc.h>
-#endif
-
-#if !defined(TRUE)
-# define TRUE (1==1)
-#endif
-#if !defined(FALSE)
-# define FALSE (1==0)
-#endif
-
-/* InitTimeval returns a newly created opaque type. */
-
-struct timeval *
-wraptime_InitTimeval (void)
-{
-#if defined(HAVE_TIMEVAL)
- return (struct timeval *) malloc (sizeof (struct timeval));
-#else
- return NULL;
-#endif
-}
-
-/* KillTimeval deallocates the memory associated with an
- opaque type. */
-
-struct timeval *
-wraptime_KillTimeval (void *tv)
-{
- free (tv);
- return NULL;
-}
-
-/* InitTimezone returns a newly created opaque type. */
-
-struct timezone *
-wraptime_InitTimezone (void)
-{
- return (struct timezone *) malloc (sizeof (struct timezone));
-}
-
-/* KillTimezone deallocates the memory associated with an
- opaque type. */
-
-struct timezone *
-wraptime_KillTimezone (struct timezone *tv)
-{
- free (tv);
- return NULL;
-}
-
-/* InitTM returns a newly created opaque type. */
-
-struct tm *
-wraptime_InitTM (void)
-{
- return (struct tm *) malloc (sizeof (struct tm));
-}
-
-/* KillTM deallocates the memory associated with an opaque type. */
-
-struct tm *
-wraptime_KillTM (struct tm *tv)
-{
- free (tv);
- return NULL;
-}
-
-/* gettimeofday calls gettimeofday(2) with the same parameters, tv,
- and, tz. It returns 0 on success. */
-
-int
-wraptime_gettimeofday (void *tv, struct timezone *tz)
-{
- return gettimeofday (tv, tz);
-}
-
-/* settimeofday calls settimeofday(2) with the same parameters, tv,
- and, tz. It returns 0 on success. */
-
-int
-wraptime_settimeofday (void *tv, struct timezone *tz)
-{
- return settimeofday (tv, tz);
-}
-
-/* wraptime_GetFractions returns the tv_usec field inside the timeval
- structure. */
-
-#if defined(HAVE_TIMEVAL)
-unsigned int
-wraptime_GetFractions (struct timeval *tv)
-{
- return (unsigned int) tv->tv_usec;
-}
-#else
-unsigned int
-wraptime_GetFractions (void *tv)
-{
- return 0;
-}
-#endif
-
-/* localtime_r returns the tm parameter, m, after it has been assigned
- with appropriate contents determined by, tv. Notice that this
- procedure function expects, timeval, as its first parameter and not
- a time_t (as expected by the posix equivalent). */
-
-#if defined(HAVE_TIMEVAL)
-struct tm *
-wraptime_localtime_r (struct timeval *tv, struct tm *m)
-{
- return localtime_r (&tv->tv_sec, m);
-}
-#else
-struct tm *
-wraptime_localtime_r (void *tv, struct tm *m)
-{
- return m;
-}
-#endif
-
-/* wraptime_GetYear returns the year from the structure, m. */
-
-unsigned int
-wraptime_GetYear (struct tm *m)
-{
- return m->tm_year;
-}
-
-/* wraptime_GetMonth returns the month from the structure, m. */
-
-unsigned int
-wraptime_GetMonth (struct tm *m)
-{
- return m->tm_mon;
-}
-
-/* wraptime_GetDay returns the day of the month from the structure, m. */
-
-unsigned int
-wraptime_GetDay (struct tm *m)
-{
- return m->tm_mday;
-}
-
-/* wraptime_GetHour returns the hour of the day from the structure, m. */
-
-unsigned int
-wraptime_GetHour (struct tm *m)
-{
- return m->tm_hour;
-}
-
-/* wraptime_GetMinute returns the minute within the hour from the structure, m. */
-
-unsigned int
-wraptime_GetMinute (struct tm *m)
-{
- return m->tm_min;
-}
-
-/* wraptime_GetSecond returns the seconds in the minute from the
- structure, m. The return value will always be in the range 0..59.
- A leap minute of value 60 will be truncated to 59. */
-
-unsigned int
-wraptime_GetSecond (struct tm *m)
-{
- if (m->tm_sec == 60)
- return 59;
- else
- return m->tm_sec;
-}
-
-/* wraptime_GetSummerTime returns true if summer time is in effect. */
-
-unsigned int
-wraptime_GetSummerTime (struct timezone *tz)
-{
- return tz->tz_dsttime != 0;
-}
-
-/* wraptime_GetDST returns the number of minutes west of GMT. */
-
-int
-wraptime_GetDST (struct timezone *tz)
-{
- return tz->tz_minuteswest;
-}
-
-/* SetTimezone set the timezone field inside timeval, tv. */
-
-void
-wraptime_SetTimezone (struct timezone *tz,
- int zone, int minuteswest)
-{
- tz->tz_dsttime = zone;
- tz->tz_minuteswest = minuteswest;
-}
-
-/* SetTimeval sets the fields in tm, t, with:
- second, minute, hour, day, month, year, fractions. */
-
-#if defined(HAVE_TIMEVAL)
-void
-wraptime_SetTimeval (struct tm *t,
- unsigned int second,
- unsigned int minute,
- unsigned int hour,
- unsigned int day,
- unsigned int month,
- unsigned int year,
- unsigned int yday,
- unsigned int wday,
- unsigned int isdst)
-{
- t->tm_sec = second;
- t->tm_min = minute;
- t->tm_hour = hour;
- t->tm_mday = day;
- t->tm_mon = month;
- t->tm_year = year;
- t->tm_yday = yday;
- t->tm_wday = wday;
- t->tm_isdst = isdst;
-}
-#else
-wraptime_SetTimeval (void *t,
- unsigned int second,
- unsigned int minute,
- unsigned int hour,
- unsigned int day,
- unsigned int month,
- unsigned int year,
- unsigned int yday,
- unsigned int wday,
- unsigned int isdst)
-{
- return t;
-}
-#endif
-
-/* init/finish functions for the module. */
-
-void
-_M2_wraptime_init ()
-{}
-
-void
-_M2_wraptime_finish ()
-{}
TYPE
ArgCVEnvP = PROCEDURE (INTEGER, ADDRESS, ADDRESS) ;
+
(*
all these procedures do nothing except satisfy the linker.
*)
-PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+PROCEDURE ConstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
-PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+
+PROCEDURE DeconstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
-PROCEDURE RegisterModule (name: ADDRESS;
+
+
+(*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*)
+
+PROCEDURE RegisterModule (name, libname: ADDRESS;
init, fini: ArgCVEnvP;
dependencies: PROC) ;
-PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+
+(*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule.
+*)
+
+PROCEDURE RequestDependant (modulename, libname,
+ dependantmodule, dependantlibname: ADDRESS) ;
+
PROCEDURE ExecuteTerminationProcedures ;
PROCEDURE ExecuteInitialProcedures ;
PROCEDURE HALT <* noreturn *> ;
(* we reference these to ensure they are dragged in to the link *)
-PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+PROCEDURE ConstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
BEGIN
END ConstructModules ;
-PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+PROCEDURE DeconstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
BEGIN
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, libname: ADDRESS;
+ init, fini: ArgCVEnvP;
+ dependencies: PROC) ;
+BEGIN
+END RegisterModule ;
+
+
(* all these procedures do nothing except satisfy the linker. *)
PROCEDURE ExecuteTerminationProcedures ;
END NoException ;
-PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
-BEGIN
-END RequestDependant ;
-
+(*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule.
+*)
-PROCEDURE ConstructModules (applicationmodule: ADDRESS;
- argc: INTEGER; argv, envp: ADDRESS) ;
+PROCEDURE RequestDependant (modulename, libname,
+ dependantmodule, dependantlibname: ADDRESS) ;
BEGIN
-END ConstructModules ;
-
-
-PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
- argc: INTEGER; argv, envp: ADDRESS) ;
-BEGIN
-END DeconstructModules ;
-
+END RequestDependant ;
-PROCEDURE RegisterModule (name: ADDRESS;
- init, fini: ArgCVEnvP;
- dependencies: PROC) ;
-BEGIN
-END RegisterModule ;
END M2RTS.
ArgCVEnvP = PROCEDURE (INTEGER, ADDRESS, ADDRESS) ;
-PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+PROCEDURE ConstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
-PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+PROCEDURE DeconstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
explored to determine initialization order.
*)
-PROCEDURE RegisterModule (name: ADDRESS;
+PROCEDURE RegisterModule (modulename, libname: ADDRESS;
init, fini: ArgCVEnvP;
dependencies: PROC) ;
(*
- RequestDependant - used to specify that modulename is dependant upon
- module dependantmodule.
+ RequestDependant - used to specify that modulename:libname
+ is dependant upon
+ module dependantmodule:dependantlibname
*)
-PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+PROCEDURE RequestDependant (modulename, libname,
+ dependantmodule, dependantlibname: ADDRESS) ;
END M2Dependent.
IMPLEMENTATION MODULE M2Dependent ;
-FROM libc IMPORT abort, exit, write, getenv, printf ;
+FROM libc IMPORT abort, exit, write, getenv, printf, snprintf, strncpy ;
(* FROM Builtins IMPORT strncmp, strcmp ; not available during bootstrap. *)
FROM M2LINK IMPORT ForcedModuleInitOrder, StaticInitialization, PtrToChar ;
FROM ASCII IMPORT nul, nl ;
-FROM SYSTEM IMPORT ADR ;
+FROM SYSTEM IMPORT ADR, SIZE ;
FROM Storage IMPORT ALLOCATE ;
FROM StrLib IMPORT StrCopy, StrLen, StrEqual ;
END ;
ModuleChain = POINTER TO RECORD
- name : ADDRESS ;
+ name,
+ libname : ADDRESS ;
init,
fini : ArgCVEnvP ;
dependency: DependencyList ;
VAR
Modules : ARRAY DependencyState OF ModuleChain ;
Initialized,
+ WarningTrace,
ModuleTrace,
+ HexTrace,
DependencyTrace,
PreTrace,
PostTrace,
ModuleChain.
*)
-PROCEDURE CreateModule (name: ADDRESS;
+PROCEDURE CreateModule (name, libname: ADDRESS;
init, fini: ArgCVEnvP;
dependencies: PROC) : ModuleChain ;
VAR
- mptr: ModuleChain ;
+ mptr : ModuleChain ;
+ p0, p1: ADDRESS ;
BEGIN
NEW (mptr) ;
mptr^.name := name ;
+ mptr^.libname := libname ;
mptr^.init := init ;
mptr^.fini := fini ;
mptr^.dependency.proc := dependencies ;
mptr^.dependency.state := unregistered ;
mptr^.prev := NIL ;
mptr^.next := NIL ;
+ IF HexTrace
+ THEN
+ printf (" (init: %p fini: %p", init, fini) ;
+ printf (" dep: %p)", dependencies)
+ END ;
RETURN mptr
END CreateModule ;
(*
- LookupModuleN - lookup module from the state list. The string is limited
- to nchar.
+ max -
+*)
+
+PROCEDURE max (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+ IF a > b
+ THEN
+ RETURN a
+ ELSE
+ RETURN b
+ END
+END max ;
+
+
+(*
+ min -
+*)
+
+PROCEDURE min (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+ IF a < b
+ THEN
+ RETURN a
+ ELSE
+ RETURN b
+ END
+END min ;
+
+
+(*
+ LookupModuleN - lookup module from the state list.
+ The strings lengths are known.
*)
PROCEDURE LookupModuleN (state: DependencyState;
- name: ADDRESS; nchar: CARDINAL) : ModuleChain ;
+ name: ADDRESS; namelen: CARDINAL;
+ libname: ADDRESS; libnamelen: CARDINAL) : ModuleChain ;
VAR
ptr: ModuleChain ;
BEGIN
THEN
ptr := Modules[state] ;
REPEAT
- IF strncmp (ptr^.name, name, nchar) = 0
+ IF (strncmp (ptr^.name, name,
+ max (namelen, strlen (ptr^.name))) = 0) AND
+ (strncmp (ptr^.libname, libname,
+ max (libnamelen, strlen (ptr^.libname))) = 0)
THEN
RETURN ptr
END ;
module name from a particular list.
*)
-PROCEDURE LookupModule (state: DependencyState; name: ADDRESS) : ModuleChain ;
+PROCEDURE LookupModule (state: DependencyState; name, libname: ADDRESS) : ModuleChain ;
BEGIN
- RETURN LookupModuleN (state, name, strlen (name))
+ RETURN LookupModuleN (state,
+ name, strlen (name),
+ libname, strlen (libname))
END LookupModule ;
PROCEDURE strncmp (a, b: PtrToChar; n: CARDINAL) : INTEGER ;
BEGIN
- IF (a # NIL) AND (b # NIL) AND (n > 0)
+ IF n = 0
+ THEN
+ RETURN 0
+ ELSIF (a # NIL) AND (b # NIL)
THEN
IF a = b
THEN
*)
PROCEDURE traceprintf2 (flag: BOOLEAN; str: ARRAY OF CHAR; arg: ADDRESS) ;
+VAR
+ ch: CHAR ;
BEGIN
IF flag
THEN
toCString (str) ;
+ IF arg = NIL
+ THEN
+ ch := 0C ;
+ arg := ADR (ch)
+ END ;
printf (str, arg)
END
END traceprintf2 ;
+(*
+ traceprintf3 - wrap printf with a boolean flag.
+*)
+
+PROCEDURE traceprintf3 (flag: BOOLEAN; str: ARRAY OF CHAR;
+ arg1, arg2: ADDRESS) ;
+VAR
+ ch: CHAR ;
+BEGIN
+ IF flag
+ THEN
+ toCString (str) ;
+ IF arg1 = NIL
+ THEN
+ ch := 0C ;
+ arg1 := ADR (ch)
+ END ;
+ IF arg2 = NIL
+ THEN
+ ch := 0C ;
+ arg2 := ADR (ch)
+ END ;
+ printf (str, arg1, arg2)
+ END
+END traceprintf3 ;
+
+
(*
moveTo - moves mptr to the new list determined by newstate.
It updates the mptr state appropriately.
ResolveDependant -
*)
-PROCEDURE ResolveDependant (mptr: ModuleChain; currentmodule: ADDRESS) ;
+PROCEDURE ResolveDependant (mptr: ModuleChain; currentmodule, libname: ADDRESS) ;
BEGIN
IF mptr = NIL
THEN
- traceprintf (DependencyTrace, " module has not been registered via a global constructor\n");
+ traceprintf3 (DependencyTrace,
+ " module %s [%s] has not been registered via a global constructor\n",
+ currentmodule, libname);
ELSE
IF onChain (started, mptr)
THEN
traceprintf (DependencyTrace, " processing...\n");
ELSE
moveTo (started, mptr) ;
- traceprintf2 (DependencyTrace, " starting: %s\n",
- currentmodule);
+ traceprintf3 (DependencyTrace, " starting: %s [%s]\n",
+ currentmodule, libname);
mptr^.dependency.proc ; (* Invoke and process the dependency graph. *)
- traceprintf2 (DependencyTrace, " finished: %s\n",
- currentmodule);
+ traceprintf3 (DependencyTrace, " finished: %s [%s]\n",
+ currentmodule, libname);
moveTo (ordered, mptr)
END
END
if we are not using StaticInitialization.
*)
-PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+PROCEDURE RequestDependant (modulename, libname,
+ dependantmodule, dependantlibname: ADDRESS) ;
BEGIN
CheckInitialized ;
IF NOT StaticInitialization
THEN
- PerformRequestDependant (modulename, dependantmodule)
+ PerformRequestDependant (modulename, libname,
+ dependantmodule, dependantlibname)
END
END RequestDependant ;
resolved.
*)
-PROCEDURE PerformRequestDependant (modulename, dependantmodule: ADDRESS) ;
+PROCEDURE PerformRequestDependant (modulename, libname,
+ dependantmodule, dependantlibname: ADDRESS) ;
VAR
mptr: ModuleChain ;
BEGIN
- traceprintf2 (DependencyTrace, " module %s", modulename) ;
+ traceprintf3 (DependencyTrace, " module %s [%s]", modulename, libname) ;
IF dependantmodule = NIL
THEN
- traceprintf2 (DependencyTrace, " has finished its import graph\n", modulename) ;
- mptr := LookupModule (unordered, modulename) ;
+ traceprintf (DependencyTrace, " has finished its import graph\n") ;
+ mptr := LookupModule (unordered, modulename, libname) ;
IF mptr # NIL
THEN
- traceprintf2 (DependencyTrace, " module %s is now ordered\n", modulename) ;
+ traceprintf3 (DependencyTrace, " module %s [%s] is now ordered\n",
+ modulename, libname) ;
moveTo (ordered, mptr)
END
ELSE
- traceprintf2 (DependencyTrace, " imports from %s\n", dependantmodule) ;
- mptr := LookupModule (ordered, dependantmodule) ;
+ traceprintf3 (DependencyTrace, " imports from %s [%s]\n",
+ dependantmodule, dependantlibname) ;
+ mptr := LookupModule (ordered, dependantmodule, dependantlibname) ;
IF mptr = NIL
THEN
- traceprintf2 (DependencyTrace, " module %s is not ordered\n", dependantmodule) ;
- mptr := LookupModule (unordered, dependantmodule) ;
+ traceprintf3 (DependencyTrace, " module %s [%s] is not ordered\n",
+ dependantmodule, dependantlibname) ;
+ mptr := LookupModule (unordered, dependantmodule, dependantlibname) ;
IF mptr = NIL
THEN
- traceprintf2 (DependencyTrace, " module %s is not unordered\n", dependantmodule) ;
- mptr := LookupModule (started, dependantmodule) ;
+ traceprintf3 (DependencyTrace, " module %s [%s] is not unordered\n",
+ dependantmodule, dependantlibname) ;
+ mptr := LookupModule (started, dependantmodule, dependantlibname) ;
IF mptr = NIL
THEN
- traceprintf2 (DependencyTrace, " module %s has not started\n", dependantmodule) ;
- traceprintf2 (DependencyTrace, " module %s attempting to import from",
- modulename) ;
- traceprintf2 (DependencyTrace, " %s which has not registered itself via a constructor\n",
- dependantmodule)
+ traceprintf3 (DependencyTrace, " module %s [%s] has not started\n",
+ dependantmodule, dependantlibname) ;
+ traceprintf3 (DependencyTrace, " module %s [%s] attempting to import from",
+ modulename, libname) ;
+ traceprintf3 (DependencyTrace, " %s [%s] which has not registered itself via a constructor\n",
+ dependantmodule, dependantlibname)
ELSE
- traceprintf2 (DependencyTrace, " module %s has registered itself and has started\n", dependantmodule)
+ traceprintf3 (DependencyTrace, " module %s [%s] has registered itself and has started\n",
+ dependantmodule, dependantlibname)
END
ELSE
- traceprintf2 (DependencyTrace, " module %s resolving\n", dependantmodule) ;
- ResolveDependant (mptr, dependantmodule)
+ traceprintf3 (DependencyTrace, " module %s [%s] resolving\n", dependantmodule, dependantlibname) ;
+ ResolveDependant (mptr, dependantmodule, dependantlibname)
END
ELSE
- traceprintf2 (DependencyTrace, " module %s ", modulename) ;
- traceprintf2 (DependencyTrace, " dependant %s is ordered\n", dependantmodule)
+ traceprintf3 (DependencyTrace, " module %s [%s]", modulename, libname) ;
+ traceprintf3 (DependencyTrace, " dependant %s [%s] is ordered\n", dependantmodule, dependantlibname)
END
END
END PerformRequestDependant ;
(*
- ResolveDependencies - resolve dependencies for currentmodule.
+ ResolveDependencies - resolve dependencies for currentmodule, libname.
*)
-PROCEDURE ResolveDependencies (currentmodule: ADDRESS) ;
+PROCEDURE ResolveDependencies (currentmodule, libname: ADDRESS) ;
VAR
mptr: ModuleChain ;
BEGIN
- mptr := LookupModule (unordered, currentmodule) ;
+ mptr := LookupModule (unordered, currentmodule, libname) ;
WHILE mptr # NIL DO
- traceprintf2 (DependencyTrace, " attempting to resolve the dependants for %s\n",
- currentmodule);
- ResolveDependant (mptr, currentmodule) ;
+ traceprintf3 (DependencyTrace, " attempting to resolve the dependants for %s [%s]\n",
+ currentmodule, libname);
+ ResolveDependant (mptr, currentmodule, libname) ;
mptr := Modules[unordered]
END
END ResolveDependencies ;
DisplayModuleInfo - displays all module in the state.
*)
-PROCEDURE DisplayModuleInfo (state: DependencyState; name: ARRAY OF CHAR) ;
+PROCEDURE DisplayModuleInfo (state: DependencyState; desc: ARRAY OF CHAR) ;
VAR
mptr : ModuleChain ;
count: CARDINAL ;
BEGIN
IF Modules[state] # NIL
THEN
- printf ("%s modules\n", ADR (name)) ;
+ printf ("%s modules\n", ADR (desc)) ;
mptr := Modules[state] ;
count := 0 ;
REPEAT
- printf (" %d %s", count, mptr^.name) ;
+ IF mptr^.name = NIL
+ THEN
+ printf (" %d %s []", count, mptr^.name)
+ ELSE
+ printf (" %d %s [%s]", count, mptr^.name, mptr^.libname)
+ END ;
INC (count) ;
IF mptr^.dependency.appl
THEN
END combine ;
+(*
+ tracemodule -
+*)
+
+PROCEDURE tracemodule (flag: BOOLEAN; modname: ADDRESS; modlen: CARDINAL; libname: ADDRESS; liblen: CARDINAL) ;
+VAR
+ buffer: ARRAY [0..100] OF CHAR ;
+ len : CARDINAL ;
+BEGIN
+ IF flag
+ THEN
+ len := min (modlen, SIZE (buffer)-1) ;
+ strncpy (ADR(buffer), modname, len) ;
+ buffer[len] := 0C ;
+ printf ("%s ", ADR (buffer)) ;
+ len := min (liblen, SIZE (buffer)-1) ;
+ strncpy (ADR(buffer), libname, len) ;
+ buffer[len] := 0C ;
+ printf (" [%s]", ADR (buffer))
+ END
+END tracemodule ;
+
+
+(*
+ ForceModule -
+*)
+
+PROCEDURE ForceModule (modname: ADDRESS; modlen: CARDINAL;
+ libname: ADDRESS; liblen: CARDINAL) ;
+VAR
+ mptr: ModuleChain ;
+BEGIN
+ traceprintf (ForceTrace, "forcing module: ") ;
+ tracemodule (ForceTrace, modname, modlen, libname, liblen) ;
+ traceprintf (ForceTrace, "\n") ;
+ mptr := LookupModuleN (ordered, modname, modlen, libname, liblen) ;
+ IF mptr # NIL
+ THEN
+ mptr^.dependency.forced := TRUE ;
+ moveTo (user, mptr)
+ END
+END ForceModule ;
+
+
(*
ForceDependencies - if the user has specified a forced order then we override
the dynamic ordering with the preference.
PROCEDURE ForceDependencies ;
VAR
- mptr,
- userChain: ModuleChain ;
- count : CARDINAL ;
+ len,
+ modlen,
+ liblen : CARDINAL ;
+ modname,
+ libname,
pc, start: PtrToChar ;
BEGIN
IF ForcedModuleInitOrder # NIL
THEN
- userChain := NIL ;
+ traceprintf2 (ForceTrace, "user forcing order: %s\n", ForcedModuleInitOrder) ;
pc := ForcedModuleInitOrder ;
start := pc ;
- count := 0 ;
+ len := 0 ;
+ modname := NIL ;
+ modlen := 0 ;
+ libname := NIL ;
+ liblen := 0 ;
WHILE pc^ # nul DO
- IF pc^ = ','
- THEN
- mptr := LookupModuleN (ordered, start, count) ;
- IF mptr # NIL
- THEN
- mptr^.dependency.forced := TRUE ;
- moveTo (user, mptr)
- END ;
- INC (pc) ;
- start := pc ;
- count := 0
+ CASE pc^ OF
+
+ ':': libname := start ;
+ liblen := len ;
+ len := 0 ;
+ INC (pc) ;
+ start := pc |
+ ',': modname := start ;
+ modlen := len ;
+ ForceModule (modname, modlen, libname, liblen) ;
+ libname := NIL ;
+ liblen := 0 ;
+ modlen := 0 ;
+ len := 0 ;
+ INC (pc) ;
+ start := pc
ELSE
INC (pc) ;
- INC (count)
+ INC (len)
END
END ;
IF start # pc
THEN
- mptr := LookupModuleN (ordered, start, count) ;
- IF mptr # NIL
- THEN
- mptr^.dependency.forced := TRUE ;
- moveTo (user, mptr)
- END
+ ForceModule (start, len, libname, liblen)
END ;
combine (user, ordered)
END
UNTIL (appl # NIL) OR (mptr=Modules[ordered]) ;
IF appl # NIL
THEN
- Modules[ordered] := appl^.next
+ RemoveModule (Modules[ordered], appl) ;
+ AppendModule (Modules[ordered], appl)
END
END
END CheckApplication ;
module constructor in turn.
*)
-PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+PROCEDURE ConstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
VAR
mptr: ModuleChain ;
nulp: ArgCVEnvP ;
BEGIN
CheckInitialized ;
- traceprintf2 (ModuleTrace, "application module: %s\n", applicationmodule);
- mptr := LookupModule (unordered, applicationmodule) ;
+ traceprintf3 (ModuleTrace, "application module: %s [%s]\n",
+ applicationmodule, libname);
+ mptr := LookupModule (unordered, applicationmodule, libname) ;
IF mptr # NIL
THEN
mptr^.dependency.appl := TRUE
END ;
traceprintf (PreTrace, "Pre resolving dependents\n");
DumpModuleData (PreTrace) ;
- ResolveDependencies (applicationmodule) ;
+ ResolveDependencies (applicationmodule, libname) ;
traceprintf (PreTrace, "Post resolving dependents\n");
DumpModuleData (PostTrace) ;
ForceDependencies ;
DumpModuleData (ForceTrace) ;
IF Modules[ordered] = NIL
THEN
- traceprintf2 (ModuleTrace, " module: %s has not registered itself using a global constructor\n", applicationmodule);
+ traceprintf3 (ModuleTrace, " module: %s [%s] has not registered itself using a global constructor\n",
+ applicationmodule, libname);
traceprintf2 (ModuleTrace, " hint try compile and linking using: gm2 %s.mod\n", applicationmodule);
traceprintf2 (ModuleTrace, " or try using: gm2 -fscaffold-static %s.mod\n",
applicationmodule);
REPEAT
IF mptr^.dependency.forc
THEN
- traceprintf2 (ModuleTrace, "initializing module: %s for C\n", mptr^.name);
+ traceprintf3 (ModuleTrace, "initializing module: %s [%s] for C\n", mptr^.name, mptr^.libname)
ELSE
- traceprintf2 (ModuleTrace, "initializing module: %s\n", mptr^.name);
+ traceprintf3 (ModuleTrace, "initializing module: %s [%s]\n", mptr^.name, mptr^.libname);
END ;
IF mptr^.dependency.appl
THEN
- traceprintf2 (ModuleTrace, "application module: %s\n", mptr^.name);
+ traceprintf3 (ModuleTrace, "application module: %s [%s]\n", mptr^.name, mptr^.libname);
traceprintf (ModuleTrace, " calling M2RTS_ExecuteInitialProcedures\n");
M2RTS.ExecuteInitialProcedures ;
traceprintf (ModuleTrace, " calling application module\n");
module constructor in turn.
*)
-PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+PROCEDURE DeconstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
VAR
mptr: ModuleChain ;
BEGIN
- traceprintf2 (ModuleTrace, "application module finishing: %s\n", applicationmodule);
+ traceprintf3 (ModuleTrace, "application module finishing: %s [%s]\n",
+ applicationmodule, libname);
IF Modules[ordered] = NIL
THEN
traceprintf (ModuleTrace, " no ordered modules found during finishing\n")
REPEAT
IF mptr^.dependency.forc
THEN
- traceprintf2 (ModuleTrace, "finalizing module: %s for C\n", mptr^.name);
+ traceprintf3 (ModuleTrace, "finalizing module: %s [%s] for C\n",
+ mptr^.name, mptr^.libname)
ELSE
- traceprintf2 (ModuleTrace, "finalizing module: %s\n", mptr^.name);
+ traceprintf3 (ModuleTrace, "finalizing module: %s [%s]\n",
+ mptr^.name, mptr^.libname)
END ;
mptr^.fini (argc, argv, envp) ;
mptr := mptr^.prev
END DeconstructModules ;
+(*
+ warning3 - write format arg1 arg2 to stderr.
+*)
+
+PROCEDURE warning3 (format: ARRAY OF CHAR; arg1, arg2: ADDRESS) ;
+VAR
+ buffer: ARRAY [0..4096] OF CHAR ;
+ len : INTEGER ;
+BEGIN
+ IF WarningTrace
+ THEN
+ len := snprintf (ADR (buffer), SIZE (buffer), "warning: ") ;
+ write (2, ADR (buffer), len) ;
+ len := snprintf (ADR (buffer), SIZE (buffer), format, arg1, arg2) ;
+ write (2, ADR (buffer), len)
+ END
+END warning3 ;
+
+
(*
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;
+PROCEDURE RegisterModule (modulename, libname: ADDRESS;
init, fini: ArgCVEnvP;
dependencies: PROC) ;
+VAR
+ mptr: ModuleChain ;
BEGIN
CheckInitialized ;
IF NOT StaticInitialization
THEN
- traceprintf2 (ModuleTrace, "module: %s registering\n",
- name);
- moveTo (unordered,
- CreateModule (name, init, fini, dependencies))
+ mptr := LookupModule (unordered, modulename, libname) ;
+ IF mptr = NIL
+ THEN
+ traceprintf3 (ModuleTrace, "module: %s [%s] registering",
+ modulename, libname);
+ moveTo (unordered,
+ CreateModule (modulename, libname, init, fini, dependencies)) ;
+ traceprintf (ModuleTrace, "\n") ;
+ ELSE
+ warning3 ("module: %s [%s] (ignoring duplicate registration)\n",
+ modulename, libname)
+ END
END
END RegisterModule ;
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.
+ "all,module,hex,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.
+ hex dump the modules ctor functions address in hex.
pre generate a list of all modules seen prior to having
their dependancies resolved.
dep display a trace as the modules are resolved.
PostTrace := FALSE ;
PreTrace := FALSE ;
ForceTrace := FALSE ;
+ HexTrace := FALSE ;
+ WarningTrace := FALSE ;
pc := getenv (ADR ("GCC_M2LINK_RTFLAG")) ;
WHILE (pc # NIL) AND (pc^ # nul) DO
IF equal (pc, "all")
PreTrace := TRUE ;
PostTrace := TRUE ;
ForceTrace := TRUE ;
+ HexTrace := TRUE ;
+ WarningTrace := TRUE ;
INC (pc, 3)
ELSIF equal (pc, "module")
THEN
ModuleTrace := TRUE ;
INC (pc, 6)
+ ELSIF equal (pc, "warning")
+ THEN
+ WarningTrace := TRUE ;
+ INC (pc, 7)
+ ELSIF equal (pc, "hex")
+ THEN
+ HexTrace := TRUE ;
+ INC (pc, 3)
ELSIF equal (pc, "dep")
THEN
DependencyTrace := TRUE ;
ArgCVEnvP = PROCEDURE (INTEGER, ADDRESS, ADDRESS) ;
-PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+PROCEDURE ConstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
-PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+PROCEDURE DeconstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
explored to determine initialization order.
*)
-PROCEDURE RegisterModule (name: ADDRESS;
+PROCEDURE RegisterModule (name, libname: ADDRESS;
init, fini: ArgCVEnvP;
dependencies: PROC) ;
module dependantmodule.
*)
-PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+PROCEDURE RequestDependant (modulename, libname,
+ dependantmodule, dependantlibname: ADDRESS) ;
(*
module constructor in turn.
*)
-PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+PROCEDURE ConstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
BEGIN
- M2Dependent.ConstructModules (applicationmodule, argc, argv, envp)
+ M2Dependent.ConstructModules (applicationmodule, libname,
+ argc, argv, envp)
END ConstructModules ;
module constructor in turn.
*)
-PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+PROCEDURE DeconstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
BEGIN
- M2Dependent.DeconstructModules (applicationmodule, argc, argv, envp)
+ M2Dependent.DeconstructModules (applicationmodule, libname,
+ argc, argv, envp)
END DeconstructModules ;
explored to determine initialization order.
*)
-PROCEDURE RegisterModule (name: ADDRESS;
+PROCEDURE RegisterModule (name, libname: ADDRESS;
init, fini: ArgCVEnvP;
dependencies: PROC) ;
BEGIN
- M2Dependent.RegisterModule (name, init, fini, dependencies)
+ M2Dependent.RegisterModule (name, libname, init, fini, dependencies)
END RegisterModule ;
module dependantmodule.
*)
-PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+PROCEDURE RequestDependant (modulename, libname,
+ dependantmodule, dependantlibname: ADDRESS) ;
BEGIN
- M2Dependent.RequestDependant (modulename, dependantmodule)
+ M2Dependent.RequestDependant (modulename, libname,
+ dependantmodule, dependantlibname)
END RequestDependant ;
(*
- FindVector - searches the exists list for a vector of type, t,
+ FindVector - searches the exists list for a vector of type
which is associated with file descriptor, fd.
*)
-PROCEDURE FindVector (fd: INTEGER; t: VectorType) : Vector ;
+PROCEDURE FindVector (fd: INTEGER; type: VectorType) : Vector ;
VAR
- v: Vector ;
+ vec: Vector ;
BEGIN
- v := Exists ;
- WHILE v#NIL DO
- IF (v^.type=t) AND (v^.File=fd)
+ vec := Exists ;
+ WHILE vec#NIL DO
+ IF (vec^.type=type) AND (vec^.File=fd)
THEN
- RETURN v
+ RETURN vec
END ;
- v := v^.exists
+ vec := vec^.exists
END ;
RETURN NIL
END FindVector ;
PROCEDURE InitInputVector (fd: INTEGER; pri: CARDINAL) : CARDINAL ;
VAR
- v: Vector ;
+ vptr: Vector ;
BEGIN
IF Debugging
THEN
printf("InitInputVector fd = %d priority = %d\n", fd, pri)
END ;
wait (lock) ;
- v := FindVector(fd, input) ;
- IF v=NIL
+ vptr := FindVector(fd, input) ;
+ IF vptr = NIL
THEN
- NEW(v) ;
- INC(VecNo) ;
- WITH v^ DO
+ NEW (vptr) ;
+ INC (VecNo) ;
+ WITH vptr^ DO
type := input ;
priority := pri ;
arg := NIL ;
no := VecNo ;
File := fd
END ;
- Exists := v ;
+ Exists := vptr ;
signal (lock) ;
RETURN VecNo
ELSE
signal (lock) ;
- RETURN v^.no
+ RETURN vptr^.no
END
END InitInputVector ;
PROCEDURE InitOutputVector (fd: INTEGER; pri: CARDINAL) : CARDINAL ;
VAR
- v: Vector ;
+ vptr: Vector ;
BEGIN
wait (lock) ;
- v := FindVector (fd, output) ;
- IF v=NIL
+ vptr := FindVector (fd, output) ;
+ IF vptr = NIL
THEN
- NEW (v) ;
- IF v = NIL
+ NEW (vptr) ;
+ IF vptr = NIL
THEN
HALT
ELSE
INC (VecNo) ;
- WITH v^ DO
+ WITH vptr^ DO
type := output ;
priority := pri ;
arg := NIL ;
no := VecNo ;
File := fd
END ;
- Exists := v ;
+ Exists := vptr ;
signal (lock) ;
RETURN VecNo
END
ELSE
signal (lock) ;
- RETURN v^.no
+ RETURN vptr^.no
END
END InitOutputVector ;
PROCEDURE InitTimeVector (micro, secs: CARDINAL; pri: CARDINAL) : CARDINAL ;
VAR
- v: Vector ;
+ vptr: Vector ;
BEGIN
wait (lock) ;
- NEW (v) ;
- IF v = NIL
+ NEW (vptr) ;
+ IF vptr = NIL
THEN
HALT
ELSE
INC (VecNo) ;
Assert (micro<Microseconds) ;
- WITH v^ DO
+ WITH vptr^ DO
type := time ;
priority := pri ;
arg := NIL ;
pending := NIL ;
exists := Exists ;
no := VecNo ;
- rel := InitTime(secs+DebugTime, micro) ;
- abs := InitTime(0, 0) ;
+ rel := InitTime (secs+DebugTime, micro) ;
+ abs := InitTime (0, 0) ;
queued := FALSE
END ;
- Exists := v
+ Exists := vptr
END ;
signal (lock) ;
RETURN VecNo
(*
- FindVectorNo - searches the Exists list for vector, vec.
+ FindVectorNo - searches the Exists list for vector vec.
*)
PROCEDURE FindVectorNo (vec: CARDINAL) : Vector ;
VAR
- v: Vector ;
+ vptr: Vector ;
BEGIN
- v := Exists ;
- WHILE (v#NIL) AND (v^.no#vec) DO
- v := v^.exists
+ vptr := Exists ;
+ WHILE (vptr#NIL) AND (vptr^.no#vec) DO
+ vptr := vptr^.exists
END ;
- RETURN v
+ RETURN vptr
END FindVectorNo ;
PROCEDURE FindPendingVector (vec: CARDINAL) : Vector ;
VAR
- i: CARDINAL ;
- v: Vector ;
+ pri : CARDINAL ;
+ vptr: Vector ;
BEGIN
- FOR i := MIN(PROTECTION) TO MAX(PROTECTION) DO
- v := Pending[i] ;
- WHILE (v#NIL) AND (v^.no#vec) DO
- v := v^.pending
+ FOR pri := MIN(PROTECTION) TO MAX(PROTECTION) DO
+ vptr := Pending[pri] ;
+ WHILE (vptr#NIL) AND (vptr^.no#vec) DO
+ vptr := vptr^.pending
END ;
- IF (v#NIL) AND (v^.no=vec)
+ IF (vptr#NIL) AND (vptr^.no=vec)
THEN
- RETURN v
+ RETURN vptr
END
END ;
RETURN NIL
PROCEDURE ReArmTimeVector (vec: CARDINAL;
micro, secs: CARDINAL) ;
VAR
- v: Vector ;
+ vptr: Vector ;
BEGIN
- Assert(micro<Microseconds) ;
+ Assert (micro<Microseconds) ;
wait (lock) ;
- v := FindVectorNo(vec) ;
- IF v=NIL
+ vptr := FindVectorNo (vec) ;
+ IF vptr = NIL
THEN
- Halt(__FILE__, __LINE__, __FUNCTION__,
- 'cannot find vector supplied')
+ Halt (__FILE__, __LINE__, __FUNCTION__,
+ 'cannot find vector supplied')
ELSE
- WITH v^ DO
+ WITH vptr^ DO
SetTime (rel, secs + DebugTime, micro)
END
END ;
PROCEDURE GetTimeVector (vec: CARDINAL; VAR micro, secs: CARDINAL) ;
VAR
- v: Vector ;
+ vptr: Vector ;
BEGIN
wait (lock) ;
- v := FindVectorNo (vec) ;
- IF v=NIL
+ vptr := FindVectorNo (vec) ;
+ IF vptr=NIL
THEN
- Halt(__FILE__, __LINE__, __FUNCTION__,
- 'cannot find vector supplied')
+ Halt (__FILE__, __LINE__, __FUNCTION__,
+ 'cannot find vector supplied')
ELSE
- WITH v^ DO
+ WITH vptr^ DO
GetTime (rel, secs, micro) ;
Assert (micro < Microseconds)
END
(*
- AttachVector - adds the pointer, p, to be associated with the interrupt
+ AttachVector - adds the pointer ptr to be associated with the interrupt
vector. It returns the previous value attached to this
vector.
*)
-PROCEDURE AttachVector (vec: CARDINAL; p: ADDRESS) : ADDRESS ;
+PROCEDURE AttachVector (vec: CARDINAL; ptr: ADDRESS) : ADDRESS ;
VAR
- v: Vector ;
- l: ADDRESS ;
+ vptr : Vector ;
+ prevArg: ADDRESS ;
BEGIN
wait (lock) ;
- v := FindVectorNo (vec) ;
- IF v=NIL
+ vptr := FindVectorNo (vec) ;
+ IF vptr = NIL
THEN
Halt (__FILE__, __LINE__, __FUNCTION__, 'cannot find vector supplied')
ELSE
- l := v^.arg ;
- v^.arg := p ;
+ prevArg := vptr^.arg ;
+ vptr^.arg := ptr ;
IF Debugging
THEN
- printf ("AttachVector %d with 0x%x\n", vec, p);
+ printf ("AttachVector %d with %p\n", vec, ptr);
DumpPendingQueue ;
END ;
signal (lock) ;
- RETURN l
+ RETURN prevArg
END
END AttachVector ;
PROCEDURE IncludeVector (vec: CARDINAL) ;
VAR
- v : Vector ;
- m, s: CARDINAL ;
- r : INTEGER ;
+ vptr : Vector ;
+ micro, sec: CARDINAL ;
+ result : INTEGER ;
BEGIN
wait (lock) ;
- v := FindPendingVector (vec) ;
- IF v=NIL
+ vptr := FindPendingVector (vec) ;
+ IF vptr = NIL
THEN
- v := FindVectorNo (vec) ;
- IF v = NIL
+ vptr := FindVectorNo (vec) ;
+ IF vptr = NIL
THEN
Halt (__FILE__, __LINE__, __FUNCTION__,
'cannot find vector supplied') ;
ELSE
(* printf('including vector %d (fd = %d)\n', vec, v^.File) ; *)
- v^.pending := Pending[v^.priority] ;
- Pending[v^.priority] := v ;
- IF (v^.type = time) AND (NOT v^.queued)
+ vptr^.pending := Pending[vptr^.priority] ;
+ Pending[vptr^.priority] := vptr ;
+ IF (vptr^.type = time) AND (NOT vptr^.queued)
THEN
- v^.queued := TRUE ;
- r := GetTimeOfDay (v^.abs) ;
- Assert (r=0) ;
- GetTime (v^.abs, s, m) ;
- Assert (m<Microseconds) ;
- AddTime (v^.abs, v^.rel) ;
- GetTime (v^.abs, s, m) ;
- Assert (m<Microseconds)
+ vptr^.queued := TRUE ;
+ result := GetTimeOfDay (vptr^.abs) ;
+ Assert (result=0) ;
+ GetTime (vptr^.abs, sec, micro) ;
+ Assert (micro<Microseconds) ;
+ AddTime (vptr^.abs, vptr^.rel) ;
+ GetTime (vptr^.abs, sec, micro) ;
+ Assert (micro<Microseconds)
END
END
ELSE
IF Debugging
THEN
- printf ('odd vector (%d) type (%d) arg (0x%x) is already attached to the pending queue\n',
- vec, v^.type, v^.arg)
- END ;
- stop
+ printf ('odd vector (%d) type (%d) arg (%p) is already attached to the pending queue\n',
+ vec, vptr^.type, vptr^.arg)
+ END
END ;
signal (lock)
END IncludeVector ;
PROCEDURE ExcludeVector (vec: CARDINAL) ;
VAR
- v, u: Vector ;
+ vptr, uptr: Vector ;
BEGIN
wait (lock) ;
- v := FindPendingVector(vec) ;
- IF v=NIL
+ vptr := FindPendingVector (vec) ;
+ IF vptr = NIL
THEN
Halt (__FILE__, __LINE__, __FUNCTION__,
'cannot find pending vector supplied')
ELSE
(* printf('excluding vector %d\n', vec) ; *)
- IF Pending[v^.priority]=v
+ IF Pending[vptr^.priority] = vptr
THEN
- Pending[v^.priority] := Pending[v^.priority]^.pending
+ Pending[vptr^.priority] := Pending[vptr^.priority]^.pending
ELSE
- u := Pending[v^.priority] ;
- WHILE u^.pending#v DO
- u := u^.pending
+ uptr := Pending[vptr^.priority] ;
+ WHILE uptr^.pending#vptr DO
+ uptr := uptr^.pending
END ;
- u^.pending := v^.pending
+ uptr^.pending := vptr^.pending
END ;
- IF v^.type=time
+ IF vptr^.type=time
THEN
- v^.queued := FALSE
+ vptr^.queued := FALSE
END
END ;
signal (lock)
(*
- AddFd - adds the file descriptor, fd, to set, s, updating, max.
+ AddFd - adds the file descriptor fd to set updating max.
*)
-PROCEDURE AddFd (VAR s: SetOfFd; VAR max: INTEGER; fd: INTEGER) ;
+PROCEDURE AddFd (VAR set: SetOfFd; VAR max: INTEGER; fd: INTEGER) ;
BEGIN
max := Max (fd, max) ;
- IF s = NIL
+ IF set = NIL
THEN
- s := InitSet () ;
- FdZero (s)
+ set := InitSet () ;
+ FdZero (set)
END ;
- FdSet (fd, s)
+ FdSet (fd, set)
(* printf('%d, ', fd) *)
END AddFd ;
PROCEDURE DumpPendingQueue ;
VAR
- p : PROTECTION ;
- v : Vector ;
- s, m: CARDINAL ;
+ pri : PROTECTION ;
+ vptr : Vector ;
+ sec,
+ micro: CARDINAL ;
BEGIN
printf ("Pending queue\n");
- FOR p := MIN (PROTECTION) TO MAX (PROTECTION) DO
- printf ("[%d] ", p);
- v := Pending[p] ;
- WHILE v#NIL DO
- IF (v^.type=input) OR (v^.type=output)
+ FOR pri := MIN (PROTECTION) TO MAX (PROTECTION) DO
+ printf ("[%d] ", pri);
+ vptr := Pending[pri] ;
+ WHILE vptr # NIL DO
+ IF (vptr^.type=input) OR (vptr^.type=output)
THEN
- printf ("(fd=%d) (vec=%d)", v^.File, v^.no)
- ELSIF v^.type=time
+ printf ("(fd=%d) (vec=%d)", vptr^.File, vptr^.no)
+ ELSIF vptr^.type=time
THEN
- GetTime(v^.rel, s, m) ;
- Assert (m<Microseconds) ;
- printf ("time (%u.%06u secs) (arg = 0x%x)\n", s, m, v^.arg)
+ GetTime (vptr^.rel, sec, micro) ;
+ Assert (micro < Microseconds) ;
+ printf ("time (%u.%06u secs) (arg = %p)\n",
+ sec, micro, vptr^.arg)
END ;
- v := v^.pending
+ vptr := vptr^.pending
END ;
printf (" \n")
END
END DumpPendingQueue ;
-PROCEDURE stop ;
-BEGIN
-END stop ;
-
-
(*
AddTime - t1 := t1 + t2
*)
*)
PROCEDURE activatePending (untilInterrupt: BOOLEAN; call: DispatchVector; pri: CARDINAL;
- maxFd: INTEGER; VAR i, o: SetOfFd; VAR t: Timeval; b4, after: Timeval) : BOOLEAN ;
+ maxFd: INTEGER; VAR inSet, outSet: SetOfFd; VAR timeval: Timeval; b4, after: Timeval) : BOOLEAN ;
VAR
- r : INTEGER ;
- p : CARDINAL ;
- v : Vector ;
+ result: INTEGER ;
+ p : CARDINAL ;
+ vec : Vector ;
b4s,
b4m,
afs,
afm,
- s, m: CARDINAL ;
+ sec,
+ micro : CARDINAL ;
BEGIN
wait (lock) ;
p := MAX (PROTECTION) ;
WHILE p > pri DO
- v := Pending[p] ;
- WHILE v # NIL DO
- WITH v^ DO
+ vec := Pending[p] ;
+ WHILE vec # NIL DO
+ WITH vec^ DO
CASE type OF
- input : IF (File < maxFd) AND (i # NIL) AND FdIsSet (File, i)
+ input : IF (File < maxFd) AND (inSet # NIL) AND FdIsSet (File, inSet)
THEN
IF Debugging
THEN
printf ('read (fd=%d) is ready (vec=%d)\n', File, no) ;
DumpPendingQueue
END ;
- FdClr (File, i) ; (* so we dont activate this again from our select. *)
+ FdClr (File, inSet) ; (* so we dont activate this again from our select. *)
signal (lock) ;
call (no, priority, arg) ;
RETURN TRUE
END |
- output: IF (File < maxFd) AND (o#NIL) AND FdIsSet (File, o)
+ output: IF (File < maxFd) AND (outSet#NIL) AND FdIsSet (File, outSet)
THEN
IF Debugging
THEN
printf ('write (fd=%d) is ready (vec=%d)\n', File, no) ;
DumpPendingQueue
END ;
- FdClr (File, o) ; (* so we dont activate this again from our select. *)
+ FdClr (File, outSet) ; (* so we dont activate this again from our select. *)
signal (lock) ;
call (no, priority, arg) ;
RETURN TRUE
END |
- time : IF untilInterrupt AND (t # NIL)
+ time : IF untilInterrupt AND (timeval # NIL)
THEN
- r := GetTimeOfDay (after) ;
- Assert (r=0) ;
+ result := GetTimeOfDay (after) ;
+ Assert (result=0) ;
IF Debugging
THEN
- GetTime (t, s, m) ;
- Assert (m < Microseconds) ;
+ GetTime (timeval, sec, micro) ;
+ Assert (micro < Microseconds) ;
GetTime (after, afs, afm) ;
Assert (afm < Microseconds) ;
GetTime (b4, b4s, b4m) ;
Assert (b4m < Microseconds) ;
printf ("waited %u.%06u + %u.%06u now is %u.%06u\n",
- s, m, b4s, b4m, afs, afm) ;
+ sec, micro, b4s, b4m, afs, afm) ;
END ;
IF IsGreaterEqual (after, abs)
THEN
DumpPendingQueue ;
printf ("time has expired calling dispatcher\n")
END ;
- t := KillTime (t) ; (* so we dont activate this again from our select. *)
+ timeval := KillTime (timeval) ; (* so we dont activate this again from our select. *)
signal (lock) ;
IF Debugging
THEN
END
END
END ;
- v := v^.pending
+ vec := vec^.pending
END ;
DEC (p)
END ;
call: DispatchVector;
pri: CARDINAL) ;
VAR
- found: BOOLEAN ;
- r : INTEGER ;
+ found : BOOLEAN ;
+ result : INTEGER ;
after,
b4,
- t : Timeval ;
- v : Vector ;
- i, o : SetOfFd ;
+ timeval: Timeval ;
+ vec : Vector ;
+ inSet,
+ outSet : SetOfFd ;
b4s,
b4m,
afs,
afm,
- s, m : CARDINAL ;
- maxFd: INTEGER ;
- p : CARDINAL ;
+ sec,
+ micro : CARDINAL ;
+ maxFd : INTEGER ;
+ p : CARDINAL ;
BEGIN
wait (lock) ;
IF pri < MAX (PROTECTION)
DumpPendingQueue
END ;
maxFd := -1 ;
- t := NIL ;
- i := NIL ;
- o := NIL ;
- t := InitTime (MAX (INTEGER), 0) ;
+ timeval := NIL ;
+ inSet := NIL ;
+ outSet := NIL ;
+ timeval := InitTime (MAX (INTEGER), 0) ;
p := MAX (PROTECTION) ;
found := FALSE ;
WHILE p>pri DO
- v := Pending[p] ;
- WHILE v#NIL DO
- WITH v^ DO
+ vec := Pending[p] ;
+ WHILE vec#NIL DO
+ WITH vec^ DO
CASE type OF
- input : AddFd (i, maxFd, File) |
- output: AddFd (o, maxFd, File) |
- time : IF IsGreaterEqual (t, abs)
+ input : AddFd (inSet, maxFd, File) |
+ output: AddFd (outSet, maxFd, File) |
+ time : IF IsGreaterEqual (timeval, abs)
THEN
- GetTime (abs, s, m) ;
- Assert (m<Microseconds) ;
+ GetTime (abs, sec, micro) ;
+ Assert (micro < Microseconds) ;
IF Debugging
THEN
- printf ("shortest delay is %u.%06u\n", s, m)
+ printf ("shortest delay is %u.%06u\n", sec, micro)
END ;
- SetTime (t, s, m) ;
+ SetTime (timeval, sec, micro) ;
found := TRUE
END
END
END ;
- v := v^.pending
+ vec := vec^.pending
END ;
DEC (p)
END ;
IF NOT untilInterrupt
THEN
- SetTime (t, 0, 0)
+ SetTime (timeval, 0, 0)
END ;
- IF untilInterrupt AND (i=NIL) AND (o=NIL) AND (NOT found)
+ IF untilInterrupt AND (inSet=NIL) AND (outSet=NIL) AND (NOT found)
THEN
Halt (__FILE__, __LINE__, __FUNCTION__,
'deadlock found, no more processes to run and no interrupts active')
END ;
- (* printf('timeval = 0x%x\n', t) ; *)
+ (* printf('timeval = 0x%x\n', timeval) ; *)
(* printf('}\n') ; *)
- IF (NOT found) AND (maxFd=-1) AND (i=NIL) AND (o=NIL)
+ IF (NOT found) AND (maxFd=-1) AND (inSet=NIL) AND (outSet=NIL)
THEN
(* no file descriptors to be selected upon. *)
- t := KillTime (t) ;
+ timeval := KillTime (timeval) ;
signal (lock) ;
RETURN
ELSE
- GetTime (t, s, m) ;
- Assert (m<Microseconds) ;
+ GetTime (timeval, sec, micro) ;
+ Assert (micro < Microseconds) ;
b4 := InitTime (0, 0) ;
after := InitTime (0, 0) ;
- r := GetTimeOfDay (b4) ;
- Assert (r=0) ;
- SubTime (s, m, t, b4) ;
- SetTime (t, s, m) ;
+ result := GetTimeOfDay (b4) ;
+ Assert (result=0) ;
+ SubTime (sec, micro, timeval, b4) ;
+ SetTime (timeval, sec, micro) ;
IF Debugging
THEN
- printf ("select waiting for %u.%06u seconds\n", s, m)
+ printf ("select waiting for %u.%06u seconds\n", sec, micro)
END ;
signal (lock) ;
REPEAT
IF Debugging
THEN
- printf ("select (.., .., .., %u.%06u)\n", s, m)
+ printf ("select (.., .., .., %u.%06u)\n", sec, micro)
END ;
- r := select (maxFd+1, i, o, NIL, t) ;
- IF r=-1
+ result := select (maxFd+1, inSet, outSet, NIL, timeval) ;
+ IF result=-1
THEN
perror ("select") ;
- r := select (maxFd+1, i, o, NIL, NIL) ;
- IF r=-1
+ result := select (maxFd+1, inSet, outSet, NIL, NIL) ;
+ IF result=-1
THEN
perror ("select timeout argument is faulty")
END ;
- r := select (maxFd+1, i, NIL, NIL, t) ;
- IF r=-1
+ result := select (maxFd+1, inSet, NIL, NIL, timeval) ;
+ IF result=-1
THEN
perror ("select output fd argument is faulty")
END ;
- r := select (maxFd+1, NIL, o, NIL, t) ;
- IF r=-1
+ result := select (maxFd+1, NIL, outSet, NIL, timeval) ;
+ IF result=-1
THEN
perror ("select input fd argument is faulty")
ELSE
perror ("select maxFD+1 argument is faulty")
END
END
- UNTIL r#-1
+ UNTIL result#-1
END ;
WHILE activatePending (untilInterrupt, call, pri,
- maxFd+1, i, o, t, b4, after) DO
+ maxFd+1, inSet, outSet, timeval, b4, after) DO
END ;
- IF t#NIL
+ IF timeval#NIL
THEN
- t := KillTime (t)
+ timeval := KillTime (timeval)
END ;
IF after#NIL
THEN
- t := KillTime (after)
+ after := KillTime (after)
END ;
IF b4#NIL
THEN
- t := KillTime (b4)
+ b4 := KillTime (b4)
END ;
- IF i#NIL
+ IF inSet#NIL
THEN
- i := KillSet (i)
+ inSet := KillSet (inSet)
END ;
- IF o#NIL
+ IF outSet#NIL
THEN
- o := KillSet (o)
+ outSet := KillSet (outSet)
END
END ;
signal (lock)
memcpy, memset, memmove, printf, realloc,
rand, srand,
time, localtime, ftime,
- shutdown, rename, setjmp, longjmp, atexit,
+ shutdown, snprintf,
+ rename, setjmp, longjmp, atexit,
ttyname, sleep, execv ;
PROCEDURE printf (format: ARRAY OF CHAR; ...) : [ INTEGER ] ;
+(*
+ int snprintf(char *str, size_t size, const char *format, ...);
+*)
+
+PROCEDURE snprintf (dest: ADDRESS; size: CSIZE_T;
+ format: ARRAY OF CHAR; ...) : [ INTEGER ] ;
+
(*
setenv - sets environment variable, name, to value.
It will overwrite an existing value if, overwrite,
DEFINITION MODULE sckt ;
FROM SYSTEM IMPORT ADDRESS ;
-EXPORT UNQUALIFIED tcpServerState,
- tcpServerEstablish, tcpServerEstablishPort,
- tcpServerAccept, getLocalIP,
- tcpServerPortNo, tcpServerIP, tcpServerSocketFd,
- tcpServerClientIP, tcpServerClientPortNo,
- tcpClientState,
- tcpClientSocket, tcpClientSocketIP, tcpClientConnect,
- tcpClientPortNo, tcpClientIP, tcpClientSocketFd ;
+EXPORT QUALIFIED tcpServerState,
+ tcpServerEstablish, tcpServerEstablishPort,
+ tcpServerAccept, getLocalIP,
+ tcpServerPortNo, tcpServerIP, tcpServerSocketFd,
+ tcpServerClientIP, tcpServerClientPortNo,
+ tcpClientState,
+ tcpClientSocket, tcpClientSocketIP, tcpClientConnect,
+ tcpClientPortNo, tcpClientIP, tcpClientSocketFd ;
TYPE
tcpServerState = ADDRESS ;
#include "gcc.h"
#include "opts.h"
#include "vec.h"
+#include <vector>
+#include <string>
#include "m2/gm2config.h"
static unsigned int gm2_newargc;
static struct cl_decoded_option *gm2_new_decoded_options;
static const char *libraries = NULL; /* Abbreviated libraries. */
+static const char *m2_path_name = "";
+typedef struct named_path_s {
+ std::vector<const char*>path;
+ const char *name;
+} named_path;
+
+static std::vector<named_path>Ipaths;
+
+
+static void
+push_back_Ipath (const char *arg)
+{
+ if (Ipaths.empty ())
+ {
+ named_path np;
+ np.path.push_back (arg);
+ np.name = m2_path_name;
+ Ipaths.push_back (np);
+ }
+ else
+ {
+ if (strcmp (Ipaths.back ().name,
+ m2_path_name) == 0)
+ Ipaths.back ().path.push_back (arg);
+ else
+ {
+ named_path np;
+ np.path.push_back (arg);
+ np.name = m2_path_name;
+ Ipaths.push_back (np);
+ }
+ }
+}
/* Return whether strings S1 and S2 are both NULL or both the same
string. */
return full_libraries;
}
+/* add_m2_I_path appends -fm2-pathname and -fm2-pathnameI options to
+ the command line which are contructed in the saved Ipaths. */
+
+static void
+add_m2_I_path (void)
+{
+ for (auto np : Ipaths)
+ {
+ if (strcmp (np.name, "") == 0)
+ append_option (OPT_fm2_pathname_, safe_strdup ("-"), 1);
+ else
+ append_option (OPT_fm2_pathname_, safe_strdup (np.name), 1);
+ for (auto *s : np.path)
+ append_option (OPT_fm2_pathnameI, safe_strdup (s), 1);
+ }
+ Ipaths.clear();
+}
+
void
lang_specific_driver (struct cl_decoded_option **in_decoded_options,
fprintf (stderr, "\n");
#endif
+ // add_spec_function ("m2I", add_m2_I_path);
gm2_xargc = argc;
gm2_x_decoded_options = decoded_options;
gm2_newargc = 0;
seen_uselist = true;
uselist = decoded_options[i].value;
break;
-
+ case OPT_fm2_pathname_:
+ args[i] |= SKIPOPT; /* We will add the option if it is needed. */
+ m2_path_name = decoded_options[i].arg;
+ break;
+ case OPT_I:
+ args[i] |= SKIPOPT; /* We will add the option if it is needed. */
+ push_back_Ipath (decoded_options[i].arg);
+ break;
case OPT_nostdlib:
case OPT_nostdlib__:
case OPT_nodefaultlibs:
#endif
}
+ add_m2_I_path ();
/* We now add in extra arguments to facilitate a successful link.
Note that the libraries are added to the end of the link here
and also placed earlier into the link by lang-specs.h. Possibly
{"@modula-2",
/* For preprocessing we use cc1 but wrap it in cc1gm2. */
"%{E|M|MM:\
- cc1gm2 " M2CPP " %{!fcpp:-fcpp;:%{fcpp}} %{I*} %i } \
+ cc1gm2 " M2CPP " %{!fcpp:-fcpp;:%{fcpp}} %{fm2-pathname*} %i } \
%{!E:%{!M:%{!MM:\
- cc1gm2 " M2CPP " %(cc1_options) %{I*} %i %{c} \
+ cc1gm2 " M2CPP " %(cc1_options) %{fm2-pathname*} %i %{c} \
%{!fcpp:%{MD|MMD|MF*: \
%eto generate dependencies you must specify '-fcpp' }} \
%{!fsyntax-only:%(invoke_as)} \
{".m2i", "@modula-2-cpp-output", 0, 0, 0},
{"@modula-2-cpp-output",
"%{!M:%{!MM:%{!E: \
- cc1gm2 %<fcpp %(cc1_options) %{v} %I -fmod=.mod.m2i -fdef=.def.m2i %{I*} \
+ cc1gm2 %<fcpp %(cc1_options) %{v} %I -fmod=.mod.m2i -fdef=.def.m2i \
+ %{fm2-pathname*} \
-fpreprocessed %i %{c} \
%{!fsyntax-only:%(invoke_as)}}}}", 0, 0, 0},
Modula-2
generate error messages which render keywords in lower case
+fm2-pathname=
+Modula-2 Joined
+specify the module mangled prefix name for all modules in the following include paths
+
+fm2-pathnameI
+Modula-2 Joined
+; For internal use only: used by the driver to copy the user facing -I option
+
fm2-plugin
Modula-2
-insert plugin to identify runtime errors at compiletime (default on)
+insert plugin to identify runtime errors at compiletime
+
+fm2-prefix=
+Modula-2 Joined
+specify the module mangled prefix name
fm2-statistics
Modula-2
<http://www.gnu.org/licenses/>. */
#include <config.h>
-#include "m2rts.h"
+// #include "m2rts.h"
extern "C" int UnixArgs_GetArgC (void);
{
}
+#if 0
struct _M2_UnixArgs_ctor { _M2_UnixArgs_ctor (); } _M2_UnixArgs_ctor;
_M2_UnixArgs_ctor::_M2_UnixArgs_ctor (void)
M2RTS_RegisterModule ("UnixArgs", _M2_UnixArgs_init, _M2_UnixArgs_fini,
_M2_UnixArgs_dep);
}
+#endif
va_start (arg, _format_high);
done = vfprintf (stdout, format, arg);
va_end (arg);
+ return done;
+}
+
+EXTERN
+int
+libc_snprintf (char *dest, size_t length, char *_format, unsigned int _format_high, ...)
+{
+ va_list arg;
+ int done;
+ char format[_format_high + 1];
+ unsigned int i = 0;
+ unsigned int j = 0;
+ char *c;
+
+ do
+ {
+ c = index (&_format[i], '\\');
+ if (c == NULL)
+ strcpy (&format[j], &_format[i]);
+ else
+ {
+ memcpy (&format[j], &_format[i], (c - _format) - i);
+ i = c - _format;
+ j += c - _format;
+ if (_format[i + 1] == 'n')
+ format[j] = '\n';
+ else
+ format[j] = _format[i + 1];
+ j++;
+ i += 2;
+ }
+ }
+ while (c != NULL);
+ va_start (arg, _format_high);
+ done = vsnprintf (dest, length, format, arg);
+ va_end (arg);
return done;
}
typedef void (*proc_con) (int, char **, char **);
typedef void (*proc_dep) (void);
-extern "C" void M2RTS_RequestDependant (const char *modulename, const char *dependancy);
-extern "C" void M2RTS_RegisterModule (const char *modulename,
+extern "C" void M2RTS_RequestDependant (const char *modulename, const char *libname,
+ const char *dependancy, const char *deplib);
+extern "C" void M2RTS_RegisterModule (const char *modulename, const char *libname,
proc_con init, proc_con fini, proc_dep dependencies);
extern "C" void _M2_M2RTS_init (void);
(*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 *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 722, (const char *) "ConcatContents", 14);
+ (*c).next = AssignDebug ((*c).next, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 722, (const char *) "ConcatContents", 14);
}
else
{
AddDebugInfo ((*c).next);
if (TraceOn)
{
- (*c).next = AssignDebug ((*c).next, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 917, (const char *) "ConcatContentsAddress", 21);
+ (*c).next = AssignDebug ((*c).next, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 917, (const char *) "ConcatContentsAddress", 21);
}
}
else
AddDebugInfo (s);
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 758, (const char *) "InitString", 10);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 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 *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 957, (const char *) "InitStringCharStar", 18);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 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 *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 977, (const char *) "InitStringChar", 14);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 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 *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1173, (const char *) "Dup", 3);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 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 *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1193, (const char *) "Add", 3);
+ a = AssignDebug (a, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 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 *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1250, (const char *) "EqualCharStar", 13);
+ t = AssignDebug (t, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1250, (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 *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1280, (const char *) "EqualArray", 10);
+ t = AssignDebug (t, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1280, (const char *) "EqualArray", 10);
}
t = AddToGarbage (t, s);
if (DynamicStrings_Equal (t, s))
}
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1312, (const char *) "Mult", 4);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1312, (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 *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1380, (const char *) "Slice", 5);
+ t->contents.next = AssignDebug (t->contents.next, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1380, (const char *) "Slice", 5);
}
}
t = t->contents.next;
}
if (TraceOn)
{
- d = AssignDebug (d, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1397, (const char *) "Slice", 5);
+ d = AssignDebug (d, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1397, (const char *) "Slice", 5);
}
return d;
/* static analysis guarentees a RETURN statement will be used before here. */
}
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1509, (const char *) "RemoveComment", 13);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1509, (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 *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1621, (const char *) "RemoveWhitePrefix", 17);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1621, (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 *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1643, (const char *) "RemoveWhitePostfix", 18);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1643, (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 *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 176, (const char *) "PopAllocationExemption", 22, (const char *) "mismatched number of PopAllocation's compared to PushAllocation's", 65);
+ M2RTS_Halt ((const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 176, (const char *) "PopAllocationExemption", 22, (const char *) "mismatched number of PopAllocation's compared to PushAllocation's", 65);
}
else
{
return f; /* create new slot */
}
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/FIO.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/FIO.def", 25, 1);
__builtin_unreachable ();
}
(*p) = static_cast<unsigned char> ((*fd->buffer->contents).array[fd->buffer->position]);
fd->buffer->left -= 1; /* remove consumed bytes */
fd->buffer->position += 1; /* move onwards n bytes */
- nBytes = 0; /* reduce the amount for future direct */
+ nBytes = 0;
/* read */
return 1;
}
if (f != Error)
{
- /* avoid dangling else. */
fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
total = 0; /* how many bytes have we read */
if (fd != NULL) /* how many bytes have we read */
}
return total;
}
- else
- {
- return -1;
- }
}
}
- else
- {
- return -1;
- }
+ return -1;
/* static analysis guarentees a RETURN statement will be used before here. */
__builtin_unreachable ();
}
return fd->name.address;
}
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/FIO.def", 25, 1);
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
__builtin_unreachable ();
}
return fd->name.size;
}
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/FIO.def", 25, 1);
+ return 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
__builtin_unreachable ();
}
{
return (n >= i->Low) && (n <= i->High);
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/Indexing.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/Indexing.def", 20, 1);
__builtin_unreachable ();
}
{
return i->High;
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/Indexing.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/Indexing.def", 20, 1);
__builtin_unreachable ();
}
{
return i->Low;
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/Indexing.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/Indexing.def", 20, 1);
__builtin_unreachable ();
}
struct M2Dependent__T3_a { M2Dependent_ModuleChain array[M2Dependent_user-M2Dependent_unregistered+1]; };
struct M2Dependent__T2_r {
void *name;
+ void *libname;
M2Dependent_ArgCVEnvP init;
M2Dependent_ArgCVEnvP fini;
M2Dependent_DependencyList dependency;
static M2Dependent__T3 Modules;
static unsigned int Initialized;
+static unsigned int WarningTrace;
static unsigned int ModuleTrace;
+static unsigned int HexTrace;
static unsigned int DependencyTrace;
static unsigned int PreTrace;
static unsigned int PostTrace;
module constructor in turn.
*/
-extern "C" void M2Dependent_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+extern "C" void M2Dependent_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
/*
DeconstructModules - resolve dependencies and then call each
module constructor in turn.
*/
-extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
/*
RegisterModule - adds module name to the list of outstanding
explored to determine initialization order.
*/
-extern "C" void M2Dependent_RegisterModule (void * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
+extern "C" void M2Dependent_RegisterModule (void * modulename, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
/*
RequestDependant - used to specify that modulename is dependant upon
if we are not using StaticInitialization.
*/
-extern "C" void M2Dependent_RequestDependant (void * modulename, void * dependantmodule);
+extern "C" void M2Dependent_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
/*
CreateModule - creates a new module entry and returns the
ModuleChain.
*/
-static M2Dependent_ModuleChain CreateModule (void * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
+static M2Dependent_ModuleChain CreateModule (void * name, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
/*
AppendModule - append chain to end of the list.
static unsigned int onChain (M2Dependent_DependencyState state, M2Dependent_ModuleChain mptr);
/*
- LookupModuleN - lookup module from the state list. The string is limited
- to nchar.
+ max -
*/
-static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int nchar);
+static unsigned int max (unsigned int a, unsigned int b);
+
+/*
+ min -
+*/
+
+static unsigned int min (unsigned int a, unsigned int b);
+
+/*
+ LookupModuleN - lookup module from the state list.
+ The strings lengths are known.
+*/
+
+static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int namelen, void * libname, unsigned int libnamelen);
/*
LookupModule - lookup and return the ModuleChain pointer containing
module name from a particular list.
*/
-static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name);
+static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name, void * libname);
/*
toCString - replace any character sequence
static void traceprintf2 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg);
+/*
+ traceprintf3 - wrap printf with a boolean flag.
+*/
+
+static void traceprintf3 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg1, void * arg2);
+
/*
moveTo - moves mptr to the new list determined by newstate.
It updates the mptr state appropriately.
ResolveDependant -
*/
-static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule);
+static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule, void * libname);
/*
PerformRequestDependant - the current modulename has a dependancy upon
resolved.
*/
-static void PerformRequestDependant (void * modulename, void * dependantmodule);
+static void PerformRequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
/*
- ResolveDependencies - resolve dependencies for currentmodule.
+ ResolveDependencies - resolve dependencies for currentmodule, libname.
*/
-static void ResolveDependencies (void * currentmodule);
+static void ResolveDependencies (void * currentmodule, void * libname);
/*
DisplayModuleInfo - displays all module in the state.
*/
-static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *name_, unsigned int _name_high);
+static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *desc_, unsigned int _desc_high);
/*
DumpModuleData -
static void combine (M2Dependent_DependencyState src, M2Dependent_DependencyState dest);
+/*
+ tracemodule -
+*/
+
+static void tracemodule (unsigned int flag, void * modname, unsigned int modlen, void * libname, unsigned int liblen);
+
+/*
+ ForceModule -
+*/
+
+static void ForceModule (void * modname, unsigned int modlen, void * libname, unsigned int liblen);
+
/*
ForceDependencies - if the user has specified a forced order then we override
the dynamic ordering with the preference.
static void CheckApplication (void);
+/*
+ warning3 - write format arg1 arg2 to stderr.
+*/
+
+static void warning3 (const char *format_, unsigned int _format_high, void * arg1, void * arg2);
+
/*
equal - return TRUE if C string cstr is equal to str.
*/
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.
+ "all,module,hex,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.
+ hex dump the modules ctor functions address in hex.
pre generate a list of all modules seen prior to having
their dependancies resolved.
dep display a trace as the modules are resolved.
ModuleChain.
*/
-static M2Dependent_ModuleChain CreateModule (void * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
+static M2Dependent_ModuleChain CreateModule (void * name, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
{
M2Dependent_ModuleChain mptr;
+ void * p0;
+ void * p1;
Storage_ALLOCATE ((void **) &mptr, sizeof (M2Dependent__T2));
mptr->name = name;
+ mptr->libname = libname;
mptr->init = init;
mptr->fini = fini;
mptr->dependency.proc = dependencies;
mptr->dependency.state = M2Dependent_unregistered;
mptr->prev = NULL;
mptr->next = NULL;
+ if (HexTrace)
+ {
+ libc_printf ((const char *) " (init: %p fini: %p", 22, init, fini);
+ libc_printf ((const char *) " dep: %p)", 10, dependencies);
+ }
return mptr;
/* static analysis guarentees a RETURN statement will be used before here. */
__builtin_unreachable ();
/*
- LookupModuleN - lookup module from the state list. The string is limited
- to nchar.
+ max -
+*/
+
+static unsigned int max (unsigned int a, unsigned int b)
+{
+ if (a > b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ min -
*/
-static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int nchar)
+static unsigned int min (unsigned int a, unsigned int b)
+{
+ if (a < b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ LookupModuleN - lookup module from the state list.
+ The strings lengths are known.
+*/
+
+static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int namelen, void * libname, unsigned int libnamelen)
{
M2Dependent_ModuleChain ptr;
{
ptr = Modules.array[state-M2Dependent_unregistered];
do {
- if ((strncmp (reinterpret_cast<M2LINK_PtrToChar> (ptr->name), reinterpret_cast<M2LINK_PtrToChar> (name), nchar)) == 0)
+ if (((strncmp (reinterpret_cast<M2LINK_PtrToChar> (ptr->name), reinterpret_cast<M2LINK_PtrToChar> (name), max (namelen, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (ptr->name)))))) == 0) && ((strncmp (reinterpret_cast<M2LINK_PtrToChar> (ptr->libname), reinterpret_cast<M2LINK_PtrToChar> (libname), max (libnamelen, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (ptr->libname)))))) == 0))
{
return ptr;
}
module name from a particular list.
*/
-static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name)
+static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name, void * libname)
{
- return LookupModuleN (state, name, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (name))));
+ return LookupModuleN (state, name, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (name))), libname, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (libname))));
/* static analysis guarentees a RETURN statement will be used before here. */
__builtin_unreachable ();
}
static int strncmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b, unsigned int n)
{
- if (((a != NULL) && (b != NULL)) && (n > 0))
+ if (n == 0)
{
- /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ return 0;
+ }
+ else if ((a != NULL) && (b != NULL))
+ {
+ /* avoid dangling else. */
if (a == b)
{
return 0;
static void traceprintf2 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg)
{
+ char ch;
char str[_str_high+1];
/* make a local copy of each unbounded array. */
if (flag)
{
toCString ((char *) str, _str_high);
+ if (arg == NULL)
+ {
+ ch = (char) 0;
+ arg = &ch;
+ }
libc_printf ((const char *) str, _str_high, arg);
}
}
+/*
+ traceprintf3 - wrap printf with a boolean flag.
+*/
+
+static void traceprintf3 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg1, void * arg2)
+{
+ char ch;
+ 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);
+ if (arg1 == NULL)
+ {
+ ch = (char) 0;
+ arg1 = &ch;
+ }
+ if (arg2 == NULL)
+ {
+ ch = (char) 0;
+ arg2 = &ch;
+ }
+ libc_printf ((const char *) str, _str_high, arg1, arg2);
+ }
+}
+
+
/*
moveTo - moves mptr to the new list determined by newstate.
It updates the mptr state appropriately.
ResolveDependant -
*/
-static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule)
+static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule, void * libname)
{
if (mptr == NULL)
{
- traceprintf (DependencyTrace, (const char *) " module has not been registered via a global constructor\\n", 60);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] has not been registered via a global constructor\\n", 68, currentmodule, libname);
}
else
{
else
{
moveTo (M2Dependent_started, mptr);
- traceprintf2 (DependencyTrace, (const char *) " starting: %s\\n", 17, currentmodule);
+ traceprintf3 (DependencyTrace, (const char *) " starting: %s [%s]\\n", 22, currentmodule, libname);
(*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. */
+ traceprintf3 (DependencyTrace, (const char *) " finished: %s [%s]\\n", 22, currentmodule, libname); /* Invoke and process the dependency graph. */
moveTo (M2Dependent_ordered, mptr);
}
}
resolved.
*/
-static void PerformRequestDependant (void * modulename, void * dependantmodule)
+static void PerformRequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname)
{
M2Dependent_ModuleChain mptr;
- traceprintf2 (DependencyTrace, (const char *) " module %s", 11, modulename);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s]", 16, modulename, libname);
if (dependantmodule == NULL)
{
/* avoid dangling else. */
- traceprintf2 (DependencyTrace, (const char *) " has finished its import graph\\n", 32, modulename);
- mptr = LookupModule (M2Dependent_unordered, modulename);
+ traceprintf (DependencyTrace, (const char *) " has finished its import graph\\n", 32);
+ mptr = LookupModule (M2Dependent_unordered, modulename, libname);
if (mptr != NULL)
{
- traceprintf2 (DependencyTrace, (const char *) " module %s is now ordered\\n", 28, modulename);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] is now ordered\\n", 33, modulename, libname);
moveTo (M2Dependent_ordered, mptr);
}
}
else
{
- traceprintf2 (DependencyTrace, (const char *) " imports from %s\\n", 18, dependantmodule);
- mptr = LookupModule (M2Dependent_ordered, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " imports from %s [%s]\\n", 23, dependantmodule, dependantlibname);
+ mptr = LookupModule (M2Dependent_ordered, dependantmodule, dependantlibname);
if (mptr == NULL)
{
- traceprintf2 (DependencyTrace, (const char *) " module %s is not ordered\\n", 28, dependantmodule);
- mptr = LookupModule (M2Dependent_unordered, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] is not ordered\\n", 33, dependantmodule, dependantlibname);
+ mptr = LookupModule (M2Dependent_unordered, dependantmodule, dependantlibname);
if (mptr == NULL)
{
- traceprintf2 (DependencyTrace, (const char *) " module %s is not unordered\\n", 30, dependantmodule);
- mptr = LookupModule (M2Dependent_started, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] is not unordered\\n", 35, dependantmodule, dependantlibname);
+ mptr = LookupModule (M2Dependent_started, dependantmodule, dependantlibname);
if (mptr == NULL)
{
- traceprintf2 (DependencyTrace, (const char *) " module %s has not started\\n", 29, dependantmodule);
- traceprintf2 (DependencyTrace, (const char *) " module %s attempting to import from", 37, modulename);
- traceprintf2 (DependencyTrace, (const char *) " %s which has not registered itself via a constructor\\n", 55, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] has not started\\n", 34, dependantmodule, dependantlibname);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] attempting to import from", 42, modulename, libname);
+ traceprintf3 (DependencyTrace, (const char *) " %s [%s] which has not registered itself via a constructor\\n", 60, dependantmodule, dependantlibname);
}
else
{
- traceprintf2 (DependencyTrace, (const char *) " module %s has registered itself and has started\\n", 51, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] has registered itself and has started\\n", 56, dependantmodule, dependantlibname);
}
}
else
{
- traceprintf2 (DependencyTrace, (const char *) " module %s resolving\\n", 23, dependantmodule);
- ResolveDependant (mptr, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] resolving\\n", 28, dependantmodule, dependantlibname);
+ ResolveDependant (mptr, dependantmodule, dependantlibname);
}
}
else
{
- traceprintf2 (DependencyTrace, (const char *) " module %s ", 12, modulename);
- traceprintf2 (DependencyTrace, (const char *) " dependant %s is ordered\\n", 26, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s]", 16, modulename, libname);
+ traceprintf3 (DependencyTrace, (const char *) " dependant %s [%s] is ordered\\n", 31, dependantmodule, dependantlibname);
}
}
}
/*
- ResolveDependencies - resolve dependencies for currentmodule.
+ ResolveDependencies - resolve dependencies for currentmodule, libname.
*/
-static void ResolveDependencies (void * currentmodule)
+static void ResolveDependencies (void * currentmodule, void * libname)
{
M2Dependent_ModuleChain mptr;
- mptr = LookupModule (M2Dependent_unordered, currentmodule);
+ mptr = LookupModule (M2Dependent_unordered, currentmodule, libname);
while (mptr != NULL)
{
- traceprintf2 (DependencyTrace, (const char *) " attempting to resolve the dependants for %s\\n", 48, currentmodule);
- ResolveDependant (mptr, currentmodule);
+ traceprintf3 (DependencyTrace, (const char *) " attempting to resolve the dependants for %s [%s]\\n", 53, currentmodule, libname);
+ ResolveDependant (mptr, currentmodule, libname);
mptr = Modules.array[M2Dependent_unordered-M2Dependent_unregistered];
}
}
DisplayModuleInfo - displays all module in the state.
*/
-static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *name_, unsigned int _name_high)
+static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *desc_, unsigned int _desc_high)
{
M2Dependent_ModuleChain mptr;
unsigned int count;
- char name[_name_high+1];
+ char desc[_desc_high+1];
/* make a local copy of each unbounded array. */
- memcpy (name, name_, _name_high+1);
+ memcpy (desc, desc_, _desc_high+1);
if (Modules.array[state-M2Dependent_unregistered] != NULL)
{
- libc_printf ((const char *) "%s modules\\n", 12, &name);
+ libc_printf ((const char *) "%s modules\\n", 12, &desc);
mptr = Modules.array[state-M2Dependent_unregistered];
count = 0;
do {
- libc_printf ((const char *) " %d %s", 8, count, mptr->name);
+ if (mptr->name == NULL)
+ {
+ libc_printf ((const char *) " %d %s []", 11, count, mptr->name);
+ }
+ else
+ {
+ libc_printf ((const char *) " %d %s [%s]", 13, count, mptr->name, mptr->libname);
+ }
count += 1;
if (mptr->dependency.appl)
{
}
+/*
+ tracemodule -
+*/
+
+static void tracemodule (unsigned int flag, void * modname, unsigned int modlen, void * libname, unsigned int liblen)
+{
+ typedef struct tracemodule__T4_a tracemodule__T4;
+
+ struct tracemodule__T4_a { char array[100+1]; };
+ tracemodule__T4 buffer;
+ unsigned int len;
+
+ if (flag)
+ {
+ len = min (modlen, sizeof (buffer)-1);
+ libc_strncpy (&buffer, modname, len);
+ buffer.array[len] = (char) 0;
+ libc_printf ((const char *) "%s ", 3, &buffer);
+ len = min (liblen, sizeof (buffer)-1);
+ libc_strncpy (&buffer, libname, len);
+ buffer.array[len] = (char) 0;
+ libc_printf ((const char *) " [%s]", 5, &buffer);
+ }
+}
+
+
+/*
+ ForceModule -
+*/
+
+static void ForceModule (void * modname, unsigned int modlen, void * libname, unsigned int liblen)
+{
+ M2Dependent_ModuleChain mptr;
+
+ traceprintf (ForceTrace, (const char *) "forcing module: ", 16);
+ tracemodule (ForceTrace, modname, modlen, libname, liblen);
+ traceprintf (ForceTrace, (const char *) "\\n", 2);
+ mptr = LookupModuleN (M2Dependent_ordered, modname, modlen, libname, liblen);
+ if (mptr != NULL)
+ {
+ mptr->dependency.forced = TRUE;
+ moveTo (M2Dependent_user, mptr);
+ }
+}
+
+
/*
ForceDependencies - if the user has specified a forced order then we override
the dynamic ordering with the preference.
static void ForceDependencies (void)
{
- M2Dependent_ModuleChain mptr;
- M2Dependent_ModuleChain userChain;
- unsigned int count;
+ unsigned int len;
+ unsigned int modlen;
+ unsigned int liblen;
+ M2LINK_PtrToChar modname;
+ M2LINK_PtrToChar libname;
M2LINK_PtrToChar pc;
M2LINK_PtrToChar start;
if (M2LINK_ForcedModuleInitOrder != NULL)
{
- userChain = NULL;
+ traceprintf2 (ForceTrace, (const char *) "user forcing order: %s\\n", 24, reinterpret_cast<void *> (M2LINK_ForcedModuleInitOrder));
pc = M2LINK_ForcedModuleInitOrder;
start = pc;
- count = 0;
+ len = 0;
+ modname = NULL;
+ modlen = 0;
+ libname = NULL;
+ liblen = 0;
while ((*pc) != ASCII_nul)
{
- if ((*pc) == ',')
- {
- mptr = LookupModuleN (M2Dependent_ordered, reinterpret_cast<void *> (start), count);
- if (mptr != NULL)
- {
- mptr->dependency.forced = TRUE;
- moveTo (M2Dependent_user, mptr);
- }
- pc += 1;
- start = pc;
- count = 0;
- }
- else
+ switch ((*pc))
{
- pc += 1;
- count += 1;
+ case ':':
+ libname = start;
+ liblen = len;
+ len = 0;
+ pc += 1;
+ start = pc;
+ break;
+
+ case ',':
+ modname = start;
+ modlen = len;
+ ForceModule (reinterpret_cast<void *> (modname), modlen, reinterpret_cast<void *> (libname), liblen);
+ libname = NULL;
+ liblen = 0;
+ modlen = 0;
+ len = 0;
+ pc += 1;
+ start = pc;
+ break;
+
+
+ default:
+ pc += 1;
+ len += 1;
+ break;
}
}
if (start != pc)
{
- mptr = LookupModuleN (M2Dependent_ordered, reinterpret_cast<void *> (start), count);
- if (mptr != NULL)
- {
- mptr->dependency.forced = TRUE;
- moveTo (M2Dependent_user, mptr);
- }
+ ForceModule (reinterpret_cast<void *> (start), len, reinterpret_cast<void *> (libname), liblen);
}
combine (M2Dependent_user, M2Dependent_ordered);
}
} while (! ((appl != NULL) || (mptr == Modules.array[M2Dependent_ordered-M2Dependent_unregistered])));
if (appl != NULL)
{
- Modules.array[M2Dependent_ordered-M2Dependent_unregistered] = appl->next;
+ RemoveModule (&Modules.array[M2Dependent_ordered-M2Dependent_unregistered], appl);
+ AppendModule (&Modules.array[M2Dependent_ordered-M2Dependent_unregistered], appl);
}
}
}
+/*
+ warning3 - write format arg1 arg2 to stderr.
+*/
+
+static void warning3 (const char *format_, unsigned int _format_high, void * arg1, void * arg2)
+{
+ typedef struct warning3__T5_a warning3__T5;
+
+ struct warning3__T5_a { char array[4096+1]; };
+ warning3__T5 buffer;
+ int len;
+ char format[_format_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (format, format_, _format_high+1);
+
+ if (WarningTrace)
+ {
+ len = libc_snprintf (&buffer, static_cast<size_t> (sizeof (buffer)), (const char *) "warning: ", 9);
+ libc_write (2, &buffer, static_cast<size_t> (len));
+ len = libc_snprintf (&buffer, static_cast<size_t> (sizeof (buffer)), (const char *) format, _format_high, arg1, arg2);
+ libc_write (2, &buffer, static_cast<size_t> (len));
+ }
+}
+
+
/*
equal - return TRUE if C string cstr is equal to str.
*/
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.
+ "all,module,hex,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.
+ hex dump the modules ctor functions address in hex.
pre generate a list of all modules seen prior to having
their dependancies resolved.
dep display a trace as the modules are resolved.
PostTrace = FALSE;
PreTrace = FALSE;
ForceTrace = FALSE;
+ HexTrace = FALSE;
+ WarningTrace = FALSE;
pc = static_cast<SetupDebugFlags__T1> (libc_getenv (const_cast<void*> (reinterpret_cast<const void*>("GCC_M2LINK_RTFLAG"))));
while ((pc != NULL) && ((*pc) != ASCII_nul))
{
PreTrace = TRUE;
PostTrace = TRUE;
ForceTrace = TRUE;
+ HexTrace = TRUE;
+ WarningTrace = TRUE;
pc += 3;
}
else if (equal (reinterpret_cast<void *> (pc), (const char *) "module", 6))
ModuleTrace = TRUE;
pc += 6;
}
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "warning", 7))
+ {
+ /* avoid dangling else. */
+ WarningTrace = TRUE;
+ pc += 7;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "hex", 3))
+ {
+ /* avoid dangling else. */
+ HexTrace = TRUE;
+ pc += 3;
+ }
else if (equal (reinterpret_cast<void *> (pc), (const char *) "dep", 3))
{
/* avoid dangling else. */
module constructor in turn.
*/
-extern "C" void M2Dependent_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp)
+extern "C" void M2Dependent_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
{
M2Dependent_ModuleChain mptr;
M2Dependent_ArgCVEnvP nulp;
CheckInitialized ();
- traceprintf2 (ModuleTrace, (const char *) "application module: %s\\n", 24, applicationmodule);
- mptr = LookupModule (M2Dependent_unordered, applicationmodule);
+ traceprintf3 (ModuleTrace, (const char *) "application module: %s [%s]\\n", 29, applicationmodule, libname);
+ mptr = LookupModule (M2Dependent_unordered, applicationmodule, libname);
if (mptr != NULL)
{
mptr->dependency.appl = TRUE;
}
traceprintf (PreTrace, (const char *) "Pre resolving dependents\\n", 26);
DumpModuleData (PreTrace);
- ResolveDependencies (applicationmodule);
+ ResolveDependencies (applicationmodule, libname);
traceprintf (PreTrace, (const char *) "Post resolving dependents\\n", 27);
DumpModuleData (PostTrace);
ForceDependencies ();
DumpModuleData (ForceTrace);
if (Modules.array[M2Dependent_ordered-M2Dependent_unregistered] == NULL)
{
- traceprintf2 (ModuleTrace, (const char *) " module: %s has not registered itself using a global constructor\\n", 67, applicationmodule);
+ traceprintf3 (ModuleTrace, (const char *) " module: %s [%s] has not registered itself using a global constructor\\n", 72, applicationmodule, libname);
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);
}
do {
if (mptr->dependency.forc)
{
- traceprintf2 (ModuleTrace, (const char *) "initializing module: %s for C\\n", 31, mptr->name);
+ traceprintf3 (ModuleTrace, (const char *) "initializing module: %s [%s] for C\\n", 36, mptr->name, mptr->libname);
}
else
{
- traceprintf2 (ModuleTrace, (const char *) "initializing module: %s\\n", 25, mptr->name);
+ traceprintf3 (ModuleTrace, (const char *) "initializing module: %s [%s]\\n", 30, mptr->name, mptr->libname);
}
if (mptr->dependency.appl)
{
- traceprintf2 (ModuleTrace, (const char *) "application module: %s\\n", 24, mptr->name);
+ traceprintf3 (ModuleTrace, (const char *) "application module: %s [%s]\\n", 29, mptr->name, mptr->libname);
traceprintf (ModuleTrace, (const char *) " calling M2RTS_ExecuteInitialProcedures\\n", 42);
M2RTS_ExecuteInitialProcedures ();
traceprintf (ModuleTrace, (const char *) " calling application module\\n", 30);
module constructor in turn.
*/
-extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp)
+extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
{
M2Dependent_ModuleChain mptr;
- traceprintf2 (ModuleTrace, (const char *) "application module finishing: %s\\n", 34, applicationmodule);
+ traceprintf3 (ModuleTrace, (const char *) "application module finishing: %s [%s]\\n", 39, applicationmodule, libname);
if (Modules.array[M2Dependent_ordered-M2Dependent_unregistered] == NULL)
{
traceprintf (ModuleTrace, (const char *) " no ordered modules found during finishing\\n", 45);
do {
if (mptr->dependency.forc)
{
- traceprintf2 (ModuleTrace, (const char *) "finalizing module: %s for C\\n", 29, mptr->name);
+ traceprintf3 (ModuleTrace, (const char *) "finalizing module: %s [%s] for C\\n", 34, mptr->name, mptr->libname);
}
else
{
- traceprintf2 (ModuleTrace, (const char *) "finalizing module: %s\\n", 23, mptr->name);
+ traceprintf3 (ModuleTrace, (const char *) "finalizing module: %s [%s]\\n", 28, mptr->name, mptr->libname);
}
(*mptr->fini.proc) (argc, argv, envp);
mptr = mptr->prev;
explored to determine initialization order.
*/
-extern "C" void M2Dependent_RegisterModule (void * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
+extern "C" void M2Dependent_RegisterModule (void * modulename, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
{
+ M2Dependent_ModuleChain mptr;
+
CheckInitialized ();
if (! M2LINK_StaticInitialization)
{
- traceprintf2 (ModuleTrace, (const char *) "module: %s registering\\n", 24, name);
- moveTo (M2Dependent_unordered, CreateModule (name, init, fini, dependencies));
+ mptr = LookupModule (M2Dependent_unordered, modulename, libname);
+ if (mptr == NULL)
+ {
+ traceprintf3 (ModuleTrace, (const char *) "module: %s [%s] registering", 27, modulename, libname);
+ moveTo (M2Dependent_unordered, CreateModule (modulename, libname, init, fini, dependencies));
+ traceprintf (ModuleTrace, (const char *) "\\n", 2);
+ }
+ else
+ {
+ warning3 ((const char *) "module: %s [%s] (ignoring duplicate registration)\\n", 51, modulename, libname);
+ }
}
}
if we are not using StaticInitialization.
*/
-extern "C" void M2Dependent_RequestDependant (void * modulename, void * dependantmodule)
+extern "C" void M2Dependent_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname)
{
CheckInitialized ();
if (! M2LINK_StaticInitialization)
{
- PerformRequestDependant (modulename, dependantmodule);
+ PerformRequestDependant (modulename, libname, dependantmodule, dependantlibname);
}
}
typedef void (*M2Dependent_ArgCVEnvP_t) (int, void *, void *);
struct M2Dependent_ArgCVEnvP_p { M2Dependent_ArgCVEnvP_t proc; };
-EXTERN void M2Dependent_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp);
-EXTERN void M2Dependent_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+EXTERN void M2Dependent_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
+EXTERN void M2Dependent_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
/*
RegisterModule - adds module name to the list of outstanding
explored to determine initialization order.
*/
-EXTERN void M2Dependent_RegisterModule (void * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
+EXTERN void M2Dependent_RegisterModule (void * modulename, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
/*
- RequestDependant - used to specify that modulename is dependant upon
- module dependantmodule.
+ RequestDependant - used to specify that modulename:libname
+ is dependant upon
+ module dependantmodule:dependantlibname
*/
-EXTERN void M2Dependent_RequestDependant (void * modulename, void * dependantmodule);
+EXTERN void M2Dependent_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
# ifdef __cplusplus
}
# endif
n = RTExceptions_GetNumber (e);
if (n == (UINT_MAX))
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/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*>("../../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 ("../../gcc-read-write/gcc/m2/gm2-libs/M2EXCEPTION.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/M2EXCEPTION.def", 25, 1);
__builtin_unreachable ();
}
module constructor in turn.
*/
-extern "C" void M2RTS_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+extern "C" void M2RTS_ConstructModules (void * applicationmodule, void * libname, 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);
+extern "C" void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
/*
RegisterModule - adds module name to the list of outstanding
explored to determine initialization order.
*/
-extern "C" void M2RTS_RegisterModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
+extern "C" void M2RTS_RegisterModule (void * name, void * libname, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
/*
RequestDependant - used to specify that modulename is dependant upon
module dependantmodule.
*/
-extern "C" void M2RTS_RequestDependant (void * modulename, void * dependantmodule);
+extern "C" void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
/*
InstallTerminationProcedure - installs a procedure, p, which will
module constructor in turn.
*/
-extern "C" void M2RTS_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp)
+extern "C" void M2RTS_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
{
- M2Dependent_ConstructModules (applicationmodule, argc, argv, envp);
+ M2Dependent_ConstructModules (applicationmodule, libname, argc, argv, envp);
}
module constructor in turn.
*/
-extern "C" void M2RTS_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp)
+extern "C" void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
{
- M2Dependent_DeconstructModules (applicationmodule, argc, argv, envp);
+ M2Dependent_DeconstructModules (applicationmodule, libname, argc, argv, envp);
}
explored to determine initialization order.
*/
-extern "C" void M2RTS_RegisterModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies)
+extern "C" void M2RTS_RegisterModule (void * name, void * libname, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies)
{
- M2Dependent_RegisterModule (name, (M2Dependent_ArgCVEnvP) {(M2Dependent_ArgCVEnvP_t) init.proc}, (M2Dependent_ArgCVEnvP) {(M2Dependent_ArgCVEnvP_t) fini.proc}, dependencies);
+ M2Dependent_RegisterModule (name, libname, (M2Dependent_ArgCVEnvP) {(M2Dependent_ArgCVEnvP_t) init.proc}, (M2Dependent_ArgCVEnvP) {(M2Dependent_ArgCVEnvP_t) fini.proc}, dependencies);
}
module dependantmodule.
*/
-extern "C" void M2RTS_RequestDependant (void * modulename, void * dependantmodule)
+extern "C" void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname)
{
- M2Dependent_RequestDependant (modulename, dependantmodule);
+ M2Dependent_RequestDependant (modulename, libname, dependantmodule, dependantlibname);
}
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);
+EXTERN void M2RTS_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
+EXTERN void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
/*
RegisterModule - adds module name to the list of outstanding
explored to determine initialization order.
*/
-EXTERN void M2RTS_RegisterModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
+EXTERN void M2RTS_RegisterModule (void * name, void * libname, 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);
+EXTERN void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
/*
InstallTerminationProcedure - installs a procedure, p, which will
}
else
{
- Debug_Halt ((const char *) "max push back stack exceeded, increase MaxPushBackStack", 55, 150, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/PushBackInput.mod", 54);
+ Debug_Halt ((const char *) "max push back stack exceeded, increase MaxPushBackStack", 55, 150, (const char *) "../../gcc/m2/gm2-libs/PushBackInput.mod", 39);
}
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 *) "../../gcc-read-write/gcc/m2/gm2-libs/PushBackInput.mod", 54);
+ Debug_Halt ((const char *) "assert failed", 13, 132, (const char *) "../../gcc/m2/gm2-libs/PushBackInput.mod", 39);
}
}
}
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 *) "../../gcc-read-write/gcc/m2/gm2-libs/PushBackInput.mod", 54);
+ Debug_Halt ((const char *) "assert failed", 13, 113, (const char *) "../../gcc/m2/gm2-libs/PushBackInput.mod", 39);
}
}
}
static void indexf (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_indexException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 613, 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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 613, 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*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 625, 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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 625, 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*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 637, 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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 637, 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*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 649, 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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 649, 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*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 661, 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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 661, 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*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 673, 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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 673, 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*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 685, 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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 685, 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*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 697, 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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 697, 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*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 709, 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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 709, 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*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 721, 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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 721, 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*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 733, 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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 733, 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*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 745, 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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 745, 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*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 757, 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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 757, 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*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 769, 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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 769, 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*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 781, 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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 781, 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 *) "../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod", 53, 599, (const char *) "GetBaseExceptionBlock", 21, (const char *) "currentEHB has not been initialized yet", 39);
+ M2RTS_Halt ((const char *) "../../gcc/m2/gm2-libs/RTExceptions.mod", 38, 599, (const char *) "GetBaseExceptionBlock", 21, (const char *) "currentEHB has not been initialized yet", 39);
}
else
{
return currentEHB;
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/RTExceptions.def", 25, 1);
__builtin_unreachable ();
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/gm2-libs/RTint.def", 25, 1);
+ CaseException ("../../gcc/m2/gm2-libs/RTint.def", 25, 1);
__builtin_unreachable ();
}
v = v->pending;
RTco_signal (lock);
return v->no;
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/RTint.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/RTint.def", 25, 1);
__builtin_unreachable ();
}
v = FindVectorNo (vec);
if (v == NULL)
{
- M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 286, (const char *) "ReArmTimeVector", 15, (const char *) "cannot find vector supplied", 27);
+ M2RTS_Halt ((const char *) "../../gcc/m2/gm2-libs/RTint.mod", 31, 286, (const char *) "ReArmTimeVector", 15, (const char *) "cannot find vector supplied", 27);
}
else
{
v = FindVectorNo (vec);
if (v == NULL)
{
- M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 312, (const char *) "GetTimeVector", 13, (const char *) "cannot find vector supplied", 27);
+ M2RTS_Halt ((const char *) "../../gcc/m2/gm2-libs/RTint.mod", 31, 312, (const char *) "GetTimeVector", 13, (const char *) "cannot find vector supplied", 27);
}
else
{
v = FindVectorNo (vec);
if (v == NULL)
{
- M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 339, (const char *) "AttachVector", 12, (const char *) "cannot find vector supplied", 27);
+ M2RTS_Halt ((const char *) "../../gcc/m2/gm2-libs/RTint.mod", 31, 339, (const char *) "AttachVector", 12, (const char *) "cannot find vector supplied", 27);
}
else
{
RTco_signal (lock);
return l;
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/RTint.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/RTint.def", 25, 1);
__builtin_unreachable ();
}
v = FindVectorNo (vec);
if (v == NULL)
{
- M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 372, (const char *) "IncludeVector", 13, (const char *) "cannot find vector supplied", 27);
+ M2RTS_Halt ((const char *) "../../gcc/m2/gm2-libs/RTint.mod", 31, 372, (const char *) "IncludeVector", 13, (const char *) "cannot find vector supplied", 27);
}
else
{
v = FindPendingVector (vec);
if (v == NULL)
{
- M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 415, (const char *) "ExcludeVector", 13, (const char *) "cannot find pending vector supplied", 35);
+ M2RTS_Halt ((const char *) "../../gcc/m2/gm2-libs/RTint.mod", 31, 415, (const char *) "ExcludeVector", 13, (const char *) "cannot find pending vector supplied", 35);
}
else
{
default:
- CaseException ("../../gcc-read-write/gcc/m2/gm2-libs/RTint.def", 25, 1);
+ CaseException ("../../gcc/m2/gm2-libs/RTint.def", 25, 1);
__builtin_unreachable ();
}
v = v->pending;
}
if (((untilInterrupt && (i == NULL)) && (o == NULL)) && ! found)
{
- M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 731, (const char *) "Listen", 6, (const char *) "deadlock found, no more processes to run and no interrupts active", 65);
+ M2RTS_Halt ((const char *) "../../gcc/m2/gm2-libs/RTint.mod", 31, 731, (const char *) "Listen", 6, (const char *) "deadlock found, no more processes to run and no interrupts active", 65);
}
/* printf('}
') ; */
M2RTS_HALT (-1);
__builtin_unreachable ();
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/StdIO.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/StdIO.def", 25, 1);
__builtin_unreachable ();
}
M2RTS_HALT (-1);
__builtin_unreachable ();
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/StdIO.def", 25, 1);
+ ReturnException ("../../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 *) "../../gcc-read-write/gcc/m2/gm2-libs/StringConvert.mod", 54, 1222, (const char *) "ToSigFig", 8);
+ Assert ((IsDigit (DynamicStrings_char (s, 0))) || ((DynamicStrings_char (s, 0)) == '.'), (const char *) "../../gcc/m2/gm2-libs/StringConvert.mod", 39, 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 *) "../../gcc-read-write/gcc/m2/gm2-libs/StringConvert.mod", 54, 1069, (const char *) "ToDecimalPlaces", 15);
+ Assert ((IsDigit (DynamicStrings_char (s, 0))) || ((DynamicStrings_char (s, 0)) == '.'), (const char *) "../../gcc/m2/gm2-libs/StringConvert.mod", 39, 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 *) "../../gcc-read-write/gcc/m2/gm2-libs/SysStorage.mod", 51);
+ Debug_Halt ((const char *) "out of memory error", 19, 50, (const char *) "../../gcc/m2/gm2-libs/SysStorage.mod", 36);
}
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 *) "../../gcc-read-write/gcc/m2/gm2-libs/SysStorage.mod", 51);
+ Debug_Halt ((const char *) "memset should have returned the first parameter", 47, 76, (const char *) "../../gcc/m2/gm2-libs/SysStorage.mod", 36);
}
}
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 *) "../../gcc-read-write/gcc/m2/gm2-libs/SysStorage.mod", 51);
+ Debug_Halt ((const char *) "out of memory error", 19, 119, (const char *) "../../gcc/m2/gm2-libs/SysStorage.mod", 36);
}
if (enableTrace && trace)
{
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_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
+extern "C" void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
+extern "C" void M2RTS_RegisterModule (void * name, void * libname, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
+extern "C" void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
extern "C" unsigned int M2RTS_InstallTerminationProcedure (PROC p);
extern "C" void M2RTS_ExecuteInitialProcedures (void);
extern "C" unsigned int M2RTS_InstallInitialProcedure (PROC p);
extern "C" void * libc_memset (void * s, int c, size_t size);
extern "C" void * libc_memmove (void * dest, void * src, size_t size);
extern "C" int libc_printf (const char *format_, unsigned int _format_high, ...);
+extern "C" int libc_snprintf (void * dest, size_t size, const char *format_, unsigned int _format_high, ...);
extern "C" int libc_setenv (void * name, void * value, int overwrite);
extern "C" void libc_srand (int seed);
extern "C" int libc_rand (void);
d->at.firstUsed = 0;
return d;
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
M2RTS_HALT (-1);
__builtin_unreachable ();
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
switch (f->kind)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* fill in, n. */
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* static analysis guarentees a RETURN statement will be used before here. */
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* static analysis guarentees a RETURN statement will be used before here. */
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../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 ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
M2RTS_HALT (-1);
__builtin_unreachable ();
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
}
M2RTS_HALT (-1);
__builtin_unreachable ();
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
return n;
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
M2RTS_HALT (-1);
__builtin_unreachable ();
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
M2RTS_HALT (-1);
__builtin_unreachable ();
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
return TRUE;
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* static analysis guarentees a RETURN statement will be used before here. */
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
return s;
}
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
return c;
}
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
M2RTS_HALT (-1); /* finish the cacading elsif statement. */
__builtin_unreachable ();
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
M2RTS_HALT (-1); /* finish the cacading elsif statement. */
__builtin_unreachable ();
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
mcPretty_setNeedSpace (p);
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
outText (p, (const char *) ";", 1);
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
if (n != NULL)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
M2RTS_HALT (-1);
__builtin_unreachable ();
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
mcPretty_setNeedSpace (p);
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* static analysis guarentees a RETURN statement will be used before here. */
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* static analysis guarentees a RETURN statement will be used before here. */
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* static analysis guarentees a RETURN statement will be used before here. */
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
M2RTS_HALT (-1);
__builtin_unreachable ();
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* static analysis guarentees a RETURN statement will be used before here. */
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
return n;
__builtin_unreachable ();
break;
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
importEnumFields (m, n);
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* static analysis guarentees a RETURN statement will be used before here. */
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
M2RTS_HALT (-1); /* most likely op needs a clause as above. */
__builtin_unreachable ();
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
M2RTS_HALT (-1); /* most likely op needs a clause as above. */
__builtin_unreachable ();
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
closeOutput ();
return TRUE;
}
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/keyc.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/keyc.def", 20, 1);
__builtin_unreachable ();
}
EXTERN void * libc_memmove (void * dest, void * src, size_t size);
EXTERN int libc_printf (const char *format_, unsigned int _format_high, ...);
+EXTERN int libc_snprintf (void * dest, size_t size, const char *format_, unsigned int _format_high, ...);
/*
setenv - sets environment variable, name, to value.
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/mcComment.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/mcComment.def", 20, 1);
__builtin_unreachable ();
}
if (cd->used)
}
mcflex_mcError (DynamicStrings_string (DynamicStrings_InitString ((const char *) "failed to find module name", 26)));
libc_exit (1);
- ReturnException ("../../gcc-read-write/gcc/m2/mc/mcComp.def", 20, 1);
+ ReturnException ("../../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 ("../../gcc-read-write/gcc/m2/mc/mcComp.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/mcComp.def", 20, 1);
__builtin_unreachable ();
}
{
if (! q)
{
- mcError_internalError ((const char *) "assert failed", 13, (const char *) "../../gcc-read-write/gcc/m2/mc/mcDebug.mod", 42, 35);
+ mcError_internalError ((const char *) "assert failed", 13, (const char *) "../../gcc/m2/mc/mcDebug.mod", 27, 35);
}
}
s = DynamicStrings_ConCatChar (s, '^');
s = SFIO_WriteS (FIO_StdOut, s);
FIO_WriteLine (FIO_StdOut);
- mcError_internalError ((const char *) m, _m_high, (const char *) "../../gcc-read-write/gcc/m2/mc/mcMetaError.mod", 46, 97);
+ mcError_internalError ((const char *) m, _m_high, (const char *) "../../gcc/m2/mc/mcMetaError.mod", 31, 97);
}
{
if (a != b)
{
- mcError_internalError ((const char *) "different string returned", 25, (const char *) "../../gcc-read-write/gcc/m2/mc/mcMetaError.mod", 46, 109);
+ mcError_internalError ((const char *) "different string returned", 25, (const char *) "../../gcc/m2/mc/mcMetaError.mod", 31, 109);
}
return a;
/* static analysis guarentees a RETURN statement will be used before here. */
case mcMetaError_chained:
if (e == NULL)
{
- mcError_internalError ((const char *) "should not be chaining an error onto an empty error note", 56, (const char *) "../../gcc-read-write/gcc/m2/mc/mcMetaError.mod", 46, 355);
+ mcError_internalError ((const char *) "should not be chaining an error onto an empty error note", 56, (const char *) "../../gcc/m2/mc/mcMetaError.mod", 31, 355);
}
else
{
default:
- mcError_internalError ((const char *) "unexpected enumeration value", 28, (const char *) "../../gcc-read-write/gcc/m2/mc/mcMetaError.mod", 46, 369);
+ mcError_internalError ((const char *) "unexpected enumeration value", 28, (const char *) "../../gcc/m2/mc/mcMetaError.mod", 31, 369);
break;
}
return e;
Indexing_DeleteIndice (s->list, Indexing_HighIndice (s->list));
return a;
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/mcStack.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/mcStack.def", 20, 1);
__builtin_unreachable ();
}
{
return Indexing_GetIndice (s->list, i);
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/mcStack.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/mcStack.def", 20, 1);
__builtin_unreachable ();
}
(*p) = ASCII_nul;
return doMakeKey (n, higha);
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/nameKey.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/nameKey.def", 20, 1);
__builtin_unreachable ();
}
return doMakeKey (n, higha);
}
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/nameKey.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/nameKey.def", 20, 1);
__builtin_unreachable ();
}
+++ /dev/null
-
-
-#if !defined (_pth_H)
-# define _pth_H
-
-# ifdef __cplusplus
-extern "C" {
-# endif
-# if !defined (PROC_D)
-# define PROC_D
- typedef void (*PROC_t) (void);
- typedef struct { PROC_t proc; } PROC;
-# endif
-
-# include "GSYSTEM.h"
-
-# if defined (_pth_C)
-# define EXTERN
-# else
-# define EXTERN extern
-# endif
-
-typedef struct pth_proc_p pth_proc;
-
-typedef unsigned int pth_size_t;
-
-typedef void *pth_pth_uctx_t;
-
-typedef void (*pth_proc_t) (void *);
-struct pth_proc_p { pth_proc_t proc; };
-
-EXTERN int pth_pth_select (int p1, void * p2, void * p3, void * p4, void * p5);
-EXTERN int pth_pth_uctx_create (void * p);
-EXTERN int pth_pth_uctx_make (pth_pth_uctx_t p1, void * p2, pth_size_t p3, void * p4, pth_proc p5, void * p6, pth_pth_uctx_t p7);
-EXTERN int pth_pth_uctx_save (pth_pth_uctx_t p1);
-EXTERN int pth_pth_uctx_switch (pth_pth_uctx_t p1, pth_pth_uctx_t p2);
-EXTERN int pth_pth_init (void);
-# ifdef __cplusplus
-}
-# endif
-
-# undef EXTERN
-#endif
(*father) = t;
if (t == NULL)
{
- Debug_Halt ((const char *) "parameter t should never be NIL", 31, 203, (const char *) "../../gcc-read-write/gcc/m2/mc/symbolKey.mod", 44);
+ Debug_Halt ((const char *) "parameter t should never be NIL", 31, 203, (const char *) "../../gcc/m2/mc/symbolKey.mod", 29);
}
(*child) = t->left;
if ((*child) != NULL)
}
else
{
- Debug_Halt ((const char *) "symbol already stored", 21, 119, (const char *) "../../gcc-read-write/gcc/m2/mc/symbolKey.mod", 44);
+ Debug_Halt ((const char *) "symbol already stored", 21, 119, (const char *) "../../gcc/m2/mc/symbolKey.mod", 29);
}
}
}
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 *) "../../gcc-read-write/gcc/m2/mc/symbolKey.mod", 44);
+ 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 *) "../../gcc/m2/mc/symbolKey.mod", 29);
}
}
{
}
-extern "C" void _M2_ASCII_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_ASCII_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
{
}
-extern "C" void _M2_Args_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_Args_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
{
}
-extern "C" void _M2_Assertion_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_Assertion_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
{
}
-extern "C" void _M2_Debug_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_Debug_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
(*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 *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 722, (const char *) "ConcatContents", 14);
+ (*c).next = AssignDebug ((*c).next, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 722, (const char *) "ConcatContents", 14);
}
else
{
AddDebugInfo ((*c).next);
if (TraceOn)
{
- (*c).next = AssignDebug ((*c).next, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 917, (const char *) "ConcatContentsAddress", 21);
+ (*c).next = AssignDebug ((*c).next, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 917, (const char *) "ConcatContentsAddress", 21);
}
}
else
AddDebugInfo (s);
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 758, (const char *) "InitString", 10);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 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 *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 957, (const char *) "InitStringCharStar", 18);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 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 *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 977, (const char *) "InitStringChar", 14);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 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 *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1173, (const char *) "Dup", 3);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 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 *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1193, (const char *) "Add", 3);
+ a = AssignDebug (a, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 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 *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1250, (const char *) "EqualCharStar", 13);
+ t = AssignDebug (t, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1250, (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 *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1280, (const char *) "EqualArray", 10);
+ t = AssignDebug (t, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1280, (const char *) "EqualArray", 10);
}
t = AddToGarbage (t, s);
if (DynamicStrings_Equal (t, s))
}
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1312, (const char *) "Mult", 4);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1312, (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 *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1380, (const char *) "Slice", 5);
+ t->contents.next = AssignDebug (t->contents.next, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1380, (const char *) "Slice", 5);
}
}
t = t->contents.next;
}
if (TraceOn)
{
- d = AssignDebug (d, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1397, (const char *) "Slice", 5);
+ d = AssignDebug (d, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1397, (const char *) "Slice", 5);
}
return d;
/* static analysis guarentees a RETURN statement will be used before here. */
}
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1509, (const char *) "RemoveComment", 13);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1509, (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 *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1621, (const char *) "RemoveWhitePrefix", 17);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1621, (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 *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1643, (const char *) "RemoveWhitePostfix", 18);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1643, (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 *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 176, (const char *) "PopAllocationExemption", 22, (const char *) "mismatched number of PopAllocation's compared to PushAllocation's", 65);
+ M2RTS_Halt ((const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 176, (const char *) "PopAllocationExemption", 22, (const char *) "mismatched number of PopAllocation's compared to PushAllocation's", 65);
}
else
{
Init ();
}
-extern "C" void _M2_DynamicStrings_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_DynamicStrings_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
return f; /* create new slot */
}
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/FIO.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/FIO.def", 25, 1);
__builtin_unreachable ();
}
(*p) = static_cast<unsigned char> ((*fd->buffer->contents).array[fd->buffer->position]);
fd->buffer->left -= 1; /* remove consumed bytes */
fd->buffer->position += 1; /* move onwards n bytes */
- nBytes = 0; /* reduce the amount for future direct */
+ nBytes = 0;
/* read */
return 1;
}
if (f != Error)
{
- /* avoid dangling else. */
fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
total = 0; /* how many bytes have we read */
if (fd != NULL) /* how many bytes have we read */
}
return total;
}
- else
- {
- return -1;
- }
}
}
- else
- {
- return -1;
- }
+ return -1;
/* static analysis guarentees a RETURN statement will be used before here. */
__builtin_unreachable ();
}
return fd->name.address;
}
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/FIO.def", 25, 1);
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
__builtin_unreachable ();
}
return fd->name.size;
}
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/FIO.def", 25, 1);
+ return 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
__builtin_unreachable ();
}
Init ();
}
-extern "C" void _M2_FIO_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_FIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
FIO_FlushOutErr ();
}
Init ();
}
-extern "C" void _M2_IO_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_IO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
{
return (n >= i->Low) && (n <= i->High);
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/Indexing.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/Indexing.def", 25, 1);
__builtin_unreachable ();
}
{
return i->High;
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/Indexing.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/Indexing.def", 25, 1);
__builtin_unreachable ();
}
{
return i->Low;
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/Indexing.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/Indexing.def", 25, 1);
__builtin_unreachable ();
}
{
}
-extern "C" void _M2_Indexing_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_Indexing_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
{
}
-extern "C" void _M2_Lists_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_Lists_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
#include <stddef.h>
#include <string.h>
#include <limits.h>
+#include <stdlib.h>
# include "GStorage.h"
+#include <unistd.h>
#if defined(__cplusplus)
# undef NULL
# define NULL 0
struct M2Dependent__T3_a { M2Dependent_ModuleChain array[M2Dependent_user-M2Dependent_unregistered+1]; };
struct M2Dependent__T2_r {
void *name;
+ void *libname;
M2Dependent_ArgCVEnvP init;
M2Dependent_ArgCVEnvP fini;
M2Dependent_DependencyList dependency;
static M2Dependent__T3 Modules;
static unsigned int Initialized;
+static unsigned int WarningTrace;
static unsigned int ModuleTrace;
+static unsigned int HexTrace;
static unsigned int DependencyTrace;
static unsigned int PreTrace;
static unsigned int PostTrace;
module constructor in turn.
*/
-extern "C" void M2Dependent_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+extern "C" void M2Dependent_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
/*
DeconstructModules - resolve dependencies and then call each
module constructor in turn.
*/
-extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
/*
RegisterModule - adds module name to the list of outstanding
explored to determine initialization order.
*/
-extern "C" void M2Dependent_RegisterModule (void * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
+extern "C" void M2Dependent_RegisterModule (void * modulename, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
/*
RequestDependant - used to specify that modulename is dependant upon
if we are not using StaticInitialization.
*/
-extern "C" void M2Dependent_RequestDependant (void * modulename, void * dependantmodule);
+extern "C" void M2Dependent_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
/*
CreateModule - creates a new module entry and returns the
ModuleChain.
*/
-static M2Dependent_ModuleChain CreateModule (void * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
+static M2Dependent_ModuleChain CreateModule (void * name, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
/*
AppendModule - append chain to end of the list.
static unsigned int onChain (M2Dependent_DependencyState state, M2Dependent_ModuleChain mptr);
/*
- LookupModuleN - lookup module from the state list. The string is limited
- to nchar.
+ max -
*/
-static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int nchar);
+static unsigned int max (unsigned int a, unsigned int b);
+
+/*
+ min -
+*/
+
+static unsigned int min (unsigned int a, unsigned int b);
+
+/*
+ LookupModuleN - lookup module from the state list.
+ The strings lengths are known.
+*/
+
+static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int namelen, void * libname, unsigned int libnamelen);
/*
LookupModule - lookup and return the ModuleChain pointer containing
module name from a particular list.
*/
-static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name);
+static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name, void * libname);
/*
toCString - replace any character sequence
static void traceprintf2 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg);
+/*
+ traceprintf3 - wrap printf with a boolean flag.
+*/
+
+static void traceprintf3 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg1, void * arg2);
+
/*
moveTo - moves mptr to the new list determined by newstate.
It updates the mptr state appropriately.
ResolveDependant -
*/
-static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule);
+static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule, void * libname);
/*
PerformRequestDependant - the current modulename has a dependancy upon
resolved.
*/
-static void PerformRequestDependant (void * modulename, void * dependantmodule);
+static void PerformRequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
/*
- ResolveDependencies - resolve dependencies for currentmodule.
+ ResolveDependencies - resolve dependencies for currentmodule, libname.
*/
-static void ResolveDependencies (void * currentmodule);
+static void ResolveDependencies (void * currentmodule, void * libname);
/*
DisplayModuleInfo - displays all module in the state.
*/
-static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *name_, unsigned int _name_high);
+static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *desc_, unsigned int _desc_high);
/*
DumpModuleData -
static void combine (M2Dependent_DependencyState src, M2Dependent_DependencyState dest);
+/*
+ tracemodule -
+*/
+
+static void tracemodule (unsigned int flag, void * modname, unsigned int modlen, void * libname, unsigned int liblen);
+
+/*
+ ForceModule -
+*/
+
+static void ForceModule (void * modname, unsigned int modlen, void * libname, unsigned int liblen);
+
/*
ForceDependencies - if the user has specified a forced order then we override
the dynamic ordering with the preference.
static void CheckApplication (void);
+/*
+ warning3 - write format arg1 arg2 to stderr.
+*/
+
+static void warning3 (const char *format_, unsigned int _format_high, void * arg1, void * arg2);
+
/*
equal - return TRUE if C string cstr is equal to str.
*/
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.
+ "all,module,hex,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.
+ hex dump the modules ctor functions address in hex.
pre generate a list of all modules seen prior to having
their dependancies resolved.
dep display a trace as the modules are resolved.
ModuleChain.
*/
-static M2Dependent_ModuleChain CreateModule (void * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
+static M2Dependent_ModuleChain CreateModule (void * name, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
{
M2Dependent_ModuleChain mptr;
+ void * p0;
+ void * p1;
Storage_ALLOCATE ((void **) &mptr, sizeof (M2Dependent__T2));
mptr->name = name;
+ mptr->libname = libname;
mptr->init = init;
mptr->fini = fini;
mptr->dependency.proc = dependencies;
mptr->dependency.state = M2Dependent_unregistered;
mptr->prev = NULL;
mptr->next = NULL;
+ if (HexTrace)
+ {
+ libc_printf ((const char *) " (init: %p fini: %p", 22, init, fini);
+ libc_printf ((const char *) " dep: %p)", 10, dependencies);
+ }
return mptr;
/* static analysis guarentees a RETURN statement will be used before here. */
__builtin_unreachable ();
/*
- LookupModuleN - lookup module from the state list. The string is limited
- to nchar.
+ max -
+*/
+
+static unsigned int max (unsigned int a, unsigned int b)
+{
+ if (a > b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ min -
*/
-static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int nchar)
+static unsigned int min (unsigned int a, unsigned int b)
+{
+ if (a < b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ LookupModuleN - lookup module from the state list.
+ The strings lengths are known.
+*/
+
+static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int namelen, void * libname, unsigned int libnamelen)
{
M2Dependent_ModuleChain ptr;
{
ptr = Modules.array[state-M2Dependent_unregistered];
do {
- if ((strncmp (reinterpret_cast<M2LINK_PtrToChar> (ptr->name), reinterpret_cast<M2LINK_PtrToChar> (name), nchar)) == 0)
+ if (((strncmp (reinterpret_cast<M2LINK_PtrToChar> (ptr->name), reinterpret_cast<M2LINK_PtrToChar> (name), max (namelen, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (ptr->name)))))) == 0) && ((strncmp (reinterpret_cast<M2LINK_PtrToChar> (ptr->libname), reinterpret_cast<M2LINK_PtrToChar> (libname), max (libnamelen, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (ptr->libname)))))) == 0))
{
return ptr;
}
module name from a particular list.
*/
-static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name)
+static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name, void * libname)
{
- return LookupModuleN (state, name, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (name))));
+ return LookupModuleN (state, name, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (name))), libname, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (libname))));
/* static analysis guarentees a RETURN statement will be used before here. */
__builtin_unreachable ();
}
static int strncmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b, unsigned int n)
{
- if (((a != NULL) && (b != NULL)) && (n > 0))
+ if (n == 0)
{
- /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ return 0;
+ }
+ else if ((a != NULL) && (b != NULL))
+ {
+ /* avoid dangling else. */
if (a == b)
{
return 0;
static void traceprintf2 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg)
{
+ char ch;
char str[_str_high+1];
/* make a local copy of each unbounded array. */
if (flag)
{
toCString ((char *) str, _str_high);
+ if (arg == NULL)
+ {
+ ch = (char) 0;
+ arg = &ch;
+ }
libc_printf ((const char *) str, _str_high, arg);
}
}
+/*
+ traceprintf3 - wrap printf with a boolean flag.
+*/
+
+static void traceprintf3 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg1, void * arg2)
+{
+ char ch;
+ 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);
+ if (arg1 == NULL)
+ {
+ ch = (char) 0;
+ arg1 = &ch;
+ }
+ if (arg2 == NULL)
+ {
+ ch = (char) 0;
+ arg2 = &ch;
+ }
+ libc_printf ((const char *) str, _str_high, arg1, arg2);
+ }
+}
+
+
/*
moveTo - moves mptr to the new list determined by newstate.
It updates the mptr state appropriately.
ResolveDependant -
*/
-static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule)
+static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule, void * libname)
{
if (mptr == NULL)
{
- traceprintf (DependencyTrace, (const char *) " module has not been registered via a global constructor\\n", 60);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] has not been registered via a global constructor\\n", 68, currentmodule, libname);
}
else
{
else
{
moveTo (M2Dependent_started, mptr);
- traceprintf2 (DependencyTrace, (const char *) " starting: %s\\n", 17, currentmodule);
+ traceprintf3 (DependencyTrace, (const char *) " starting: %s [%s]\\n", 22, currentmodule, libname);
(*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. */
+ traceprintf3 (DependencyTrace, (const char *) " finished: %s [%s]\\n", 22, currentmodule, libname); /* Invoke and process the dependency graph. */
moveTo (M2Dependent_ordered, mptr);
}
}
resolved.
*/
-static void PerformRequestDependant (void * modulename, void * dependantmodule)
+static void PerformRequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname)
{
M2Dependent_ModuleChain mptr;
- traceprintf2 (DependencyTrace, (const char *) " module %s", 11, modulename);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s]", 16, modulename, libname);
if (dependantmodule == NULL)
{
/* avoid dangling else. */
- traceprintf2 (DependencyTrace, (const char *) " has finished its import graph\\n", 32, modulename);
- mptr = LookupModule (M2Dependent_unordered, modulename);
+ traceprintf (DependencyTrace, (const char *) " has finished its import graph\\n", 32);
+ mptr = LookupModule (M2Dependent_unordered, modulename, libname);
if (mptr != NULL)
{
- traceprintf2 (DependencyTrace, (const char *) " module %s is now ordered\\n", 28, modulename);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] is now ordered\\n", 33, modulename, libname);
moveTo (M2Dependent_ordered, mptr);
}
}
else
{
- traceprintf2 (DependencyTrace, (const char *) " imports from %s\\n", 18, dependantmodule);
- mptr = LookupModule (M2Dependent_ordered, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " imports from %s [%s]\\n", 23, dependantmodule, dependantlibname);
+ mptr = LookupModule (M2Dependent_ordered, dependantmodule, dependantlibname);
if (mptr == NULL)
{
- traceprintf2 (DependencyTrace, (const char *) " module %s is not ordered\\n", 28, dependantmodule);
- mptr = LookupModule (M2Dependent_unordered, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] is not ordered\\n", 33, dependantmodule, dependantlibname);
+ mptr = LookupModule (M2Dependent_unordered, dependantmodule, dependantlibname);
if (mptr == NULL)
{
- traceprintf2 (DependencyTrace, (const char *) " module %s is not unordered\\n", 30, dependantmodule);
- mptr = LookupModule (M2Dependent_started, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] is not unordered\\n", 35, dependantmodule, dependantlibname);
+ mptr = LookupModule (M2Dependent_started, dependantmodule, dependantlibname);
if (mptr == NULL)
{
- traceprintf2 (DependencyTrace, (const char *) " module %s has not started\\n", 29, dependantmodule);
- traceprintf2 (DependencyTrace, (const char *) " module %s attempting to import from", 37, modulename);
- traceprintf2 (DependencyTrace, (const char *) " %s which has not registered itself via a constructor\\n", 55, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] has not started\\n", 34, dependantmodule, dependantlibname);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] attempting to import from", 42, modulename, libname);
+ traceprintf3 (DependencyTrace, (const char *) " %s [%s] which has not registered itself via a constructor\\n", 60, dependantmodule, dependantlibname);
}
else
{
- traceprintf2 (DependencyTrace, (const char *) " module %s has registered itself and has started\\n", 51, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] has registered itself and has started\\n", 56, dependantmodule, dependantlibname);
}
}
else
{
- traceprintf2 (DependencyTrace, (const char *) " module %s resolving\\n", 23, dependantmodule);
- ResolveDependant (mptr, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] resolving\\n", 28, dependantmodule, dependantlibname);
+ ResolveDependant (mptr, dependantmodule, dependantlibname);
}
}
else
{
- traceprintf2 (DependencyTrace, (const char *) " module %s ", 12, modulename);
- traceprintf2 (DependencyTrace, (const char *) " dependant %s is ordered\\n", 26, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s]", 16, modulename, libname);
+ traceprintf3 (DependencyTrace, (const char *) " dependant %s [%s] is ordered\\n", 31, dependantmodule, dependantlibname);
}
}
}
/*
- ResolveDependencies - resolve dependencies for currentmodule.
+ ResolveDependencies - resolve dependencies for currentmodule, libname.
*/
-static void ResolveDependencies (void * currentmodule)
+static void ResolveDependencies (void * currentmodule, void * libname)
{
M2Dependent_ModuleChain mptr;
- mptr = LookupModule (M2Dependent_unordered, currentmodule);
+ mptr = LookupModule (M2Dependent_unordered, currentmodule, libname);
while (mptr != NULL)
{
- traceprintf2 (DependencyTrace, (const char *) " attempting to resolve the dependants for %s\\n", 48, currentmodule);
- ResolveDependant (mptr, currentmodule);
+ traceprintf3 (DependencyTrace, (const char *) " attempting to resolve the dependants for %s [%s]\\n", 53, currentmodule, libname);
+ ResolveDependant (mptr, currentmodule, libname);
mptr = Modules.array[M2Dependent_unordered-M2Dependent_unregistered];
}
}
DisplayModuleInfo - displays all module in the state.
*/
-static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *name_, unsigned int _name_high)
+static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *desc_, unsigned int _desc_high)
{
M2Dependent_ModuleChain mptr;
unsigned int count;
- char name[_name_high+1];
+ char desc[_desc_high+1];
/* make a local copy of each unbounded array. */
- memcpy (name, name_, _name_high+1);
+ memcpy (desc, desc_, _desc_high+1);
if (Modules.array[state-M2Dependent_unregistered] != NULL)
{
- libc_printf ((const char *) "%s modules\\n", 12, &name);
+ libc_printf ((const char *) "%s modules\\n", 12, &desc);
mptr = Modules.array[state-M2Dependent_unregistered];
count = 0;
do {
- libc_printf ((const char *) " %d %s", 8, count, mptr->name);
+ if (mptr->name == NULL)
+ {
+ libc_printf ((const char *) " %d %s []", 11, count, mptr->name);
+ }
+ else
+ {
+ libc_printf ((const char *) " %d %s [%s]", 13, count, mptr->name, mptr->libname);
+ }
count += 1;
if (mptr->dependency.appl)
{
}
+/*
+ tracemodule -
+*/
+
+static void tracemodule (unsigned int flag, void * modname, unsigned int modlen, void * libname, unsigned int liblen)
+{
+ typedef struct tracemodule__T4_a tracemodule__T4;
+
+ struct tracemodule__T4_a { char array[100+1]; };
+ tracemodule__T4 buffer;
+ unsigned int len;
+
+ if (flag)
+ {
+ len = min (modlen, sizeof (buffer)-1);
+ libc_strncpy (&buffer, modname, len);
+ buffer.array[len] = (char) 0;
+ libc_printf ((const char *) "%s ", 3, &buffer);
+ len = min (liblen, sizeof (buffer)-1);
+ libc_strncpy (&buffer, libname, len);
+ buffer.array[len] = (char) 0;
+ libc_printf ((const char *) " [%s]", 5, &buffer);
+ }
+}
+
+
+/*
+ ForceModule -
+*/
+
+static void ForceModule (void * modname, unsigned int modlen, void * libname, unsigned int liblen)
+{
+ M2Dependent_ModuleChain mptr;
+
+ traceprintf (ForceTrace, (const char *) "forcing module: ", 16);
+ tracemodule (ForceTrace, modname, modlen, libname, liblen);
+ traceprintf (ForceTrace, (const char *) "\\n", 2);
+ mptr = LookupModuleN (M2Dependent_ordered, modname, modlen, libname, liblen);
+ if (mptr != NULL)
+ {
+ mptr->dependency.forced = TRUE;
+ moveTo (M2Dependent_user, mptr);
+ }
+}
+
+
/*
ForceDependencies - if the user has specified a forced order then we override
the dynamic ordering with the preference.
static void ForceDependencies (void)
{
- M2Dependent_ModuleChain mptr;
- M2Dependent_ModuleChain userChain;
- unsigned int count;
+ unsigned int len;
+ unsigned int modlen;
+ unsigned int liblen;
+ M2LINK_PtrToChar modname;
+ M2LINK_PtrToChar libname;
M2LINK_PtrToChar pc;
M2LINK_PtrToChar start;
if (M2LINK_ForcedModuleInitOrder != NULL)
{
- userChain = NULL;
+ traceprintf2 (ForceTrace, (const char *) "user forcing order: %s\\n", 24, reinterpret_cast<void *> (M2LINK_ForcedModuleInitOrder));
pc = M2LINK_ForcedModuleInitOrder;
start = pc;
- count = 0;
+ len = 0;
+ modname = NULL;
+ modlen = 0;
+ libname = NULL;
+ liblen = 0;
while ((*pc) != ASCII_nul)
{
- if ((*pc) == ',')
- {
- mptr = LookupModuleN (M2Dependent_ordered, reinterpret_cast<void *> (start), count);
- if (mptr != NULL)
- {
- mptr->dependency.forced = TRUE;
- moveTo (M2Dependent_user, mptr);
- }
- pc += 1;
- start = pc;
- count = 0;
- }
- else
+ switch ((*pc))
{
- pc += 1;
- count += 1;
+ case ':':
+ libname = start;
+ liblen = len;
+ len = 0;
+ pc += 1;
+ start = pc;
+ break;
+
+ case ',':
+ modname = start;
+ modlen = len;
+ ForceModule (reinterpret_cast<void *> (modname), modlen, reinterpret_cast<void *> (libname), liblen);
+ libname = NULL;
+ liblen = 0;
+ modlen = 0;
+ len = 0;
+ pc += 1;
+ start = pc;
+ break;
+
+
+ default:
+ pc += 1;
+ len += 1;
+ break;
}
}
if (start != pc)
{
- mptr = LookupModuleN (M2Dependent_ordered, reinterpret_cast<void *> (start), count);
- if (mptr != NULL)
- {
- mptr->dependency.forced = TRUE;
- moveTo (M2Dependent_user, mptr);
- }
+ ForceModule (reinterpret_cast<void *> (start), len, reinterpret_cast<void *> (libname), liblen);
}
combine (M2Dependent_user, M2Dependent_ordered);
}
} while (! ((appl != NULL) || (mptr == Modules.array[M2Dependent_ordered-M2Dependent_unregistered])));
if (appl != NULL)
{
- Modules.array[M2Dependent_ordered-M2Dependent_unregistered] = appl->next;
+ RemoveModule (&Modules.array[M2Dependent_ordered-M2Dependent_unregistered], appl);
+ AppendModule (&Modules.array[M2Dependent_ordered-M2Dependent_unregistered], appl);
}
}
}
+/*
+ warning3 - write format arg1 arg2 to stderr.
+*/
+
+static void warning3 (const char *format_, unsigned int _format_high, void * arg1, void * arg2)
+{
+ typedef struct warning3__T5_a warning3__T5;
+
+ struct warning3__T5_a { char array[4096+1]; };
+ warning3__T5 buffer;
+ int len;
+ char format[_format_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (format, format_, _format_high+1);
+
+ if (WarningTrace)
+ {
+ len = libc_snprintf (&buffer, static_cast<size_t> (sizeof (buffer)), (const char *) "warning: ", 9);
+ libc_write (2, &buffer, static_cast<size_t> (len));
+ len = libc_snprintf (&buffer, static_cast<size_t> (sizeof (buffer)), (const char *) format, _format_high, arg1, arg2);
+ libc_write (2, &buffer, static_cast<size_t> (len));
+ }
+}
+
+
/*
equal - return TRUE if C string cstr is equal to str.
*/
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.
+ "all,module,hex,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.
+ hex dump the modules ctor functions address in hex.
pre generate a list of all modules seen prior to having
their dependancies resolved.
dep display a trace as the modules are resolved.
PostTrace = FALSE;
PreTrace = FALSE;
ForceTrace = FALSE;
+ HexTrace = FALSE;
+ WarningTrace = FALSE;
pc = static_cast<SetupDebugFlags__T1> (libc_getenv (const_cast<void*> (reinterpret_cast<const void*>("GCC_M2LINK_RTFLAG"))));
while ((pc != NULL) && ((*pc) != ASCII_nul))
{
PreTrace = TRUE;
PostTrace = TRUE;
ForceTrace = TRUE;
+ HexTrace = TRUE;
+ WarningTrace = TRUE;
pc += 3;
}
else if (equal (reinterpret_cast<void *> (pc), (const char *) "module", 6))
ModuleTrace = TRUE;
pc += 6;
}
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "warning", 7))
+ {
+ /* avoid dangling else. */
+ WarningTrace = TRUE;
+ pc += 7;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "hex", 3))
+ {
+ /* avoid dangling else. */
+ HexTrace = TRUE;
+ pc += 3;
+ }
else if (equal (reinterpret_cast<void *> (pc), (const char *) "dep", 3))
{
/* avoid dangling else. */
module constructor in turn.
*/
-extern "C" void M2Dependent_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp)
+extern "C" void M2Dependent_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
{
M2Dependent_ModuleChain mptr;
M2Dependent_ArgCVEnvP nulp;
CheckInitialized ();
- traceprintf2 (ModuleTrace, (const char *) "application module: %s\\n", 24, applicationmodule);
- mptr = LookupModule (M2Dependent_unordered, applicationmodule);
+ traceprintf3 (ModuleTrace, (const char *) "application module: %s [%s]\\n", 29, applicationmodule, libname);
+ mptr = LookupModule (M2Dependent_unordered, applicationmodule, libname);
if (mptr != NULL)
{
mptr->dependency.appl = TRUE;
}
traceprintf (PreTrace, (const char *) "Pre resolving dependents\\n", 26);
DumpModuleData (PreTrace);
- ResolveDependencies (applicationmodule);
+ ResolveDependencies (applicationmodule, libname);
traceprintf (PreTrace, (const char *) "Post resolving dependents\\n", 27);
DumpModuleData (PostTrace);
ForceDependencies ();
DumpModuleData (ForceTrace);
if (Modules.array[M2Dependent_ordered-M2Dependent_unregistered] == NULL)
{
- traceprintf2 (ModuleTrace, (const char *) " module: %s has not registered itself using a global constructor\\n", 67, applicationmodule);
+ traceprintf3 (ModuleTrace, (const char *) " module: %s [%s] has not registered itself using a global constructor\\n", 72, applicationmodule, libname);
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);
}
do {
if (mptr->dependency.forc)
{
- traceprintf2 (ModuleTrace, (const char *) "initializing module: %s for C\\n", 31, mptr->name);
+ traceprintf3 (ModuleTrace, (const char *) "initializing module: %s [%s] for C\\n", 36, mptr->name, mptr->libname);
}
else
{
- traceprintf2 (ModuleTrace, (const char *) "initializing module: %s\\n", 25, mptr->name);
+ traceprintf3 (ModuleTrace, (const char *) "initializing module: %s [%s]\\n", 30, mptr->name, mptr->libname);
}
if (mptr->dependency.appl)
{
- traceprintf2 (ModuleTrace, (const char *) "application module: %s\\n", 24, mptr->name);
+ traceprintf3 (ModuleTrace, (const char *) "application module: %s [%s]\\n", 29, mptr->name, mptr->libname);
traceprintf (ModuleTrace, (const char *) " calling M2RTS_ExecuteInitialProcedures\\n", 42);
M2RTS_ExecuteInitialProcedures ();
traceprintf (ModuleTrace, (const char *) " calling application module\\n", 30);
module constructor in turn.
*/
-extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp)
+extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
{
M2Dependent_ModuleChain mptr;
- traceprintf2 (ModuleTrace, (const char *) "application module finishing: %s\\n", 34, applicationmodule);
+ traceprintf3 (ModuleTrace, (const char *) "application module finishing: %s [%s]\\n", 39, applicationmodule, libname);
if (Modules.array[M2Dependent_ordered-M2Dependent_unregistered] == NULL)
{
traceprintf (ModuleTrace, (const char *) " no ordered modules found during finishing\\n", 45);
do {
if (mptr->dependency.forc)
{
- traceprintf2 (ModuleTrace, (const char *) "finalizing module: %s for C\\n", 29, mptr->name);
+ traceprintf3 (ModuleTrace, (const char *) "finalizing module: %s [%s] for C\\n", 34, mptr->name, mptr->libname);
}
else
{
- traceprintf2 (ModuleTrace, (const char *) "finalizing module: %s\\n", 23, mptr->name);
+ traceprintf3 (ModuleTrace, (const char *) "finalizing module: %s [%s]\\n", 28, mptr->name, mptr->libname);
}
(*mptr->fini.proc) (argc, argv, envp);
mptr = mptr->prev;
explored to determine initialization order.
*/
-extern "C" void M2Dependent_RegisterModule (void * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
+extern "C" void M2Dependent_RegisterModule (void * modulename, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
{
+ M2Dependent_ModuleChain mptr;
+
CheckInitialized ();
if (! M2LINK_StaticInitialization)
{
- traceprintf2 (ModuleTrace, (const char *) "module: %s registering\\n", 24, name);
- moveTo (M2Dependent_unordered, CreateModule (name, init, fini, dependencies));
+ mptr = LookupModule (M2Dependent_unordered, modulename, libname);
+ if (mptr == NULL)
+ {
+ traceprintf3 (ModuleTrace, (const char *) "module: %s [%s] registering", 27, modulename, libname);
+ moveTo (M2Dependent_unordered, CreateModule (modulename, libname, init, fini, dependencies));
+ traceprintf (ModuleTrace, (const char *) "\\n", 2);
+ }
+ else
+ {
+ warning3 ((const char *) "module: %s [%s] (ignoring duplicate registration)\\n", 51, modulename, libname);
+ }
}
}
if we are not using StaticInitialization.
*/
-extern "C" void M2Dependent_RequestDependant (void * modulename, void * dependantmodule)
+extern "C" void M2Dependent_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname)
{
CheckInitialized ();
if (! M2LINK_StaticInitialization)
{
- PerformRequestDependant (modulename, dependantmodule);
+ PerformRequestDependant (modulename, libname, dependantmodule, dependantlibname);
}
}
CheckInitialized ();
}
-extern "C" void _M2_M2Dependent_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_M2Dependent_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
#if !defined (_M2Dependent_H)
# define _M2Dependent_H
-#include "config.h"
-#include "system.h"
# ifdef __cplusplus
extern "C" {
# endif
typedef void (*M2Dependent_ArgCVEnvP_t) (int, void *, void *);
struct M2Dependent_ArgCVEnvP_p { M2Dependent_ArgCVEnvP_t proc; };
-EXTERN void M2Dependent_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp);
-EXTERN void M2Dependent_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+EXTERN void M2Dependent_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
+EXTERN void M2Dependent_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
/*
RegisterModule - adds module name to the list of outstanding
explored to determine initialization order.
*/
-EXTERN void M2Dependent_RegisterModule (void * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
+EXTERN void M2Dependent_RegisterModule (void * modulename, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
/*
- RequestDependant - used to specify that modulename is dependant upon
- module dependantmodule.
+ RequestDependant - used to specify that modulename:libname
+ is dependant upon
+ module dependantmodule:dependantlibname
*/
-EXTERN void M2Dependent_RequestDependant (void * modulename, void * dependantmodule);
+EXTERN void M2Dependent_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
# ifdef __cplusplus
}
# endif
n = RTExceptions_GetNumber (e);
if (n == (UINT_MAX))
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/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*>("../../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 ("../../gcc-read-write/gcc/m2/gm2-libs/M2EXCEPTION.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/M2EXCEPTION.def", 25, 1);
__builtin_unreachable ();
}
RTExceptions_SetExceptionBlock (RTExceptions_InitExceptionBlock ());
}
-extern "C" void _M2_M2EXCEPTION_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_M2EXCEPTION_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
module constructor in turn.
*/
-extern "C" void M2RTS_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+extern "C" void M2RTS_ConstructModules (void * applicationmodule, void * libname, 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);
+extern "C" void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
/*
RegisterModule - adds module name to the list of outstanding
explored to determine initialization order.
*/
-extern "C" void M2RTS_RegisterModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
+extern "C" void M2RTS_RegisterModule (void * name, void * libname, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
/*
RequestDependant - used to specify that modulename is dependant upon
module dependantmodule.
*/
-extern "C" void M2RTS_RequestDependant (void * modulename, void * dependantmodule);
+extern "C" void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
/*
InstallTerminationProcedure - installs a procedure, p, which will
to stderr and calls exit (1).
*/
-extern "C" void M2RTS_HaltC (void * filename, unsigned int line, void * function, void * description);
+extern "C" void M2RTS_HaltC (void * filename, unsigned int line, void * function, void * description) __attribute__ ((noreturn));
/*
ExitOnHalt - if HALT is executed then call exit with the exit code, e.
*/
extern "C" unsigned int M2RTS_Length (const char *a_, unsigned int _a_high);
-extern "C" void M2RTS_AssignmentException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_ReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_IncException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_DecException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_InclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_ExclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_ShiftException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_RotateException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_StaticArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_DynamicArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_ForLoopBeginException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_ForLoopToException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_ForLoopEndException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_PointerNilException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_NoReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_CaseException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_WholeNonPosDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_WholeNonPosModException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_WholeZeroDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_WholeZeroRemException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_WholeValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_RealValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-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);
+extern "C" void M2RTS_AssignmentException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_IncException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_DecException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_InclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ExclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ShiftException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_RotateException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_StaticArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_DynamicArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ForLoopBeginException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ForLoopToException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ForLoopEndException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_PointerNilException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_NoReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_CaseException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_WholeNonPosDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_WholeNonPosModException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_WholeZeroDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_WholeZeroRemException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_WholeValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_RealValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ParameterException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_NoException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
/*
ExecuteReverse - execute the procedure associated with procptr
module constructor in turn.
*/
-extern "C" void M2RTS_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp)
+extern "C" void M2RTS_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
{
- M2Dependent_ConstructModules (applicationmodule, argc, argv, envp);
+ M2Dependent_ConstructModules (applicationmodule, libname, argc, argv, envp);
}
module constructor in turn.
*/
-extern "C" void M2RTS_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp)
+extern "C" void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
{
- M2Dependent_DeconstructModules (applicationmodule, argc, argv, envp);
+ M2Dependent_DeconstructModules (applicationmodule, libname, argc, argv, envp);
}
explored to determine initialization order.
*/
-extern "C" void M2RTS_RegisterModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies)
+extern "C" void M2RTS_RegisterModule (void * name, void * libname, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies)
{
- M2Dependent_RegisterModule (name, (M2Dependent_ArgCVEnvP) {(M2Dependent_ArgCVEnvP_t) init.proc}, (M2Dependent_ArgCVEnvP) {(M2Dependent_ArgCVEnvP_t) fini.proc}, dependencies);
+ M2Dependent_RegisterModule (name, libname, (M2Dependent_ArgCVEnvP) {(M2Dependent_ArgCVEnvP_t) init.proc}, (M2Dependent_ArgCVEnvP) {(M2Dependent_ArgCVEnvP_t) fini.proc}, dependencies);
}
module dependantmodule.
*/
-extern "C" void M2RTS_RequestDependant (void * modulename, void * dependantmodule)
+extern "C" void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname)
{
- M2Dependent_RequestDependant (modulename, dependantmodule);
+ M2Dependent_RequestDependant (modulename, libname, dependantmodule, dependantlibname);
}
CheckInitialized ();
}
-extern "C" void _M2_M2RTS_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_M2RTS_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
#if !defined (_M2RTS_H)
# define _M2RTS_H
-#include "config.h"
-#include "system.h"
# ifdef __cplusplus
extern "C" {
# endif
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);
+EXTERN void M2RTS_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
+EXTERN void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
/*
RegisterModule - adds module name to the list of outstanding
explored to determine initialization order.
*/
-EXTERN void M2RTS_RegisterModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
+EXTERN void M2RTS_RegisterModule (void * name, void * libname, 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);
+EXTERN void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
/*
InstallTerminationProcedure - installs a procedure, p, which will
/*
Halt - provides a more user friendly version of HALT, which takes
- four parameters to aid debugging.
+ four parameters to aid debugging. It writes an error message
+ to stderr and calls exit (1).
*/
-EXTERN void M2RTS_Halt (const char *file_, unsigned int _file_high, unsigned int line, const char *function_, unsigned int _function_high, const char *description_, unsigned int _description_high) __attribute__ ((noreturn));
+EXTERN void M2RTS_Halt (const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high, const char *description_, unsigned int _description_high) __attribute__ ((noreturn));
+
+/*
+ HaltC - provides a more user friendly version of HALT, which takes
+ four parameters to aid debugging. It writes an error message
+ to stderr and calls exit (1).
+*/
+
+EXTERN void M2RTS_HaltC (void * filename, unsigned int line, void * function, void * description) __attribute__ ((noreturn));
/*
ExitOnHalt - if HALT is executed then call exit with the exit code, e.
ErrorMessage - emits an error message to stderr and then calls exit (1).
*/
-EXTERN 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) __attribute__ ((noreturn));
+EXTERN void M2RTS_ErrorMessage (const char *message_, unsigned int _message_high, const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high) __attribute__ ((noreturn));
/*
Length - returns the length of a string, a. This is called whenever
*/
EXTERN unsigned int M2RTS_Length (const char *a_, unsigned int _a_high);
-EXTERN void M2RTS_AssignmentException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_ReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_IncException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_DecException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_InclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_ExclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_ShiftException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_RotateException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_StaticArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_DynamicArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_ForLoopBeginException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_ForLoopToException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_ForLoopEndException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_PointerNilException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_NoReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_CaseException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_WholeNonPosDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_WholeNonPosModException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_WholeZeroDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_WholeZeroRemException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_WholeValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_RealValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_ParameterException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_NoException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_AssignmentException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_ReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_IncException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_DecException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_InclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_ExclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_ShiftException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_RotateException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_StaticArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_DynamicArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_ForLoopBeginException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_ForLoopToException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_ForLoopEndException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_PointerNilException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_NoReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_CaseException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_WholeNonPosDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_WholeNonPosModException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_WholeZeroDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_WholeZeroRemException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_WholeValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_RealValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_ParameterException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_NoException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
# ifdef __cplusplus
}
# endif
(*p) = ASCII_nul;
return DoMakeKey (n, higha);
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-compiler/NameKey.def", 20, 1);
+ ReturnException ("../../gcc/m2/gm2-compiler/NameKey.def", 20, 1);
__builtin_unreachable ();
}
return DoMakeKey (n, higha);
}
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-compiler/NameKey.def", 20, 1);
+ ReturnException ("../../gcc/m2/gm2-compiler/NameKey.def", 20, 1);
__builtin_unreachable ();
}
BinaryTree->Left = NULL;
}
-extern "C" void _M2_NameKey_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_NameKey_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
{
}
-extern "C" void _M2_NumberIO_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_NumberIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
outputFile = FIO_StdOut;
}
-extern "C" void _M2_Output_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_Output_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
}
else
{
- Debug_Halt ((const char *) "max push back stack exceeded, increase MaxPushBackStack", 55, 150, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/PushBackInput.mod", 54);
+ Debug_Halt ((const char *) "max push back stack exceeded, increase MaxPushBackStack", 55, 150, (const char *) "../../gcc/m2/gm2-libs/PushBackInput.mod", 39);
}
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 *) "../../gcc-read-write/gcc/m2/gm2-libs/PushBackInput.mod", 54);
+ Debug_Halt ((const char *) "assert failed", 13, 132, (const char *) "../../gcc/m2/gm2-libs/PushBackInput.mod", 39);
}
}
}
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 *) "../../gcc-read-write/gcc/m2/gm2-libs/PushBackInput.mod", 54);
+ Debug_Halt ((const char *) "assert failed", 13, 113, (const char *) "../../gcc/m2/gm2-libs/PushBackInput.mod", 39);
}
}
}
Init ();
}
-extern "C" void _M2_PushBackInput_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_PushBackInput_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
and message in the EHBlock for later use.
*/
-extern "C" void RTExceptions_Raise (unsigned int number, void * file, unsigned int line, unsigned int column, void * function, void * message);
+extern "C" void RTExceptions_Raise (unsigned int number, void * file, unsigned int line, unsigned int column, void * function, void * message) __attribute__ ((noreturn));
/*
SetExceptionBlock - sets, source, as the active EHB.
exception in the active EHB.
*/
-static void InvokeHandler (void);
+static void InvokeHandler (void) __attribute__ ((noreturn));
/*
DoThrow - throw the exception number in the exception block.
else
{
(*h->p.proc) ();
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
}
}
static void indexf (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_indexException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 613, 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*>("../../gcc-read-write/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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 625, 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*>("../../gcc-read-write/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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 637, 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*>("../../gcc-read-write/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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 649, 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*>("../../gcc-read-write/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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 661, 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*>("../../gcc-read-write/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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 673, 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*>("../../gcc-read-write/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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 685, 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*>("../../gcc-read-write/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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 697, 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*>("../../gcc-read-write/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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 709, 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*>("../../gcc-read-write/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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 721, 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*>("../../gcc-read-write/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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 733, 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*>("../../gcc-read-write/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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 745, 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*>("../../gcc-read-write/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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 757, 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*>("../../gcc-read-write/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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 769, 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*>("../../gcc-read-write/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*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 781, 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 *) "../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod", 53, 598, (const char *) "GetBaseExceptionBlock", 21, (const char *) "currentEHB has not been initialized yet", 39);
+ M2RTS_Halt ((const char *) "../../gcc/m2/gm2-libs/RTExceptions.mod", 38, 599, (const char *) "GetBaseExceptionBlock", 21, (const char *) "currentEHB has not been initialized yet", 39);
}
else
{
return currentEHB;
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/RTExceptions.def", 25, 1);
__builtin_unreachable ();
}
Init ();
}
-extern "C" void _M2_RTExceptions_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_RTExceptions_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
TidyUp ();
}
{
}
-extern "C" void _M2_SFIO_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_SFIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
M2RTS_HALT (-1);
__builtin_unreachable ();
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/StdIO.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/StdIO.def", 25, 1);
__builtin_unreachable ();
}
M2RTS_HALT (-1);
__builtin_unreachable ();
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/StdIO.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/StdIO.def", 25, 1);
__builtin_unreachable ();
}
StdIO_PushInput ((StdIO_ProcRead) {(StdIO_ProcRead_t) IO_Read});
}
-extern "C" void _M2_StdIO_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_StdIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
{
}
-extern "C" void _M2_Storage_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_Storage_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
{
}
-extern "C" void _M2_StrCase_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_StrCase_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
IsATTY = FALSE;
}
-extern "C" void _M2_StrIO_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_StrIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
{
}
-extern "C" void _M2_StrLib_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_StrLib_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
(*parent) = t;
if (t == NULL)
{
- Debug_Halt ((const char *) "parameter t should never be NIL", 31, 240, (const char *) "../../gcc-read-write/gcc/m2/gm2-compiler/SymbolKey.mod", 54);
+ Debug_Halt ((const char *) "parameter t should never be NIL", 31, 240, (const char *) "../../gcc/m2/gm2-compiler/SymbolKey.mod", 39);
}
Assertion_Assert (t->Right == NULL);
(*child) = t->Left;
}
else
{
- Debug_Halt ((const char *) "symbol already stored", 21, 156, (const char *) "../../gcc-read-write/gcc/m2/gm2-compiler/SymbolKey.mod", 54);
+ Debug_Halt ((const char *) "symbol already stored", 21, 156, (const char *) "../../gcc/m2/gm2-compiler/SymbolKey.mod", 39);
}
}
}
else
{
- Debug_Halt ((const char *) "trying to delete a symbol that is not in the tree - the compiler never expects this to occur", 92, 223, (const char *) "../../gcc-read-write/gcc/m2/gm2-compiler/SymbolKey.mod", 54);
+ Debug_Halt ((const char *) "trying to delete a symbol that is not in the tree - the compiler never expects this to occur", 92, 223, (const char *) "../../gcc/m2/gm2-compiler/SymbolKey.mod", 39);
}
}
{
}
-extern "C" void _M2_SymbolKey_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_SymbolKey_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
EXTERN
void
-_M2_SysExceptions_finish (void)
+_M2_SysExceptions_fini (void)
{
}
(*a) = libc_malloc (static_cast<size_t> (size));
if ((*a) == NULL)
{
- Debug_Halt ((const char *) "out of memory error", 19, 50, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/SysStorage.mod", 51);
+ Debug_Halt ((const char *) "out of memory error", 19, 50, (const char *) "../../gcc/m2/gm2-libs/SysStorage.mod", 36);
}
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 *) "../../gcc-read-write/gcc/m2/gm2-libs/SysStorage.mod", 51);
+ Debug_Halt ((const char *) "memset should have returned the first parameter", 47, 76, (const char *) "../../gcc/m2/gm2-libs/SysStorage.mod", 36);
}
}
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 *) "../../gcc-read-write/gcc/m2/gm2-libs/SysStorage.mod", 51);
+ Debug_Halt ((const char *) "out of memory error", 19, 119, (const char *) "../../gcc/m2/gm2-libs/SysStorage.mod", 36);
}
if (enableTrace && trace)
{
}
}
-extern "C" void _M2_SysStorage_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_SysStorage_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
}
extern "C" void
-_M2_UnixArgs_finish (int argc, char *argv[], char *envp[])
+_M2_UnixArgs_fini (int argc, char *argv[], char *envp[])
{
}
_M2_UnixArgs_ctor::_M2_UnixArgs_ctor (void)
{
- M2RTS_RegisterModule ("UnixArgs", _M2_UnixArgs_init, _M2_UnixArgs_finish,
+ M2RTS_RegisterModule ("UnixArgs", _M2_UnixArgs_init, _M2_UnixArgs_fini,
_M2_UnixArgs_dep);
}
Init ();
}
-extern "C" void _M2_bnflex_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_bnflex_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
/* finish deconstructor for the module. */
void
-_M2_errno_finish (int argc, char *p)
+_M2_errno_fini (int argc, char *p)
{
}
return done;
}
+EXTERN
+int
+libc_snprintf (char *dest, size_t length, char *_format, unsigned int _format_high, ...)
+{
+ va_list arg;
+ int done;
+ char format[_format_high + 1];
+ unsigned int i = 0;
+ unsigned int j = 0;
+ char *c;
+
+ do
+ {
+ c = index (&_format[i], '\\');
+ if (c == NULL)
+ strcpy (&format[j], &_format[i]);
+ else
+ {
+ memcpy (&format[j], &_format[i], (c - _format) - i);
+ i = c - _format;
+ j += c - _format;
+ if (_format[i + 1] == 'n')
+ format[j] = '\n';
+ else
+ format[j] = _format[i + 1];
+ j++;
+ i += 2;
+ }
+ }
+ while (c != NULL);
+
+ va_start (arg, _format_high);
+ done = vsnprintf (dest, length, format, arg);
+ va_end (arg);
+ return done;
+}
+
EXTERN
void *
libc_malloc (unsigned int size)
EXTERN void * libc_memmove (void * dest, void * src, size_t size);
EXTERN int libc_printf (const char *format_, unsigned int _format_high, ...);
+EXTERN int libc_snprintf (void *dest, size_t length, const char *format_, unsigned int _format_high, ...);
/*
setenv - sets environment variable, name, to value.
Init ();
}
-extern "C" void _M2_pge_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_pge_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
}
void
-_M2_termios_finish (void)
+_M2_termios_fini (void)
{
}
extern "C" void _M2_RTExceptions_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_RTExceptions_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_RTExceptions_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_M2EXCEPTION_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_M2EXCEPTION_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_M2EXCEPTION_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_M2RTS_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_M2RTS_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_M2RTS_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_SysExceptions_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_SysExceptions_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_SysExceptions_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_StrLib_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_StrLib_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_StrLib_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_errno_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_errno_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_errno_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_termios_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_termios_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_termios_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_IO_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_IO_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_IO_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_StdIO_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_StdIO_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_StdIO_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_Debug_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_Debug_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Debug_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_SysStorage_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_SysStorage_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_SysStorage_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_Storage_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_Storage_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Storage_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_StrIO_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_StrIO_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_StrIO_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_DynamicStrings_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_DynamicStrings_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_DynamicStrings_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_Assertion_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_Assertion_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Assertion_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_Indexing_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_Indexing_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Indexing_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_NameKey_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_NameKey_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_NameKey_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_NumberIO_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_NumberIO_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_NumberIO_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_PushBackInput_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_PushBackInput_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_PushBackInput_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_SymbolKey_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_SymbolKey_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_SymbolKey_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_UnixArgs_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_UnixArgs_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_UnixArgs_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_FIO_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_FIO_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_FIO_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_SFIO_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_SFIO_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_SFIO_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_StrCase_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_StrCase_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_StrCase_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_bnflex_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_bnflex_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_bnflex_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_Lists_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_Lists_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Lists_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_Args_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_Args_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Args_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_Output_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_Output_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Output_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_pge_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_pge_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_pge_fini (int argc, char *argv[], char *envp[]);
extern "C" void _exit(int);
_M2_Args_init (argc, argv, envp);
_M2_Output_init (argc, argv, envp);
_M2_pge_init (argc, argv, envp);
- _M2_pge_finish (argc, argv, envp);
- _M2_Output_finish (argc, argv, envp);
- _M2_Args_finish (argc, argv, envp);
- _M2_Lists_finish (argc, argv, envp);
- _M2_bnflex_finish (argc, argv, envp);
- _M2_StrCase_finish (argc, argv, envp);
- _M2_SFIO_finish (argc, argv, envp);
- _M2_FIO_finish (argc, argv, envp);
- _M2_UnixArgs_finish (argc, argv, envp);
- _M2_SymbolKey_finish (argc, argv, envp);
- _M2_PushBackInput_finish (argc, argv, envp);
- _M2_NumberIO_finish (argc, argv, envp);
- _M2_NameKey_finish (argc, argv, envp);
- _M2_Indexing_finish (argc, argv, envp);
- _M2_Assertion_finish (argc, argv, envp);
- _M2_DynamicStrings_finish (argc, argv, envp);
- _M2_StrIO_finish (argc, argv, envp);
- _M2_Storage_finish (argc, argv, envp);
- _M2_SysStorage_finish (argc, argv, envp);
- _M2_Debug_finish (argc, argv, envp);
- _M2_StdIO_finish (argc, argv, envp);
- _M2_IO_finish (argc, argv, envp);
- _M2_termios_finish (argc, argv, envp);
- _M2_errno_finish (argc, argv, envp);
- _M2_StrLib_finish (argc, argv, envp);
- _M2_SysExceptions_finish (argc, argv, envp);
- _M2_M2RTS_finish (argc, argv, envp);
- _M2_M2EXCEPTION_finish (argc, argv, envp);
- _M2_RTExceptions_finish (argc, argv, envp);
+ _M2_pge_fini (argc, argv, envp);
+ _M2_Output_fini (argc, argv, envp);
+ _M2_Args_fini (argc, argv, envp);
+ _M2_Lists_fini (argc, argv, envp);
+ _M2_bnflex_fini (argc, argv, envp);
+ _M2_StrCase_fini (argc, argv, envp);
+ _M2_SFIO_fini (argc, argv, envp);
+ _M2_FIO_fini (argc, argv, envp);
+ _M2_UnixArgs_fini (argc, argv, envp);
+ _M2_SymbolKey_fini (argc, argv, envp);
+ _M2_PushBackInput_fini (argc, argv, envp);
+ _M2_NumberIO_fini (argc, argv, envp);
+ _M2_NameKey_fini (argc, argv, envp);
+ _M2_Indexing_fini (argc, argv, envp);
+ _M2_Assertion_fini (argc, argv, envp);
+ _M2_DynamicStrings_fini (argc, argv, envp);
+ _M2_StrIO_fini (argc, argv, envp);
+ _M2_Storage_fini (argc, argv, envp);
+ _M2_SysStorage_fini (argc, argv, envp);
+ _M2_Debug_fini (argc, argv, envp);
+ _M2_StdIO_fini (argc, argv, envp);
+ _M2_IO_fini (argc, argv, envp);
+ _M2_termios_fini (argc, argv, envp);
+ _M2_errno_fini (argc, argv, envp);
+ _M2_StrLib_fini (argc, argv, envp);
+ _M2_SysExceptions_fini (argc, argv, envp);
+ _M2_M2RTS_fini (argc, argv, envp);
+ _M2_M2EXCEPTION_fini (argc, argv, envp);
+ _M2_RTExceptions_fini (argc, argv, envp);
return(0);
}
basic block of a reachable function. */
static const char *m2_runtime_error_calls[] = {
- "M2RTS_AssignmentException",
- "M2RTS_ReturnException",
- "M2RTS_IncException",
- "M2RTS_DecException",
- "M2RTS_InclException",
- "M2RTS_ExclException",
- "M2RTS_ShiftException",
- "M2RTS_RotateException",
- "M2RTS_StaticArraySubscriptException",
- "M2RTS_DynamicArraySubscriptException",
- "M2RTS_ForLoopBeginException",
- "M2RTS_ForLoopToException",
- "M2RTS_ForLoopEndException",
- "M2RTS_PointerNilException",
- "M2RTS_NoReturnException",
- "M2RTS_CaseException",
- "M2RTS_WholeNonPosDivException",
- "M2RTS_WholeNonPosModException",
- "M2RTS_WholeZeroDivException",
- "M2RTS_WholeZeroRemException",
- "M2RTS_WholeValueException",
- "M2RTS_RealValueException",
- "M2RTS_ParameterException",
- "M2RTS_NoException",
+ "m2pim_M2RTS_AssignmentException",
+ "m2pim_M2RTS_ReturnException",
+ "m2pim_M2RTS_IncException",
+ "m2pim_M2RTS_DecException",
+ "m2pim_M2RTS_InclException",
+ "m2pim_M2RTS_ExclException",
+ "m2pim_M2RTS_ShiftException",
+ "m2pim_M2RTS_RotateException",
+ "m2pim_M2RTS_StaticArraySubscriptException",
+ "m2pim_M2RTS_DynamicArraySubscriptException",
+ "m2pim_M2RTS_ForLoopBeginException",
+ "m2pim_M2RTS_ForLoopToException",
+ "m2pim_M2RTS_ForLoopEndException",
+ "m2pim_M2RTS_PointerNilException",
+ "m2pim_M2RTS_NoReturnException",
+ "m2pim_M2RTS_CaseException",
+ "m2pim_M2RTS_WholeNonPosDivException",
+ "m2pim_M2RTS_WholeNonPosModException",
+ "m2pim_M2RTS_WholeZeroDivException",
+ "m2pim_M2RTS_WholeZeroRemException",
+ "m2pim_M2RTS_WholeValueException",
+ "m2pim_M2RTS_RealValueException",
+ "m2pim_M2RTS_ParameterException",
+ "m2pim_M2RTS_NoException",
+
+ "m2iso_M2RTS_AssignmentException",
+ "m2iso_M2RTS_ReturnException",
+ "m2iso_M2RTS_IncException",
+ "m2iso_M2RTS_DecException",
+ "m2iso_M2RTS_InclException",
+ "m2iso_M2RTS_ExclException",
+ "m2iso_M2RTS_ShiftException",
+ "m2iso_M2RTS_RotateException",
+ "m2iso_M2RTS_StaticArraySubscriptException",
+ "m2iso_M2RTS_DynamicArraySubscriptException",
+ "m2iso_M2RTS_ForLoopBeginException",
+ "m2iso_M2RTS_ForLoopToException",
+ "m2iso_M2RTS_ForLoopEndException",
+ "m2iso_M2RTS_PointerNilException",
+ "m2iso_M2RTS_NoReturnException",
+ "m2iso_M2RTS_CaseException",
+ "m2iso_M2RTS_WholeNonPosDivException",
+ "m2iso_M2RTS_WholeNonPosModException",
+ "m2iso_M2RTS_WholeZeroDivException",
+ "m2iso_M2RTS_WholeZeroRemException",
+ "m2iso_M2RTS_WholeValueException",
+ "m2iso_M2RTS_RealValueException",
+ "m2iso_M2RTS_ParameterException",
+ "m2iso_M2RTS_NoException",
NULL,
};
# load support procs
load_lib gm2-torture.exp
-gm2_init_pim "$srcdir/$subdir"
+gm2_init_pim "${srcdir}/${subdir}"
foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
# If we're only testing specific files and this isn't one of them, skip it.
set gm2src ${srcdir}/../m2
-gm2_init_iso "$srcdir/$subdir"
+gm2_init_iso "${srcdir}/${subdir}"
gm2_link_obj "c.o"
set output [target_compile $srcdir/$subdir/c.c c.o object "-g"]
# load support procs
load_lib gm2-torture.exp
-gm2_init_pim "$srcdir/$subdir/" -fcpp
+gm2_init_pim "${srcdir}/${subdir}/" -fcpp
foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
# If we're only testing specific files and this isn't one of them, skip it.
# load support procs
load_lib gm2-torture.exp
-gm2_init_pim "$srcdir/$subdir/" -DVALUE=999 -fcpp
+gm2_init_pim "${srcdir}/${subdir}/" -DVALUE=999 -fcpp
foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
# If we're only testing specific files and this isn't one of them, skip it.
# load support procs
load_lib gm2-torture.exp
-gm2_init_pim "$srcdir/$subdir"
+gm2_init_pim "${srcdir}/${subdir}"
foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
# If we're only testing specific files and this isn't one of them, skip it.
# load support procs
load_lib gm2-torture.exp
-gm2_init_pim "$srcdir/$subdir"
+gm2_init_pim "${srcdir}/${subdir}"
# We should be able to compile, link or run in 30 seconds.
gm2_push_timeout 30
{ -O3 -fsoft-check-all } \
{ -O3 -g -fsoft-check-all } ]
-gm2_init_iso "${srcdir}/gm2/iso/check/fail"
+gm2_init_iso "${srcdir}/gm2/iso/check/fail" -fm2-pathname=- -I${srcdir}/gm2/iso/check/fail
foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
# If we're only testing specific files and this isn't one of them, skip it.
# load support procs
load_lib gm2-torture.exp
-gm2_init_pim "${srcdir}/gm2/pim/pass" -fscaffold-main -fno-scaffold-dynamic
+gm2_init_pim "${srcdir}/gm2/pim/pass" -fscaffold-main -fno-scaffold-dynamic -fm2-pathname=- -I${srcdir}/gm2/pim/pass
gm2_link_obj scaffold.o
set output [target_compile $srcdir/$subdir/scaffold.c scaffold.o object "-g"]
extern void exit (int);
-extern void _M2_SYSTEM_init (int argc, char *argv[]);
-extern void _M2_SYSTEM_fini (void);
-extern void _M2_M2RTS_init (int argc, char *argv[]);
-extern void _M2_M2RTS_fini (void);
-extern void _M2_RTExceptions_init (int argc, char *argv[]);
-extern void _M2_RTExceptions_fini (void);
+extern void m2pim_M2_SYSTEM_init (int argc, char *argv[]);
+extern void m2pim_M2_SYSTEM_fini (void);
+extern void m2pim_M2_M2RTS_init (int argc, char *argv[]);
+extern void m2pim_M2_M2RTS_fini (void);
+extern void m2pim_M2_RTExceptions_init (int argc, char *argv[]);
+extern void m2pim_M2_RTExceptions_fini (void);
extern void _M2_hello_init (int argc, char *argv[]);
extern void _M2_hello_fini (void);
static void init (int argc, char *argv[])
{
- _M2_SYSTEM_init (argc, argv);
- _M2_M2RTS_init (argc, argv);
- _M2_RTExceptions_init (argc, argv);
+ m2pim_M2_SYSTEM_init (argc, argv);
+ m2pim_M2_M2RTS_init (argc, argv);
+ m2pim_M2_RTExceptions_init (argc, argv);
_M2_hello_init (argc, argv);
}
static void finish (void)
{
- M2RTS_Terminate ();
+ m2pim_M2RTS_Terminate ();
_M2_hello_fini ();
- _M2_RTExceptions_fini ();
- _M2_M2RTS_fini ();
- _M2_SYSTEM_fini ();
+ m2pim_M2_RTExceptions_fini ();
+ m2pim_M2_M2RTS_fini ();
+ m2pim_M2_SYSTEM_fini ();
exit (0);
}
-(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
- 2010
- Free Software Foundation, Inc. *)
-(* This file is part of GNU Modula-2.
-
-This library is free software; you can redistribute it and/or
-modify it under the terms of the GNU Lesser General Public
-License as published by the Free Software Foundation; either
-version 2.1 of the License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
+(* FIO.mod provides a simple buffered file input/output library.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
+General Public License for more details.
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *)
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. *)
IMPLEMENTATION MODULE FIO ;
(* bufstart above. *)
PtrToChar = POINTER TO CHAR ;
-(* we only need forward directives for the p2c bootstrapping tool *)
-
-(* %%%FORWARD%%%
-PROCEDURE SetEndOfLine (f: File; ch: CHAR) ; FORWARD ;
-PROCEDURE FormatError (a: ARRAY OF CHAR) ; FORWARD ;
-PROCEDURE FormatError1 (a: ARRAY OF CHAR; w: ARRAY OF BYTE) ; FORWARD ;
-PROCEDURE CheckAccess (f: File; use: FileUsage; towrite: BOOLEAN) ; FORWARD ;
-PROCEDURE BufferedRead (f: File; nBytes: CARDINAL; a: ADDRESS) : INTEGER ; FORWARD ;
-PROCEDURE InitializeFile (f: File; fname: ADDRESS; flength: CARDINAL;
- fstate: FileStatus; use: FileUsage; towrite: BOOLEAN; buflength: CARDINAL) : File ; FORWARD ;
-PROCEDURE ConnectToUnix (f: File; towrite, newfile: BOOLEAN) ; FORWARD ;
-PROCEDURE SetState (f: File; s: FileStatus) ; FORWARD ;
-PROCEDURE PreInitialize (f: File; fname: ARRAY OF CHAR;
- state: FileStatus; use: FileUsage;
- towrite: BOOLEAN; osfd: INTEGER; bufsize: CARDINAL) ; FORWARD ;
- %%%FORWARD%%% *)
VAR
FileInfo: Index ;
*)
PROCEDURE ReadFromBuffer (f: File; a: ADDRESS; nBytes: CARDINAL) : INTEGER ;
-VAR
+VAR
t : ADDRESS ;
result: INTEGER ;
total,
(*
- 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.
*)
-PROCEDURE ReadNBytes (f: File; nBytes: CARDINAL; a: ADDRESS) : CARDINAL ;
+PROCEDURE ReadNBytes (f: File; nBytes: CARDINAL; dest: ADDRESS) : CARDINAL ;
VAR
n: INTEGER ;
p: POINTER TO CHAR ;
BEGIN
- IF f#Error
+ IF f # Error
THEN
- CheckAccess(f, openedforread, FALSE) ;
- n := ReadFromBuffer(f, a, nBytes) ;
- IF n<0
+ CheckAccess (f, openedforread, FALSE) ;
+ n := ReadFromBuffer (f, dest, nBytes) ;
+ IF n <= 0
THEN
- RETURN( 0 )
+ RETURN 0
ELSE
- p := a ;
- INC(p, n) ;
- SetEndOfLine(f, p^) ;
- RETURN( n )
+ p := dest ;
+ INC (p, n-1) ;
+ SetEndOfLine (f, p^) ;
+ RETURN n
END
ELSE
- RETURN( 0 )
+ RETURN 0
END
END ReadNBytes ;
*)
PROCEDURE BufferedRead (f: File; nBytes: CARDINAL; a: ADDRESS) : INTEGER ;
-VAR
+VAR
t : ADDRESS ;
result: INTEGER ;
total,
END
END ;
RETURN( total )
- ELSE
- RETURN( -1 )
END
END
END
- ELSE
- RETURN( -1 )
- END
+ END ;
+ RETURN( -1 )
END BufferedRead ;
BEGIN
HighSrc := StrLen(src) ;
HighDest := HIGH(dest) ;
+ p := NIL ;
+ c := 0 ;
i := 0 ;
j := 0 ;
WHILE (i<HighSrc) AND (src[i]#nul) AND (j<HighDest) AND (src[i]#'%') DO
PROCEDURE FormatError (a: ARRAY OF CHAR) ;
BEGIN
- WriteString(StdErr, a)
+ WriteString (StdErr, a)
END FormatError ;
(*
- FormatError1 - fairly generic error procedure.
+ FormatError1 - generic error procedure taking standard format string
+ and single parameter.
*)
PROCEDURE FormatError1 (a: ARRAY OF CHAR; w: ARRAY OF BYTE) ;
VAR
s: ARRAY [0..MaxErrorString] OF CHAR ;
BEGIN
- StringFormat1(s, a, w) ;
- FormatError(s)
+ StringFormat1 (s, a, w) ;
+ FormatError (s)
END FormatError1 ;
(*
- FormatError2 - fairly generic error procedure.
+ FormatError2 - generic error procedure taking standard format string
+ and two parameters.
*)
PROCEDURE FormatError2 (a: ARRAY OF CHAR;
VAR
s: ARRAY [0..MaxErrorString] OF CHAR ;
BEGIN
- StringFormat1(s, a, w1) ;
- FormatError1(s, w2)
+ StringFormat1 (s, a, w1) ;
+ FormatError1 (s, w2)
END FormatError2 ;
(*
- CheckAccess - checks to see whether a file, f, has been
+ CheckAccess - checks to see whether a file f has been
opened for read/write.
*)
BEGIN
IF f#Error
THEN
- fd := GetIndice(FileInfo, f) ;
+ fd := GetIndice (FileInfo, f) ;
IF fd=NIL
THEN
IF f#StdErr
THEN
- FormatError('this file has probably been closed and not reopened successfully or alternatively never opened\n')
+ FormatError ('this file has probably been closed and not reopened successfully or alternatively never opened\n')
END ;
HALT
ELSE
WITH fd^ DO
IF (use=openedforwrite) AND (usage=openedforread)
THEN
- FormatError1('this file (%s) has been opened for reading but is now being written\n',
- name.address) ;
+ FormatError1 ('this file (%s) has been opened for reading but is now being written\n',
+ name.address) ;
HALT
ELSIF (use=openedforread) AND (usage=openedforwrite)
THEN
(*
- ReadChar - returns a character read from file, f.
+ ReadChar - returns a character read from file f.
Sensible to check with IsNoError or EOF after calling
this function.
*)
VAR
ch: CHAR ;
BEGIN
- CheckAccess(f, openedforread, FALSE) ;
- IF BufferedRead(f, SIZE(ch), ADR(ch)) = INTEGER (SIZE(ch))
+ CheckAccess (f, openedforread, FALSE) ;
+ IF BufferedRead (f, SIZE (ch), ADR (ch)) = VAL (INTEGER, SIZE (ch))
THEN
- SetEndOfLine(f, ch) ;
- RETURN( ch )
+ SetEndOfLine (f, ch) ;
+ RETURN ch
ELSE
- RETURN( nul )
+ RETURN nul
END
END ReadChar ;
(*
- SetEndOfLine -
+ SetEndOfLine -
*)
PROCEDURE SetEndOfLine (f: File; ch: CHAR) ;
IF ch=nl
THEN
state := endofline
+ ELSE
+ state := successful
END
END
END
(*
- UnReadChar - replaces a character, ch, back into file, f.
+ UnReadChar - replaces a character, ch, back into file f.
This character must have been read by ReadChar
and it does not allow successive calls. It may
only be called if the previous read was successful
or end of file was seen.
+ If the state was previously endoffile then it
+ is altered to successful.
+ Otherwise it is left alone.
*)
-PROCEDURE UnReadChar (f: File ; ch: CHAR) ;
+PROCEDURE UnReadChar (f: File; ch: CHAR) ;
VAR
fd : FileDescriptor ;
n : CARDINAL ;
DEC(position) ;
INC(left) ;
contents^[position] := ch ;
- SetEndOfLine(f, ch)
ELSE
(* position=0 *)
(* if possible make room and store ch *)
a := memcpy(a, b, n) ;
INC(filled) ;
contents^[position] := ch ;
- SetEndOfLine(f, ch)
END
END
END
PROCEDURE ReadAny (f: File; VAR a: ARRAY OF BYTE) ;
BEGIN
CheckAccess(f, openedforread, FALSE) ;
- IF BufferedRead(f, HIGH(a), ADR(a)) = INTEGER (HIGH(a))
+ IF BufferedRead (f, HIGH (a), ADR (a)) = VAL (INTEGER, HIGH (a))
THEN
SetEndOfLine(f, a[HIGH(a)])
END
fd := GetIndice(FileInfo, f) ;
IF fd#NIL
THEN
- IF fd^.state=successful
+ IF (fd^.state=successful) OR (fd^.state=endofline)
THEN
ch := ReadChar(f) ;
- IF fd^.state=successful
+ IF (fd^.state=successful) OR (fd^.state=endofline)
THEN
UnReadChar(f, ch)
END ;
(*
- 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.
*)
-PROCEDURE WriteNBytes (f: File; nBytes: CARDINAL; a: ADDRESS) : CARDINAL ;
+PROCEDURE WriteNBytes (f: File; nBytes: CARDINAL; src: ADDRESS) : CARDINAL ;
VAR
total: INTEGER ;
fd : FileDescriptor ;
IF fd#NIL
THEN
WITH fd^ DO
- total := write(unixfd, a, INTEGER(nBytes)) ;
+ total := write(unixfd, src, INTEGER(nBytes)) ;
IF total<0
THEN
state := failed ;
*)
PROCEDURE BufferedWrite (f: File; nBytes: CARDINAL; a: ADDRESS) : INTEGER ;
-VAR
+VAR
t : ADDRESS ;
result: INTEGER ;
total,
END
ELSE
FlushBuffer(f) ;
- IF state#successful
+ IF (state#successful) AND (state#endofline)
THEN
nBytes := 0
END
PROCEDURE WriteAny (f: File; VAR a: ARRAY OF BYTE) ;
BEGIN
- CheckAccess(f, openedforwrite, TRUE) ;
- IF BufferedWrite (f, HIGH(a), ADR(a)) = INTEGER (HIGH(a))
+ CheckAccess (f, openedforwrite, TRUE) ;
+ IF BufferedWrite (f, HIGH (a), ADR (a)) = VAL (INTEGER, HIGH (a))
THEN
END
END WriteAny ;
PROCEDURE WriteChar (f: File; ch: CHAR) ;
BEGIN
- CheckAccess(f, openedforwrite, TRUE) ;
- IF BufferedWrite(f, SIZE(ch), ADR(ch)) = INTEGER (SIZE(ch))
+ CheckAccess (f, openedforwrite, TRUE) ;
+ IF BufferedWrite (f, SIZE (ch), ADR (ch)) = VAL (INTEGER, SIZE (ch))
THEN
END
END WriteChar ;
ELSE
RETURN fd^.name.address
END
- END
+ END ;
+ RETURN NIL
END getFileName ;
ELSE
RETURN fd^.name.size
END
- END
+ END ;
+ RETURN 0
END getFileNameLength ;
(*
- FlushOutErr - called when the application calls M2RTS.Terminate (automatically
- placed in program modules by GM2.
+ FlushOutErr - flushes, StdOut, and, StdErr.
+ It is also called when the application calls M2RTS.Terminate.
+ (which is automatically placed in program modules by the GM2
+ scaffold).
*)
PROCEDURE FlushOutErr ;
-(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
- Free Software Foundation, Inc. *)
-(* This file is part of GNU Modula-2.
+(* StrLib.mod provides string manipulation procedures.
-This library is free software; you can redistribute it and/or
-modify it under the terms of the GNU Lesser General Public
-License as published by the Free Software Foundation; either
-version 2.1 of the License, or (at your option) any later version.
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
-This library is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *)
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. *)
IMPLEMENTATION MODULE StrLib ;
FROM ASCII IMPORT nul, tab ;
-(* %%%FORWARD%%%
-PROCEDURE StrEqual (a, b: ARRAY OF CHAR) : BOOLEAN ; FORWARD ;
-PROCEDURE StrLen (a: ARRAY OF CHAR) : CARDINAL ; FORWARD ;
-PROCEDURE StrCopy (a: ARRAY OF CHAR ; VAR b: ARRAY OF CHAR) ; FORWARD ;
-PROCEDURE StrConCat (a: ARRAY OF CHAR ; b: ARRAY OF CHAR ; VAR c: ARRAY OF CHAR) ; FORWARD ;
-PROCEDURE IsSubString (a, b: ARRAY OF CHAR) : BOOLEAN ; FORWARD ;
- %%%FORWARD%%% *)
-
(*
StrConCat - combines a and b into c.
PROCEDURE StrEqual (a, b: ARRAY OF CHAR) : BOOLEAN ;
VAR
i,
- Higha,
- Highb: CARDINAL ;
- Equal: BOOLEAN ;
+ higha,
+ highb: CARDINAL ;
BEGIN
- Higha := StrLen(a) ;
- Highb := StrLen(b) ;
- IF Higha=Highb
- THEN
- Equal := TRUE ;
- i := 0 ;
- WHILE Equal AND (i<Higha) DO
- Equal := (a[i]=b[i]) ;
- INC(i)
+ higha := HIGH(a) ;
+ highb := HIGH(b) ;
+ i := 0 ;
+ WHILE (i<=higha) AND (i<=highb) AND (a[i]#nul) AND (b[i]#nul) DO
+ IF a[i]#b[i]
+ THEN
+ RETURN( FALSE )
END ;
- RETURN( Equal )
- ELSE
- RETURN( FALSE )
- END
+ INC(i)
+ END ;
+ RETURN NOT (((i<=higha) AND (a[i]#nul)) OR
+ ((i<=highb) AND (b[i]#nul)))
END StrEqual ;
END StrLen ;
-PROCEDURE StrCopy (a: ARRAY OF CHAR ; VAR b: ARRAY OF CHAR) ;
+(*
+ StrCopy - copy string src into string dest providing dest is large enough.
+ If dest is smaller than a then src then the string is truncated when
+ dest is full. Add a nul character if there is room in dest.
+*)
+
+PROCEDURE StrCopy (src: ARRAY OF CHAR ; VAR dest: ARRAY OF CHAR) ;
VAR
- Higha,
- Highb,
- n : CARDINAL ;
+ HighSrc,
+ HighDest,
+ n : CARDINAL ;
BEGIN
n := 0 ;
- Higha := StrLen(a) ;
- Highb := HIGH(b) ;
- WHILE (n<Higha) AND (n<=Highb) DO
- b[n] := a[n] ;
- INC(n)
+ HighSrc := StrLen (src) ;
+ HighDest := HIGH (dest) ;
+ WHILE (n < HighSrc) AND (n <= HighDest) DO
+ dest[n] := src[n] ;
+ INC (n)
END ;
- IF n<=Highb
+ IF n <= HighDest
THEN
- b[n] := nul
+ dest[n] := nul
END
END StrCopy ;
set gm2src ${srcdir}/../m2
-gm2_init_pim "${srcdir}/gm2/pimlib/base/run/pass"
+gm2_init_pim ""
# We should be able to compile, link or run in 20 seconds.
gm2_push_timeout 20
# load support procs
load_lib gm2-torture.exp
-gm2_init_pim "$srcdir/$subdir" -g
+gm2_init_pim "${srcdir}/${subdir}" -g
gm2_link_obj "WriteMap.o AdvMap.o BoxMap.o Chance.o Geometry.o MakeBoxes.o MapOptions.o Options.o RoomMap.o StoreCoords.o"
# If we want these to be re-built for each torture option we need some different
--- /dev/null
+DEFINITION MODULE AdvCmd ;
+
+
+EXPORT QUALIFIED ExecuteCommand ;
+
+
+PROCEDURE ExecuteCommand (ch: CHAR ; VAR Dead: BOOLEAN) ;
+
+
+END AdvCmd.
--- /dev/null
+IMPLEMENTATION MODULE AdvCmd ;
+
+
+FROM ASCII IMPORT ff, esc ;
+FROM Storage IMPORT ALLOCATE ;
+
+FROM AdvMap IMPORT IncPosition ;
+FROM DrawG IMPORT DrawMan, EraseMan ;
+FROM AdvTreasure IMPORT GetTreasure, DropTreasure, UseTreasure ;
+FROM ProcArgs IMPORT SetArgs ;
+
+FROM AdvSystem IMPORT ArrowArgs,
+ Player, TypeOfDeath, PlayerNo,
+ GetWriteAccessToPlayer,
+ ReleaseWriteAccessToPlayer,
+ GetReadAccessToPlayer,
+ ReleaseReadAccessToPlayer,
+ GetAccessToScreenNo,
+ ReleaseAccessToScreenNo ;
+
+FROM AdvMath IMPORT UpDateWoundsAndFatigue,
+ StrengthToFireArrow,
+ StrengthToFireMagic ;
+
+FROM AdvUtil IMPORT MoveMan, Exit, InitialDisplay,
+ OpenDoor, CloseDoor, ExamineDoor, HideDoor,
+ Attack, Thrust, Parry,
+ Speak ;
+
+FROM Screen IMPORT Height, Width, WriteTime, ClearScreen, Pause,
+ WriteString,
+ WriteCommentLine1,
+ DelCommentLine1,
+ WriteArrows, WriteMagicArrows ;
+
+
+CONST
+ MaxCard = 65535 ;
+ CtrlL = ff ;
+
+
+(* Adventure Commands! - Interpreted *)
+
+
+PROCEDURE ExecuteCommand (ch: CHAR ; VAR Dead: BOOLEAN) ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ GetWriteAccessToPlayer ;
+ Dead := DeathType#living ;
+ IF Dead
+ THEN
+ RoomOfMan := 0 ;
+ Xman := MaxCard-Width ;
+ Yman := MaxCard-Height ;
+ ReleaseWriteAccessToPlayer
+ ELSE
+ WriteTime (p) ; (* always start by displaying the current time. *)
+
+ ReleaseWriteAccessToPlayer ;
+ GetAccessToScreenNo(p) ;
+ UpDateWoundsAndFatigue(p) ;
+ ReleaseAccessToScreenNo(p) ;
+
+ CASE ch OF
+
+ 'h' : Help |
+ 'v' : ValtTurn |
+ 'r' : RightTurn |
+ 'l' : LeftTurn |
+ '0'..'9' : MoveMan( ORD(ch)-ORD('0') ) |
+ 'f' : FireNormalArrow |
+ 'm' : FireMagicArrow |
+ 'p' : Parry |
+ 't' : Thrust |
+ 'a' : Attack |
+ 'o' : OpenDoor |
+ 'c' : CloseDoor |
+ 'e' : ExamineDoor |
+ 'g' : GetTreasure |
+ 'd' : DropTreasure |
+ 'u' : UseTreasure |
+ 's' : Speak |
+ 'w' : |
+
+ CtrlL: RedrawScreen |
+
+ esc : Exit ;
+ DeathType := exitdungeon
+
+ ELSE
+ END ;
+ GetWriteAccessToPlayer ;
+ Dead := DeathType#living ;
+ IF Dead
+ THEN
+ Xman := MaxCard-Width ;
+ Yman := MaxCard-Height ;
+ RoomOfMan := 0
+ END ;
+ ReleaseWriteAccessToPlayer
+ END
+ END
+END ExecuteCommand ;
+
+
+PROCEDURE Help ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ GetAccessToScreenNo(p) ;
+ ClearScreen(p) ;
+ WriteString(p, 'Key commands are:') ;
+ WriteString(p, '') ;
+ WriteString(p, "'1'..'9' move 1..9 squares forward") ;
+ WriteString(p, "'r' turn right") ;
+ WriteString(p, "'l' turn left") ;
+ WriteString(p, "'v' vault turn") ;
+ WriteString(p, "'f' fire normal arrow") ;
+ WriteString(p, "'m' fire magic arrow") ;
+ WriteString(p, "'o' open door in front of you") ;
+ WriteString(p, "'c' close door in front of you") ;
+ WriteString(p, "'e' examine wall for secret door in front of you") ;
+ WriteString(p, "'p' parry with sword") ;
+ WriteString(p, "'a' attack with sword") ;
+ WriteString(p, "'t' thrust with sword") ;
+ WriteString(p, "'g' get treasure in front of you") ;
+ WriteString(p, "'d' <no> drop treasure in front of you") ;
+ WriteString(p, "'u' <no> use treasure") ;
+ ReleaseAccessToScreenNo(p) ;
+ Pause(p) ;
+ RedrawScreen
+END Help ;
+
+
+PROCEDURE ValtTurn ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ GetWriteAccessToPlayer ;
+ EraseMan(p) ;
+ WITH Player[p] DO
+ Direction := (Direction+2) MOD 4 ;
+ END ;
+ DrawMan( p ) ;
+ ReleaseWriteAccessToPlayer
+END ValtTurn ;
+
+
+PROCEDURE RightTurn ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ GetWriteAccessToPlayer ;
+ EraseMan(p) ;
+ WITH Player[p] DO
+ Direction := (Direction+3) MOD 4 ;
+ END ;
+ DrawMan(p) ;
+ ReleaseWriteAccessToPlayer
+END RightTurn ;
+
+
+PROCEDURE LeftTurn ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ GetWriteAccessToPlayer ;
+ EraseMan(p) ;
+ WITH Player[p] DO
+ Direction := (Direction+1) MOD 4 ;
+ END ;
+ DrawMan( p ) ;
+ ReleaseWriteAccessToPlayer
+END LeftTurn ;
+
+
+PROCEDURE SendFireToProcess (p, r, x, y, d: CARDINAL; magic: BOOLEAN) ;
+VAR
+ aa: ArrowArgs ;
+BEGIN
+ NEW(aa) ;
+ WITH aa^ DO
+ ArrowPlayer := p ;
+ ArrowRoom := r ;
+ ArrowX := x ;
+ ArrowY := y ;
+ ArrowDir := d ;
+ IsMagic := FALSE
+ END ;
+ WITH Player[p] DO
+ IF magic
+ THEN
+ aa := SetArgs(MagicProcArgs, aa)
+ ELSE
+ aa := SetArgs(NormalProcArgs, aa)
+ END
+ END
+END SendFireToProcess ;
+
+
+PROCEDURE FireMagicArrow ;
+VAR
+ r,
+ x, y, p,
+ Dir : CARDINAL ;
+ yes : BOOLEAN ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ GetWriteAccessToPlayer ;
+ StrengthToFireMagic(yes) ;
+ IF yes
+ THEN
+ IF NoOfMagic>0
+ THEN
+ DEC(NoOfMagic) ;
+ Dir := Direction ;
+ x := Xman ;
+ y := Yman ;
+ r := RoomOfMan ;
+ ReleaseWriteAccessToPlayer ;
+ IncPosition(x, y, Dir) ;
+ SendFireToProcess(p, r, x, y, Dir, TRUE) ;
+ GetAccessToScreenNo(p) ;
+ WriteMagicArrows(p, NoOfMagic) ;
+ ReleaseAccessToScreenNo(p)
+ ELSE
+ ReleaseWriteAccessToPlayer ;
+ GetAccessToScreenNo(p) ;
+ DelCommentLine1(p) ;
+ WriteCommentLine1(p, 'None left') ;
+ ReleaseAccessToScreenNo(p)
+ END
+ ELSE
+ ReleaseWriteAccessToPlayer
+ END
+ END
+END FireMagicArrow ;
+
+
+PROCEDURE FireNormalArrow ;
+VAR
+ r,
+ x, y, p,
+ Dir : CARDINAL ;
+ yes : BOOLEAN ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ GetWriteAccessToPlayer ;
+ StrengthToFireArrow(yes) ;
+ IF yes
+ THEN
+ IF NoOfNormal>0
+ THEN
+ DEC(NoOfNormal) ;
+ Dir := Direction ;
+ x := Xman ;
+ y := Yman ;
+ r := RoomOfMan ;
+ ReleaseWriteAccessToPlayer ;
+ IncPosition(x, y, Dir) ;
+ SendFireToProcess(p, r, x, y, Dir, FALSE) ;
+ GetAccessToScreenNo(p) ;
+ DelCommentLine1(p) ;
+ WriteArrows(p, NoOfNormal) ;
+ ReleaseAccessToScreenNo(p)
+ ELSE
+ ReleaseWriteAccessToPlayer ;
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'None left') ;
+ ReleaseAccessToScreenNo(p)
+ END
+ ELSE
+ ReleaseWriteAccessToPlayer
+ END
+ END
+END FireNormalArrow ;
+
+
+PROCEDURE RedrawScreen ;
+BEGIN
+ InitialDisplay
+END RedrawScreen ;
+
+
+END AdvCmd.
--- /dev/null
+DEFINITION MODULE AdvIntroduction ;
+
+EXPORT QUALIFIED StartGame ;
+
+PROCEDURE StartGame ;
+
+END AdvIntroduction.
--- /dev/null
+(* Copyright (C) 2003
+ Free Software Foundation, Inc. *)
+(* This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 2, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING. If not, write to the Free Software
+Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+IMPLEMENTATION MODULE AdvIntroduction ;
+
+FROM SYSTEM IMPORT ADR, SIZE ;
+FROM ASCII IMPORT lf, cr, nul ;
+FROM StrLib IMPORT StrLen ;
+FROM SocketControl IMPORT nonBlocking, ignoreSignals ;
+
+FROM Executive IMPORT WaitForIO, InitProcess, InitSemaphore, Wait, Signal, Resume,
+ Suspend, DESCRIPTOR, SEMAPHORE, KillProcess ;
+
+FROM RTint IMPORT InitInputVector ;
+FROM COROUTINES IMPORT PROTECTION ;
+FROM sckt IMPORT tcpServerState, tcpServerEstablish, tcpServerAccept, tcpServerSocketFd ;
+FROM libc IMPORT printf, read, write ;
+FROM AdvUtil IMPORT Positioning, TestIfLastLivePlayer ;
+
+FROM AdvSystem IMPORT Player, TypeOfDeath, StartPlayer, PlayerNo,
+ ClientRead, DefaultWrite, UnAssign,
+ ReadString, GetReadAccessToPlayer,
+ ReleaseReadAccessToPlayer,
+ GetAccessToScreen, ReleaseAccessToScreen ;
+
+FROM AdvTreasure IMPORT DisplayEnemy, Grenade ;
+FROM AdvUtil IMPORT InitialDisplay ;
+FROM AdvCmd IMPORT ExecuteCommand ;
+FROM Screen IMPORT WriteCommand, ClearScreen, WriteString, PromptString, Pause, Quit ;
+FROM AdvSound IMPORT EnterGame ;
+FROM StdIO IMPORT PushOutput ;
+
+
+CONST
+ Meg = 1024*1024 ;
+ StackSize = 30 * Meg ;
+
+VAR
+ ToBeTaken: SEMAPHORE ;
+ NextFd : INTEGER ;
+
+
+PROCEDURE theServer ;
+VAR
+ fd: INTEGER ;
+ v : CARDINAL ;
+ ch: CHAR ;
+ r : INTEGER ;
+BEGIN
+ fd := NextFd ;
+ Signal(ToBeTaken) ;
+ v := InitInputVector(fd, MAX(PROTECTION)) ;
+ r := printf("inside `theServer' using fd=%d\n", fd);
+ StartPlayer(fd) ;
+ Copyleft ;
+ Title ;
+ Knight ;
+ WITH Player[PlayerNo()] DO
+ fd := -1 ;
+ PlayerProcess := NIL ;
+ END ;
+ UnAssign ;
+ KillProcess
+END theServer ;
+
+
+PROCEDURE StartGame ;
+VAR
+ r : INTEGER ;
+ v : CARDINAL ;
+ fd : INTEGER ;
+ s : tcpServerState ;
+ g, p: DESCRIPTOR ;
+BEGIN
+ ignoreSignals ;
+ PushOutput(DefaultWrite) ;
+ g := Resume(InitProcess(Grenade, StackSize, 'grenade')) ;
+ s := tcpServerEstablish() ;
+ ToBeTaken := InitSemaphore(1, 'ToBeTaken') ;
+ v := InitInputVector(tcpServerSocketFd(s), MAX(PROTECTION)) ;
+ LOOP
+ r := printf("before WaitForIO\n");
+ WaitForIO(v) ;
+ fd := tcpServerAccept(s) ;
+ r := nonBlocking(fd) ;
+ r := printf("before InitProcess\n");
+ p := InitProcess(theServer, StackSize, 'theServer') ;
+ NextFd := fd ;
+ r := printf("before Resume\n");
+ p := Resume(p) ;
+ Wait(ToBeTaken)
+ END
+END StartGame ;
+
+
+PROCEDURE Knight ;
+VAR
+ Dead: BOOLEAN ;
+ ch : CHAR ;
+ p : CARDINAL ;
+BEGIN
+ EquipKnight ;
+ SetUpKnight ;
+ InitialDisplay ;
+ p := PlayerNo() ;
+ EnterGame(p) ;
+ Dead := FALSE ;
+ REPEAT
+ IF ClientRead(ch)
+ THEN
+ WriteCommand(p, ch) ;
+ ExecuteCommand(ch, Dead)
+ ELSE
+ Dead := TRUE
+ END
+ UNTIL Dead ;
+ GiveResults
+END Knight ;
+
+
+PROCEDURE Copyleft ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ ClearScreen(p) ;
+ WriteString(p, 'Written whilst on holiday during the rainy months of\n') ;
+ WriteString(p, 'August 85, August 86 and ported to GNU/linux during July/August 2005\n\n') ;
+ WriteString(p, '\n') ;
+ WriteString(p, 'A multiplayer game inspired by two single player Commodore PET\n') ;
+ WriteString(p, 'game of circa 1979 (Morloc Tower and Temple of Apshai)\n') ;
+ WriteString(p, '\n') ;
+ WriteString(p, 'This game is rather different (similar key commands) and\n') ;
+ WriteString(p, 'in retrospect a very very poor persons multiplayer doom!\n') ;
+ Pause(p)
+END Copyleft ;
+
+
+PROCEDURE Title ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ ClearScreen(p) ;
+ WriteString(p, '...set in a time of long ago, when life hast no value and\n') ;
+ WriteString(p, ' death sometimes, hadst a price. Thou needst to be quick\n') ;
+ WriteString(p, ' with thy sword and fast with thy bow, for only the best\n') ;
+ WriteString(p, ' survived...\n\n\n')
+END Title ;
+
+
+PROCEDURE EquipKnight ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ PromptString(p, 'What is thy name? ') ;
+ WITH Player[PlayerNo()] DO
+ ReadString(ManName)
+ END ;
+ WriteString(p, '\n')
+END EquipKnight ;
+
+
+PROCEDURE SetUpKnight ;
+BEGIN
+ WITH Player[PlayerNo()] DO
+ NoOfMagic := 1 ;
+ NoOfNormal := 7
+ END ;
+ Positioning
+END SetUpKnight ;
+
+
+PROCEDURE GiveResults ;
+VAR
+ yes: BOOLEAN ;
+ p : CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ Pause(p) ;
+ GetReadAccessToPlayer ;
+ GetAccessToScreen ;
+ ClearScreen(p) ;
+ WITH Player[p] DO
+ IF Wounds=0
+ THEN
+ WriteString(p, 'Thou art slain...') ;
+ GiveDescriptionOfDeath(p, DeathType)
+ ELSE
+ TestIfLastLivePlayer(yes) ;
+ IF yes
+ THEN
+ WriteString(p, 'Thou art the conqueror of the dungeon')
+ ELSE
+ WriteString(p, 'Thou art the coward of the dungeon')
+ END ;
+ Wounds := 0
+ END ;
+ WriteString(p, '\n\n\n')
+ END ;
+ ReleaseAccessToScreen ;
+ ReleaseReadAccessToPlayer ;
+ Pause(p) ;
+ Quit(p)
+END GiveResults ;
+
+
+PROCEDURE GiveDescriptionOfDeath (p: CARDINAL; Dt: TypeOfDeath) ;
+BEGIN
+ WriteString(p, '\n\n\n\nThou expired from life after :\n\n') ;
+ CASE Dt OF
+
+ sword : WriteString(p, 'being slain with a sword') |
+ magicarrow : WriteString(p, 'being pierced by a magic arrow') |
+ fireball : WriteString(p, 'thou wast struck by a fireball burning thy body fatally') |
+ normalarrow : WriteString(p, 'thou wast struck a deadly blow caused by an arrow') |
+ explosion : WriteString(p, 'having thy guts blown all over the dungeon') |
+ exitdungeon : WriteString(p, 'thou crawlest out of the dungeon and expired')
+
+ END
+END GiveDescriptionOfDeath ;
+
+
+(* Monitor allows a dead player to look around the dungeon unaffecting *)
+(* the current game. *)
+
+PROCEDURE Monitor ;
+VAR
+ p : CARDINAL ;
+ ch: CHAR ;
+BEGIN
+ p := PlayerNo() ;
+ REPEAT
+ ClearScreen(p) ;
+ WriteString(p, 'Monitor --- Look at other players\n\n\n\n') ;
+ WriteString(p, 'Commands:\n') ;
+ WriteString(p, '1) Look at other players\n') ;
+ WriteString(p, '2) Exit\n\n') ;
+ WriteString(p, 'Option:') ;
+ IF ClientRead(ch)
+ THEN
+ DefaultWrite(ch) ;
+ IF ch='1'
+ THEN
+ DisplayEnemy
+ END
+ ELSE
+ RETURN
+ END
+ UNTIL ch='2'
+END Monitor ;
+
+
+END AdvIntroduction.
+(*
+ * Local variables:
+ * compile-command: "make"
+ * End:
+ *)
--- /dev/null
+DEFINITION MODULE AdvMap ;
+
+FROM AdvMath IMPORT MaxNoOfTreasures ;
+
+EXPORT QUALIFIED Rooms, Line, DoorStatus, Door, Room, Treasure,
+ ActualNoOfRooms, MaxNoOfRooms,
+ WallsPerRoom, DoorsPerRoom,
+ NoOfRoomsToHidePlayers, NoOfRoomsToSpring,
+ NoOfRoomsToHideCoal, NoOfRoomsToHideGrenade,
+ TreasureKind,
+ Adjacent, IncPosition,
+ FileName, MaxLengthOfFileName ;
+
+
+CONST
+ MaxNoOfRooms = 350 ; (* An upper limit *)
+ WallsPerRoom = 12 ; (* An upper limit *)
+ DoorsPerRoom = 8 ; (* An upper limit *)
+
+ MaxLengthOfFileName = 11 ;
+ NoOfRoomsToHidePlayers = 50 ;
+ NoOfRoomsToSpring = 50 ;
+ NoOfRoomsToHideCoal = 50 ;
+ NoOfRoomsToHideGrenade = 50 ;
+
+
+TYPE
+ Line = RECORD
+ X1 : CARDINAL ;
+ Y1 : CARDINAL ;
+ X2 : CARDINAL ;
+ Y2 : CARDINAL
+ END ;
+
+ DoorStatus = (Open, Closed, Secret) ;
+
+ Door = RECORD
+ Position : Line ;
+ StateOfDoor : DoorStatus ;
+ LeadsTo : CARDINAL
+ END ;
+
+ TreasureKind = (unused, respawnnormal, respawnmagic,
+ onperson, onfloor, normal, magic) ;
+
+ TreasureInfo = RECORD
+ Xpos : CARDINAL ;
+ Ypos : CARDINAL ;
+ Rm : CARDINAL ;
+ Tweight : CARDINAL ;
+ TreasureName : ARRAY [0..12] OF CHAR ;
+ kind : TreasureKind ;
+ amount : CARDINAL ; (* number of arrows. *)
+ END ;
+
+ Room = RECORD
+ NoOfWalls : CARDINAL ;
+ NoOfDoors : CARDINAL ;
+ Walls : ARRAY [1..WallsPerRoom] OF Line ;
+ Doors : ARRAY [1..DoorsPerRoom] OF Door ;
+ Treasures : BITSET ;
+ END ;
+
+
+VAR
+ ActualNoOfRooms : CARDINAL ;
+ Treasure : ARRAY [1..MaxNoOfTreasures] OF TreasureInfo ;
+ Rooms : ARRAY [1..MaxNoOfRooms] OF Room ;
+ FileName : ARRAY [0..MaxLengthOfFileName] OF CHAR ;
+
+
+(* Tests to see if two rooms are Adjacent to each other. *)
+
+PROCEDURE Adjacent (R1, R2: CARDINAL) : BOOLEAN ;
+
+
+(* Increments the position of x, y by the direction that are facing *)
+
+PROCEDURE IncPosition (VAR x, y: CARDINAL ; Dir: CARDINAL) ;
+
+
+END AdvMap.
--- /dev/null
+IMPLEMENTATION MODULE AdvMap ;
+
+
+(* IncPosition increments the x,y coordinates according *)
+(* the Direction sent. *)
+
+PROCEDURE IncPosition (VAR x, y: CARDINAL ; Dir: CARDINAL) ;
+BEGIN
+ IF (Dir=0) AND (y>0)
+ THEN
+ DEC(y)
+ ELSIF Dir=3
+ THEN
+ INC(x)
+ ELSIF Dir=2
+ THEN
+ INC(y)
+ ELSIF x>0
+ THEN
+ DEC(x)
+ END
+END IncPosition ;
+
+
+
+(* Adjacent tests whether two rooms R1 & R2 are adjacent *)
+(* Assume that access to map has been granted. *)
+
+PROCEDURE Adjacent (R1, R2: CARDINAL) : BOOLEAN ;
+VAR
+ i, r1, r2 : CARDINAL ;
+ ok: BOOLEAN ;
+BEGIN
+ WITH Rooms[R1] DO
+ i := NoOfDoors ;
+ ok := FALSE ;
+ WHILE (i>0) AND (NOT ok) DO
+ IF Doors[i].LeadsTo=R2
+ THEN
+ ok := TRUE
+ ELSE
+ DEC (i)
+ END
+ END
+ END ;
+ RETURN ok
+END Adjacent ;
+
+
+BEGIN
+ ActualNoOfRooms := 0
+END AdvMap.
+(*
+ * Local variables:
+ * compile-command: "make"
+ * End:
+ *)
--- /dev/null
+DEFINITION MODULE AdvMath ;
+
+EXPORT QUALIFIED RequiredToParry,
+ RequiredToAttack,
+ RequiredToThrust,
+ RequiredToFireArrow,
+ RequiredToFireMagic,
+ RequiredToMove,
+ RequiredToMagicShoes,
+ RequiredToMagicParry,
+ RequiredToMagicAttack,
+ RequiredToMagicThrust,
+
+ DammageByParry,
+ DammageByAttack,
+ DammageByThrust,
+ DammageByFireArrow,
+ DammageByFireMagic,
+ DammageByHandGrenade,
+ DammageByHotIron,
+ DammageByMagicParry,
+ DammageByMagicAttack,
+ DammageByMagicThrust,
+
+ MagicKey,
+ CrystalBall,
+ MagicSpring,
+ SackOfCoal1,
+ SackOfCoal2,
+ HotIron,
+ HandGrenade,
+ MagicSword,
+ MagicShoes,
+ SleepPotion,
+ LumpOfIron,
+ TreasTrove,
+ SpeedPotion,
+ MagicShield,
+ VisionChest,
+ QuiverNormal,
+ QuiverMagic,
+ HealingPotion,
+ LowFreePool,
+ HighFreePool,
+ MaxNoOfTreasures,
+
+ UpDateWoundsAndFatigue,
+ StrengthToParry,
+ StrengthToAttack,
+ StrengthToThrust,
+ StrengthToFireArrow,
+ StrengthToFireMagic,
+ StrengthToMove ;
+
+
+CONST
+ RequiredToParry = 3 ;
+ RequiredToAttack = 5 ;
+ RequiredToThrust = 9 ;
+ RequiredToFireArrow = 10 ;
+ RequiredToFireMagic = 15 ;
+ RequiredToMove = 6 ; (* For 9 squares *)
+ RequiredToMagicShoes = 3 ; (* For 9 squares *)
+ RequiredToMagicParry = 1 ;
+ RequiredToMagicAttack = 3 ;
+ RequiredToMagicThrust = 6 ;
+
+ DammageByParry = 7 ;
+ DammageByAttack = 13 ;
+ DammageByThrust = 17 ;
+ DammageByFireArrow = 23 ;
+ DammageByFireMagic = 74 ;
+ DammageByHandGrenade = 69 ;
+ DammageByHotIron = 19 ;
+ DammageByMagicParry = 8 ;
+ DammageByMagicAttack = 14 ;
+ DammageByMagicThrust = 18 ;
+
+ MagicKey = 1 ; (* Treasure Numbers *)
+ CrystalBall = 2 ;
+ MagicSpring = 3 ;
+ SackOfCoal1 = 4 ;
+ SackOfCoal2 = 5 ;
+ HotIron = 6 ;
+ HandGrenade = 7 ;
+ MagicSword = 8 ;
+ MagicShoes = 9 ;
+ SleepPotion = 10 ;
+ LumpOfIron = 11 ;
+ TreasTrove = 12 ;
+ SpeedPotion = 13 ;
+ MagicShield = 14 ;
+ VisionChest = 15 ;
+ QuiverNormal = 16 ;
+ QuiverMagic = 17 ;
+ HealingPotion = 18 ;
+
+ MaxNoOfTreasures = 31 ; (* An upper limit *)
+ HighFreePool = MaxNoOfTreasures ;
+ LowFreePool = 19 ; (* start of dynamic treasures. (see AdvMath.def for static list). *)
+
+TYPE
+ FreePool = [LowFreePool..HighFreePool] ;
+
+PROCEDURE UpDateWoundsAndFatigue (p: CARDINAL) ;
+
+PROCEDURE StrengthToParry (VAR ok: BOOLEAN) ;
+
+PROCEDURE StrengthToAttack (VAR ok: BOOLEAN) ;
+
+PROCEDURE StrengthToThrust (VAR ok: BOOLEAN) ;
+
+PROCEDURE StrengthToFireArrow (VAR ok: BOOLEAN) ;
+
+PROCEDURE StrengthToFireMagic (VAR ok: BOOLEAN) ;
+
+PROCEDURE StrengthToMove (n: CARDINAL ; VAR ok: BOOLEAN) ;
+
+
+END AdvMath.
--- /dev/null
+IMPLEMENTATION MODULE AdvMath ;
+
+
+FROM TimerHandler IMPORT TicksPerSecond, GetTicks ;
+
+FROM AdvSystem IMPORT Player, ManWeight,
+ PlayerNo,
+ TimeMinSec,
+ GetAccessToScreenNo, ReleaseAccessToScreenNo ;
+
+FROM Screen IMPORT WriteWounds, WriteFatigue, WriteCommentLine1 ;
+
+
+(* No access lock on anything ! *)
+
+PROCEDURE UpDateWoundsAndFatigue (p: CARDINAL) ;
+VAR
+ HalfSecs,
+ sec, tsec: CARDINAL ;
+BEGIN
+ TimeMinSec(sec) ;
+ HalfSecs := GetTicks() DIV (TicksPerSecond DIV 2) ; (* we want half seconds *)
+ WITH Player[p] DO
+ IF HalfSecs>LastSecFatigue
+ THEN
+ tsec := HalfSecs-LastSecFatigue ;
+ IF Fatigue<100
+ THEN
+ Fatigue := Fatigue+tsec ;
+ IF Fatigue>100
+ THEN
+ Fatigue := 100
+ END ;
+ WriteFatigue(p, Fatigue)
+ END ;
+ LastSecFatigue := HalfSecs
+ END ;
+ IF sec>LastSecWounds
+ THEN
+ tsec := sec-LastSecWounds ;
+ IF tsec>5
+ THEN
+ LastSecWounds := sec
+ END ;
+ IF Wounds<100
+ THEN
+ Wounds := Wounds+(tsec DIV 6) ;
+ IF Wounds>100
+ THEN
+ Wounds := 100
+ END ;
+ WriteWounds(p, Wounds)
+ END ;
+ LastSecWounds := sec
+ END
+ END
+END UpDateWoundsAndFatigue ;
+
+
+(* The following routines do use AccessToScreen when needed *)
+
+PROCEDURE StrengthToParry (VAR ok: BOOLEAN) ;
+VAR
+ p, t : CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ IF MagicSword IN TreasureOwn (* Magic Sword *)
+ THEN
+ t := (Weight * RequiredToMagicParry) DIV ManWeight
+ ELSE
+ t := (Weight * RequiredToParry) DIV ManWeight
+ END ;
+ GetAccessToScreenNo( p ) ;
+ IF t>Fatigue
+ THEN
+ WriteCommentLine1(p, 'too tired') ;
+ ok := FALSE
+ ELSE
+ DEC( Fatigue, t ) ;
+ WriteFatigue(p, Fatigue) ;
+ ok := TRUE
+ END ;
+ ReleaseAccessToScreenNo( p )
+ END
+END StrengthToParry ;
+
+
+PROCEDURE StrengthToAttack (VAR ok: BOOLEAN) ;
+VAR
+ p, t : CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ IF MagicSword IN TreasureOwn (* Magic Sword *)
+ THEN
+ t := (Weight * RequiredToMagicAttack) DIV ManWeight
+ ELSE
+ t := (Weight * RequiredToAttack) DIV ManWeight
+ END ;
+ GetAccessToScreenNo( p ) ;
+ IF t>Fatigue
+ THEN
+ WriteCommentLine1(p, 'too tired') ;
+ ok := FALSE
+ ELSE
+ DEC( Fatigue, t ) ;
+ WriteFatigue(p, Fatigue) ;
+ ok := TRUE
+ END ;
+ ReleaseAccessToScreenNo( p )
+ END
+END StrengthToAttack ;
+
+
+
+PROCEDURE StrengthToThrust (VAR ok: BOOLEAN) ;
+VAR
+ p, t : CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ IF MagicSword IN TreasureOwn (* Magic Sword *)
+ THEN
+ t := (Weight * RequiredToMagicThrust) DIV ManWeight
+ ELSE
+ t := (Weight * RequiredToThrust) DIV ManWeight
+ END ;
+ GetAccessToScreenNo( p ) ;
+ IF t>Fatigue
+ THEN
+ WriteCommentLine1(p, 'too tired') ;
+ ok := FALSE
+ ELSE
+ DEC( Fatigue, t ) ;
+ WriteFatigue(p, Fatigue) ;
+ ok := TRUE
+ END ;
+ ReleaseAccessToScreenNo( p )
+ END
+END StrengthToThrust ;
+
+
+PROCEDURE StrengthToFireArrow (VAR ok: BOOLEAN) ;
+VAR
+ p, t : CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ t := (Weight * RequiredToFireArrow) DIV ManWeight ;
+ GetAccessToScreenNo( p ) ;
+ IF t>Fatigue
+ THEN
+ WriteCommentLine1(p, 'too tired') ;
+ ok := FALSE
+ ELSE
+ DEC( Fatigue, t ) ;
+ WriteFatigue(p, Fatigue) ;
+ ok := TRUE
+ END ;
+ ReleaseAccessToScreenNo( p )
+ END
+END StrengthToFireArrow ;
+
+
+PROCEDURE StrengthToFireMagic (VAR ok: BOOLEAN) ;
+VAR
+ p, t : CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ t := (Weight * RequiredToFireMagic) DIV ManWeight ;
+ GetAccessToScreenNo( p ) ;
+ IF t>Fatigue
+ THEN
+ WriteCommentLine1(p, 'too tired') ;
+ ok := FALSE
+ ELSE
+ DEC( Fatigue, t ) ;
+ WriteFatigue(p, Fatigue) ;
+ ok := TRUE
+ END ;
+ ReleaseAccessToScreenNo( p )
+ END
+END StrengthToFireMagic ;
+
+
+PROCEDURE StrengthToMove (n: CARDINAL ; VAR ok: BOOLEAN) ;
+VAR
+ p, t : CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ IF MagicShoes IN TreasureOwn (* Magic Shoes *)
+ THEN
+ t := (((Weight * RequiredToMagicShoes) DIV 9) * n) DIV ManWeight
+ ELSE
+ t := (((Weight * RequiredToMove) DIV 9) * n) DIV ManWeight
+ END ;
+ GetAccessToScreenNo( p ) ;
+ IF t>Fatigue
+ THEN
+ WriteCommentLine1(p, 'too tired') ;
+ ok := FALSE
+ ELSE
+ DEC( Fatigue, t ) ;
+ WriteFatigue(p, Fatigue) ;
+ ok := TRUE
+ END ;
+ ReleaseAccessToScreenNo( p )
+ END
+END StrengthToMove ;
+
+
+END AdvMath.
+(*
+ * Local variables:
+ * compile-command: "make"
+ * End:
+ *)
--- /dev/null
+% module AdvParse begin
+IMPLEMENTATION MODULE AdvParse ;
+
+(*
+ Author : Gaius Mulley
+ Title : AdvParse
+ Date : 16/7/2005
+ SYSTEM : GNU Modula-2
+ Description: parses maps.
+*)
+
+FROM libc IMPORT printf ;
+FROM SYSTEM IMPORT ADDRESS ;
+FROM DynamicStrings IMPORT String, string, InitStringCharStar, KillString,
+ InitString, ConCat, ConCatChar, Mark ;
+FROM StringConvert IMPORT stoi ;
+FROM advflex IMPORT toktype, OpenSource, CloseSource, error, GetToken,
+ currenttoken, currentinteger ;
+FROM AdvMap IMPORT Rooms, Line, DoorStatus, Door, Room, Treasure,
+ ActualNoOfRooms, MaxNoOfTreasures, MaxNoOfRooms,
+ WallsPerRoom, DoorsPerRoom, TreasureKind ;
+FROM AdvUtil IMPORT HideTreasure ;
+
+
+CONST
+ Debugging = TRUE ;
+
+TYPE
+ BITSET = SET OF toktype ;
+
+VAR
+ LastInt,
+ ExitValue : INTEGER ;
+
+ CurDoor,
+ CurWall,
+ CurRoom : CARDINAL ;
+
+
+(*
+ Min -
+*)
+
+PROCEDURE Min (a, b: INTEGER) : INTEGER ;
+BEGIN
+ IF a<b
+ THEN
+ RETURN( a )
+ ELSE
+ RETURN( b )
+ END
+END Min ;
+
+
+(*
+ Max -
+*)
+
+PROCEDURE Max (a, b: INTEGER) : INTEGER ;
+BEGIN
+ IF a>b
+ THEN
+ RETURN( a )
+ ELSE
+ RETURN( b )
+ END
+END Max ;
+
+
+(*
+ OpenFile - attempts to open a file, mapfile.
+*)
+
+PROCEDURE OpenFile (mapfile: ADDRESS) : INTEGER ;
+VAR
+ r: INTEGER ;
+BEGIN
+ ExitValue := 0 ;
+ IF OpenSource(mapfile)
+ THEN
+ RETURN( 0 )
+ ELSE
+ r := printf("cannot open file: %s\n", mapfile) ;
+ RETURN( 1 )
+ END ;
+END OpenFile ;
+
+
+(*
+ CloseFile -
+*)
+
+PROCEDURE CloseFile ;
+BEGIN
+ CloseSource
+END CloseFile ;
+
+% declaration AdvParse begin
+
+
+(*
+ ErrorArray -
+*)
+
+PROCEDURE ErrorArray (a: ARRAY OF CHAR) ;
+BEGIN
+ ErrorString(InitString(a))
+END ErrorArray ;
+
+
+(*
+ ErrorString -
+*)
+
+PROCEDURE ErrorString (s: String) ;
+BEGIN
+ error(string(s)) ;
+ ExitValue := 1
+END ErrorString ;
+
+
+(*
+ SyntaxError - after a syntax error we skip all tokens up until we reach
+ a stop symbol.
+*)
+
+PROCEDURE SyntaxError (stopset: BITSET) ;
+VAR
+ r: INTEGER ;
+BEGIN
+ DescribeError(stopset) ;
+ IF Debugging
+ THEN
+ r := printf('\nskipping token *** ')
+ END ;
+ WHILE NOT (currenttoken IN stopset)
+ DO
+ GetToken
+ END ;
+ IF Debugging
+ THEN
+ r := printf(' ***\n')
+ END ;
+ ExitValue := 1
+END SyntaxError ;
+
+
+(*
+ SyntaxCheck -
+*)
+
+PROCEDURE SyntaxCheck (stopset: BITSET) ;
+BEGIN
+ IF NOT (currenttoken IN stopset)
+ THEN
+ SyntaxError(stopset)
+ END
+END SyntaxCheck ;
+
+
+(*
+ WarnMissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE WarnMissingToken (t: toktype) ;
+VAR
+ s : BITSET ;
+ str: String ;
+BEGIN
+ s := BITSET{t} ;
+ str := DescribeStop(s) ;
+
+ str := ConCat(InitString('syntax error,'), Mark(str)) ;
+ ErrorString(str)
+END WarnMissingToken ;
+
+
+(*
+ MissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE MissingToken (t: toktype) ;
+VAR
+ r: INTEGER ;
+BEGIN
+ WarnMissingToken(t)
+END MissingToken ;
+
+
+(*
+ InStopSet
+*)
+
+PROCEDURE InStopSet (t: toktype; stopset: BITSET) : BOOLEAN ;
+BEGIN
+ RETURN t IN stopset
+END InStopSet ;
+
+
+(*
+ Expect -
+*)
+
+PROCEDURE Expect (t: toktype; stopset: BITSET) ;
+BEGIN
+ IF currenttoken=t
+ THEN
+ GetToken
+ ELSE
+ MissingToken(t)
+ END ;
+ SyntaxCheck(stopset)
+END Expect ;
+
+
+PROCEDURE ParseMap (a: ADDRESS) : INTEGER ;
+VAR
+ r: INTEGER ;
+BEGIN
+ r := OpenFile(a) ;
+ IF r=0
+ THEN
+ GetToken ;
+ FileUnit(BITSET{eoftok}) ;
+ CloseFile ;
+ RETURN( ExitValue )
+ ELSE
+ RETURN( r )
+ END
+END ParseMap ;
+
+
+(*
+ Integer -
+*)
+
+PROCEDURE Integer (stopset: BITSET) ;
+BEGIN
+ LastInt := currentinteger ;
+ Expect(integertok, stopset)
+END Integer ;
+
+
+% module AdvParse end
+
+
+END AdvParse.
+% rules
+error 'ErrorArray' 'ErrorString'
+tokenfunc 'currenttoken'
+
+token '' eoftok -- internal token
+token 'ROOM' roomtok
+token 'DOOR' doortok
+token 'WALL' walltok
+token 'TREASURE' treasuretok
+token 'AT' attok
+token 'LEADS' leadstok
+token 'TO' totok
+token 'STATUS' statustok
+token "CLOSED" closedtok
+token "OPEN" opentok
+token "SECRET" secrettok
+token 'IS' istok
+token 'END' endtok
+token 'END.' enddottok
+token 'integer number' integertok
+token 'RANDOMIZE' randomizetok
+
+special Integer first { < integertok > } follow { }
+
+BNF
+
+FileUnit := RoomDesc { RoomDesc } [ RandomTreasure ] "END." =:
+
+RoomDesc := 'ROOM' Integer % VAR r: INTEGER ; %
+ % CurRoom := LastInt ;
+ ActualNoOfRooms := Max(CurRoom,
+ ActualNoOfRooms) ;
+ WITH Rooms[CurRoom] DO
+ NoOfWalls := 0 ;
+ NoOfDoors := 0 ;
+ Treasures := {}
+ END ;
+ IF Debugging
+ THEN
+ r := printf('reading room %d\n', CurRoom)
+ END %
+ { WallDesc | DoorDesc | TreasureDesc } 'END' =:
+
+WallDesc := 'WALL' WallCoords { WallCoords } =:
+
+WallCoords := % WITH Rooms[CurRoom] DO
+ INC(NoOfWalls) ;
+ IF NoOfWalls>WallsPerRoom
+ THEN
+ ErrorArray('too many walls') ;
+ NoOfWalls := WallsPerRoom
+ END ;
+ CurWall := NoOfWalls
+ END %
+ Integer % VAR x1, y1, x2, y2: INTEGER ; %
+ % x1 := LastInt %
+ Integer % y1 := LastInt %
+
+ Integer % x2 := LastInt %
+
+ Integer % y2 := LastInt ;
+ WITH Rooms[CurRoom].Walls[CurWall] DO
+ X1 := Min(x1, x2) ;
+ Y1 := Min(y1, y2) ;
+ X2 := Max(x1, x2) ;
+ Y2 := Max(y1, y2) ;
+ IF (X1#X2) AND (Y1#Y2)
+ THEN
+ error(string(InitString("not allowed diagonal wall")))
+ END
+ END %
+ =:
+
+DoorDesc := 'DOOR' DoorCoords { DoorCoords } =:
+
+DoorCoords := % WITH Rooms[CurRoom] DO
+ INC(NoOfDoors) ;
+ IF NoOfDoors>DoorsPerRoom
+ THEN
+ ErrorArray('too many doors') ;
+ NoOfDoors := DoorsPerRoom
+ END ;
+ CurDoor := NoOfDoors
+ END %
+ Integer % VAR x1, y1, x2, y2: INTEGER ; %
+ % x1 := LastInt %
+ Integer % y1 := LastInt %
+
+ Integer % x2 := LastInt %
+
+ Integer % y2 := LastInt ;
+ WITH Rooms[CurRoom].Doors[CurDoor].Position DO
+ X1 := Min(x1, x2) ;
+ Y1 := Min(y1, y2) ;
+ X2 := Max(x1, x2) ;
+ Y2 := Max(y1, y2) ;
+ IF (X1#X2) AND (Y1#Y2)
+ THEN
+ error(string(InitString("not allowed diagonal door")))
+ END
+
+ END %
+
+ Status
+ 'LEADS' 'TO' Integer % Rooms[CurRoom].Doors[CurDoor].LeadsTo := LastInt %
+ =:
+
+Status := 'STATUS' ( 'OPEN' % Rooms[CurRoom].Doors[CurDoor].StateOfDoor := Open %
+ | 'CLOSED' % Rooms[CurRoom].Doors[CurDoor].StateOfDoor := Closed %
+ | 'SECRET' % Rooms[CurRoom].Doors[CurDoor].StateOfDoor := Secret %
+ )
+ =:
+
+TreasureDesc := 'TREASURE' 'AT' Integer
+ % VAR x, y: INTEGER ; %
+ % x := LastInt %
+ Integer % y := LastInt %
+ 'IS' Integer % WITH Treasure[LastInt] DO
+ Xpos := x ;
+ Ypos := y ;
+ Rm := CurRoom ;
+ kind := onfloor
+ END ;
+ INCL(Rooms[CurRoom].Treasures, LastInt) %
+ =:
+
+RandomTreasure := 'RANDOMIZE' 'TREASURE' Integer % HideTreasure(LastInt) %
+ { Integer % HideTreasure(LastInt) %
+ }
+ =:
+
+FNB
--- /dev/null
+DEFINITION MODULE AdvParse ;
+
+(*
+ Title : AdvParse
+ Author : Gaius Mulley
+ System : GNU Modula-2
+ Date : Sun Jul 17 14:26:41 2005
+ Revision : $Version$
+ Description: provides a simple interface to the parser.
+*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT QUALIFIED ParseMap ;
+
+PROCEDURE ParseMap (a: ADDRESS) : INTEGER ;
+
+
+END AdvParse.
--- /dev/null
+(* it is advisable not to edit this file as it was automatically generated from the grammer file AdvParse.bnf *)
+# 2 "AdvParse.bnf"
+
+IMPLEMENTATION MODULE AdvParse ;
+
+(*
+ Author : Gaius Mulley
+ Title : AdvParse
+ Date : 16/7/2005
+ SYSTEM : GNU Modula-2
+ Description: parses maps.
+*)
+
+FROM libc IMPORT printf ;
+FROM SYSTEM IMPORT ADDRESS ;
+FROM DynamicStrings IMPORT String, string, InitStringCharStar, KillString,
+ InitString, ConCat, ConCatChar, Mark ;
+FROM StringConvert IMPORT stoi ;
+FROM advflex IMPORT toktype, OpenSource, CloseSource, error, GetToken,
+ currenttoken, currentinteger ;
+FROM AdvMap IMPORT Rooms, Line, DoorStatus, Door, Room, Treasure,
+ ActualNoOfRooms, MaxNoOfRooms,
+ WallsPerRoom, DoorsPerRoom, TreasureKind ;
+FROM AdvUtil IMPORT HideTreasure ;
+
+FROM AdvMath IMPORT MaxNoOfTreasures ;
+
+
+CONST
+ Debugging = TRUE ;
+
+TYPE
+ SetOfTok = SET OF toktype ;
+
+VAR
+ LastInt,
+ ExitValue : INTEGER ;
+
+ CurDoor,
+ CurWall,
+ CurRoom : CARDINAL ;
+
+
+(*
+ Min -
+*)
+
+PROCEDURE Min (a, b: INTEGER) : INTEGER ;
+BEGIN
+ IF a<b
+ THEN
+ RETURN( a )
+ ELSE
+ RETURN( b )
+ END
+END Min ;
+
+
+(*
+ Max -
+*)
+
+PROCEDURE Max (a, b: INTEGER) : INTEGER ;
+BEGIN
+ IF a>b
+ THEN
+ RETURN( a )
+ ELSE
+ RETURN( b )
+ END
+END Max ;
+
+
+(*
+ OpenFile - attempts to open a file, mapfile.
+*)
+
+PROCEDURE OpenFile (mapfile: ADDRESS) : INTEGER ;
+VAR
+ r: INTEGER ;
+BEGIN
+ ExitValue := 0 ;
+ IF OpenSource (mapfile)
+ THEN
+ RETURN 0
+ ELSE
+ r := printf ("cannot open file: %s\n", mapfile) ;
+ RETURN 1
+ END ;
+END OpenFile ;
+
+
+(*
+ CloseFile -
+*)
+
+PROCEDURE CloseFile ;
+BEGIN
+ CloseSource
+END CloseFile ;
+
+(*
+ expecting token set defined as an enumerated type
+ (eoftok, roomtok, doortok, walltok, treasuretok, attok, leadstok, totok, statustok, closedtok, opentok, secrettok, istok, endtok, enddottok, integertok, randomizetok) ;
+*)
+
+(* %%%FORWARD%%%
+PROCEDURE Integer (stopset: SetOfTok) ; FORWARD ;
+PROCEDURE FileUnit (stopset: SetOfTok) ; FORWARD ;
+PROCEDURE RoomDesc (stopset: SetOfTok) ; FORWARD ;
+PROCEDURE WallDesc (stopset: SetOfTok) ; FORWARD ;
+PROCEDURE WallCoords (stopset: SetOfTok) ; FORWARD ;
+PROCEDURE DoorDesc (stopset: SetOfTok) ; FORWARD ;
+PROCEDURE DoorCoords (stopset: SetOfTok) ; FORWARD ;
+PROCEDURE Status (stopset: SetOfTok) ; FORWARD ;
+PROCEDURE TreasureDesc (stopset: SetOfTok) ; FORWARD ;
+PROCEDURE RandomTreasure (stopset: SetOfTok) ; FORWARD ;
+ %%%FORWARD%%% *)
+
+(*
+ DescribeStop - issues a message explaining what tokens were expected
+*)
+
+PROCEDURE DescribeStop (stopset: SetOfTok) : String ;
+VAR
+ n : CARDINAL ;
+ str,
+ message: String ;
+BEGIN
+ n := 0 ;
+ message := InitString('') ;
+ IF randomizetok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`RANDOMIZE'"))) ; INC(n)
+ END ;
+ IF integertok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`integer number'"))) ; INC(n)
+ END ;
+ IF enddottok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`END.'"))) ; INC(n)
+ END ;
+ IF endtok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`END'"))) ; INC(n)
+ END ;
+ IF istok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`IS'"))) ; INC(n)
+ END ;
+ IF secrettok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`SECRET'"))) ; INC(n)
+ END ;
+ IF opentok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`OPEN'"))) ; INC(n)
+ END ;
+ IF closedtok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`CLOSED'"))) ; INC(n)
+ END ;
+ IF statustok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`STATUS'"))) ; INC(n)
+ END ;
+ IF totok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`TO'"))) ; INC(n)
+ END ;
+ IF leadstok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`LEADS'"))) ; INC(n)
+ END ;
+ IF attok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`AT'"))) ; INC(n)
+ END ;
+ IF treasuretok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`TREASURE'"))) ; INC(n)
+ END ;
+ IF walltok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`WALL'"))) ; INC(n)
+ END ;
+ IF doortok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`DOOR'"))) ; INC(n)
+ END ;
+ IF roomtok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`ROOM'"))) ; INC(n)
+ END ;
+ IF eoftok IN stopset
+ THEN
+ (* eoftok has no token name (needed to generate error messages) *)
+ END ;
+
+ IF n=0
+ THEN
+ str := InitString(' syntax error') ;
+ message := KillString(message) ;
+ ELSIF n=1
+ THEN
+ str := ConCat(message, Mark(InitString(' missing '))) ;
+ ELSE
+ str := ConCat(InitString(' expecting one of'), message) ;
+ message := KillString(message) ;
+ END ;
+ RETURN( str )
+END DescribeStop ;
+
+
+(*
+ DescribeError - issues a message explaining what tokens were expected
+*)
+
+PROCEDURE DescribeError (stopset: SetOfTok) ;
+VAR
+ str: String ;
+BEGIN
+ str := InitString('') ;
+ CASE currenttoken OF
+
+ randomizetok: str := ConCat(InitString("syntax error, found `RANDOMIZE'"), Mark(str)) |
+ integertok: str := ConCat(InitString("syntax error, found `integer number'"), Mark(str)) |
+ enddottok: str := ConCat(InitString("syntax error, found `END.'"), Mark(str)) |
+ endtok: str := ConCat(InitString("syntax error, found `END'"), Mark(str)) |
+ istok: str := ConCat(InitString("syntax error, found `IS'"), Mark(str)) |
+ secrettok: str := ConCat(InitString("syntax error, found `SECRET'"), Mark(str)) |
+ opentok: str := ConCat(InitString("syntax error, found `OPEN'"), Mark(str)) |
+ closedtok: str := ConCat(InitString("syntax error, found `CLOSED'"), Mark(str)) |
+ statustok: str := ConCat(InitString("syntax error, found `STATUS'"), Mark(str)) |
+ totok: str := ConCat(InitString("syntax error, found `TO'"), Mark(str)) |
+ leadstok: str := ConCat(InitString("syntax error, found `LEADS'"), Mark(str)) |
+ attok: str := ConCat(InitString("syntax error, found `AT'"), Mark(str)) |
+ treasuretok: str := ConCat(InitString("syntax error, found `TREASURE'"), Mark(str)) |
+ walltok: str := ConCat(InitString("syntax error, found `WALL'"), Mark(str)) |
+ doortok: str := ConCat(InitString("syntax error, found `DOOR'"), Mark(str)) |
+ roomtok: str := ConCat(InitString("syntax error, found `ROOM'"), Mark(str)) |
+ eoftok: str := ConCat(InitString("syntax error, found `'"), Mark(str))
+ ELSE
+ END ;
+ ErrorString(str) ;
+END DescribeError ;
+# 99 "AdvParse.bnf"
+
+
+
+(*
+ ErrorArray -
+*)
+
+PROCEDURE ErrorArray (a: ARRAY OF CHAR) ;
+BEGIN
+ ErrorString(InitString(a))
+END ErrorArray ;
+
+
+(*
+ ErrorString -
+*)
+
+PROCEDURE ErrorString (s: String) ;
+BEGIN
+ error(string(s)) ;
+ ExitValue := 1
+END ErrorString ;
+
+
+(*
+ SyntaxError - after a syntax error we skip all tokens up until we reach
+ a stop symbol.
+*)
+
+PROCEDURE SyntaxError (stopset: SetOfTok) ;
+VAR
+ r: INTEGER ;
+BEGIN
+ DescribeError(stopset) ;
+ IF Debugging
+ THEN
+ r := printf('\nskipping token *** ')
+ END ;
+ WHILE NOT (currenttoken IN stopset)
+ DO
+ GetToken
+ END ;
+ IF Debugging
+ THEN
+ r := printf(' ***\n')
+ END ;
+ ExitValue := 1
+END SyntaxError ;
+
+
+(*
+ SyntaxCheck -
+*)
+
+PROCEDURE SyntaxCheck (stopset: SetOfTok) ;
+BEGIN
+ IF NOT (currenttoken IN stopset)
+ THEN
+ SyntaxError(stopset)
+ END
+END SyntaxCheck ;
+
+
+(*
+ WarnMissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE WarnMissingToken (t: toktype) ;
+VAR
+ s : SetOfTok ;
+ str: String ;
+BEGIN
+ s := SetOfTok{t} ;
+ str := DescribeStop(s) ;
+
+ str := ConCat(InitString('syntax error,'), Mark(str)) ;
+ ErrorString(str)
+END WarnMissingToken ;
+
+
+(*
+ MissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE MissingToken (t: toktype) ;
+VAR
+ r: INTEGER ;
+BEGIN
+ WarnMissingToken(t)
+END MissingToken ;
+
+
+(*
+ InStopSet
+*)
+
+PROCEDURE InStopSet (t: toktype; stopset: SetOfTok) : BOOLEAN ;
+BEGIN
+ RETURN t IN stopset
+END InStopSet ;
+
+
+(*
+ Expect -
+*)
+
+PROCEDURE Expect (t: toktype; stopset: SetOfTok) ;
+BEGIN
+ IF currenttoken=t
+ THEN
+ GetToken
+ ELSE
+ MissingToken(t)
+ END ;
+ SyntaxCheck(stopset)
+END Expect ;
+
+
+PROCEDURE ParseMap (a: ADDRESS) : INTEGER ;
+VAR
+ r: INTEGER ;
+BEGIN
+ r := OpenFile(a) ;
+ IF r=0
+ THEN
+ GetToken ;
+ FileUnit(SetOfTok{eoftok}) ;
+ CloseFile ;
+ RETURN( ExitValue )
+ ELSE
+ RETURN( r )
+ END
+END ParseMap ;
+
+
+(*
+ Integer -
+*)
+
+PROCEDURE Integer (stopset: SetOfTok) ;
+BEGIN
+ LastInt := currentinteger ;
+ Expect(integertok, stopset)
+END Integer ;
+
+
+(*
+ Integer :=
+
+ first symbols:integertok
+
+ cannot reachend
+*)
+(*
+ FileUnit := RoomDesc { RoomDesc } [ RandomTreasure ] 'END.'
+
+ first symbols:roomtok
+
+ cannot reachend
+*)
+
+# 274 "AdvParse.bnf"
+PROCEDURE FileUnit (stopset: SetOfTok) ;
+# 274 "AdvParse.bnf"
+BEGIN
+# 274 "AdvParse.bnf"
+ RoomDesc(stopset + SetOfTok{enddottok, roomtok, randomizetok}) ;
+# 274 "AdvParse.bnf"
+ WHILE currenttoken=roomtok DO
+ RoomDesc(stopset + SetOfTok{enddottok, randomizetok, roomtok}) ;
+ END (* while *) ;
+# 274 "AdvParse.bnf"
+ IF currenttoken=randomizetok
+ THEN
+ RandomTreasure(stopset + SetOfTok{enddottok}) ;
+ END ;
+# 274 "AdvParse.bnf"
+ Expect(enddottok, stopset) ;
+END FileUnit ;
+
+
+(*
+ RoomDesc := 'ROOM' Integer
+ % VAR r: INTEGER ; %
+
+ % CurRoom := LastInt ;
+ ActualNoOfRooms := Max(CurRoom,
+ ActualNoOfRooms) ;
+ WITH Rooms[CurRoom] DO
+ NoOfWalls := 0 ;
+ NoOfDoors := 0 ;
+ Treasures := {}
+ END ;
+ IF Debugging
+ THEN
+ r := printf('reading room %d\n', CurRoom)
+ END %
+ { WallDesc | DoorDesc | TreasureDesc } 'END'
+
+ first symbols:roomtok
+
+ cannot reachend
+*)
+
+# 276 "AdvParse.bnf"
+PROCEDURE RoomDesc (stopset: SetOfTok) ;
+VAR
+ r: INTEGER ;
+# 276 "AdvParse.bnf"
+BEGIN
+# 276 "AdvParse.bnf"
+ Expect(roomtok, stopset + SetOfTok{integertok}) ;
+# 276 "AdvParse.bnf"
+ Integer(stopset + SetOfTok{endtok, walltok, doortok, treasuretok}) ;
+# 276 "AdvParse.bnf"
+# 277 "AdvParse.bnf"
+# 288 "AdvParse.bnf"
+ CurRoom := LastInt ;
+ ActualNoOfRooms := Max(CurRoom,
+ ActualNoOfRooms) ;
+ WITH Rooms[CurRoom] DO
+ NoOfWalls := 0 ;
+ NoOfDoors := 0 ;
+ Treasures := {}
+ END ;
+ IF Debugging
+ THEN
+ r := printf('reading room %d\n', CurRoom)
+ END ;
+# 289 "AdvParse.bnf"
+ IF (currenttoken IN SetOfTok{treasuretok, doortok, walltok})
+ THEN
+ (* seen optional { | } expression *)
+ WHILE (currenttoken IN SetOfTok{treasuretok, doortok, walltok}) DO
+# 289 "AdvParse.bnf"
+ IF currenttoken=walltok
+ THEN
+ WallDesc(stopset + SetOfTok{endtok, treasuretok, doortok, walltok}) ;
+# 289 "AdvParse.bnf"
+ ELSIF currenttoken=doortok
+ THEN
+ DoorDesc(stopset + SetOfTok{endtok, treasuretok, doortok, walltok}) ;
+# 289 "AdvParse.bnf"
+ ELSIF currenttoken=treasuretok
+ THEN
+ TreasureDesc(stopset + SetOfTok{endtok, treasuretok, doortok, walltok}) ;
+ END ;
+ (* end of optional { | } expression *)
+ END ;
+ END ;
+# 289 "AdvParse.bnf"
+Expect(endtok, stopset) ;
+END RoomDesc ;
+
+
+(*
+ WallDesc := 'WALL' WallCoords { WallCoords }
+
+ first symbols:walltok
+
+ cannot reachend
+*)
+
+# 291 "AdvParse.bnf"
+PROCEDURE WallDesc (stopset: SetOfTok) ;
+# 291 "AdvParse.bnf"
+BEGIN
+# 291 "AdvParse.bnf"
+ Expect(walltok, stopset + SetOfTok{integertok}) ;
+# 291 "AdvParse.bnf"
+ WallCoords(stopset + SetOfTok{integertok}) ;
+# 291 "AdvParse.bnf"
+ WHILE currenttoken=integertok DO
+ WallCoords(stopset + SetOfTok{integertok}) ;
+ END (* while *) ;
+END WallDesc ;
+
+
+(*
+ WallCoords :=
+ % WITH Rooms[CurRoom] DO
+ INC(NoOfWalls) ;
+ IF NoOfWalls>WallsPerRoom
+ THEN
+ ErrorArray('too many walls') ;
+ NoOfWalls := WallsPerRoom
+ END ;
+ CurWall := NoOfWalls
+ END %
+ Integer
+ % VAR x1, y1, x2, y2: INTEGER ; %
+
+ % x1 := LastInt %
+ Integer
+ % y1 := LastInt %
+ Integer
+ % x2 := LastInt %
+ Integer
+ % y2 := LastInt ;
+ WITH Rooms[CurRoom].Walls[CurWall] DO
+ X1 := Min(x1, x2) ;
+ Y1 := Min(y1, y2) ;
+ X2 := Max(x1, x2) ;
+ Y2 := Max(y1, y2) ;
+ IF (X1#X2) AND (Y1#Y2)
+ THEN
+ error(string(InitString("not allowed diagonal wall")))
+ END
+ END %
+
+
+ first symbols:integertok
+
+ cannot reachend
+*)
+
+# 293 "AdvParse.bnf"
+PROCEDURE WallCoords (stopset: SetOfTok) ;
+VAR
+ x1, y1, x2, y2: INTEGER ;
+# 293 "AdvParse.bnf"
+BEGIN
+# 293 "AdvParse.bnf"
+# 301 "AdvParse.bnf"
+ WITH Rooms[CurRoom] DO
+ INC(NoOfWalls) ;
+ IF NoOfWalls>WallsPerRoom
+ THEN
+ ErrorArray('too many walls') ;
+ NoOfWalls := WallsPerRoom
+ END ;
+ CurWall := NoOfWalls
+ END ;
+# 302 "AdvParse.bnf"
+ Integer(stopset + SetOfTok{integertok}) ;
+# 302 "AdvParse.bnf"
+# 303 "AdvParse.bnf"
+ x1 := LastInt ;
+# 304 "AdvParse.bnf"
+ Integer(stopset + SetOfTok{integertok}) ;
+# 304 "AdvParse.bnf"
+ y1 := LastInt ;
+# 306 "AdvParse.bnf"
+ Integer(stopset + SetOfTok{integertok}) ;
+# 306 "AdvParse.bnf"
+ x2 := LastInt ;
+# 308 "AdvParse.bnf"
+ Integer(stopset) ;
+# 308 "AdvParse.bnf"
+# 318 "AdvParse.bnf"
+ y2 := LastInt ;
+ WITH Rooms[CurRoom].Walls[CurWall] DO
+ X1 := Min(x1, x2) ;
+ Y1 := Min(y1, y2) ;
+ X2 := Max(x1, x2) ;
+ Y2 := Max(y1, y2) ;
+ IF (X1#X2) AND (Y1#Y2)
+ THEN
+ error(string(InitString("not allowed diagonal wall")))
+ END
+ END ;
+END WallCoords ;
+
+
+(*
+ DoorDesc := 'DOOR' DoorCoords { DoorCoords }
+
+ first symbols:doortok
+
+ cannot reachend
+*)
+
+# 321 "AdvParse.bnf"
+PROCEDURE DoorDesc (stopset: SetOfTok) ;
+# 321 "AdvParse.bnf"
+BEGIN
+# 321 "AdvParse.bnf"
+ Expect(doortok, stopset + SetOfTok{integertok}) ;
+# 321 "AdvParse.bnf"
+ DoorCoords(stopset + SetOfTok{integertok}) ;
+# 321 "AdvParse.bnf"
+ WHILE currenttoken=integertok DO
+ DoorCoords(stopset + SetOfTok{integertok}) ;
+ END (* while *) ;
+END DoorDesc ;
+
+
+(*
+ DoorCoords :=
+ % WITH Rooms[CurRoom] DO
+ INC(NoOfDoors) ;
+ IF NoOfDoors>DoorsPerRoom
+ THEN
+ ErrorArray('too many doors') ;
+ NoOfDoors := DoorsPerRoom
+ END ;
+ CurDoor := NoOfDoors
+ END %
+ Integer
+ % VAR x1, y1, x2, y2: INTEGER ; %
+
+ % x1 := LastInt %
+ Integer
+ % y1 := LastInt %
+ Integer
+ % x2 := LastInt %
+ Integer
+ % y2 := LastInt ;
+ WITH Rooms[CurRoom].Doors[CurDoor].Position DO
+ X1 := Min(x1, x2) ;
+ Y1 := Min(y1, y2) ;
+ X2 := Max(x1, x2) ;
+ Y2 := Max(y1, y2) ;
+ IF (X1#X2) AND (Y1#Y2)
+ THEN
+ error(string(InitString("not allowed diagonal door")))
+ END
+
+ END %
+ Status 'LEADS' 'TO' Integer
+ % Rooms[CurRoom].Doors[CurDoor].LeadsTo := LastInt %
+
+
+ first symbols:integertok
+
+ cannot reachend
+*)
+
+# 323 "AdvParse.bnf"
+PROCEDURE DoorCoords (stopset: SetOfTok) ;
+VAR
+ x1, y1, x2, y2: INTEGER ;
+# 323 "AdvParse.bnf"
+BEGIN
+# 323 "AdvParse.bnf"
+# 331 "AdvParse.bnf"
+ WITH Rooms[CurRoom] DO
+ INC(NoOfDoors) ;
+ IF NoOfDoors>DoorsPerRoom
+ THEN
+ ErrorArray('too many doors') ;
+ NoOfDoors := DoorsPerRoom
+ END ;
+ CurDoor := NoOfDoors
+ END ;
+# 332 "AdvParse.bnf"
+ Integer(stopset + SetOfTok{integertok}) ;
+# 332 "AdvParse.bnf"
+# 333 "AdvParse.bnf"
+ x1 := LastInt ;
+# 334 "AdvParse.bnf"
+ Integer(stopset + SetOfTok{integertok}) ;
+# 334 "AdvParse.bnf"
+ y1 := LastInt ;
+# 336 "AdvParse.bnf"
+ Integer(stopset + SetOfTok{integertok}) ;
+# 336 "AdvParse.bnf"
+ x2 := LastInt ;
+# 338 "AdvParse.bnf"
+ Integer(stopset + SetOfTok{statustok}) ;
+# 338 "AdvParse.bnf"
+# 349 "AdvParse.bnf"
+ y2 := LastInt ;
+ WITH Rooms[CurRoom].Doors[CurDoor].Position DO
+ X1 := Min(x1, x2) ;
+ Y1 := Min(y1, y2) ;
+ X2 := Max(x1, x2) ;
+ Y2 := Max(y1, y2) ;
+ IF (X1#X2) AND (Y1#Y2)
+ THEN
+ error(string(InitString("not allowed diagonal door")))
+ END
+
+ END ;
+# 352 "AdvParse.bnf"
+ Status(stopset + SetOfTok{leadstok}) ;
+# 352 "AdvParse.bnf"
+ Expect(leadstok, stopset + SetOfTok{totok}) ;
+# 352 "AdvParse.bnf"
+ Expect(totok, stopset + SetOfTok{integertok}) ;
+# 352 "AdvParse.bnf"
+ Integer(stopset) ;
+# 352 "AdvParse.bnf"
+ Rooms[CurRoom].Doors[CurDoor].LeadsTo := LastInt ;
+END DoorCoords ;
+
+
+(*
+ Status := 'STATUS' ( 'OPEN'
+ % Rooms[CurRoom].Doors[CurDoor].StateOfDoor := Open %
+ | 'CLOSED'
+ % Rooms[CurRoom].Doors[CurDoor].StateOfDoor := Closed %
+ | 'SECRET'
+ % Rooms[CurRoom].Doors[CurDoor].StateOfDoor := Secret %
+ )
+
+ first symbols:statustok
+
+ cannot reachend
+*)
+
+# 355 "AdvParse.bnf"
+PROCEDURE Status (stopset: SetOfTok) ;
+# 355 "AdvParse.bnf"
+BEGIN
+# 355 "AdvParse.bnf"
+ Expect(statustok, stopset + SetOfTok{opentok, closedtok, secrettok}) ;
+# 355 "AdvParse.bnf"
+ IF currenttoken=opentok
+ THEN
+ Expect(opentok, stopset) ;
+# 355 "AdvParse.bnf"
+ Rooms[CurRoom].Doors[CurDoor].StateOfDoor := Open ;
+# 356 "AdvParse.bnf"
+ ELSIF currenttoken=closedtok
+ THEN
+ Expect(closedtok, stopset) ;
+# 356 "AdvParse.bnf"
+ Rooms[CurRoom].Doors[CurDoor].StateOfDoor := Closed ;
+# 357 "AdvParse.bnf"
+ ELSIF currenttoken=secrettok
+ THEN
+ Expect(secrettok, stopset) ;
+# 357 "AdvParse.bnf"
+ Rooms[CurRoom].Doors[CurDoor].StateOfDoor := Secret ;
+ ELSE
+ ErrorArray('expecting one of: SECRET CLOSED OPEN')
+ END ;
+END Status ;
+
+
+(*
+ TreasureDesc := 'TREASURE' 'AT' Integer
+ % VAR x, y: INTEGER ; %
+
+ % x := LastInt %
+ Integer
+ % y := LastInt %
+ 'IS' Integer
+ % WITH Treasure[LastInt] DO
+ Xpos := x ;
+ Ypos := y ;
+ Rm := CurRoom
+ END ;
+ INCL(Rooms[CurRoom].Treasures, LastInt) %
+
+
+ first symbols:treasuretok
+
+ cannot reachend
+*)
+
+# 361 "AdvParse.bnf"
+PROCEDURE TreasureDesc (stopset: SetOfTok) ;
+VAR
+ x, y: INTEGER ;
+# 361 "AdvParse.bnf"
+BEGIN
+# 361 "AdvParse.bnf"
+ Expect(treasuretok, stopset + SetOfTok{attok}) ;
+# 361 "AdvParse.bnf"
+ Expect(attok, stopset + SetOfTok{integertok}) ;
+# 362 "AdvParse.bnf"
+ Integer(stopset + SetOfTok{integertok}) ;
+# 362 "AdvParse.bnf"
+# 363 "AdvParse.bnf"
+ x := LastInt ;
+# 364 "AdvParse.bnf"
+ Integer(stopset + SetOfTok{istok}) ;
+# 364 "AdvParse.bnf"
+ y := LastInt ;
+# 365 "AdvParse.bnf"
+ Expect(istok, stopset + SetOfTok{integertok}) ;
+# 365 "AdvParse.bnf"
+ Integer(stopset) ;
+# 365 "AdvParse.bnf"
+# 370 "AdvParse.bnf"
+ WITH Treasure[LastInt] DO
+ Xpos := x ;
+ Ypos := y ;
+ Rm := CurRoom ;
+ kind := onfloor
+ END ;
+ INCL(Rooms[CurRoom].Treasures, VAL(CARDINAL, LastInt))
+END TreasureDesc ;
+
+
+(*
+ RandomTreasure := 'RANDOMIZE' 'TREASURE' Integer
+ % HideTreasure(LastInt) %
+ { Integer
+ % HideTreasure(LastInt) %
+ }
+
+ first symbols:randomizetok
+
+ cannot reachend
+*)
+
+# 373 "AdvParse.bnf"
+PROCEDURE RandomTreasure (stopset: SetOfTok) ;
+# 373 "AdvParse.bnf"
+BEGIN
+# 373 "AdvParse.bnf"
+ Expect(randomizetok, stopset + SetOfTok{treasuretok}) ;
+# 373 "AdvParse.bnf"
+ Expect(treasuretok, stopset + SetOfTok{integertok}) ;
+# 373 "AdvParse.bnf"
+ Integer(stopset + SetOfTok{integertok}) ;
+# 373 "AdvParse.bnf"
+ HideTreasure(LastInt) ;
+# 374 "AdvParse.bnf"
+ WHILE currenttoken=integertok DO
+ Integer(stopset + SetOfTok{integertok}) ;
+# 374 "AdvParse.bnf"
+ HideTreasure(LastInt) ;
+ END (* while *) ;
+END RandomTreasure ;
+
+
+# 245 "AdvParse.bnf"
+
+
+
+END AdvParse.
--- /dev/null
+(* Copyright (C) 2003
+ Free Software Foundation, Inc. *)
+(* This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 2, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING. If not, write to the Free Software
+Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+DEFINITION MODULE AdvSound ;
+
+(*
+ Title : AdvSound
+ Author : Gaius Mulley
+ System : GNU Modula-2
+ Date : Mon Jul 11 21:40:59 2005
+ Revision : $Version$
+ Description: provides a simple set of routines to generate
+ sound.
+*)
+
+EXPORT QUALIFIED EnterGame, Explode, Swish, Miss, Hit ;
+
+
+(*
+ EnterGame - play the enter game sound to player, p.
+*)
+
+PROCEDURE EnterGame (p: CARDINAL) ;
+
+
+(*
+ Explode - play the explosion for each player in room, r, and adjacent
+ rooms.
+*)
+
+PROCEDURE Explode (r: CARDINAL; pulled: CARDINAL; hit: BOOLEAN) ;
+
+
+(*
+ Swish - play the arrow swish sound to each player in room, r.
+*)
+
+PROCEDURE Swish (r: CARDINAL) ;
+
+
+(*
+ Miss - play the arrow miss sound to each player in room, r.
+*)
+
+PROCEDURE Miss (r: CARDINAL) ;
+
+
+(*
+ Hit - play the arrow hit sound to player, p.
+*)
+
+PROCEDURE Hit (p: CARDINAL) ;
+
+
+END AdvSound.
--- /dev/null
+IMPLEMENTATION MODULE AdvSound ;
+
+
+FROM AdvMap IMPORT Adjacent ;
+IMPORT StrIO ;
+FROM AdvSystem IMPORT GetAccessToScreenNo, ReleaseAccessToScreenNo,
+ Player, PlayerNo,
+ NextFreePlayer,
+ IsPlayerActive,
+ GetReadAccessToPlayer,
+ ReleaseReadAccessToPlayer ;
+
+
+PROCEDURE EnterGame (p: CARDINAL) ;
+BEGIN
+ GetAccessToScreenNo(p) ;
+ StrIO.WriteString('pS start') ; StrIO.WriteLn ;
+ ReleaseAccessToScreenNo(p)
+END EnterGame ;
+
+
+(*
+ Explode - play the explosion for each player in room, r, and adjacent
+ rooms.
+*)
+
+PROCEDURE Explode (r: CARDINAL; pulled: CARDINAL; hit: BOOLEAN) ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ GetReadAccessToPlayer ;
+ FOR p := 0 TO NextFreePlayer-1 DO
+ IF IsPlayerActive(p)
+ THEN
+ WITH Player[p] DO
+ IF p=pulled
+ THEN
+ IF r=RoomOfMan
+ THEN
+ GetAccessToScreenNo(p) ;
+ StrIO.WriteString('pS ohnoexplode') ; StrIO.WriteLn ;
+ ReleaseAccessToScreenNo(p)
+ ELSIF Adjacent(r, RoomOfMan)
+ THEN
+ IF hit
+ THEN
+ GetAccessToScreenNo(p) ;
+ StrIO.WriteString('pS laughexplode') ; StrIO.WriteLn ;
+ ReleaseAccessToScreenNo(p)
+ ELSE
+ GetAccessToScreenNo(p) ;
+ StrIO.WriteString('pS handgrenade') ; StrIO.WriteLn ;
+ ReleaseAccessToScreenNo(p)
+ END
+ END
+ ELSE
+ GetAccessToScreenNo(p) ;
+ StrIO.WriteString('pS handgrenade') ; StrIO.WriteLn ;
+ ReleaseAccessToScreenNo(p)
+ END
+ END
+ END
+ END ;
+ ReleaseReadAccessToPlayer
+END Explode ;
+
+
+(*
+ ForeachIn -
+*)
+
+PROCEDURE ForeachIn (r: CARDINAL; sound: ARRAY OF CHAR) ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ GetReadAccessToPlayer ;
+ FOR p := 0 TO NextFreePlayer-1 DO
+ IF IsPlayerActive(p)
+ THEN
+ WITH Player[p] DO
+ IF r=RoomOfMan
+ THEN
+ GetAccessToScreenNo(p) ;
+ StrIO.WriteString(sound) ; StrIO.WriteLn ;
+ ReleaseAccessToScreenNo(p)
+ END
+ END
+ END
+ END ;
+ ReleaseReadAccessToPlayer
+END ForeachIn ;
+
+
+(*
+ Swish - play the arrow swish sound to each player in room, r.
+*)
+
+PROCEDURE Swish (r: CARDINAL) ;
+BEGIN
+ ForeachIn(r, 'pS arrowswish')
+END Swish ;
+
+
+(*
+ Miss - play the arrow miss sound to each player in room, r.
+*)
+
+PROCEDURE Miss (r: CARDINAL) ;
+BEGIN
+ ForeachIn(r, 'pS brokenglass')
+END Miss ;
+
+
+(*
+ OhNo - play the OhNo sound to player, p.
+*)
+
+PROCEDURE OhNo (p: CARDINAL) ;
+BEGIN
+ GetAccessToScreenNo(p) ;
+ StrIO.WriteString('pS ohno') ; StrIO.WriteLn ;
+ ReleaseAccessToScreenNo(p)
+END OhNo ;
+
+
+(*
+ Hit - play the arrow hit sound to player, p.
+*)
+
+PROCEDURE Hit (p: CARDINAL) ;
+BEGIN
+ GetAccessToScreenNo(p) ;
+ StrIO.WriteString('pS applause') ; StrIO.WriteLn ;
+ ReleaseAccessToScreenNo(p)
+END Hit ;
+
+
+END AdvSound.
+(*
+ * Local variables:
+ * compile-command: "make"
+ * End:
+ *)
--- /dev/null
+DEFINITION MODULE AdvSystem ;
+
+
+FROM Executive IMPORT SEMAPHORE, DESCRIPTOR ;
+FROM ProcArgs IMPORT ProcessArgs ;
+
+
+EXPORT QUALIFIED ManWeight,
+ MaxNoOfPlayers,
+ Man,
+ TypeOfDeath,
+ Player,
+ PlayerSet,
+ PlayerNo,
+ ArrowArgs,
+ StartPlayer,
+ TimeMinSec,
+ RandomNumber,
+ ClientRead,
+ DefaultWrite,
+ ReadString,
+ NextFreePlayer,
+ IsPlayerActive,
+ AssignOutputTo,
+ UnAssign,
+
+ GetReadAccessToPlayer,
+ GetWriteAccessToPlayer,
+ ReleaseReadAccessToPlayer,
+ ReleaseWriteAccessToPlayer,
+
+ GetReadAccessToDoor,
+ GetWriteAccessToDoor,
+ ReleaseReadAccessToDoor,
+ ReleaseWriteAccessToDoor,
+
+ GetReadAccessToTreasure,
+ GetWriteAccessToTreasure,
+ ReleaseReadAccessToTreasure,
+ ReleaseWriteAccessToTreasure,
+
+ GetAccessToScreen,
+ ReleaseAccessToScreen,
+ GetAccessToScreenNo,
+ ReleaseAccessToScreenNo ;
+
+
+CONST
+ ManWeight = 70 ; (* Kgs *)
+ MaxNoOfPlayers = 100 ;
+
+TYPE
+ TypeOfDeath = (living, normalarrow, magicarrow,
+ exitdungeon, explosion, sword, fireball) ;
+
+ PlayerSet = SET OF [0..MaxNoOfPlayers] ;
+
+ ArrowArgs = POINTER TO RECORD
+ ArrowPlayer: CARDINAL ;
+ ArrowRoom : CARDINAL ;
+ ArrowX : CARDINAL ; (* X coord of Arrow *)
+ ArrowY : CARDINAL ; (* Y coord of Arrow *)
+ ArrowDir : INTEGER ; (* Direction of Arrow *)
+ IsMagic : BOOLEAN ;
+ END ;
+
+ Man = RECORD
+ ManName : ARRAY [0..9] OF CHAR ;
+ DeathType : TypeOfDeath ;(* How man died! *)
+ Weight : CARDINAL ; (* Mans Weight in lbs *)
+ Wounds : CARDINAL ; (* 0..100 0= Dead! *)
+ Fatigue : CARDINAL ; (* 0..100 0= V Tired *)
+ TreasureOwn : BITSET ; (* Treasures that own *)
+ NoOfMagic : CARDINAL ; (* No Of Magic Arrows *)
+ NoOfNormal : CARDINAL ; (* No Of Normal Arrows *)
+ Xman : CARDINAL ; (* X coord of Man *)
+ Yman : CARDINAL ; (* Y coord of Man *)
+ Direction : CARDINAL ; (* Direction of Man 0.4 *)
+ ScreenX : CARDINAL ; (* Top Right of screen *)
+ ScreenY : CARDINAL ; (* ditto *)
+ RoomOfMan : CARDINAL ; (* Room Man Current in *)
+ NormalProcArgs : ProcessArgs ;
+ MagicProcArgs : ProcessArgs ;
+ MagicP,
+ NormalP : DESCRIPTOR ;
+ LastSecWounds : CARDINAL ; (* Last updated Wounds *)
+ LastSecFatigue : CARDINAL ; (* Last updated Fatigue *)
+ PlayerProcess : DESCRIPTOR ; (* process of player *)
+ fd : INTEGER ; (* socket file desc *)
+ END ;
+
+
+VAR
+ Player : ARRAY [0..MaxNoOfPlayers] OF Man ;
+ NextFreePlayer: CARDINAL ; (* 0..NextFreePlayer-1 are potentially playing *)
+
+
+PROCEDURE ClientRead (VAR ch: CHAR) : BOOLEAN ;
+PROCEDURE DefaultWrite (ch: CHAR) ;
+PROCEDURE ReadString (VAR s: ARRAY OF CHAR) ;
+
+
+(*
+ AssignOutputTo - assigns the current process to be associated with
+ player, p.
+*)
+
+PROCEDURE AssignOutputTo (p: CARDINAL) ;
+
+
+(*
+ UnAssign - unassign the current process from any player.
+*)
+
+PROCEDURE UnAssign ;
+
+
+(*
+ IsPlayerActive - returns TRUE if player, p, is still playing
+*)
+
+PROCEDURE IsPlayerActive (p: CARDINAL) : BOOLEAN ;
+
+
+(* PlayerNo - returns the Player number of the current man calling *)
+
+PROCEDURE PlayerNo () : CARDINAL ;
+
+
+PROCEDURE StartPlayer (f: INTEGER) ;
+
+
+(* Returns Minutes and seconds in Seconds. *)
+
+PROCEDURE TimeMinSec (VAR MinSec: CARDINAL) ;
+
+
+(* RandomNumber delivers a random number in r which is in the *)
+(* range 0..n-1. However n must be in the range 1..256 *)
+
+PROCEDURE RandomNumber (VAR r: CARDINAL ; n: CARDINAL) ;
+
+
+(* The rules which govern the allocation of these resourses are *)
+
+(* 1) One may claim multiple resourses in the following order: *)
+(* AccessPlayer *)
+(* AccessDoor *)
+(* AccessTreasure *)
+(* AccessScreen *)
+(* *)
+(* All r/w - doesn't matter. *)
+(* 2) Must never reverse this claiming or DEADLOCK may occur. *)
+(* *)
+(* 3) Must claim players in order ie 0 1 2 *)
+
+
+(* All Player access commands *)
+
+PROCEDURE GetReadAccessToPlayer ;
+PROCEDURE GetWriteAccessToPlayer ;
+PROCEDURE ReleaseReadAccessToPlayer ;
+PROCEDURE ReleaseWriteAccessToPlayer ;
+
+(* All Door access commands *)
+
+PROCEDURE GetReadAccessToDoor ;
+PROCEDURE GetWriteAccessToDoor ;
+PROCEDURE ReleaseReadAccessToDoor ;
+PROCEDURE ReleaseWriteAccessToDoor ;
+
+
+(* All Treasure access commands *)
+
+PROCEDURE GetReadAccessToTreasure ;
+PROCEDURE GetWriteAccessToTreasure ;
+PROCEDURE ReleaseReadAccessToTreasure ;
+PROCEDURE ReleaseWriteAccessToTreasure ;
+
+
+(* All Screen access commands *)
+
+PROCEDURE GetAccessToScreen ;
+PROCEDURE ReleaseAccessToScreen ;
+PROCEDURE GetAccessToScreenNo (Sn: CARDINAL) ;
+PROCEDURE ReleaseAccessToScreenNo (Sn: CARDINAL) ;
+
+
+END AdvSystem.
--- /dev/null
+IMPLEMENTATION MODULE AdvSystem ;
+
+FROM ASCII IMPORT nul, cr, lf, bs ;
+FROM StdIO IMPORT PushOutput, PopOutput ;
+FROM libc IMPORT printf, write, read ;
+FROM StrLib IMPORT StrLen ;
+FROM SYSTEM IMPORT ADR ;
+FROM Debug IMPORT Halt ;
+FROM TimerHandler IMPORT GetTicks, TicksPerSecond ;
+FROM RTint IMPORT InitInputVector, InitOutputVector ;
+FROM COROUTINES IMPORT PROTECTION ;
+
+FROM Executive IMPORT GetCurrentProcess, DESCRIPTOR, SEMAPHORE,
+ Resume, InitProcess, InitSemaphore, Wait, Signal,
+ WaitForIO ;
+
+FROM Lock IMPORT InitLock, GetReadAccess, GetWriteAccess, LOCK,
+ ReleaseReadAccess, ReleaseWriteAccess ;
+FROM ProcArgs IMPORT ProcessArgs, InitArgs, SetArgs, CollectArgs ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM AdvUtil IMPORT NormalArrow, MagicArrow ;
+
+
+CONST
+ MaxNoOfProcesses = MaxNoOfPlayers*3 + 1 ;
+ ArrowProcessSize = 30 * 1024 * 1024 ;
+
+TYPE
+ ProcPlayer = RECORD
+ process : DESCRIPTOR ;
+ playerId: CARDINAL ;
+ END ;
+
+VAR
+ GlobalFd : INTEGER ;
+ ScreenQ : SEMAPHORE ;
+ PlayerLock : LOCK ;
+ DoorLock : LOCK ;
+ TreasureLock : LOCK ;
+ AccessToRandom: SEMAPHORE ;
+ RandomCount : CARDINAL ;
+ ProcToPlay : ARRAY [0..MaxNoOfPlayers] OF ProcPlayer ;
+ PArgs : ProcessArgs ;
+
+(*
+ AssignOutputTo - assigns the current process to be associated with
+ player, p.
+*)
+
+PROCEDURE AssignOutputTo (p: CARDINAL) ;
+VAR
+ i: CARDINAL ;
+BEGIN
+ i := 0 ;
+ WHILE i<MaxNoOfProcesses DO
+ WITH ProcToPlay[i] DO
+ IF process=NIL
+ THEN
+ process := GetCurrentProcess() ;
+ playerId := p ;
+ RETURN
+ ELSIF process=GetCurrentProcess()
+ THEN
+ playerId := p ;
+ RETURN
+ END
+ END ;
+ INC(i)
+ END ;
+ Halt(__FILE__, __LINE__, __FUNCTION__, 'increase MaxNoOfProcesses')
+END AssignOutputTo ;
+
+
+(*
+ UnAssign - unassign the current process from any player.
+*)
+
+PROCEDURE UnAssign ;
+VAR
+ i: CARDINAL ;
+BEGIN
+ i := 0 ;
+ WHILE i<MaxNoOfProcesses DO
+ WITH ProcToPlay[i] DO
+ IF process=GetCurrentProcess()
+ THEN
+ process := NIL ;
+ RETURN
+ END
+ END ;
+ INC(i)
+ END
+END UnAssign ;
+
+
+(*
+ ProcessToPlayer - returns the player associated with the current process.
+*)
+
+PROCEDURE ProcessToPlayer () : CARDINAL ;
+VAR
+ i: CARDINAL ;
+BEGIN
+ i := 0 ;
+ WHILE i<MaxNoOfProcesses DO
+ WITH ProcToPlay[i] DO
+ IF process=GetCurrentProcess()
+ THEN
+ RETURN( playerId )
+ END
+ END ;
+ INC(i)
+ END ;
+ Halt(__FILE__, __LINE__, __FUNCTION__,
+ 'process has never has a player assigned to its output')
+END ProcessToPlayer ;
+
+
+(*
+ checkStatus -
+*)
+
+PROCEDURE checkStatus (r: INTEGER) ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ IF r<1
+ THEN
+ r := printf("WriteS client has gone away - tidying up\n") ;
+ p := ProcessToPlayer() ;
+ WITH Player[p] DO
+ fd := -1 ;
+ IF DeathType=living
+ THEN
+ DeathType := exitdungeon
+ END
+ END
+ END
+END checkStatus ;
+
+
+PROCEDURE localWrite (fd: INTEGER; ch: CHAR) ;
+VAR
+ r: INTEGER ;
+BEGIN
+ IF fd>=0
+ THEN
+ WaitForIO(InitOutputVector(fd, MAX(PROTECTION))) ;
+ checkStatus(write(fd, ADR(ch), SIZE(ch)))
+ END
+END localWrite ;
+
+
+PROCEDURE localWriteS (fd: INTEGER; s: ARRAY OF CHAR) ;
+VAR
+ r: INTEGER ;
+BEGIN
+ IF fd>=0
+ THEN
+ checkStatus(write(fd, ADR(s), StrLen(s)))
+ END
+END localWriteS ;
+
+
+PROCEDURE ReadString (VAR s: ARRAY OF CHAR) ;
+VAR
+ r: INTEGER ;
+ h: CARDINAL ;
+BEGIN
+ h := 0 ;
+ WHILE h<HIGH(s) DO
+ IF ClientRead(s[h])
+ THEN
+ IF (s[h]=lf) OR (s[h]=cr) OR (s[h]=nul)
+ THEN
+ s[h] := nul ;
+ RETURN
+ ELSIF s[h]=bs
+ THEN
+ IF h>0
+ THEN
+ WriteChar(bs) ;
+ DEC(h)
+ END
+ ELSE
+ WriteChar(s[h]) ;
+ INC(h)
+ END
+ ELSE
+ s[h] := nul ;
+ RETURN
+ END
+ END ;
+ IF (s[h]=lf) OR (s[h]=cr)
+ THEN
+ s[h] := nul
+ END
+END ReadString ;
+
+
+(*
+ DefaultWrite - writes to the default (local) file descriptor.
+*)
+
+PROCEDURE DefaultWrite (ch: CHAR) ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ p := ProcessToPlayer() ;
+ localWrite(Player[p].fd, ch)
+END DefaultWrite ;
+
+
+PROCEDURE ClientRead (VAR ch: CHAR) : BOOLEAN ;
+VAR
+ r: INTEGER ;
+BEGIN
+ WITH Player[PlayerNo()] DO
+ IF fd>=0
+ THEN
+ WaitForIO(InitInputVector(fd, MAX(PROTECTION))) ;
+ r := read(fd, ADR(ch), SIZE(ch)) ;
+ checkStatus(r) ;
+ RETURN( r=1 )
+ ELSE
+ RETURN( FALSE )
+ END
+ END ;
+END ClientRead ;
+
+
+PROCEDURE WriteChar (ch: CHAR) ;
+VAR
+ r: INTEGER ;
+BEGIN
+ WITH Player[PlayerNo()] DO
+ IF fd>=0
+ THEN
+ IF ch=bs
+ THEN
+ localWriteS(fd, 'eC')
+ ELSE
+ localWriteS(fd, 'dC ') ;
+ localWrite(fd, ch)
+ END ;
+ localWrite(fd, lf)
+ END
+ END ;
+END WriteChar ;
+
+
+PROCEDURE PlayerNo () : CARDINAL ;
+VAR
+ i: CARDINAL ;
+BEGIN
+ FOR i := 0 TO NextFreePlayer-1 DO
+ IF GetCurrentProcess()=Player[i].PlayerProcess
+ THEN
+ RETURN( i )
+ END
+ END ;
+ Halt(__FILE__, __LINE__, __FUNCTION__,
+ 'process calling is not a player process')
+END PlayerNo ;
+
+
+(*
+ IsaPlayer -
+*)
+
+PROCEDURE IsaPlayer (d: DESCRIPTOR) : BOOLEAN ;
+VAR
+ i: CARDINAL ;
+BEGIN
+ FOR i := 0 TO NextFreePlayer-1 DO
+ IF Player[i].PlayerProcess=d
+ THEN
+ RETURN( TRUE )
+ END
+ END ;
+ RETURN( FALSE )
+END IsaPlayer ;
+
+
+(*
+ FindFreePlayer -
+*)
+
+PROCEDURE FindFreePlayer () : INTEGER ;
+VAR
+ i : INTEGER ;
+ pc: POINTER TO CARDINAL ;
+BEGIN
+ IF NextFreePlayer<=MaxNoOfPlayers
+ THEN
+ IF NextFreePlayer>0
+ THEN
+ (* reuse an old player who has left the game *)
+ FOR i := 0 TO NextFreePlayer-1 DO
+ WITH Player[i] DO
+ IF fd=-1
+ THEN
+ Weight := ManWeight ;
+ TreasureOwn := {} ;
+ RETURN( i )
+ END
+ END
+ END
+ END ;
+ i := NextFreePlayer ;
+ INC(NextFreePlayer) ;
+ WITH Player[i] DO
+ Weight := ManWeight ;
+ TreasureOwn := {} ;
+ NormalProcArgs := InitArgs() ;
+ MagicProcArgs := InitArgs() ;
+ NEW(pc) ;
+ pc^ := i ;
+ MagicP := Resume(InitProcess(MagicArrowP, ArrowProcessSize, 'Magic Arrow')) ;
+ pc := SetArgs(PArgs, pc) ;
+ NormalP := Resume(InitProcess(NormalArrowP, ArrowProcessSize, 'Normal Arrow')) ;
+ NEW(pc) ;
+ pc^ := i ;
+ pc := SetArgs(PArgs, pc)
+ END ;
+ RETURN( i )
+ ELSE
+ RETURN( -1 )
+ END
+END FindFreePlayer ;
+
+
+(*
+ IsPlayerActive - returns TRUE if player, p, is still playing
+*)
+
+PROCEDURE IsPlayerActive (p: CARDINAL) : BOOLEAN ;
+BEGIN
+ RETURN( (p<NextFreePlayer) AND (Player[p].fd#-1) )
+END IsPlayerActive ;
+
+
+PROCEDURE NormalArrowP ;
+VAR
+ pc: POINTER TO CARDINAL ;
+BEGIN
+ pc := CollectArgs(PArgs) ;
+ LOOP
+ NormalArrow(pc^)
+ END
+END NormalArrowP ;
+
+
+PROCEDURE MagicArrowP ;
+VAR
+ pc: POINTER TO CARDINAL ;
+BEGIN
+ pc := CollectArgs(PArgs) ;
+ LOOP
+ MagicArrow(pc^)
+ END
+END MagicArrowP ;
+
+
+PROCEDURE StartPlayer (f: INTEGER) ;
+VAR
+ i : INTEGER ;
+BEGIN
+ i := FindFreePlayer() ;
+ IF i=-1
+ THEN
+ (* write an error message to fd *)
+ ELSE
+ WITH Player[i] DO
+ fd := f ;
+ PlayerProcess := GetCurrentProcess() ;
+ DeathType := living ;
+ Wounds := 100 ;
+ Fatigue := 100 ;
+ Direction := 0 ;
+ TimeMinSec(LastSecWounds) ;
+ LastSecFatigue := GetTicks() DIV (TicksPerSecond DIV 2)
+ END
+ END
+END StartPlayer ;
+
+
+PROCEDURE Init ;
+BEGIN
+ PlayerLock := InitLock('player lock') ;
+ ScreenQ := InitSemaphore(1, 'ScreenQ') ;
+ DoorLock := InitLock('DoorLock') ;
+ TreasureLock := InitLock('TreasureLock') ;
+ AccessToRandom := InitSemaphore(1, 'AccessToRandom') ;
+ PArgs := InitArgs() ;
+ TimeMinSec (RandomCount) ;
+ NextFreePlayer := 0 ;
+ PushOutput (DefaultWrite)
+END Init ;
+
+
+PROCEDURE TimeMinSec (VAR MinSec: CARDINAL) ;
+BEGIN
+ MinSec := GetTicks() DIV TicksPerSecond
+END TimeMinSec ;
+
+
+PROCEDURE RandomNumber (VAR r: CARDINAL; n: CARDINAL) ;
+VAR
+ ms: CARDINAL ;
+BEGIN
+ IF n=1
+ THEN
+ r := 0
+ ELSE
+ Wait( AccessToRandom ) ;
+ r := RandomCount MOD n ;
+
+ ms := RandomCount MOD 256 ;
+ RandomCount := ms*256+ms ; (* multiply by 257 *)
+
+ IF (MAX(CARDINAL)-RandomCount) >= 0ABCDH (* Add 0ABCDH *)
+ THEN
+ INC( RandomCount, 0ABCDH )
+ ELSE
+ DEC( RandomCount, (MAX(CARDINAL)-0ABCDH) )
+ END ;
+
+ Signal( AccessToRandom ) ;
+
+ (* Returns a number 1..n *)
+ END
+END RandomNumber ;
+
+
+
+(* The rules which govern the allocation of these resourses are *)
+
+(* 1) One may claim multiple resourses in the following order: *)
+(* AccessPlayer *)
+(* AccessDoor *)
+(* AccessTreasure *)
+(* AccessScreen *)
+(* GetTime - Procedure NOT lock! *)
+(* *)
+(* All r/w - doesn't matter! *)
+(* *)
+(* 2) Must never reverse this claiming or DEADLOCK may occur. *)
+(* *)
+(* 3) Must access players in order ie 0 1 2 *)
+
+
+
+(*
+ * Access To Players
+ *)
+
+PROCEDURE GetReadAccessToPlayer ;
+BEGIN
+ GetReadAccess(PlayerLock)
+END GetReadAccessToPlayer ;
+
+
+PROCEDURE GetWriteAccessToPlayer ;
+BEGIN
+ GetWriteAccess(PlayerLock)
+END GetWriteAccessToPlayer ;
+
+
+PROCEDURE ReleaseReadAccessToPlayer ;
+BEGIN
+ ReleaseReadAccess(PlayerLock)
+END ReleaseReadAccessToPlayer ;
+
+
+PROCEDURE ReleaseWriteAccessToPlayer ;
+BEGIN
+ ReleaseWriteAccess(PlayerLock)
+END ReleaseWriteAccessToPlayer ;
+
+
+(*
+ * Access To Doors
+ *)
+
+PROCEDURE GetReadAccessToDoor ;
+BEGIN
+ GetReadAccess(DoorLock)
+END GetReadAccessToDoor ;
+
+
+PROCEDURE GetWriteAccessToDoor ;
+BEGIN
+ GetWriteAccess(DoorLock)
+END GetWriteAccessToDoor ;
+
+
+PROCEDURE ReleaseReadAccessToDoor ;
+BEGIN
+ ReleaseReadAccess(DoorLock)
+END ReleaseReadAccessToDoor ;
+
+
+PROCEDURE ReleaseWriteAccessToDoor ;
+BEGIN
+ ReleaseWriteAccess(DoorLock)
+END ReleaseWriteAccessToDoor ;
+
+
+(*
+ * Access To Treasures
+ *)
+
+PROCEDURE GetReadAccessToTreasure ;
+BEGIN
+ GetReadAccess(TreasureLock)
+END GetReadAccessToTreasure ;
+
+
+PROCEDURE GetWriteAccessToTreasure ;
+BEGIN
+ GetWriteAccess(TreasureLock)
+END GetWriteAccessToTreasure ;
+
+
+PROCEDURE ReleaseReadAccessToTreasure ;
+BEGIN
+ ReleaseReadAccess(TreasureLock)
+END ReleaseReadAccessToTreasure ;
+
+
+PROCEDURE ReleaseWriteAccessToTreasure ;
+BEGIN
+ ReleaseWriteAccess(TreasureLock)
+END ReleaseWriteAccessToTreasure ;
+
+
+(*
+ * Access To Screen
+ *)
+
+PROCEDURE GetAccessToScreen ;
+BEGIN
+ GetAccessToScreenNo(PlayerNo())
+END GetAccessToScreen ;
+
+
+PROCEDURE ReleaseAccessToScreen ;
+BEGIN
+ ReleaseAccessToScreenNo(PlayerNo())
+END ReleaseAccessToScreen ;
+
+
+PROCEDURE GetAccessToScreenNo (p: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ Wait(ScreenQ)
+END GetAccessToScreenNo ;
+
+
+PROCEDURE ReleaseAccessToScreenNo (p: CARDINAL) ;
+BEGIN
+ Signal(ScreenQ)
+END ReleaseAccessToScreenNo ;
+
+
+BEGIN
+ Init
+END AdvSystem.
+(*
+ * Local variables:
+ * compile-command: "make"
+ * End:
+ *)
--- /dev/null
+DEFINITION MODULE AdvTreasure ;
+
+FROM AdvMap IMPORT TreasureKind ;
+
+EXPORT QUALIFIED GetTreasure, DropTreasure, UseTreasure,
+ Grenade, DisplayEnemy, ScatterTreasures,
+ RespawnTreasure, RespawnArrow ;
+
+
+PROCEDURE GetTreasure ;
+PROCEDURE DropTreasure ;
+PROCEDURE UseTreasure ;
+PROCEDURE Grenade ;
+PROCEDURE DisplayEnemy ;
+PROCEDURE ScatterTreasures (p, r: CARDINAL) ;
+PROCEDURE RespawnTreasure (seedRoom: CARDINAL; tno: CARDINAL; ticks: CARDINAL) ;
+PROCEDURE RespawnArrow (seedRoom: CARDINAL; tno: CARDINAL;
+ spawnKind, arrowKind: TreasureKind;
+ amount: CARDINAL; ticks: CARDINAL) ;
+
+
+END AdvTreasure.
--- /dev/null
+IMPLEMENTATION MODULE AdvTreasure ;
+
+
+FROM libc IMPORT printf ;
+FROM Executive IMPORT GetCurrentProcess, InitSemaphore, SEMAPHORE,
+ Wait, Signal, InitProcess, Resume, DESCRIPTOR ;
+FROM TimerHandler IMPORT Sleep, TicksPerSecond, EVENT, ReArmEvent, ArmEvent, WaitOn, Cancel ;
+
+FROM ASCII IMPORT cr ;
+FROM StrLib IMPORT StrCopy, StrConCat, StrLen ;
+FROM NumberIO IMPORT CardToStr, WriteCard ;
+FROM Storage IMPORT ALLOCATE ;
+FROM Assertion IMPORT Assert ;
+
+FROM AdvSystem IMPORT MaxNoOfPlayers,
+ ManWeight,
+ Man,
+ TypeOfDeath,
+ Player,
+ PlayerSet,
+ PlayerNo,
+ ArrowArgs,
+ StartPlayer,
+ TimeMinSec,
+ RandomNumber,
+ ClientRead,
+ DefaultWrite,
+ ReadString,
+ NextFreePlayer,
+ IsPlayerActive,
+ AssignOutputTo,
+
+ GetReadAccessToPlayer,
+ GetWriteAccessToPlayer,
+ ReleaseReadAccessToPlayer,
+ ReleaseWriteAccessToPlayer,
+
+ GetReadAccessToDoor,
+ GetWriteAccessToDoor,
+ ReleaseReadAccessToDoor,
+ ReleaseWriteAccessToDoor,
+
+ GetReadAccessToTreasure,
+ GetWriteAccessToTreasure,
+ ReleaseReadAccessToTreasure,
+ ReleaseWriteAccessToTreasure,
+
+ GetAccessToScreen,
+ ReleaseAccessToScreen,
+ GetAccessToScreenNo,
+ ReleaseAccessToScreenNo ;
+
+FROM AdvMap IMPORT Treasure, Rooms, DoorStatus, IncPosition,
+ NoOfRoomsToSpring,
+ NoOfRoomsToHideCoal, NoOfRoomsToHideGrenade,
+ TreasureKind, Treasure,
+ ActualNoOfRooms ;
+
+FROM AdvMath IMPORT MaxNoOfTreasures, LowFreePool, HighFreePool ;
+
+FROM Screen IMPORT Width, Height,
+ ClearScreen,
+ InitScreen,
+ WriteWounds,
+ WriteWeight,
+ WriteString,
+ WriteCommentLine1,
+ WriteCommentLine2,
+ WriteCommentLine3,
+ DelCommentLine1,
+ DelCommentLine2,
+ DelCommentLine3,
+ WriteArrows, WriteMagicArrows ;
+
+FROM AdvMath IMPORT MagicKey,
+ CrystalBall,
+ MagicSpring,
+ SackOfCoal1,
+ SackOfCoal2,
+ HotIron,
+ HandGrenade,
+ MagicSword,
+ MagicShoes,
+ SleepPotion,
+ LumpOfIron,
+ TreasTrove,
+ SpeedPotion,
+ MagicShield,
+ VisionChest,
+ QuiverNormal,
+ QuiverMagic,
+ HealingPotion,
+
+ UpDateWoundsAndFatigue,
+ DammageByHandGrenade,
+ DammageByHotIron ;
+
+
+FROM DrawG IMPORT DrawTreasure, EraseTreasure, EraseMan, DrawMan ;
+FROM DrawL IMPORT DrawRoom, DrawAllPlayers ;
+FROM AdvSound IMPORT Explode ;
+
+FROM AdvUtil IMPORT PointOnWall, GetDoorOnPoint, PointOnTreasure,
+ HideDoor, RandomRoom, PositionInRoom, InitialDisplay,
+ FreeOfPlayersAndTreasure, Dead ;
+
+
+
+(* Treasure routines. *)
+(* *)
+(* The treasures are as follows: *)
+(* *)
+(* 1: Magic Key - This treasures allows one to make a *)
+(* closed door into a secret door *)
+(* *)
+(* 2: Crystal Ball - This treasure allows one to get the *)
+(* direction and Room No of the other *)
+(* players *)
+(* *)
+(* 3: Magic Spring - When Grabbed, it springs one to another *)
+(* random picked room *)
+(* *)
+(* 4: Sack Of Coal - When Grabbed, it insists that it must *)
+(* be taken to a randomly picked room *)
+(* before it can be dropped *)
+(* *)
+(* 5: Sack Of Coal - Ditto *)
+(* *)
+(* 6: Hot Iron - Scolds one if picked up *)
+(* *)
+(* 7: Hand Grenade - If used will blow up whole room in *)
+(* 25 seconds *)
+(* *)
+(* 8: Magic Sword - Enables one to fight with ease *)
+(* *)
+(* 9: Magic Shoes - Enable one to run with minimal effort *)
+(* *)
+(* 10: Sleep Potion - Makes one fall to sleep for 24 seconds *)
+(* *)
+(* 11: Lump Of Iron - When picked up scatters all treasure in *)
+(* current room. *)
+(* *)
+(* 12: Treasure Trove - Tells one where or who has the *)
+(* treasures. *)
+(* *)
+(* 13: Speed Potion - Increases ones responce time. *)
+(* *)
+(* 14: Magic Shield - Repels Normal Arrows. *)
+(* *)
+(* 15: Vision Chest - Allows one to see enemies screen. *)
+
+
+CONST
+ respawnStack = 10 * 1024 * 1024 ;
+ RespawnArrowTime = 13 ; (* seconds delay between respawning more arrow treasures 16/17. *)
+ RespawnArrowInventory = 20 ; (* seconds delay between respawning inventory arrows after death. *)
+ RespawnMagicInventory = 30 ; (* seconds delay between respawning inventory magic arrows after death. *)
+
+TYPE
+ QDesc = POINTER TO RECORD
+ right: QDesc ;
+ Rm,
+ tno : CARDINAL ;
+ kind : TreasureKind ;
+ amount,
+ ticks : CARDINAL ;
+ END ;
+
+
+
+
+VAR
+ Tmessage : ARRAY [0..13] OF CHAR ;
+ SackOfCoal : ARRAY [0..1] OF CARDINAL ;
+ PinPulled : SEMAPHORE ;
+ PinHasBeenPulled : BOOLEAN ;
+ PlayerPulled : CARDINAL ;
+ qHead,
+ freeDesc : QDesc ;
+ armedTimer : EVENT ;
+ qAvailable,
+ qMutex : SEMAPHORE ;
+ qThread : DESCRIPTOR ;
+
+
+PROCEDURE GetTreasure ;
+VAR
+ p, r : CARDINAL ;
+ died : BOOLEAN ;
+ Tno : CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ GetWriteAccessToPlayer ;
+ Tno := GetTreasure1(p) ;
+ (* Only way so far to die directly from getting treasures. *)
+ died := (Player[p].DeathType=fireball) ;
+ r := Player[p].RoomOfMan ;
+ ReleaseWriteAccessToPlayer ;
+ IF Tno=SleepPotion
+ THEN
+ (* must not sleep holding the lock. *)
+ Sleep(24*TicksPerSecond)
+ END ;
+ IF died
+ THEN
+ Dead(p, r)
+ END
+END GetTreasure ;
+
+
+PROCEDURE GetTreasure1 (p: CARDINAL) : CARDINAL ;
+VAR
+ x, y, d,
+ r,
+ TreasNo: CARDINAL ;
+ ReDraw,
+ ok : BOOLEAN ;
+BEGIN
+ ReDraw := FALSE ;
+ WITH Player[p] DO
+ d := Direction ;
+ r := RoomOfMan ;
+ x := Xman ;
+ y := Yman ;
+ IncPosition(x, y, d) ;
+ GetWriteAccessToTreasure ;
+ PointOnTreasure(r, x, y, TreasNo, ok) ;
+ IF ok
+ THEN
+ IF TreasNo>9
+ THEN
+ Tmessage[12] := '1' ;
+ Tmessage[13] := CHR((TreasNo MOD 10)+ORD('0'))
+ ELSE
+ Tmessage[12] := ' ' ;
+ Tmessage[13] := CHR(TreasNo+ORD('0'))
+ END ;
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, Tmessage) ;
+ WriteCommentLine2(p, Treasure[TreasNo].TreasureName) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo(p) ;
+ PickUpTreasure(p, r, TreasNo, x, y, ReDraw)
+ ELSE
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'thou canst') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo(p)
+ END ;
+ ReleaseWriteAccessToTreasure ;
+ IF ReDraw
+ THEN
+ InitScreen(p) ;
+ DrawRoom
+ END
+ END ;
+ RETURN( TreasNo )
+END GetTreasure1 ;
+
+
+(*
+ RandomDrop -
+*)
+
+PROCEDURE RandomDrop (VAR r, x, y: CARDINAL) : BOOLEAN ;
+VAR
+ roomCount: CARDINAL ;
+ ok : BOOLEAN ;
+BEGIN
+ REPEAT
+ RandomNumber (roomCount, ActualNoOfRooms) ;
+ INC (roomCount) ;
+ RandomRoom (roomCount, NoOfRoomsToSpring, r) ;
+ PositionInRoom (r, x, y, ok)
+ UNTIL ok ;
+ RETURN TRUE
+END RandomDrop ;
+
+
+(*
+ IsTreasureArrow - returns TRUE if treasure, i, is an arrow (normal or magic)
+ it can be a respawnable treasure or an item dropped after
+ death.
+*)
+
+PROCEDURE IsTreasureArrow (i: CARDINAL) : BOOLEAN ;
+BEGIN
+ RETURN (i = QuiverNormal) OR (i = QuiverMagic) OR (i >= LowFreePool)
+END IsTreasureArrow ;
+
+
+PROCEDURE PickUpTreasure (p, r, TreasNo, tx, ty: CARDINAL ;
+ VAR ReDraw: BOOLEAN) ;
+VAR
+ tr, i: CARDINAL ;
+ ok : BOOLEAN ;
+ a : ARRAY [0..14] OF CHAR ;
+ b : ARRAY [0..4] OF CHAR ;
+BEGIN
+ WITH Player[p] DO
+ (* Magic Spring CANNOT be Grabbed AND neither can Lump Of Iron *)
+ IF (TreasNo#MagicSpring) AND (TreasNo#LumpOfIron) AND
+ (NOT IsTreasureArrow (TreasNo))
+ THEN
+ pickUp (p, r, TreasNo) ;
+ GetAccessToScreenNo (p) ;
+ WriteWeight (p, Weight) ;
+ ReleaseAccessToScreenNo (p) ;
+ END ;
+ EXCL (Rooms[r].Treasures, TreasNo) ; (* Room no longer has treasure *)
+ EraseTreasure(r, tx, ty) ;
+
+ IF TreasNo=MagicSpring
+ THEN
+ (* Magic Spring - Springs treasure and player into different *)
+ (* rooms. *)
+
+ EraseMan(p) ;
+ REPEAT
+ RandomNumber(r, ActualNoOfRooms) ; (* r>=0 & r<=ActualNoOfRooms-1 *)
+ INC(r) ;
+ RandomRoom(r, NoOfRoomsToSpring, tr) ;
+ PositionInRoom(tr, tx, ty, ok)
+ UNTIL ok ;
+ RoomOfMan := tr ;
+ Xman := tx ;
+ Yman := ty ;
+ ScreenX := tx-(tx MOD Width) ;
+ ScreenY := ty-(ty MOD Height) ;
+ DrawMan(p) ;
+ IF RandomDrop (tr, tx, ty)
+ THEN
+ WITH Treasure[TreasNo] DO
+ Rm := tr ;
+ Xpos := tx ;
+ Ypos := ty
+ END
+ END ;
+ INCL(Rooms[tr].Treasures, TreasNo) ; (* Room has treasure *)
+ DrawTreasure(tr, tx, ty) ;
+ ReDraw := TRUE
+ ELSIF (TreasNo=SackOfCoal1) OR (TreasNo=SackOfCoal2) (* Sacks Of Coal *)
+ THEN
+ RandomNumber(r, ActualNoOfRooms) ;
+ INC(r) ;
+ RandomRoom(r, NoOfRoomsToHideCoal, tr) ;
+ SackOfCoal[TreasNo-SackOfCoal1] := tr ;
+ StrCopy('to room ', a ) ;
+ CardToStr(tr, 4, b) ;
+ StrConCat(a, b, a) ;
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine3(p, a) ;
+ ReleaseAccessToScreenNo(p)
+ ELSIF TreasNo=HotIron (* Hot iron *)
+ THEN
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'ouch') ;
+ WriteCommentLine2(p, 'fire ball') ;
+ WriteCommentLine3(p, 'hit thee') ;
+ IF DammageByHotIron>Wounds
+ THEN
+ Wounds := 0 ;
+ DeathType := fireball
+ ELSE
+ DEC(Wounds, DammageByHotIron)
+ END ;
+ WriteWounds(p, Wounds) ;
+ ReleaseAccessToScreenNo(p)
+ ELSIF TreasNo=LumpOfIron
+ THEN
+ ScatterAllTreasures(p, RoomOfMan)
+ ELSIF TreasNo=SpeedPotion
+ THEN
+ (* PutPriority(CurrentProcess, User, 4) *)
+ ELSIF (TreasNo=QuiverNormal) OR (TreasNo=QuiverMagic)
+ THEN
+ IF TreasNo=QuiverNormal
+ THEN
+ INC (NoOfNormal, 6) ;
+ GetAccessToScreenNo (p) ;
+ WriteArrows (p, NoOfNormal) ;
+ WriteCommentLine1 (p, '6 normal') ;
+ WriteCommentLine2 (p, 'arrows') ;
+ ReleaseAccessToScreenNo (p) ;
+ Treasure[TreasNo].kind := respawnnormal
+ ELSE
+ INC (NoOfMagic, 1) ;
+ GetAccessToScreenNo (p) ;
+ WriteMagicArrows (p, NoOfMagic) ;
+ WriteCommentLine1 (p, 'a magic') ;
+ WriteCommentLine2 (p, 'arrow') ;
+ ReleaseAccessToScreenNo (p) ;
+ Treasure[TreasNo].kind := respawnmagic
+ END ;
+ RespawnTreasure (tr, TreasNo, RespawnArrowTime * TicksPerSecond) ;
+ ELSIF IsTreasureArrow (TreasNo)
+ THEN
+ GetAccessToScreenNo (p) ;
+ IF Treasure[TreasNo].kind = normal
+ THEN
+ INC (NoOfNormal, Treasure[TreasNo].amount) ;
+ WriteArrows (p, NoOfNormal) ;
+ ELSIF Treasure[TreasNo].kind = magic
+ THEN
+ INC (NoOfMagic, Treasure[TreasNo].amount) ;
+ WriteMagicArrows (p, NoOfMagic) ;
+ END ;
+ Treasure[TreasNo].amount := 0 ;
+ Treasure[TreasNo].Rm := 0 ;
+ Treasure[TreasNo].kind := unused ;
+ ReleaseAccessToScreenNo (p)
+ END
+ END
+END PickUpTreasure ;
+
+
+PROCEDURE ScatterAllTreasures (p, r: CARDINAL) ;
+VAR
+ tp, tr,
+ x, y, i : CARDINAL ;
+ ok : BOOLEAN ;
+BEGIN
+ FOR i := 1 TO MaxNoOfTreasures DO
+ FOR tp := 0 TO NextFreePlayer-1 DO
+ IF IsPlayerActive(tp)
+ THEN
+ WITH Player[tp] DO
+ IF (i IN TreasureOwn) AND (r=RoomOfMan)
+ THEN
+ REPEAT
+ RandomRoom(r, NoOfRoomsToSpring, tr) ;
+ PositionInRoom(tr, x, y, ok)
+ UNTIL ok ;
+ putDown (tp, tr, i, x, y) ;
+ printf ("treasure %d is in room %d at %d,%d\n", i, tr, x, y)
+ END
+ END
+ END
+ END ;
+ IF Treasure[i].Rm=r
+ THEN
+ REPEAT
+ RandomRoom(r, NoOfRoomsToSpring, tr) ;
+ PositionInRoom(tr, x, y, ok)
+ UNTIL ok ;
+ printf ("treasure %d is in room %d at %d,%d\n", i, tr, x, y) ;
+ WITH Treasure[i] DO
+ EraseTreasure (Rm, Xpos, Ypos) ;
+ EXCL (Rooms[Rm].Treasures, i) ;
+ Xpos := x ;
+ Ypos := y ;
+ Rm := tr
+ END ;
+ INCL (Rooms[tr].Treasures, i)
+ END ;
+ WITH Treasure[i] DO
+ DrawTreasure (Rm, Xpos, Ypos)
+ END
+ END ;
+ FOR tp := 0 TO NextFreePlayer-1 DO
+ IF IsPlayerActive(tp)
+ THEN
+ WITH Player[tp] DO
+ IF (TreasureOwn#{}) AND (RoomOfMan=r)
+ THEN
+ (* Now undo treasures which have an automatic effect *)
+ IF SpeedPotion IN TreasureOwn
+ THEN
+ (* PutPriority(PlayerProcess(p), User, 3) *)
+ END ;
+
+ TreasureOwn := {} ;
+ GetAccessToScreenNo(tp) ;
+
+ WriteWeight(p, Weight) ;
+ WriteCommentLine1(p, 'thy burdens') ;
+ WriteCommentLine2(p, 'hast been') ;
+ WriteCommentLine3(p, 'lifted') ;
+
+ ReleaseAccessToScreenNo(tp)
+ END
+ END
+ END
+ END
+END ScatterAllTreasures ;
+
+
+PROCEDURE ScatterTreasures (p, r: CARDINAL) ;
+VAR
+ c : INTEGER ;
+ x, y, i : CARDINAL ;
+ ok : BOOLEAN ;
+BEGIN
+ WITH Player[p] DO
+ FOR i := 1 TO MaxNoOfTreasures DO
+ IF i IN TreasureOwn
+ THEN
+ (* Now undo treasures which have an automatic effect *)
+ IF SpeedPotion IN TreasureOwn
+ THEN
+ (* PutPriority(PlayerProcess(p), User, 3) *)
+ END ;
+
+ REPEAT
+ PositionInRoom(r, x, y, ok) ;
+ IF ok
+ THEN
+ WITH Treasure[i] DO
+ DEC(Weight, Tweight) ;
+ Xpos := x ;
+ Ypos := y ;
+ Rm := r
+ END ;
+ DrawTreasure(r, x, y) ;
+ INCL(Rooms[r].Treasures, i) ;
+ ELSE
+ c := printf('trying another room\n') ;
+ RandomRoom(r, 1, x) ;
+ r := x
+ END
+ UNTIL ok
+ END
+ END ;
+ TreasureOwn := {} ;
+ (* and respawn arrows. *)
+ RespawnArrow (r, 0, respawnmagic, magic, NoOfMagic, TicksPerSecond * RespawnMagicInventory) ;
+ RespawnArrow (r, 0, respawnnormal, normal, NoOfNormal, TicksPerSecond * RespawnArrowInventory) ;
+ GetAccessToScreenNo(p) ;
+ WriteWeight(p, Weight) ;
+ ReleaseAccessToScreenNo(p)
+ END
+END ScatterTreasures ;
+
+
+PROCEDURE DropTreasure ;
+VAR
+ ok : BOOLEAN ;
+ p, TreasNo: CARDINAL ;
+ ch,
+ units,
+ tens : CHAR ;
+BEGIN
+ p := PlayerNo() ;
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine2(p, 'which one?') ;
+ ReleaseAccessToScreenNo(p) ;
+ ch := ' ' ;
+ units := ' ' ;
+ tens := ' ' ;
+ REPEAT
+ tens := units ;
+ units := ch ;
+ ok := ClientRead(ch)
+ UNTIL (NOT ok) OR (ch=cr) ;
+ IF ok
+ THEN
+ IF (units>='0') AND (units<='9')
+ THEN
+ TreasNo := ORD(units)-ORD('0') ;
+ IF (tens>='0') AND (tens<='9')
+ THEN
+ TreasNo := TreasNo+10*(ORD(tens)-ORD('0'))
+ END
+ END ;
+ IF (TreasNo<1) OR (TreasNo>MaxNoOfTreasures)
+ THEN
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'thou canst') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p);
+ ReleaseAccessToScreenNo(p)
+ ELSE
+ GetWriteAccessToPlayer ;
+ DropTreasure1(p, TreasNo) ;
+ ReleaseWriteAccessToPlayer
+ END
+ END
+END DropTreasure ;
+
+
+PROCEDURE DropTreasure1(p, TreasNo: CARDINAL) ;
+VAR
+ x, y, d,
+ r, z : CARDINAL ;
+ ok : BOOLEAN ;
+BEGIN
+ WITH Player[p] DO
+ IF TreasNo IN TreasureOwn
+ THEN
+ d := Direction ;
+ r := RoomOfMan ;
+ x := Xman ;
+ y := Yman ;
+ IncPosition(x, y, d) ;
+ PointOnWall(r, x, y, ok) ;
+ IF NOT ok
+ THEN
+ GetDoorOnPoint(r, x, y, z, ok) ;
+ IF NOT ok
+ THEN
+ GetWriteAccessToTreasure ;
+ FreeOfPlayersAndTreasure(r, x, y, ok) ;
+ IF ok
+ THEN
+ IF TreasNo>9
+ THEN
+ Tmessage[12] := '1' ;
+ Tmessage[13] := CHR((TreasNo MOD 10)+ORD('0'))
+ ELSE
+ Tmessage[12] := ' ' ;
+ Tmessage[13] := CHR(TreasNo+ORD('0'))
+ END ;
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, Tmessage) ;
+ WriteCommentLine2(p, Treasure[TreasNo].TreasureName) ;
+ ReleaseAccessToScreenNo( p ) ;
+ PutDownTreasure(p, r, TreasNo, x, y)
+ ELSE
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'thou canst') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo(p)
+ END ;
+ ReleaseWriteAccessToTreasure
+ ELSE
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'thou canst') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ ELSE
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'thou canst') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ ELSE
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'thou canst') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ END
+END DropTreasure1 ;
+
+
+(*
+ putDown -
+*)
+
+PROCEDURE putDown (p, r, TreasNo, tx, ty: CARDINAL) ;
+BEGIN
+ WITH Player[p] DO
+ DEC (Weight, Treasure[TreasNo].Tweight) ;
+ Treasure[TreasNo].Rm := r ; (* Put in this Room *)
+ Treasure[TreasNo].Xpos := tx ;
+ Treasure[TreasNo].Ypos := ty ;
+ Treasure[TreasNo].kind := onfloor ;
+ INCL (Rooms[r].Treasures, TreasNo) ; (* Room has treasure *)
+ EXCL (TreasureOwn, TreasNo) ; (* Player no longer has treasure *)
+ END
+END putDown ;
+
+
+(*
+ pickUp -
+*)
+
+PROCEDURE pickUp (p, r, TreasNo: CARDINAL) ;
+BEGIN
+ WITH Player[p] DO
+ INC (Weight, Treasure[TreasNo].Tweight) ;
+ Treasure[TreasNo].Rm := 0 ; (* No longer in a Room *)
+ Treasure[TreasNo].kind := onperson ; (* No longer in a Room *)
+ INCL (TreasureOwn, TreasNo)
+ END
+END pickUp ;
+
+
+PROCEDURE PutDownTreasure (p, r, TreasNo, tx, ty: CARDINAL) ;
+VAR
+ tr, i: CARDINAL ;
+ ok : BOOLEAN ;
+ a : ARRAY [0..14] OF CHAR ;
+ b : ARRAY [0..4] OF CHAR ;
+BEGIN
+ WITH Player[p] DO
+ IF (TreasNo=SackOfCoal1) OR (TreasNo=SackOfCoal2) (* Sacks Of Coal *)
+ THEN
+ IF r=SackOfCoal[TreasNo-SackOfCoal1]
+ THEN
+ GetAccessToScreenNo(p) ;
+ WriteWeight(p, Weight) ;
+ WriteCommentLine3(p, 'dropped') ;
+ ReleaseAccessToScreenNo(p) ;
+ putDown (p, r, TreasNo, tx, ty) ;
+ DrawTreasure(r, tx, ty)
+ ELSE
+ StrCopy('to room ', a) ;
+ CardToStr(SackOfCoal[TreasNo-SackOfCoal1], 4, b) ;
+ StrConCat(a, b, a) ;
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine3(p, a) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ ELSE
+ IF TreasNo=SpeedPotion
+ THEN
+ (* PutPriority(CurrentProcess, User, 3) *)
+ END ;
+ putDown (p, r, TreasNo, tx, ty) ;
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine3(p, 'dropped') ;
+ WriteWeight(p, Weight) ;
+ ReleaseAccessToScreenNo(p) ;
+ DrawTreasure(r, tx, ty)
+ END
+ END
+END PutDownTreasure ;
+
+
+PROCEDURE UseTreasure ;
+VAR
+ x, y, d,
+ r, p,
+ TreasNo: CARDINAL ;
+ ok : BOOLEAN ;
+ ch,
+ units,
+ tens : CHAR ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine2(p, 'which one?') ;
+ ReleaseAccessToScreenNo(p) ;
+ ch := ' ' ;
+ units := ' ' ;
+ tens := ' ' ;
+ REPEAT
+ tens := units ;
+ units := ch ;
+ ok := ClientRead(ch)
+ UNTIL (NOT ok) OR (ch=cr) ;
+ IF ok
+ THEN
+ IF (units>='0') AND (units<='9')
+ THEN
+ TreasNo := ORD(units)-ORD('0') ;
+ IF (tens>='0') AND (tens<='9')
+ THEN
+ TreasNo := TreasNo+10*(ORD(tens)-ORD('0'))
+ END
+ END ;
+ GetReadAccessToPlayer ;
+ IF (TreasNo<1) OR (TreasNo>MaxNoOfTreasures)
+ THEN
+ ReleaseReadAccessToPlayer ;
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'thou canst') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo(p)
+ ELSIF TreasNo IN TreasureOwn
+ THEN
+ ReleaseReadAccessToPlayer ;
+ IF TreasNo>9
+ THEN
+ Tmessage[12] := tens ;
+ Tmessage[13] := units
+ ELSE
+ Tmessage[12] := ' ' ;
+ Tmessage[13] := units
+ END ;
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'using') ;
+ WriteCommentLine2(p, Tmessage) ;
+ WriteCommentLine3(p, Treasure[TreasNo].TreasureName) ;
+ ReleaseAccessToScreenNo(p) ;
+ IF TreasNo=MagicKey (* Magic Key *)
+ THEN
+ HideDoor
+ ELSIF TreasNo=CrystalBall (* Crystal Ball *)
+ THEN
+ UseCrystalBall
+ ELSIF TreasNo=HandGrenade (* Hand Grenade *)
+ THEN
+ PullPin
+ ELSIF TreasNo=TreasTrove
+ THEN
+ DisplayTreasures
+ ELSIF TreasNo=VisionChest
+ THEN
+ DisplayEnemy
+ END
+ ELSE
+ ReleaseReadAccessToPlayer ;
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'thou canst') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ END
+ END
+END UseTreasure ;
+
+
+PROCEDURE UseCrystalBall ;
+VAR
+ p, x, y,
+ px, py,
+ r, i : CARDINAL ;
+ a : ARRAY [0..14] OF CHAR ;
+ b : ARRAY [0..4] OF CHAR ;
+ who : ARRAY [0..1] OF CARDINAL ;
+ first: BOOLEAN ;
+ ch : CHAR ;
+BEGIN
+(*
+ p := PlayerNo() ;
+ first := TRUE ;
+ FOR i := 0 TO MaxNoOfPlayers DO
+ IF i#p
+ THEN
+ IF first
+ THEN
+ who[0] := i ;
+ first := FALSE
+ ELSE
+ who[1] := i
+ END
+ END
+ END ;
+ GetReadAccessToPlayerNo( p ) ;
+ WITH Player[p] DO
+ px := Xman ;
+ py := Yman
+ END ;
+ ReleaseReadAccessToPlayerNo( p ) ;
+ GetReadAccessToPlayerNo( who[0] ) ;
+ StrConCat('1: ', Player[who[0]].ManName, a ) ;
+ ReleaseReadAccessToPlayerNo( who[0] ) ;
+ GetAccessToScreenNo( p ) ;
+ WriteCommentLine1(p, a) ;
+ ReleaseAccessToScreenNo( p ) ;
+ GetReadAccessToPlayerNo( who[1] ) ;
+ StrConCat('2: ', Player[who[1]].ManName, a ) ;
+ ReleaseReadAccessToPlayerNo( who[1] ) ;
+ GetAccessToScreenNo( p ) ;
+ WriteCommentLine2(p, a) ;
+ WriteCommentLine3(p, 'peer at ?') ;
+ ReleaseAccessToScreenNo( p ) ;
+ REPEAT
+ Read( ch ) ;
+ IF (ch='1') OR (ch='2')
+ THEN
+ i := ORD(ch)-ORD('1') ;
+ GetReadAccessToPlayerNo( who[i] ) ;
+ WITH Player[who[i]] DO
+ x := Xman ;
+ y := Yman ;
+ r := RoomOfMan
+ END ;
+ ReleaseReadAccessToPlayerNo( who[i] ) ;
+ IF r=0
+ THEN
+ StrCopy('is slain: ', a )
+ ELSE
+ StrCopy('room', a) ;
+ CardToStr( r, 4, b ) ;
+ StrConCat( a, b, a ) ;
+ StrConCat( a, ' ', a )
+ END ;
+ IF y>py
+ THEN
+ StrConCat( a, 'S', a )
+ END ;
+ IF y<py
+ THEN
+ StrConCat( a, 'N', a )
+ END ;
+ IF x>px
+ THEN
+ StrConCat( a, 'E', a )
+ END ;
+ IF x<px
+ THEN
+ StrConCat( a, 'W', a )
+ END ;
+ GetAccessToScreenNo( p ) ;
+ IF ch='1'
+ THEN
+ WriteCommentLine1(p, a)
+ ELSE
+ WriteCommentLine2(p, a)
+ END ;
+ ReleaseAccessToScreenNo( p )
+ END
+ UNTIL (ch#'1') AND (ch#'2') ;
+ GetAccessToScreenNo( p ) ;
+ DelCommentLine1(p) ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo( p )
+*)
+END UseCrystalBall ;
+
+(*
+PROCEDURE DisplayWounds ;
+VAR
+ p, w,
+ r, i : CARDINAL ;
+ b : ARRAY [0..4] OF CHAR ;
+ a : ARRAY [0..14] OF CHAR ;
+ who : ARRAY [0..1] OF CARDINAL ;
+ first: BOOLEAN ;
+ ch : CHAR ;
+BEGIN
+ p := PlayerNo() ;
+ first := TRUE ;
+ FOR i := 0 TO MaxNoOfPlayers DO
+ IF i#p
+ THEN
+ IF first
+ THEN
+ who[0] := i ;
+ first := FALSE
+ ELSE
+ who[1] := i
+ END
+ END
+ END ;
+ GetReadAccessToPlayerNo( who[0] ) ;
+ StrConCat('1: ', Player[who[0]].ManName, a ) ;
+ ReleaseReadAccessToPlayerNo( who[0] ) ;
+ GetAccessToScreenNo( p ) ;
+ WriteCommentLine1(p, a) ;
+ ReleaseAccessToScreenNo( p ) ;
+ GetReadAccessToPlayerNo( who[1] ) ;
+ StrConCat('2: ', Player[who[1]].ManName, a ) ;
+ ReleaseReadAccessToPlayerNo( who[1] ) ;
+ GetAccessToScreenNo( p ) ;
+ WriteCommentLine2(p, a) ;
+ WriteCommentLine3(p, 'peer at ?') ;
+ ReleaseAccessToScreenNo( p ) ;
+ REPEAT
+ Read( ch ) ;
+ IF (ch='1') OR (ch='2')
+ THEN
+ i := ORD(ch)-ORD('1') ;
+ GetReadAccessToPlayerNo( who[i] ) ;
+ WITH Player[who[i]] DO
+ w := Wounds ;
+ r := RoomOfMan
+ END ;
+ ReleaseReadAccessToPlayerNo( who[i] ) ;
+ IF r=0
+ THEN
+ StrCopy('is slain: ', a )
+ ELSE
+ StrCopy('Wounds ', a) ;
+ CardToStr( w, 4, b ) ;
+ StrConCat( a, b, a ) ;
+ StrConCat( a, ' ', a )
+ END ;
+ GetAccessToScreenNo( p ) ;
+ IF ch='1'
+ THEN
+ WriteCommentLine1(p, a)
+ ELSE
+ WriteCommentLine2(p, a)
+ END ;
+ ReleaseAccessToScreenNo( p )
+ END
+ UNTIL (ch#'1') AND (ch#'2') ;
+ GetAccessToScreenNo( p ) ;
+ DelCommentLine1(p) ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo( p )
+END DisplayWounds ;
+*)
+
+PROCEDURE DisplayEnemy ;
+VAR
+ p,
+ r, i : CARDINAL ;
+ who : ARRAY [0..1] OF CARDINAL ;
+ a : ARRAY [0..14] OF CHAR ;
+ first: BOOLEAN ;
+ ch : CHAR ;
+BEGIN
+(*
+ p := PlayerNo() ;
+ first := TRUE ;
+ FOR i := 0 TO MaxNoOfPlayers DO
+ IF i#p
+ THEN
+ IF first
+ THEN
+ who[0] := i ;
+ first := FALSE
+ ELSE
+ who[1] := i
+ END
+ END
+ END ;
+ REPEAT
+ GetReadAccessToPlayerNo( who[0] ) ;
+ StrConCat('1: ', Player[who[0]].ManName, a ) ;
+ ReleaseReadAccessToPlayerNo( who[0] ) ;
+ GetAccessToScreenNo( p ) ;
+ WriteCommentLine1(p, a) ;
+ ReleaseAccessToScreenNo( p ) ;
+ GetReadAccessToPlayerNo( who[1] ) ;
+ StrConCat('2: ', Player[who[1]].ManName, a ) ;
+ ReleaseReadAccessToPlayerNo( who[1] ) ;
+ GetAccessToScreenNo( p ) ;
+ WriteCommentLine2(p, a) ;
+ WriteCommentLine3(p, 'peer at ?') ;
+ ReleaseAccessToScreenNo( p ) ;
+ Read( ch ) ;
+ IF (ch='1') OR (ch='2')
+ THEN
+ i := ORD(ch)-ORD('1') ;
+ GetReadAccessToPlayerNo( who[i] ) ;
+ WITH Player[who[i]] DO
+ r := RoomOfMan
+ END ;
+ ReleaseReadAccessToPlayerNo( who[i] ) ;
+ IF r=0
+ THEN
+ GetAccessToScreenNo( p ) ;
+ IF ch='1'
+ THEN
+ WriteCommentLine1(p, 'is slain:')
+ ELSE
+ WriteCommentLine2(p, 'is slain:')
+ END ;
+ ReleaseAccessToScreenNo( p )
+ ELSE
+ DisplayEn( p, who[i] )
+ END
+ END
+ UNTIL (ch#'1') AND (ch#'2') ;
+ GetAccessToScreenNo( p ) ;
+ DelCommentLine1(p) ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo( p )
+*)
+END DisplayEnemy ;
+
+
+PROCEDURE DisplayEn (p, e: CARDINAL) ;
+VAR
+ OldMan: Man ;
+ ch : CHAR ;
+BEGIN
+(* ******************
+ (* Save player p man first *)
+ GetWriteAccessToAllPlayers ;
+ OldMan := Player[p] ;
+ Player[p] := Player[e] ;
+ (* Now draw Screen etc *)
+ InitScreen ;
+ DrawRoom ;
+ DrawAllPlayers ;
+ Player[p] := OldMan ;
+ ReleaseWriteAccessToAllPlayers ;
+ Read( ch ) ;
+ IF Player[p].RoomOfMan#0 (* So alive - or just killed hopefully... *)
+ THEN
+ InitialDisplay
+ END
+********************** *)
+END DisplayEn ;
+
+
+PROCEDURE DisplayTreasures ;
+VAR
+ p, tp,
+ i, j : CARDINAL ;
+ ok : BOOLEAN ;
+ ch : CHAR ;
+ no : ARRAY [0..3] OF CHAR ;
+ line : ARRAY [0..80] OF CHAR ;
+BEGIN
+ p := PlayerNo() ;
+ GetReadAccessToPlayer ;
+ GetReadAccessToTreasure ;
+ GetAccessToScreenNo(p) ;
+ ClearScreen(p) ;
+ FOR i := 1 TO MaxNoOfTreasures DO
+ ok := FALSE ;
+ FOR tp := 0 TO MaxNoOfPlayers DO
+ IF IsPlayerActive(tp)
+ THEN
+ WITH Player[tp] DO
+ IF i IN TreasureOwn
+ THEN
+ StrCopy(ManName, line) ;
+ StrConCat(line, ' ', line) ;
+ ok := TRUE
+ END
+ END
+ END
+ END ;
+ IF (Treasure[i].Rm # 0) AND (Treasure[i].kind = onfloor)
+ THEN
+ IF (NOT ok)
+ THEN
+ CardToStr(Treasure[i].Rm, 6, line) ;
+ StrConCat(' ', line, line) ;
+ StrConCat('Room Number', line, line) ;
+ END ;
+ StrConCat(line, ' has Treasure No ', line) ;
+ CardToStr(i, 0, no) ;
+ StrConCat(line, no, line) ;
+ StrConCat(line, ' The ', line) ;
+ StrConCat(line, Treasure[i].TreasureName, line) ;
+ WriteString(p, line)
+ END
+ END ;
+ ReleaseReadAccessToPlayer ;
+ ReleaseReadAccessToTreasure ;
+ ReleaseAccessToScreenNo(p) ;
+ IF ClientRead(ch)
+ THEN
+ END ;
+ InitialDisplay
+END DisplayTreasures ;
+
+
+PROCEDURE PullPin ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ GetWriteAccessToTreasure ;
+ IF PinHasBeenPulled
+ THEN
+ ReleaseWriteAccessToTreasure ;
+ GetAccessToScreen ;
+ WriteCommentLine1(p, 'pin has been') ;
+ WriteCommentLine2(p, 'pulled') ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreen
+ ELSE
+ PinHasBeenPulled := TRUE ;
+ PlayerPulled := p ;
+ ReleaseWriteAccessToTreasure ;
+ Signal(PinPulled)
+ END
+END PullPin ;
+
+
+PROCEDURE Grenade ;
+VAR
+ pulled,
+ RoomOfExplosion,
+ sec, i,
+ start : CARDINAL ;
+ hit,
+ ok : BOOLEAN ;
+ SlainP: PlayerSet ;
+BEGIN
+ LOOP
+ Wait(PinPulled) ;
+ pulled := PlayerPulled ;
+ Sleep(25*TicksPerSecond) ;
+
+ (* Ok now explode! *)
+
+ hit := FALSE ;
+ GetWriteAccessToPlayer ;
+ GetWriteAccessToTreasure ;
+
+ (* Find out where grenade is! *)
+
+ WITH Treasure[HandGrenade] DO
+ IF Rm=0
+ THEN
+ i := 0 ;
+ RoomOfExplosion := 0 ;
+ REPEAT
+ IF IsPlayerActive(i)
+ THEN
+ WITH Player[i] DO
+ IF HandGrenade IN TreasureOwn
+ THEN
+ RoomOfExplosion := RoomOfMan ;
+ DEC(Weight, Tweight) ;
+ EXCL(TreasureOwn, HandGrenade) ;
+ GetAccessToScreenNo(i) ;
+ WriteWeight(i, Weight) ;
+ ReleaseAccessToScreenNo(i)
+ END
+ END
+ END ;
+ INC(i)
+ UNTIL (RoomOfExplosion#0) OR (i=NextFreePlayer)
+ ELSE
+ RoomOfExplosion := Rm ;
+ EXCL(Rooms[Rm].Treasures, HandGrenade) ;
+ EraseTreasure(Rm, Xpos, Ypos)
+ END
+ END ;
+
+ IF RoomOfExplosion # 0
+ THEN
+ SlainP := PlayerSet{} ;
+ FOR i := 0 TO NextFreePlayer-1 DO
+ IF IsPlayerActive(i)
+ THEN
+ WITH Player[i] DO
+ IF RoomOfExplosion=RoomOfMan
+ THEN
+ hit := TRUE ;
+ GetAccessToScreenNo(i) ;
+ UpDateWoundsAndFatigue(i) ;
+ WriteCommentLine1(i, 'boooommm') ;
+ DelCommentLine2(i) ;
+ DelCommentLine3(i) ;
+ IF Wounds>DammageByHandGrenade
+ THEN
+ DEC(Wounds, DammageByHandGrenade) ;
+ ELSE
+ INCL(SlainP, i) ;
+ Wounds := 0 ;
+ DeathType := explosion
+ END ;
+ WriteWounds(i, Wounds) ;
+ ReleaseAccessToScreenNo(i)
+ END
+ END
+ END
+ END
+ END ;
+ ReleaseWriteAccessToTreasure ;
+ ReleaseWriteAccessToPlayer ;
+ IF RoomOfExplosion # 0
+ THEN
+ Explode(RoomOfExplosion, pulled, hit) ;
+ FOR i := 0 TO MaxNoOfPlayers DO
+ IF i IN SlainP
+ THEN
+ Dead(i, RoomOfExplosion)
+ END
+ END
+ END ;
+
+ (* and hide the grenade again. *)
+ GetWriteAccessToPlayer ;
+ GetWriteAccessToTreasure ;
+ WITH Treasure[HandGrenade] DO
+ REPEAT
+ RandomRoom(RoomOfExplosion, NoOfRoomsToHideGrenade, Rm) ;
+ PositionInRoom(Rm, Xpos, Ypos, ok)
+ UNTIL ok ;
+ INCL(Rooms[Rm].Treasures, HandGrenade) ;
+ DrawTreasure(Rm, Xpos, Ypos)
+ END ;
+ PinHasBeenPulled := FALSE ;
+ ReleaseWriteAccessToTreasure ;
+ ReleaseWriteAccessToPlayer ;
+ END
+END Grenade ;
+
+
+(*
+ newQDesc -
+*)
+
+PROCEDURE newQDesc (Rm, tno: CARDINAL; kind: TreasureKind; amount, ticks: CARDINAL) : QDesc ;
+VAR
+ d: QDesc ;
+BEGIN
+ IF freeDesc = NIL
+ THEN
+ NEW (d)
+ ELSE
+ d := freeDesc ;
+ freeDesc := freeDesc^.right
+ END ;
+ d^.Rm := Rm ;
+ d^.tno := tno ;
+ d^.kind := kind ;
+ d^.amount := amount ;
+ d^.ticks := ticks ;
+ d^.right := NIL ;
+ RETURN d
+END newQDesc ;
+
+
+(*
+ freeQ - return the head desc to the freeQ.
+*)
+
+PROCEDURE freeQ ;
+VAR
+ desc: QDesc ;
+BEGIN
+ desc := qHead ;
+ qHead := qHead^.right ;
+ desc^.right := freeDesc ;
+ freeDesc := desc
+END freeQ ;
+
+
+(*
+ respawnThread -
+*)
+
+PROCEDURE respawnThread ;
+VAR
+ desc: QDesc ;
+BEGIN
+ LOOP
+ printf ("respawnThread\n");
+ Wait (qAvailable) ;
+ REPEAT
+ Wait (qMutex) ;
+ armedTimer := ArmEvent (qHead^.ticks) ;
+ Signal (qMutex) ;
+ UNTIL NOT WaitOn (armedTimer) ;
+ printf ("respawnThread has waited\n");
+ Wait (qMutex) ;
+ IF qHead # NIL
+ THEN
+ WITH qHead^ DO
+ IF tno < LowFreePool
+ THEN
+ RespawnTreasure (Rm, tno, 0)
+ ELSE
+ (* as the time is zero there is no need for a respawn kind. *)
+ RespawnArrow (Rm, tno, kind, kind, amount, 0)
+ END
+ END
+ END ;
+ freeQ ;
+ Signal (qMutex)
+ END
+END respawnThread ;
+
+
+(*
+ relativeAdd -
+*)
+
+PROCEDURE relativeAdd (desc: QDesc) ;
+VAR
+ s, t: QDesc ;
+ sum : CARDINAL ;
+BEGIN
+(* works - ish...
+ qHead := desc ;
+ desc^.right := NIL ;
+ RETURN ;
+*)
+ IF qHead = NIL
+ THEN
+ (* simple as the queue is empty (relative=absolute). *)
+ qHead := desc ;
+ desc^.right := NIL
+ ELSE
+ (* at the end of the while loop sum will contain the total of all
+ events up to but not including, t.
+ If the value of sum is < e^.NoOfTicks then e must be placed at the end
+ >= e^.NoOfTicks then e needs to be placed in the middle
+ *)
+
+ sum := qHead^.ticks ;
+ s := qHead ;
+ t := qHead^.right ; (* second event *)
+ WHILE (sum < desc^.ticks) AND (t # NIL) DO
+ INC (sum, t^.ticks) ;
+ s := t ;
+ t := t^.right
+ END ;
+ IF sum < desc^.ticks
+ THEN
+ (* desc will occur after all the current qHead has expired therefore
+ we must add it to the end of the qHead. *)
+ DEC (desc^.ticks, sum) ;
+ s^.right:= desc ;
+ desc^.right := NIL
+ ELSE
+ (* as sum >= desc^.ticks we know that desc is scheduled to occur
+ in the middle of the queue but after, s.
+ *)
+ Assert (sum >= s^.ticks) ;
+ DEC (desc^.ticks, sum - s^.ticks) ;
+ desc^.right := t ;
+ s^.right := desc
+ END ;
+ (* the first event after desc must have its relative ticks altered. *)
+ IF desc^.right # NIL
+ THEN
+ DEC (desc^.right^.ticks, desc^.ticks)
+ END
+ END
+END relativeAdd ;
+
+
+(*
+ addToQueue -
+*)
+
+PROCEDURE addToQueue (seedRoom: CARDINAL; tno: CARDINAL; kind: TreasureKind;
+ amount: CARDINAL; ticks: CARDINAL) ;
+VAR
+ desc: QDesc ;
+BEGIN
+ Wait (qMutex) ;
+ desc := newQDesc (seedRoom, tno, kind, amount, ticks) ;
+ relativeAdd (desc) ;
+ IF armedTimer = NIL
+ THEN
+ armedTimer := ArmEvent (desc^.ticks)
+ ELSE
+ IF Cancel (armedTimer)
+ THEN
+ END ;
+ armedTimer := ArmEvent (desc^.ticks)
+ END ;
+ Signal (qAvailable) ;
+ Signal (qMutex) ;
+ IF qThread = NIL
+ THEN
+ qThread := Resume (InitProcess (respawnThread, respawnStack, "respawnThread"))
+ END
+END addToQueue ;
+
+
+PROCEDURE RespawnTreasure (seedRoom: CARDINAL; tno: CARDINAL; ticks: CARDINAL) ;
+VAR
+ x, y: CARDINAL ;
+BEGIN
+ IF ticks = 0
+ THEN
+ randomPlace (seedRoom, tno, onfloor)
+ ELSE
+ addToQueue (seedRoom, tno, onfloor, 0, ticks)
+ END
+END RespawnTreasure ;
+
+
+(*
+ findSpareTreasure -
+*)
+
+PROCEDURE findSpareTreasure (newkind: TreasureKind) : CARDINAL ;
+VAR
+ i: CARDINAL ;
+BEGIN
+ i := LowFreePool ;
+ WHILE i <= HighFreePool DO
+ IF Treasure[i].kind = unused
+ THEN
+ Treasure[i].kind := newkind ;
+ RETURN i
+ END ;
+ INC (i)
+ END ;
+ RETURN 0
+END findSpareTreasure ;
+
+
+(*
+ randomPlace -
+*)
+
+PROCEDURE randomPlace (seedRoom: CARDINAL; tno: CARDINAL; k: TreasureKind) ;
+VAR
+ x, y: CARDINAL ;
+BEGIN
+ IF RandomDrop (seedRoom, x, y)
+ THEN
+ WITH Treasure[tno] DO
+ Rm := seedRoom ;
+ Xpos := x ;
+ Ypos := y ;
+ kind := k ;
+ END ;
+ IF (tno >= LowFreePool) AND (tno <= HighFreePool)
+ THEN
+ IF k = magic
+ THEN
+ StrCopy ('Magic Arrows', Treasure[tno].TreasureName)
+ ELSIF k = normal
+ THEN
+ StrCopy ('Arrow Quiver', Treasure[tno].TreasureName)
+ END
+ END ;
+ INCL (Rooms[seedRoom].Treasures, tno) ;
+ WITH Treasure[tno] DO
+ IF (kind = onfloor) AND (Rm # 0)
+ THEN
+ DrawTreasure (Rm, Xpos, Ypos)
+ END
+ END
+ END
+END randomPlace ;
+
+
+PROCEDURE RespawnArrow (seedRoom: CARDINAL; tno: CARDINAL;
+ spawnKind, arrowKind: TreasureKind;
+ amount: CARDINAL; ticks: CARDINAL) ;
+BEGIN
+ IF amount > 0
+ THEN
+ IF tno = 0
+ THEN
+ tno := findSpareTreasure (spawnKind) ;
+ END ;
+ IF tno # 0
+ THEN
+ (* this should nearly always be true, but if we did run out of slots then
+ we forget the dynamic arrow treasure. *)
+ IF ticks = 0
+ THEN
+ randomPlace (seedRoom, tno, arrowKind)
+ ELSE
+ addToQueue (seedRoom, tno, arrowKind, amount, ticks)
+ END
+ END
+ END
+END RespawnArrow ;
+
+
+(*
+ initPool - initialise a treasure so that it might be dynamically allocated
+ as items on the floor.
+*)
+
+PROCEDURE initPool (i: CARDINAL) ;
+BEGIN
+ WITH Treasure[i] DO
+ Xpos := 0 ;
+ Ypos := 0 ;
+ Rm := 0 ;
+ Tweight := 0 ;
+ StrCopy ('', TreasureName) ;
+ kind := unused ;
+ amount := 0
+ END
+END initPool ;
+
+
+(*
+ initTreasure - initialize weight and kind.
+*)
+
+PROCEDURE initTreasure (i: CARDINAL; weight: CARDINAL; kind: TreasureKind) ;
+BEGIN
+ Treasure[i].Tweight := weight ;
+ Treasure[i].kind := kind ;
+END initTreasure ;
+
+
+PROCEDURE Init ;
+VAR
+ i: CARDINAL ;
+BEGIN
+ FOR i := 1 TO MaxNoOfTreasures DO
+ initPool (i)
+ END ;
+
+ PinPulled := InitSemaphore(0, 'PinPulled') ;
+ PinHasBeenPulled := FALSE ;
+
+ StrCopy('Magic Key' , Treasure[MagicKey ].TreasureName ) ;
+ StrCopy('Crystal Ball', Treasure[CrystalBall].TreasureName ) ;
+ StrCopy('Magic Spring', Treasure[MagicSpring].TreasureName ) ;
+ StrCopy('Sack Of Coal', Treasure[SackOfCoal1].TreasureName ) ;
+ StrCopy('Sack Of Coal', Treasure[SackOfCoal2].TreasureName ) ;
+ StrCopy('Hot Iron' , Treasure[HotIron ].TreasureName ) ;
+ StrCopy('Hand Grenade', Treasure[HandGrenade].TreasureName ) ;
+ StrCopy('Magic Sword' , Treasure[MagicSword ].TreasureName ) ;
+ StrCopy('Magic Shoes' , Treasure[MagicShoes ].TreasureName ) ;
+ StrCopy('Sleep Potion', Treasure[SleepPotion].TreasureName ) ;
+ StrCopy('Lump Of Iron', Treasure[LumpOfIron ].TreasureName ) ;
+ StrCopy('Treas. Trove', Treasure[TreasTrove ].TreasureName ) ;
+ StrCopy('Speed Potion', Treasure[SpeedPotion].TreasureName ) ;
+ StrCopy('Magic Shield', Treasure[MagicShield].TreasureName ) ;
+ StrCopy('Vision Chest', Treasure[VisionChest].TreasureName ) ;
+ StrCopy('Arrow Quiver', Treasure[QuiverNormal].TreasureName ) ;
+ StrCopy('Magic Arrows', Treasure[QuiverMagic].TreasureName ) ;
+ StrCopy('Salve ', Treasure[HealingPotion].TreasureName ) ;
+
+ initTreasure (MagicKey , 0, unused) ;
+ initTreasure (CrystalBall, 33, unused) ;
+ initTreasure (MagicSpring, 0, unused) ;
+ initTreasure (SackOfCoal1, 100, unused) ;
+ initTreasure (SackOfCoal2, 100, unused) ;
+ initTreasure (HotIron , 4, unused) ; (* was 4 *)
+ initTreasure (HandGrenade, 3, unused) ; (* was 3 *)
+ initTreasure (MagicSword , 1, unused) ; (* was 1 *)
+ initTreasure (MagicShoes , 0, unused) ; (* was 0 *)
+ initTreasure (SleepPotion, 5, unused) ; (* was 5 *)
+ initTreasure (LumpOfIron , 0, unused) ; (* was 0 *)
+ initTreasure (TreasTrove , 53, unused) ; (* was 43 *)
+ initTreasure (SpeedPotion, 0, unused) ; (* was 0 *)
+ initTreasure (MagicShield, 2, unused) ; (* was 2 *)
+ initTreasure (VisionChest, 120, unused) ; (* was 150 *)
+ initTreasure (HealingPotion, 0, unused) ;
+
+ StrCopy('Treasure No xx', Tmessage ) ;
+ armedTimer := NIL ;
+ qMutex := InitSemaphore (1, "qMutex") ;
+ qAvailable := InitSemaphore (0, "qAvailable") ;
+ qHead := NIL ;
+ freeDesc := NIL ;
+ qThread := NIL
+END Init ;
+
+
+BEGIN
+ Init
+END AdvTreasure.
+(*
+ * Local variables:
+ * compile-command: "make"
+ * End:
+ *)
--- /dev/null
+DEFINITION MODULE AdvUtil ;
+
+
+EXPORT QUALIFIED InitialDisplay, TestIfLastLivePlayer,
+ GetDoorOnPoint, PointOnWall, PointOnTreasure,
+ Positioning, RandomRoom, PositionInRoom,
+ FreeOfPlayersAndTreasure,
+ MoveMan, Dead, Exit,
+ OpenDoor, CloseDoor, ExamineDoor, HideDoor,
+ MagicArrow, NormalArrow, HideTreasure,
+ Parry, Thrust, Attack,
+ Speak ;
+
+
+PROCEDURE InitialDisplay ;
+PROCEDURE Positioning ;
+PROCEDURE Dead (p, room: CARDINAL) ;
+PROCEDURE TestIfLastLivePlayer (VAR yes: BOOLEAN) ;
+PROCEDURE PointOnWall (RoomNo, x, y: CARDINAL ; VAR Success: BOOLEAN) ;
+
+PROCEDURE GetDoorOnPoint (RoomNo, x, y: CARDINAL ;
+ VAR DoorNo: CARDINAL ; VAR Success: BOOLEAN) ;
+
+PROCEDURE PointOnTreasure (RoomNo, x, y: CARDINAL ;
+ VAR TreasNo: CARDINAL ; VAR Success: BOOLEAN) ;
+
+PROCEDURE FreeOfPlayersAndTreasure (room, x, y: CARDINAL ;
+ VAR Success: BOOLEAN) ;
+
+PROCEDURE RandomRoom (CurrentRoom, NoOfRoomsApart: CARDINAL ;
+ VAR room: CARDINAL) ;
+
+(*
+ HideTreasure - hides treasure, t, which is assummed to be absent from the
+ data structures when this procedure is called.
+*)
+
+PROCEDURE HideTreasure (t: CARDINAL) ;
+
+PROCEDURE PositionInRoom (room: CARDINAL ;
+ VAR x, y: CARDINAL ; VAR Success: BOOLEAN) ;
+
+PROCEDURE MoveMan (n: CARDINAL) ;
+PROCEDURE MagicArrow (p: CARDINAL) ;
+PROCEDURE NormalArrow (p: CARDINAL) ;
+PROCEDURE OpenDoor ;
+PROCEDURE CloseDoor ;
+PROCEDURE ExamineDoor ;
+PROCEDURE HideDoor ;
+PROCEDURE Parry ;
+PROCEDURE Attack ;
+PROCEDURE Thrust ;
+PROCEDURE Speak ;
+PROCEDURE Exit ;
+
+
+END AdvUtil.
--- /dev/null
+IMPLEMENTATION MODULE AdvUtil ;
+
+
+FROM libc IMPORT printf ;
+FROM AdvSystem IMPORT PlayerSet ;
+FROM ASCII IMPORT cr, lf, nul, bs, del, nak ;
+FROM Screen IMPORT WriteString ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM Assertion IMPORT Assert ;
+FROM AdvSound IMPORT Miss, Swish, Hit ;
+
+FROM AdvSystem IMPORT Player, PlayerNo, IsPlayerActive,
+ MaxNoOfPlayers,
+ ArrowArgs,
+ NextFreePlayer,
+ TypeOfDeath,
+ RandomNumber,
+ DefaultWrite,
+
+ GetReadAccessToPlayer,
+ ReleaseReadAccessToPlayer,
+ GetWriteAccessToPlayer,
+ ReleaseWriteAccessToPlayer,
+
+ GetReadAccessToTreasure,
+ ReleaseReadAccessToTreasure,
+ GetWriteAccessToTreasure,
+ ReleaseWriteAccessToTreasure,
+
+ GetReadAccessToDoor,
+ ReleaseReadAccessToDoor,
+ GetWriteAccessToDoor,
+ ReleaseWriteAccessToDoor,
+
+ GetAccessToScreen,
+ ReleaseAccessToScreen,
+ GetAccessToScreenNo,
+ ReleaseAccessToScreenNo,
+ ClientRead ;
+
+FROM AdvMath IMPORT MaxNoOfTreasures ;
+
+FROM AdvMap IMPORT Treasure, Rooms, DoorStatus, TreasureKind,
+ NoOfRoomsToHidePlayers,
+ ActualNoOfRooms,
+ IncPosition ;
+
+FROM Executive IMPORT GetCurrentProcess, Wait, Signal ;
+FROM TimerHandler IMPORT Sleep, TicksPerSecond, GetTicks ;
+FROM ProcArgs IMPORT ProcessArgs, CollectArgs ;
+
+FROM Screen IMPORT InitScreen,
+ WriteWounds,
+ WriteRoom, WriteWeight,
+ WriteCommentLine1, DelCommentLine1,
+ WriteCommentLine2, DelCommentLine2,
+ WriteCommentLine3, DelCommentLine3,
+ InnerX, OuterX, InnerY, OuterY, OffX, OffY,
+ Height, Width ;
+
+FROM AdvMath IMPORT DammageByParry,
+ DammageByAttack,
+ DammageByThrust,
+ DammageByFireArrow,
+ DammageByFireMagic,
+ DammageByMagicParry,
+ DammageByMagicAttack,
+ DammageByMagicThrust,
+
+ MagicSword,
+ MagicShield,
+
+ StrengthToParry,
+ StrengthToAttack,
+ StrengthToThrust,
+ StrengthToFireArrow,
+ StrengthToFireMagic,
+ StrengthToMove,
+ UpDateWoundsAndFatigue ;
+
+FROM DrawL IMPORT DrawAllPlayers, DrawRoom, ClearRoom ;
+
+FROM DrawG IMPORT DrawMan, EraseMan, DrawDoor, DrawArrow, EraseArrow,
+ DisplayMessage, DrawTreasure ;
+
+FROM AdvTreasure IMPORT ScatterTreasures, RespawnTreasure ;
+
+
+CONST
+ SquaresPerSecond = 25 ; (* speed of arrows *)
+ DelayPerSquare = TicksPerSecond DIV SquaresPerSecond ;
+
+
+PROCEDURE Max (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+ IF a>b
+ THEN
+ RETURN( a )
+ ELSE
+ RETURN( b )
+ END
+END Max ;
+
+
+PROCEDURE PointOnLine (x, y, x1, y1, x2, y2: CARDINAL ; VAR ok: BOOLEAN) ;
+BEGIN
+ IF (x=x1) AND (y>=y1) AND (y<=y2)
+ THEN
+ ok := TRUE
+ ELSIF (y=y1) AND (x>=x1) AND (x<=x2)
+ THEN
+ ok := TRUE
+ ELSE
+ ok := FALSE
+ END
+END PointOnLine ;
+
+
+(* All the following routines assume that the calling process has gained *)
+(* access to map, if needed! *)
+
+PROCEDURE ChangeStatusOfDoor (RoomNo, DoorNo: CARDINAL ; ds: DoorStatus) ;
+VAR
+ r,i,x1,x2,y1,y2: CARDINAL ;
+BEGIN
+ WITH Rooms[RoomNo].Doors[DoorNo] DO
+ r := LeadsTo ;
+ StateOfDoor := ds ;
+ x1 := Position.X1 ;
+ y1 := Position.Y1 ;
+ x2 := Position.X2 ;
+ y2 := Position.Y2
+ END ;
+ DrawDoor( RoomNo, DoorNo ) ;
+ IF r#0
+ THEN
+ GetDoorIndex( r, x1, y1, x2, y2, i ) ;
+ Rooms[r].Doors[i].StateOfDoor := ds ;
+ DrawDoor( r, i )
+ END
+END ChangeStatusOfDoor ;
+
+
+PROCEDURE GetDoorIndex (RoomNo,
+ x1, y1, x2, y2: CARDINAL ;
+ VAR i: CARDINAL) ;
+VAR
+ Max : CARDINAL ;
+ ok : BOOLEAN ;
+BEGIN
+ i := 1 ;
+ ok := TRUE ;
+ Max := Rooms[RoomNo].NoOfDoors ;
+ WITH Rooms[RoomNo] DO
+ WHILE (i<=NoOfDoors) AND ok DO
+ WITH Doors[i].Position DO
+ IF (x1=X1) AND (y1=Y1) AND
+ (x2=X2) AND (y2=Y2)
+ THEN
+ ok := FALSE
+ ELSE
+ INC( i )
+ END
+ END
+ END
+ END
+END GetDoorIndex ;
+
+
+PROCEDURE GetDoorOnPoint (RoomNo, x, y: CARDINAL ;
+ VAR DoorNo: CARDINAL ; VAR Success: BOOLEAN) ;
+VAR
+ Max : CARDINAL ;
+BEGIN
+ Max := Rooms[RoomNo].NoOfDoors ;
+ DoorNo := 1 ;
+ Success := FALSE ;
+ WITH Rooms[RoomNo] DO
+ WHILE (NOT Success) AND (DoorNo<=Max) DO
+ WITH Doors[DoorNo].Position DO
+ PointOnLine( x, y, X1, Y1, X2, Y2, Success ) ;
+ IF NOT Success
+ THEN
+ INC( DoorNo )
+ END
+ END
+ END
+ END
+END GetDoorOnPoint ;
+
+
+PROCEDURE OpenToClosedDoor (VAR Success: BOOLEAN) ;
+VAR
+ x, y, DoorNo: CARDINAL ;
+BEGIN
+ WITH Player[PlayerNo()] DO
+ x := Xman ;
+ y := Yman ;
+ IncPosition( x, y, Direction ) ;
+ GetDoorOnPoint( RoomOfMan, x, y, DoorNo, Success ) ;
+ IF Success
+ THEN
+ IF Rooms[RoomOfMan].Doors[DoorNo].StateOfDoor=Open
+ THEN
+ ChangeStatusOfDoor( RoomOfMan, DoorNo, Closed )
+ ELSE
+ Success := FALSE
+ END
+ END
+ END
+END OpenToClosedDoor ;
+
+
+PROCEDURE ClosedToOpenDoor (VAR Success: BOOLEAN) ;
+VAR
+ x, y, DoorNo: CARDINAL ;
+BEGIN
+ WITH Player[PlayerNo()] DO
+ x := Xman ;
+ y := Yman ;
+ IncPosition(x, y, Direction) ;
+ GetDoorOnPoint( RoomOfMan, x, y, DoorNo, Success ) ;
+ IF Success
+ THEN
+ IF Rooms[RoomOfMan].Doors[DoorNo].StateOfDoor=Closed
+ THEN
+ ChangeStatusOfDoor( RoomOfMan, DoorNo, Open )
+ ELSE
+ Success := FALSE
+ END
+ END
+ END
+END ClosedToOpenDoor ;
+
+
+PROCEDURE ClosedToSecretDoor (VAR Success: BOOLEAN) ;
+VAR
+ x, y, DoorNo: CARDINAL ;
+BEGIN
+ WITH Player[PlayerNo()] DO
+ x := Xman ;
+ y := Yman ;
+ IncPosition( x, y, Direction ) ;
+ GetDoorOnPoint( RoomOfMan, x, y, DoorNo, Success ) ;
+ IF Success
+ THEN
+ IF Rooms[RoomOfMan].Doors[DoorNo].StateOfDoor=Closed
+ THEN
+ ChangeStatusOfDoor( RoomOfMan, DoorNo, Secret )
+ ELSE
+ Success := FALSE
+ END
+ END
+ END
+END ClosedToSecretDoor ;
+
+
+PROCEDURE SecretToClosedDoor (VAR Success: BOOLEAN) ;
+VAR
+ x, y, DoorNo: CARDINAL ;
+BEGIN
+ WITH Player[PlayerNo()] DO
+ x := Xman ;
+ y := Yman ;
+ IncPosition( x, y, Direction ) ;
+ GetDoorOnPoint( RoomOfMan, x, y, DoorNo, Success ) ;
+ IF Success
+ THEN
+ IF Rooms[RoomOfMan].Doors[DoorNo].StateOfDoor=Secret
+ THEN
+ ChangeStatusOfDoor( RoomOfMan, DoorNo, Closed )
+ ELSE
+ Success := FALSE
+ END
+ END
+ END
+END SecretToClosedDoor ;
+
+
+PROCEDURE PointOnWall (RoomNo, x, y: CARDINAL ;
+ VAR Success: BOOLEAN) ;
+VAR
+ Max,
+ WallNo : CARDINAL ;
+BEGIN
+ Max := Rooms[RoomNo].NoOfWalls ;
+ WallNo := 1 ;
+ Success := FALSE ;
+ WHILE (NOT Success) AND (WallNo<=Max) DO
+ WITH Rooms[RoomNo].Walls[WallNo] DO
+ PointOnLine( x, y, X1, Y1, X2, Y2, Success ) ;
+ IF NOT Success
+ THEN
+ INC( WallNo )
+ END
+ END
+ END
+END PointOnWall ;
+
+
+PROCEDURE PointOnTreasure (RoomNo, x, y: CARDINAL ;
+ VAR TreasNo: CARDINAL ; VAR Success: BOOLEAN) ;
+BEGIN
+ TreasNo := 1 ;
+ Success := FALSE ;
+ WHILE (NOT Success) AND (TreasNo<=MaxNoOfTreasures) DO
+ WITH Treasure[TreasNo] DO
+ IF (Rm = RoomNo) AND (kind = onfloor)
+ THEN
+ IF (Xpos=x) AND (Ypos=y)
+ THEN
+ Success := TRUE
+ ELSE
+ INC( TreasNo )
+ END
+ ELSE
+ INC( TreasNo )
+ END
+ END
+ END
+END PointOnTreasure ;
+
+
+(* This routine finds out if a point is upon a player. It does use *)
+(* GetReadAccessToPlayer & ReleaseReadAccessToPlayer. This routine *)
+(* returns Success if the point was on a player and also sets *)
+(* PlayNo to tell which player is upon this square. *)
+
+PROCEDURE PointOnPlayer (RoomNo, x, y: CARDINAL ;
+ VAR PlayNo: CARDINAL ; VAR Success: BOOLEAN) ;
+BEGIN
+ PlayNo := 0 ;
+ Success := FALSE ;
+ GetReadAccessToPlayer ;
+ WHILE (NOT Success) AND (PlayNo<NextFreePlayer) DO
+ WITH Player[PlayNo] DO
+ IF IsPlayerActive(PlayNo) AND (Xman=x) AND (Yman=y)
+ THEN
+ Success := TRUE
+ ELSE
+ INC(PlayNo)
+ END
+ END
+ END ;
+ ReleaseReadAccessToPlayer
+END PointOnPlayer ;
+
+
+PROCEDURE TestIfLastLivePlayer (VAR yes: BOOLEAN) ;
+VAR
+ p, i: CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ i := 0 ;
+ yes := TRUE ;
+ WHILE (i<NextFreePlayer) AND yes DO
+ IF p#i
+ THEN
+ IF (Player[i].DeathType=living) AND IsPlayerActive(i)
+ THEN
+ yes := FALSE
+ END
+ END ;
+ INC( i )
+ END
+END TestIfLastLivePlayer ;
+
+PROCEDURE ReceiveFireFromProcess (p: CARDINAL;
+ VAR r, x, y, d: CARDINAL; magic: BOOLEAN) ;
+VAR
+ aa: ArrowArgs ;
+BEGIN
+ IF magic
+ THEN
+ aa := CollectArgs(Player[p].MagicProcArgs)
+ ELSE
+ aa := CollectArgs(Player[p].NormalProcArgs)
+ END ;
+ WITH aa^ DO
+ Assert(p=ArrowPlayer) ;
+ r := ArrowRoom ;
+ x := ArrowX ;
+ y := ArrowY ;
+ d := ArrowDir
+ END ;
+ DISPOSE(aa)
+END ReceiveFireFromProcess ;
+
+
+PROCEDURE NormalArrow (p: CARDINAL) ;
+VAR
+ x, y, r,
+ d,
+ player : CARDINAL ;
+ hit,
+ done,
+ SlainP : BOOLEAN ;
+BEGIN
+ WITH Player[p] DO
+ LOOP
+ SlainP := FALSE ;
+ ReceiveFireFromProcess(p, r, x, y, d, FALSE) ;
+ REPEAT
+ FireArrow(p, r, x, y, d, hit, player) ;
+ IF hit
+ THEN
+ GetReadAccessToPlayer ;
+ WITH Player[player] DO
+ IF MagicShield IN TreasureOwn
+ THEN
+ done := FALSE ;
+ d := (d+2) MOD 4 ;
+ x := Xman ;
+ y := Yman ;
+ r := RoomOfMan ;
+ IncPosition(x, y, d)
+ ELSE
+ done := TRUE
+ END
+ END ;
+ ReleaseReadAccessToPlayer
+ ELSE
+ done := TRUE
+ END
+ UNTIL done ;
+ IF hit
+ THEN
+ WITH Player[player] DO
+ GetWriteAccessToPlayer ;
+
+ GetAccessToScreenNo(player) ;
+ UpDateWoundsAndFatigue(player) ;
+ IF Wounds<=DammageByFireArrow
+ THEN
+ r := RoomOfMan ;
+ SlainP := TRUE ;
+ Wounds := 0 ;
+ DeathType := normalarrow ;
+ ELSE
+ DEC( Wounds, DammageByFireArrow )
+ END ;
+ WriteWounds(player, Wounds) ;
+ WriteCommentLine1(player, 'struck thee') ;
+ DelCommentLine2(player) ;
+ DelCommentLine3(player) ;
+ ReleaseAccessToScreenNo(player) ;
+
+ GetAccessToScreenNo(p) ;
+ IF Wounds=0
+ THEN
+ DelCommentLine1(p) ;
+ WriteCommentLine2(p, 'slain') ;
+ WriteCommentLine3(p, ManName )
+ ELSE
+ WriteCommentLine1(p, 'thwunk') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p)
+ END ;
+ ReleaseAccessToScreenNo(p) ;
+ ReleaseWriteAccessToPlayer
+ END
+ ELSE
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'swish') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo(p)
+ END ;
+ IF SlainP
+ THEN
+ Dead(player, r)
+ END
+ END
+ END
+END NormalArrow ;
+
+
+PROCEDURE MagicArrow (p: CARDINAL) ;
+VAR
+ x, y, r,
+ d,
+ player : CARDINAL ;
+ hit,
+ SlainP : BOOLEAN ;
+BEGIN
+ WITH Player[p] DO
+ LOOP
+ SlainP := FALSE ;
+ ReceiveFireFromProcess(p, r, x, y, d, TRUE) ;
+ FireArrow(p, r, x, y, d, hit, player) ;
+ IF hit
+ THEN
+ WITH Player[player] DO
+ GetWriteAccessToPlayer ;
+
+ GetAccessToScreenNo(player) ;
+ UpDateWoundsAndFatigue(player) ;
+ IF Wounds<=DammageByFireMagic
+ THEN
+ r := RoomOfMan ;
+ SlainP := TRUE ;
+ DeathType := magicarrow ;
+ Wounds := 0
+ ELSE
+ DEC(Wounds, DammageByFireMagic)
+ END ;
+ WriteWounds(player, Wounds) ;
+ WriteCommentLine1(player, 'struck thee') ;
+ DelCommentLine2(player) ;
+ DelCommentLine3(player) ;
+ ReleaseAccessToScreenNo(player) ;
+
+ GetAccessToScreenNo(p) ;
+
+ IF Wounds=0
+ THEN
+ DelCommentLine1(p) ;
+ WriteCommentLine2(p, 'slain') ;
+ WriteCommentLine3(p, ManName)
+ ELSE
+ WriteCommentLine1(p, 'thwunk') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p)
+ END ;
+ ReleaseAccessToScreenNo(p) ;
+ ReleaseWriteAccessToPlayer
+ END
+ ELSE
+ GetAccessToScreenNo(p) ;
+
+ WriteCommentLine1(p, 'swish') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo(p)
+ END ;
+ IF SlainP
+ THEN
+ Dead(player, r)
+ END
+ END
+ END
+END MagicArrow ;
+
+
+PROCEDURE FireArrow (p, r, x, y, d: CARDINAL ;
+ VAR hit: BOOLEAN ; VAR player: CARDINAL) ;
+VAR
+ t : INTEGER ;
+ NotCont : BOOLEAN ;
+ door,
+ X, Y,
+ i, j : CARDINAL ;
+ playerscreen: PlayerSet ;
+ LastTime,
+ DelayTime : CARDINAL ;
+BEGIN
+ i := x ; (* old x & y *)
+ j := y ;
+ playerscreen := PlayerSet{} ;
+ Swish(r) ;
+ REPEAT
+ LastTime := GetTicks() ;
+ PointOnPlayer(r, x, y, player, NotCont) ;
+ hit := NotCont ;
+ IF NOT NotCont
+ THEN
+ GetReadAccessToDoor ;
+ GetDoorOnPoint(r, x, y, door, NotCont) ;
+ IF NotCont
+ THEN
+ WITH Rooms[r].Doors[door] DO
+ IF (StateOfDoor=Open) AND (LeadsTo#0)
+ THEN
+ NotCont := FALSE ;
+ r := LeadsTo
+ END
+ END ;
+ ReleaseReadAccessToDoor ;
+ ELSE
+ ReleaseReadAccessToDoor ;
+ PointOnWall(r, x, y, NotCont) ;
+ IF NOT NotCont
+ THEN
+ GetReadAccessToTreasure ;
+ PointOnTreasure(r, x, y, door, NotCont) ;
+ ReleaseReadAccessToTreasure ;
+ IF NOT NotCont
+ THEN
+ GetReadAccessToPlayer ;
+ EraseArrow(i, j, playerscreen, FALSE) ;
+ DrawArrow(r, x, y, d, playerscreen) ;
+ ReleaseReadAccessToPlayer ;
+ i := x ;
+ j := y
+ END
+ END
+ END
+ END ;
+ IncPosition(x, y, d) ;
+ (* now we regulate a constant velocity arrow! *)
+ DelayTime := GetTicks() - LastTime ;
+ IF DelayTime<DelayPerSquare
+ THEN
+ (* t := printf("before Sleep for %d ticks\n", DelayPerSquare-DelayTime) ; *)
+ Sleep(DelayPerSquare-DelayTime)
+ (* ; t := printf("after Sleep\n") ; *)
+ END
+ UNTIL NotCont ;
+ IF hit
+ THEN
+ Hit(p)
+ ELSE
+ Miss(r)
+ END ;
+ IF (X#i) OR (Y#j)
+ THEN
+ GetReadAccessToPlayer ;
+ EraseArrow(i, j, playerscreen, TRUE) ;
+ ReleaseReadAccessToPlayer
+ END
+END FireArrow ;
+
+
+PROCEDURE Exit ;
+VAR
+ p : CARDINAL ;
+ yes: BOOLEAN ;
+BEGIN
+ p := PlayerNo() ;
+ GetReadAccessToPlayer ;
+ TestIfLastLivePlayer(yes) ;
+ ReleaseReadAccessToPlayer ;
+ IF NOT yes
+ THEN
+ Dead(p, Player[p].RoomOfMan)
+ END
+END Exit ;
+
+
+(* MoveMan moves the man forward n squares, providing these squares *)
+(* are free from a WALL, DOOR (closed, secret), TREASURE and MAN. *)
+
+PROCEDURE MoveMan (n: CARDINAL) ;
+VAR
+ p : CARDINAL ;
+ yes : BOOLEAN ;
+BEGIN
+ IF n>0
+ THEN
+ p := PlayerNo() ;
+ GetWriteAccessToPlayer ;
+ MoveMan1(n, p) ;
+ ReleaseWriteAccessToPlayer ;
+ IF Player[p].DeathType=exitdungeon
+ THEN
+ TestIfLastLivePlayer(yes) ;
+ IF NOT yes
+ THEN
+ Dead(p, Player[0].RoomOfMan)
+ END
+ END
+ END
+END MoveMan ;
+
+
+PROCEDURE MoveMan1 (n, p: CARDINAL) ;
+VAR
+ x, y,
+ i, j, s,
+ r, dir,
+ tr, z,
+ Sx, Sy,
+ DoorNo : CARDINAL ;
+ hit : BOOLEAN ;
+BEGIN
+ StrengthToMove(n, hit) ;
+ IF hit
+ THEN
+ WITH Player[p] DO
+ EraseMan(p) ;
+ dir := Direction ;
+ tr := RoomOfMan ;
+ x := Xman ;
+ y := Yman ;
+ Sx := ScreenX ;
+ Sy := ScreenY ;
+ hit := FALSE ;
+ s := 1 ;
+ i := x ;
+ j := y ;
+ r := tr ;
+ WHILE (s<=n) AND (NOT hit) DO
+ IncPosition(i, j, dir) ;
+ GetReadAccessToDoor ;
+ GetDoorOnPoint(r, i, j, DoorNo, hit) ;
+ IF hit
+ THEN
+ IF Rooms[r].Doors[DoorNo].StateOfDoor=Open
+ THEN
+ z := Rooms[r].Doors[DoorNo].LeadsTo ;
+ ReleaseReadAccessToDoor ;
+ IF z=0
+ THEN
+ DeathType := exitdungeon
+ ELSE
+ IncPosition(i, j, dir) ;
+ TakenPointInRoom(z, i, j, hit) ;
+ IF NOT hit (* Empty Point In Room *)
+ THEN
+ INC(s) ;
+ x := i ;
+ y := j ;
+ r := z (* Ok so changed room *)
+ END
+ END
+ ELSE
+ ReleaseReadAccessToDoor
+ END ;
+ ELSE
+ ReleaseReadAccessToDoor ;
+ PointOnWall(r, i, j, hit) ;
+ IF NOT hit
+ THEN
+ GetReadAccessToTreasure ;
+ PointOnTreasure(r, i, j, z, hit) ;
+ ReleaseReadAccessToTreasure ;
+ IF NOT hit
+ THEN
+ PointOnOtherPlayer(i, j, z, hit) ;
+ IF NOT hit
+ THEN
+ x := i ;
+ y := j ;
+ INC(s)
+ END
+ END
+ END
+ END
+ END ;
+ IF (x#Xman) OR (y#Yman)
+ THEN
+ Xman := x ;
+ Yman := y ;
+ ScaleSights(x, y, Sx, Sy, hit) ;
+ ScreenX := Sx ;
+ ScreenY := Sy ;
+ RoomOfMan := r ;
+ IF r#0
+ THEN
+ IF (tr#r) OR hit
+ THEN
+ IF hit
+ THEN
+ InitScreen(p)
+ ELSE
+ GetAccessToScreenNo(p) ;
+ WriteRoom(p, r) ;
+ ReleaseAccessToScreenNo(p)
+ END ;
+ ClearRoom(tr) ;
+ DrawRoom
+ END ;
+ DrawMan(p)
+ END
+ ELSE
+ DrawMan(p)
+ END
+ END
+ END
+END MoveMan1 ;
+
+
+PROCEDURE TakenPointInRoom (room, x, y: CARDINAL ; VAR ok: BOOLEAN) ;
+VAR
+ z: CARDINAL ;
+BEGIN
+ PointOnWall( room, x, y, ok ) ;
+ IF NOT ok
+ THEN
+ GetReadAccessToDoor ;
+ GetDoorOnPoint(room, x, y, z, ok) ;
+ ReleaseReadAccessToDoor ;
+ IF NOT ok
+ THEN
+
+ (* No need to get Read Access To Player 's since taken care of *)
+ (* in the called routine. *)
+
+ PointOnOtherPlayer(x, y, z, ok) ;
+ IF NOT ok
+ THEN
+ GetReadAccessToTreasure ;
+ PointOnTreasure(room, x, y, z, ok) ;
+ ReleaseReadAccessToTreasure
+ END
+ END
+ END
+END TakenPointInRoom ;
+
+
+(* ScaleSights scales the sights of the ScreenX and ScreenY *)
+(* coordinates according to whether the player is off the *)
+(* screen or off the boundary. It returns Done if the routine *)
+(* has altered Sx, Sy. *)
+
+PROCEDURE ScaleSights (x, y: CARDINAL ; VAR Sx, Sy: CARDINAL ;
+ VAR Done: BOOLEAN) ;
+VAR
+ sx, sy: CARDINAL ;
+BEGIN
+ sx := Sx ;
+ sy := Sy ;
+ IF Sx+InnerX>x
+ THEN
+ Dec(Sx, OffX)
+ ELSIF Sx+OuterX < x
+ THEN
+ Inc(Sx, OffX)
+ END ;
+ IF Sy+InnerY>y
+ THEN
+ Dec(Sy, OffY)
+ ELSIF Sy+OuterY<y
+ THEN
+ Inc(Sy, OffY)
+ END ;
+ Done := (sx#Sx) OR (sy#Sy)
+END ScaleSights ;
+
+
+PROCEDURE Inc (VAR s: CARDINAL ; c: CARDINAL) ;
+BEGIN
+ IF (c DIV 2) + (s DIV 2) < 32768
+ THEN
+ INC(s, c)
+ END
+END Inc ;
+
+
+PROCEDURE Dec (VAR s: CARDINAL ; c: CARDINAL) ;
+BEGIN
+ IF c<=s
+ THEN
+ DEC(s, c)
+ ELSIF s>0
+ THEN
+ s := 0
+ END
+END Dec ;
+
+
+PROCEDURE Parry ;
+VAR
+ p, r, x, y, Pn : CARDINAL ;
+ hit, SlainP : BOOLEAN ;
+BEGIN
+ SlainP := FALSE ;
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ GetWriteAccessToPlayer ;
+ StrengthToParry(hit) ;
+ IF hit
+ THEN
+ ReleaseWriteAccessToPlayer ;
+ GetReadAccessToPlayer ;
+ x := Xman ;
+ y := Yman ;
+ IncPosition(x, y, Direction) ;
+ PointOnOtherPlayer(x, y, Pn, hit) ;
+ ReleaseReadAccessToPlayer ;
+ IF hit
+ THEN
+ WITH Player[Pn] DO
+ GetWriteAccessToPlayer ;
+
+ GetAccessToScreenNo(Pn) ;
+ UpDateWoundsAndFatigue(Pn) ;
+ ReleaseAccessToScreenNo(Pn) ;
+
+ IF MagicSword IN Player[p].TreasureOwn
+ THEN
+ GetAccessToScreenNo(p) ;
+ IF Wounds>DammageByMagicParry
+ THEN
+ DEC(Wounds, DammageByMagicParry) ;
+ WriteCommentLine1(p, 'hit') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p)
+ ELSE
+ r := RoomOfMan ;
+ SlainP := TRUE ;
+ Wounds := 0 ;
+ DeathType := sword ;
+ DelCommentLine1(p) ;
+ WriteCommentLine2(p, 'Slain') ;
+ WriteCommentLine3(p, ManName )
+ END ;
+ ReleaseAccessToScreenNo(p)
+ ELSE
+ GetAccessToScreenNo(p) ;
+ IF Wounds>DammageByParry
+ THEN
+ DEC( Wounds, DammageByParry ) ;
+ WriteCommentLine1(p, 'hit') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p)
+ ELSE
+ r := RoomOfMan ;
+ SlainP := TRUE ;
+ Wounds := 0 ;
+ DeathType := sword ;
+ DelCommentLine1(p) ;
+ WriteCommentLine2(p, 'Slain') ;
+ WriteCommentLine3(p, ManName ) ;
+ END ;
+ ReleaseAccessToScreenNo(p)
+ END ;
+
+ GetAccessToScreenNo(Pn) ;
+ WriteCommentLine1(Pn, 'hit thee') ;
+ DelCommentLine2(Pn) ;
+ DelCommentLine3(Pn) ;
+ WriteWounds( Pn, Wounds ) ;
+ ReleaseAccessToScreenNo(Pn) ;
+
+ ReleaseWriteAccessToPlayer
+ END
+ ELSE
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'missed') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ ELSE
+ ReleaseWriteAccessToPlayer
+ END
+ END ;
+ IF SlainP
+ THEN
+ Dead( Pn, r )
+ END
+END Parry ;
+
+
+PROCEDURE Attack ;
+VAR
+ p, r, x, y, Pn : CARDINAL ;
+ hit, SlainP : BOOLEAN ;
+BEGIN
+ SlainP := FALSE ;
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ GetWriteAccessToPlayer ;
+ StrengthToAttack( hit ) ;
+ IF hit
+ THEN
+ ReleaseWriteAccessToPlayer ;
+ GetReadAccessToPlayer ;
+ x := Xman ;
+ y := Yman ;
+ IncPosition(x, y, Direction) ;
+ PointOnOtherPlayer(x, y, Pn, hit) ;
+ ReleaseReadAccessToPlayer ;
+ IF hit
+ THEN
+ WITH Player[Pn] DO
+ GetWriteAccessToPlayer ;
+
+ GetAccessToScreenNo(Pn) ;
+ UpDateWoundsAndFatigue(Pn) ;
+ ReleaseAccessToScreenNo(Pn) ;
+
+ IF MagicSword IN Player[p].TreasureOwn
+ THEN
+ GetAccessToScreenNo(p) ;
+ IF Wounds>DammageByMagicAttack
+ THEN
+ DEC(Wounds, DammageByMagicAttack) ;
+ WriteCommentLine1(p, 'hit') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p)
+ ELSE
+ r := RoomOfMan ;
+ SlainP := TRUE ;
+ Wounds := 0 ;
+ DeathType := sword ;
+ DelCommentLine1(p) ;
+ WriteCommentLine2(p, 'Slain') ;
+ WriteCommentLine3(p, ManName)
+ END ;
+ ReleaseAccessToScreenNo( p )
+ ELSE
+ GetAccessToScreenNo( p ) ;
+ IF Wounds>DammageByAttack
+ THEN
+ DEC( Wounds, DammageByAttack ) ;
+ WriteCommentLine1(p, 'hit') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p)
+ ELSE
+ r := RoomOfMan ;
+ SlainP := TRUE ;
+ Wounds := 0 ;
+ DeathType := sword ;
+ DelCommentLine1(p) ;
+ WriteCommentLine2(p, 'Slain') ;
+ WriteCommentLine3(p, ManName)
+ END ;
+ ReleaseAccessToScreenNo(p)
+ END ;
+
+ GetAccessToScreenNo(Pn) ;
+
+ WriteCommentLine1(Pn, 'hit thee') ;
+ DelCommentLine2(Pn) ;
+ DelCommentLine3(Pn) ;
+ WriteWounds(Pn, Wounds) ;
+ ReleaseAccessToScreenNo(Pn) ;
+
+ ReleaseWriteAccessToPlayer
+ END
+ ELSE
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'missed') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ ELSE
+ ReleaseWriteAccessToPlayer
+ END
+ END ;
+ IF SlainP
+ THEN
+ Dead( Pn, r )
+ END
+END Attack ;
+
+
+PROCEDURE Thrust ;
+VAR
+ p, r, x, y, Pn : CARDINAL ;
+ hit, SlainP : BOOLEAN ;
+BEGIN
+ SlainP := FALSE ;
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ GetWriteAccessToPlayer ;
+ StrengthToThrust(hit) ;
+ IF hit
+ THEN
+ ReleaseWriteAccessToPlayer ;
+ GetReadAccessToPlayer ;
+ x := Xman ;
+ y := Yman ;
+ IncPosition(x, y, Direction) ;
+ PointOnOtherPlayer(x, y, Pn, hit) ;
+ ReleaseReadAccessToPlayer ;
+ IF hit
+ THEN
+ WITH Player[Pn] DO
+ GetWriteAccessToPlayer ;
+
+ GetAccessToScreenNo(Pn) ;
+ UpDateWoundsAndFatigue(Pn) ;
+ ReleaseAccessToScreenNo(Pn) ;
+
+ IF MagicSword IN Player[p].TreasureOwn
+ THEN
+ GetAccessToScreenNo(p) ;
+ IF Wounds>DammageByMagicThrust
+ THEN
+ DEC(Wounds, DammageByMagicThrust) ;
+ WriteCommentLine1(p, 'hit') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p)
+ ELSE
+ r := RoomOfMan ;
+ SlainP := TRUE ;
+ Wounds := 0 ;
+ DeathType := sword ;
+ DelCommentLine1(p) ;
+ WriteCommentLine2(p, 'Slain') ;
+ WriteCommentLine3(p, ManName)
+ END ;
+ ReleaseAccessToScreenNo(p)
+ ELSE
+ GetAccessToScreenNo(p) ;
+ IF Wounds>DammageByThrust
+ THEN
+ DEC(Wounds, DammageByThrust) ;
+ WriteCommentLine1(p, 'hit') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p)
+ ELSE
+ r := RoomOfMan ;
+ SlainP := TRUE ;
+ Wounds := 0 ;
+ DeathType := sword ;
+ DelCommentLine1(p) ;
+ WriteCommentLine2(p, 'Slain') ;
+ WriteCommentLine3(p, ManName)
+ END ;
+ ReleaseAccessToScreenNo( p )
+ END ;
+
+ GetAccessToScreenNo(Pn) ;
+
+ WriteCommentLine1(Pn, 'hit thee') ;
+ DelCommentLine2(Pn) ;
+ DelCommentLine3(Pn) ;
+ WriteWounds( Pn, Wounds ) ;
+ ReleaseAccessToScreenNo(Pn) ;
+
+ ReleaseWriteAccessToPlayer
+ END
+ ELSE
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'missed') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ ELSE
+ ReleaseWriteAccessToPlayer
+ END
+ END ;
+ IF SlainP
+ THEN
+ Dead( Pn, r )
+ END
+END Thrust ;
+
+
+(* Tests to see whether the point is occupied by another player. *)
+(* This procedure does NOT use any lock. *)
+
+PROCEDURE PointOnOtherPlayer (x, y: CARDINAL ;
+ VAR Pn: CARDINAL ; VAR Success: BOOLEAN) ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ Success := FALSE ;
+ p := PlayerNo() ;
+ Pn := 0 ;
+ WHILE (Pn<NextFreePlayer) AND (NOT Success) DO
+ IF (Pn#p) AND IsPlayerActive(Pn)
+ THEN
+ WITH Player[Pn] DO
+ IF (Xman=x) AND (Yman=y)
+ THEN
+ Success := TRUE
+ ELSE
+ INC( Pn )
+ END
+ END
+ ELSE
+ INC( Pn )
+ END
+ END
+END PointOnOtherPlayer ;
+
+
+PROCEDURE OpenDoor ;
+VAR
+ Success: BOOLEAN ;
+BEGIN
+ GetReadAccessToPlayer ;
+ GetWriteAccessToDoor ;
+ ClosedToOpenDoor(Success) ;
+ GetAccessToScreen ;
+ IF Success
+ THEN
+ DelCommentLine1(PlayerNo())
+ ELSE
+ WriteCommentLine1(PlayerNo(), 'thou canst')
+ END ;
+ ReleaseAccessToScreen ;
+ ReleaseWriteAccessToDoor ;
+ ReleaseReadAccessToPlayer
+END OpenDoor ;
+
+
+PROCEDURE ExamineDoor ;
+VAR
+ Success: BOOLEAN ;
+BEGIN
+ GetReadAccessToPlayer ;
+ GetWriteAccessToDoor ;
+ SecretToClosedDoor(Success) ;
+ GetAccessToScreen ;
+ IF Success
+ THEN
+ DelCommentLine1(PlayerNo())
+ ELSE
+ WriteCommentLine1(PlayerNo(), 'nothing')
+ END ;
+ ReleaseAccessToScreen ;
+ ReleaseWriteAccessToDoor ;
+ ReleaseReadAccessToPlayer
+END ExamineDoor ;
+
+
+PROCEDURE CloseDoor ;
+VAR
+ Success: BOOLEAN ;
+BEGIN
+ GetReadAccessToPlayer ;
+ GetWriteAccessToDoor ;
+ OpenToClosedDoor(Success) ;
+ GetAccessToScreen ;
+ IF Success
+ THEN
+ DelCommentLine1(PlayerNo())
+ ELSE
+ WriteCommentLine1(PlayerNo(), 'thou canst')
+ END ;
+ ReleaseAccessToScreen ;
+ ReleaseWriteAccessToDoor ;
+ ReleaseReadAccessToPlayer
+END CloseDoor ;
+
+
+PROCEDURE HideDoor ;
+VAR
+ Success: BOOLEAN ;
+BEGIN
+ GetReadAccessToPlayer ;
+ GetWriteAccessToDoor ;
+ ClosedToSecretDoor(Success) ;
+ GetAccessToScreen ;
+ IF Success
+ THEN
+ DelCommentLine1(PlayerNo())
+ ELSE
+ WriteCommentLine1(PlayerNo(), 'thou canst')
+ END ;
+ ReleaseAccessToScreen ;
+ ReleaseWriteAccessToDoor ;
+ ReleaseReadAccessToPlayer
+END HideDoor ;
+
+
+(* Speak Function *)
+
+PROCEDURE Speak ;
+VAR
+ a1, a2, a3: ARRAY [0..14] OF CHAR ;
+ i, r, p : CARDINAL ;
+ ch : CHAR ;
+BEGIN
+ p := PlayerNo() ;
+ r := Player[p].RoomOfMan ;
+ i := 0 ;
+ a1[0] := nul ;
+ a2[0] := nul ;
+ a3[0] := nul ;
+ REPEAT
+ IF ClientRead(ch)
+ THEN
+ IF ch=nak
+ THEN
+ i := 0
+ ELSIF (ch=del) OR (ch=bs)
+ THEN
+ IF i>0
+ THEN
+ DEC( i )
+ END
+ ELSIF (ch>=' ') OR (ch=cr)
+ THEN
+ IF ch=cr
+ THEN
+ ch := nul
+ END ;
+ IF i<15
+ THEN
+ a1[i] := ch
+ ELSIF i<30
+ THEN
+ a2[i-15] := ch
+ ELSE
+ a3[i-30] := ch
+ END ;
+ INC( i )
+ END
+ ELSE
+ RETURN
+ END
+ UNTIL (ch=nul) OR (i>44) ;
+ DisplayMessage( a1, a2, a3 ) ;
+END Speak ;
+
+
+(* Assumes we are configured to write to player, p, *)
+
+PROCEDURE Dead (p, room : CARDINAL) ;
+BEGIN
+ WITH Player[p] DO
+ GetWriteAccessToPlayer ;
+ IF room#0
+ THEN
+ GetReadAccessToDoor ;
+ GetWriteAccessToTreasure ;
+ ScatterTreasures(p, room) ;
+ EraseMan(p) ;
+ ReleaseWriteAccessToTreasure ;
+ ReleaseReadAccessToDoor
+ END ;
+ ReleaseWriteAccessToPlayer
+ END
+END Dead ;
+
+
+(* RandomRoom takes the current room and works out a random room. *)
+
+PROCEDURE RandomRoom (CurrentRoom, NoOfRoomsApart: CARDINAL ;
+ VAR room: CARDINAL) ;
+VAR
+ i: CARDINAL ;
+BEGIN
+ (* Warning the method used here may cause problems to a map which *)
+ (* does not have consecutive rooms. *)
+
+ RandomNumber( i, ActualNoOfRooms) ;
+ room := i+1
+
+(*
+ Cutting out this routine for the moment.
+
+ room := CurrentRoom ;
+ WHILE NoOfRoomsApart>0 DO
+ IF Rooms[CurrentRoom].NoOfDoors=1
+ THEN
+ i := 1
+ ELSE
+ RandomNumber( i, Rooms[CurrentRoom].NoOfDoors ) ;
+ INC( i )
+ END ;
+ room := Rooms[CurrentRoom].Doors[i].LeadsTo ;
+ IF room=0
+ THEN
+ room := CurrentRoom
+ ELSE
+ CurrentRoom := room
+ END ;
+ DEC( NoOfRoomsApart )
+ END
+*)
+END RandomRoom ;
+
+
+(* GetRandomPosition finds a free random position within a room *)
+
+PROCEDURE PositionInRoom (room: CARDINAL ;
+ VAR x, y: CARDINAL ; VAR Success: BOOLEAN) ;
+VAR
+ r : INTEGER ;
+ maxx, maxy,
+ x1, y1, doorno,
+ j, i, d, z,
+ OldRoom : CARDINAL ;
+ OkOld, ok,
+ OkCurrent : BOOLEAN ;
+BEGIN
+ doorno := 1 ;
+ Success := FALSE ;
+ WHILE (doorno<=Rooms[room].NoOfDoors) AND (NOT Success) DO
+ OldRoom := Rooms[room].Doors[doorno].LeadsTo ;
+ IF OldRoom#0
+ THEN
+ WITH Rooms[room].Doors[doorno].Position DO
+ x1 := X1 ;
+ y1 := Y1 ;
+ i := X2
+ END ;
+ IF x1=i
+ THEN
+ d := 1
+ ELSE
+ d := 0
+ END ;
+ i := 1 ;
+ maxx := 0 ;
+ maxy := 0 ;
+ WHILE i<=Rooms[room].NoOfWalls DO
+ maxx := Max(Rooms[room].Walls[i].X2, maxx) ;
+ maxy := Max(Rooms[room].Walls[i].Y2, maxy) ;
+ INC(i)
+ END ;
+ OkCurrent := FALSE ;
+ OkOld := FALSE ;
+ WHILE NOT OkCurrent DO
+ d := (d+2) MOD 4 ;
+ i := x1 ;
+ j := y1 ;
+ REPEAT
+ IncPosition(i, j, d) ;
+ PointOnWall(room, i, j, OkCurrent) ;
+ IF NOT OkCurrent
+ THEN
+ GetDoorOnPoint(room, i, j, z, OkCurrent)
+ END ;
+ PointOnWall(OldRoom, i, j, OkOld) ;
+ IF NOT OkOld
+ THEN
+ GetDoorOnPoint(OldRoom, i, j, z, OkOld)
+ END ;
+ IF NOT OkCurrent
+ THEN
+ FreeOfPlayersAndTreasure(room, i, j, ok) ;
+ IF ok
+ THEN
+ Success := TRUE ;
+ x := i ;
+ y := j
+ END
+ END
+ UNTIL OkCurrent OR OkOld OR
+ (ODD(d) AND ((i=0) OR (i>=maxx))) OR
+ ((NOT ODD(d)) AND ((j=0) OR (j>=maxy))) ;
+ IF OkOld
+ THEN
+ Success := FALSE
+ END
+ END
+ END ;
+ INC(doorno)
+ END ;
+ IF Success
+ THEN
+ r := printf("room %d position %d %d\n", room, x, y)
+ END
+END PositionInRoom ;
+
+
+PROCEDURE FreeOfPlayersAndTreasure (room, x, y: CARDINAL ; VAR Success: BOOLEAN) ;
+VAR
+ i : CARDINAL ;
+BEGIN
+ Success := TRUE ;
+ i := 0 ;
+ WHILE (i<NextFreePlayer) AND Success DO
+ IF IsPlayerActive(i)
+ THEN
+ WITH Player[i] DO
+ IF room=RoomOfMan
+ THEN
+ IF (Xman=x) AND (Yman=y)
+ THEN
+ Success := FALSE
+ END
+ END
+ END
+ END ;
+ INC (i)
+ END ;
+ IF Success
+ THEN
+ i := 1 ;
+ WHILE (i<=MaxNoOfTreasures) AND Success DO
+ WITH Treasure[i] DO
+ IF (Rm=room) AND (kind=onfloor)
+ THEN
+ IF (Xpos=x) AND (Ypos=y)
+ THEN
+ Success := FALSE
+ END
+ END
+ END ;
+ INC (i)
+ END
+ END
+END FreeOfPlayersAndTreasure ;
+
+
+(*
+ HideTreasure - hides treasure, t, which is assummed to be absent from the
+ data structures when this procedure is called.
+*)
+
+PROCEDURE HideTreasure (t: CARDINAL) ;
+VAR
+ ok: BOOLEAN ;
+BEGIN
+ GetReadAccessToTreasure ;
+ RespawnTreasure (GetRandomRoom(NoOfRoomsToHidePlayers, ActualNoOfRooms), t, 0) ;
+ ReleaseReadAccessToTreasure
+END HideTreasure ;
+
+
+(*
+ GetRandomRoom - returns a random room.
+*)
+
+PROCEDURE GetRandomRoom (NoOfRoomsToTraverse, TotalRooms: CARDINAL) : CARDINAL ;
+VAR
+ x, y, r: CARDINAL ;
+BEGIN
+ RandomNumber(x, NoOfRoomsToTraverse) ;
+ INC(x) ;
+ RandomNumber(y, TotalRooms) ;
+ INC(y) ;
+ RandomRoom(y, x, r) ;
+ RETURN( r )
+END GetRandomRoom ;
+
+
+PROCEDURE Positioning ;
+VAR
+ Attempt,
+ i, r, x, y, p: CARDINAL ;
+ ok : BOOLEAN ;
+BEGIN
+ Attempt := MaxNoOfPlayers ;
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ GetWriteAccessToPlayer ;
+ GetReadAccessToDoor ;
+ GetReadAccessToTreasure ;
+ REPEAT
+ r := GetRandomRoom(NoOfRoomsToHidePlayers, ActualNoOfRooms) ;
+ ok := TRUE ;
+ IF Attempt>0
+ THEN
+ FOR i := 0 TO NextFreePlayer-1 DO
+ IF IsPlayerActive(i) AND (i#p)
+ THEN
+ IF r=Player[i].RoomOfMan
+ THEN
+ ok := FALSE
+ END
+ END
+ END ;
+ DEC(Attempt)
+ END ;
+ IF ok
+ THEN
+ PositionInRoom(r, x, y, ok)
+ END
+ UNTIL ok ;
+ ScreenX := x-(x MOD Width) ;
+ ScreenY := y-(y MOD Height) ;
+ RoomOfMan := r ;
+ Xman := x ;
+ Yman := y ;
+ ScaleSights(Xman, Yman, ScreenX, ScreenY, ok) ;
+ ReleaseReadAccessToTreasure ;
+ ReleaseReadAccessToDoor ;
+ ReleaseWriteAccessToPlayer
+ END
+END Positioning ;
+
+
+(* Miscellaneous routines that connect the screen to the main program *)
+
+
+PROCEDURE InitialDisplay ;
+BEGIN
+ InitScreen(PlayerNo()) ;
+ GetReadAccessToPlayer ;
+ DrawRoom ;
+ ReleaseReadAccessToPlayer
+END InitialDisplay ;
+
+
+END AdvUtil.
+(*
+ * Local variables:
+ * compile-command: "make"
+ * End:
+ *)
--- /dev/null
+DEFINITION MODULE DrawG ;
+
+FROM AdvSystem IMPORT PlayerSet ;
+EXPORT QUALIFIED DrawMan, EraseMan, DrawDoor, DrawTreasure,
+ EraseTreasure, DrawArrow, EraseArrow,
+ DisplayMessage ;
+
+
+(* All these procedures to draw on the screens - are Global *)
+(* Ie they will draw to all the screens that are within *)
+(* the area of effect. *)
+
+
+PROCEDURE DrawMan (p: CARDINAL) ;
+
+PROCEDURE EraseMan (p: CARDINAL) ;
+
+
+(* DrawDoor draws a door on every screen possible ie all that *)
+(* are in this particular area. Hence the coordinates need *)
+(* to be absolute NOT relative! *)
+
+PROCEDURE DrawDoor (RoomOfDoor, IndexToDoor: CARDINAL) ;
+
+PROCEDURE DrawTreasure (room, x, y: CARDINAL) ;
+
+PROCEDURE EraseTreasure (room, x, y: CARDINAL) ;
+
+PROCEDURE DrawArrow (room, x, y, dir: CARDINAL ; VAR playerscreen: PlayerSet) ;
+
+PROCEDURE EraseArrow (x, y: CARDINAL ; playerscreen: PlayerSet; flush: BOOLEAN) ;
+
+PROCEDURE DisplayMessage (a1, a2, a3: ARRAY OF CHAR) ;
+
+
+END DrawG.
--- /dev/null
+IMPLEMENTATION MODULE DrawG ;
+
+
+FROM AdvMap IMPORT Rooms, Door, DoorStatus, Line, Adjacent ;
+FROM ASCII IMPORT lf, bs ;
+FROM Window IMPORT Clip, ClipPoint ;
+FROM StdIO IMPORT Write ;
+IMPORT DrawL ;
+
+FROM Screen IMPORT Height, Width, Flush,
+ WriteCommentLine1, WriteCommentLine2, WriteCommentLine3 ;
+
+FROM AdvSystem IMPORT Player, PlayerNo, PlayerSet,
+ NextFreePlayer,
+ IsPlayerActive,
+ GetReadAccessToPlayer,
+ GetWriteAccessToPlayer,
+ ReleaseReadAccessToPlayer,
+ ReleaseWriteAccessToPlayer,
+ GetReadAccessToDoor,
+ ReleaseReadAccessToDoor,
+ GetReadAccessToTreasure,
+ ReleaseReadAccessToTreasure,
+ GetAccessToScreenNo,
+ ReleaseAccessToScreenNo ;
+
+
+(* All these procedures to draw on the screens - are Global *)
+(* Ie they will draw to all the screens that are within *)
+(* the area of effect. *)
+
+
+(* DrawMan draws the calling player on every screen that *)
+(* is within the area of effect. And which has the same *)
+(* current room number. *)
+(* This routine only uses the AccessToScreen Locks. *)
+
+PROCEDURE DrawMan (p: CARDINAL) ;
+VAR
+ i,
+ x, y, Sx, Sy, r,
+ dir : CARDINAL ;
+BEGIN
+ WITH Player[p] DO
+ r := RoomOfMan ;
+ x := Xman ;
+ y := Yman ;
+ dir := Direction
+ END ;
+
+ FOR i := 0 TO NextFreePlayer-1 DO
+ IF IsPlayerActive(i)
+ THEN
+ WITH Player[i] DO
+ IF r=RoomOfMan
+ THEN
+ Sy := ScreenY ;
+ Sx := ScreenX ;
+ IF (x>=Sx) AND (x<=Sx+Width) AND
+ (y>=Sy) AND (y<=Sy+Height)
+ THEN
+ GetAccessToScreenNo(i) ;
+ DrawL.DrawMan(p#i, x-Sx, y-Sy, dir) ;
+ ReleaseAccessToScreenNo(i)
+ END
+ END
+ END
+ END
+ END
+END DrawMan ;
+
+
+(* EraseMan erases the calling player on every screen that is *)
+(* currently displaying this player. *)
+
+PROCEDURE EraseMan (p: CARDINAL) ;
+VAR
+ i, r, x, y, Sx, Sy: CARDINAL ;
+BEGIN
+ WITH Player[p] DO
+ r := RoomOfMan ;
+ x := Xman ;
+ y := Yman
+ END ;
+
+ FOR i := 0 TO NextFreePlayer-1 DO
+ IF IsPlayerActive(i)
+ THEN
+ WITH Player[i] DO
+ IF r=RoomOfMan
+ THEN
+ Sy := ScreenY ;
+ Sx := ScreenX ;
+ IF (x>=Sx) AND (x<=Sx+Width) AND
+ (y>=Sy) AND (y<=Sy+Height)
+ THEN
+ GetAccessToScreenNo(i) ;
+ DrawL.Erase(x-Sx, y-Sy) ;
+ Flush(i) ;
+ ReleaseAccessToScreenNo(i)
+ END
+ END
+ END
+ END
+ END
+END EraseMan ;
+
+
+(* DrawDoor draws a door on every screen possible ie all that *)
+(* are in this particular area. Hence the coordinates need *)
+(* to be absolute NOT relative! *)
+(* This procedure uses Locks GetAccessToScreen ONLY! *)
+
+PROCEDURE DrawDoor (RoomOfDoor, IndexToDoor: CARDINAL) ;
+VAR
+ p : CARDINAL ;
+ hx, hy,
+ x, y, NextRoom,
+ i, j, x1, y1, x2, y2: CARDINAL ;
+ ok : BOOLEAN ;
+ yt, xt : CARDINAL ;
+ ds : DoorStatus ;
+BEGIN
+ WITH Rooms[RoomOfDoor].Doors[IndexToDoor].Position DO
+ x1 := X1 ;
+ x2 := X2 ;
+ y1 := Y1 ;
+ y2 := Y2
+ END ;
+
+ WITH Rooms[RoomOfDoor].Doors[IndexToDoor] DO
+ ds := StateOfDoor ;
+ NextRoom := LeadsTo
+ END ;
+
+ FOR p := 0 TO NextFreePlayer-1 DO
+ IF IsPlayerActive(p)
+ THEN
+ WITH Player[p] DO
+ IF (RoomOfDoor=RoomOfMan) OR (RoomOfMan=NextRoom)
+ THEN
+ i := x1 ;
+ j := y1 ;
+ x := x2 ;
+ y := y2 ;
+ Clip(i, j, x, y, ScreenX, ScreenY, ok) ;
+ IF ok
+ THEN
+ GetAccessToScreenNo(p) ;
+ IF i=x
+ THEN
+ hx := x2 ;
+ hy := y2 ;
+ ClipPoint(hx, hy, ScreenX, ScreenY, ok) ;
+ DrawL.DLine(i, j, x, y, ok, ds)
+ ELSE
+ hx := x1 ;
+ hy := y1 ;
+ ClipPoint(hx, hy, ScreenX, ScreenY, ok) ;
+ DrawL.DLine(i, j, x, y, ok, ds)
+ END ;
+ ReleaseAccessToScreenNo(p)
+ END
+ END
+ END
+ END
+ END
+END DrawDoor ;
+
+
+(* This procedure only uses LOCKS GetAccessToScreen *)
+
+PROCEDURE DrawTreasure (room, x, y: CARDINAL) ;
+VAR
+ p : CARDINAL ;
+ Sx, Sy: CARDINAL ;
+BEGIN
+ p := 0 ;
+ WHILE p < NextFreePlayer DO
+ IF IsPlayerActive(p)
+ THEN
+ WITH Player[p] DO
+ IF room=RoomOfMan
+ THEN
+ Sy := ScreenY ;
+ Sx := ScreenX ;
+ IF (x>=Sx) AND (x<=Sx+Width) AND
+ (y>=Sy) AND (y<=Sy+Height)
+ THEN
+ GetAccessToScreenNo(p) ;
+ DrawL.DTreasure(x-Sx, y-Sy) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ END
+ END
+ END ;
+ INC (p)
+ END
+END DrawTreasure ;
+
+
+PROCEDURE EraseTreasure (room, x, y: CARDINAL) ;
+VAR
+ p : CARDINAL ;
+ Sx, Sy: CARDINAL ;
+BEGIN
+ p := 0 ;
+ WHILE p < NextFreePlayer DO
+ IF IsPlayerActive(p)
+ THEN
+ WITH Player[p] DO
+ IF room=RoomOfMan
+ THEN
+ Sy := ScreenY ;
+ Sx := ScreenX ;
+ IF (x>=Sx) AND (x<=Sx+Width) AND
+ (y>=Sy) AND (y<=Sy+Height)
+ THEN
+ GetAccessToScreenNo(p) ;
+ DrawL.Erase(x-Sx, y-Sy) ;
+ Flush(p) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ END
+ END
+ END ;
+ INC (p)
+ END
+END EraseTreasure ;
+
+
+(* This procedure only uses LOCKS GetAccessToScreen *)
+
+PROCEDURE DrawArrow (room, x, y, dir: CARDINAL ; VAR playerscreen: PlayerSet) ;
+VAR
+ p, Sx, Sy: CARDINAL ;
+BEGIN
+ playerscreen := PlayerSet{} ;
+ p := 0 ;
+ WHILE p < NextFreePlayer DO
+ IF IsPlayerActive(p)
+ THEN
+ WITH Player[p] DO
+ IF room=RoomOfMan
+ THEN
+ Sy := ScreenY ;
+ Sx := ScreenX ;
+ IF (x>=Sx) AND (x<=Sx+Width) AND
+ (y>=Sy) AND (y<=Sy+Height)
+ THEN
+ INCL(playerscreen, p) ;
+ GetAccessToScreenNo(p) ;
+ DrawL.DArrow(x-Sx, y-Sy, dir) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ END
+ END
+ END ;
+ INC (p)
+ END
+END DrawArrow ;
+
+
+PROCEDURE EraseArrow (x, y: CARDINAL ; playerscreen: PlayerSet; flush: BOOLEAN) ;
+VAR
+ p, Sx, Sy: CARDINAL ;
+BEGIN
+ p := 0 ;
+ WHILE p < NextFreePlayer DO
+ IF IsPlayerActive(p)
+ THEN
+ WITH Player[p] DO
+ IF p IN playerscreen
+ THEN
+ Sy := ScreenY ;
+ Sx := ScreenX ;
+ IF (x>=Sx) AND (x<=Sx+Width) AND
+ (y>=Sy) AND (y<=Sy+Height)
+ THEN
+ GetAccessToScreenNo(p) ;
+ DrawL.Erase(x-Sx, y-Sy) ;
+ IF flush
+ THEN
+ Flush(p)
+ END ;
+ ReleaseAccessToScreenNo(p)
+ END
+ END
+ END
+ END ;
+ INC (p)
+ END
+END EraseArrow ;
+
+
+PROCEDURE DisplayMessage (a1, a2, a3: ARRAY OF CHAR) ;
+VAR
+ i, p, r: CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ GetReadAccessToPlayer ;
+ r := Player[p].RoomOfMan ;
+ FOR i := 0 TO NextFreePlayer-1 DO
+ IF IsPlayerActive(i)
+ THEN
+ WITH Player[i] DO
+ IF r=RoomOfMan
+ THEN
+ GetAccessToScreenNo(i) ;
+ WriteCommentLine1(i, a1) ;
+ WriteCommentLine2(i, a2) ;
+ WriteCommentLine3(i, a3) ;
+ ReleaseAccessToScreenNo(i)
+ END
+ END
+ END
+ END ;
+ ReleaseReadAccessToPlayer
+END DisplayMessage ;
+
+
+END DrawG.
+(*
+ * Local variables:
+ * compile-command: "make"
+ * End:
+ *)
--- /dev/null
+DEFINITION MODULE DrawL ;
+
+FROM AdvMap IMPORT DoorStatus ;
+EXPORT QUALIFIED DrawRoom, ClearRoom, DrawAllPlayers, EraseAllPlayers,
+ StrPoint, DTreasure, Erase, DrawMan, DLine, DArrow ;
+
+
+PROCEDURE DrawRoom ;
+PROCEDURE ClearRoom (r: CARDINAL) ;
+PROCEDURE DrawAllPlayers ;
+PROCEDURE EraseAllPlayers ;
+
+(* and some low level string routines *)
+
+PROCEDURE StrPoint (a: ARRAY OF CHAR; x, y: CARDINAL) ;
+PROCEDURE DTreasure (x, y: CARDINAL) ;
+PROCEDURE Erase (x, y: CARDINAL) ;
+PROCEDURE DrawMan (other: BOOLEAN; x, y, dir: CARDINAL) ;
+PROCEDURE DLine (x1, y1, x2, y2: CARDINAL; hinge: BOOLEAN; ds: DoorStatus) ;
+PROCEDURE DArrow (x, y, dir: CARDINAL) ;
+
+
+END DrawL.
--- /dev/null
+IMPLEMENTATION MODULE DrawL ;
+
+
+FROM ASCII IMPORT lf, bs ;
+FROM Window IMPORT Clip, ClipPoint ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard ;
+FROM StdIO IMPORT Write ;
+FROM Debug IMPORT Halt ;
+FROM Assertion IMPORT Assert ;
+
+FROM AdvMap IMPORT Rooms, DoorStatus, Line, Room, Door, Treasure ;
+
+FROM AdvMath IMPORT MaxNoOfTreasures ;
+
+FROM AdvSystem IMPORT Player, PlayerNo,
+ IsPlayerActive,
+ NextFreePlayer,
+ GetAccessToScreen,
+ ReleaseAccessToScreen,
+ GetAccessToScreenNo,
+ ReleaseAccessToScreenNo,
+ GetWriteAccessToPlayer,
+ ReleaseWriteAccessToPlayer,
+ GetReadAccessToPlayer,
+ ReleaseReadAccessToPlayer,
+ GetReadAccessToDoor,
+ ReleaseReadAccessToDoor,
+ GetReadAccessToTreasure,
+ ReleaseReadAccessToTreasure ;
+
+
+(* Draws the current Room that the callers player is in. It also draws *)
+(* all treasures, doors and players associated with this room. This *)
+(* procedure DOES get access to treasure locks and door locks but NO *)
+(* player lock is used. *)
+(* This procedure does NOT draw SECRET doors as might give them away! *)
+(* It is assumed that walls cover ALL doors. *)
+
+PROCEDURE DrawRoom ;
+VAR
+ ok : BOOLEAN ;
+ hx, hy,
+ x1, y1, x2, y2,
+ p, t, r, i,
+ Sx, Sy : CARDINAL ;
+ ds : DoorStatus ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+
+ r := RoomOfMan ;
+ Sx := ScreenX ;
+ Sy := ScreenY ;
+ t := Rooms[r].NoOfWalls ;
+ FOR i := 1 TO t DO
+ WITH Rooms[r].Walls[i] DO
+ x1 := X1 ;
+ y1 := Y1 ;
+ x2 := X2 ;
+ y2 := Y2
+ END ;
+ Clip( x1, y1, x2, y2, Sx, Sy, ok ) ;
+
+ IF ok
+ THEN
+ GetAccessToScreen ;
+ WLine(x1, y1, x2, y2) ;
+ ReleaseAccessToScreen
+ END
+ END ;
+
+ GetReadAccessToDoor ;
+ t := Rooms[r].NoOfDoors ;
+ FOR i := 1 TO t DO
+ WITH Rooms[r].Doors[i] DO
+ x1 := Position.X1 ;
+ y1 := Position.Y1 ;
+ x2 := Position.X2 ;
+ y2 := Position.Y2 ;
+ ds := StateOfDoor ;
+ IF ds#Secret
+ THEN
+ Clip( x1, y1, x2, y2, Sx, Sy, ok ) ;
+ IF ok
+ THEN
+ GetAccessToScreen ;
+ IF Position.X1=Position.X2
+ THEN
+ hx := Position.X2 ;
+ hy := Position.Y2 ;
+ Assert((ScreenX=Sx) AND (ScreenY=Sy)) ;
+ ClipPoint(hx, hy, ScreenX, ScreenY, ok) ;
+ DLine(x1, y1, x2, y2, ok, ds)
+ ELSE
+ hx := Position.X1 ;
+ hy := Position.Y1 ;
+ Assert((ScreenX=Sx) AND (ScreenY=Sy)) ;
+ ClipPoint(hx, hy, ScreenX, ScreenY, ok) ;
+ DLine(x1, y1, x2, y2, ok, ds)
+ END ;
+ ReleaseAccessToScreen
+ END
+ END
+ END
+ END ;
+ ReleaseReadAccessToDoor ;
+
+ GetReadAccessToTreasure ;
+ FOR i := 1 TO MaxNoOfTreasures DO
+ WITH Rooms[r] DO
+ IF i IN Treasures
+ THEN
+ x1 := Treasure[i].Xpos ;
+ y1 := Treasure[i].Ypos ;
+ ClipPoint(x1, y1, ScreenX, ScreenY, ok) ;
+ IF ok
+ THEN
+ GetAccessToScreen ;
+ DTreasure(x1, y1) ;
+ ReleaseAccessToScreen
+ END
+ END
+ END
+ END ;
+ ReleaseReadAccessToTreasure ;
+ END ;
+
+ (* This called routine must now draw the other players as well *)
+ (* as drawing the current man. *)
+ (* Assumes that this player has been updated in Data Structure *)
+ (* but has not yet been displayed on the screen. *)
+
+ DrawAllPlayers ;
+
+END DrawRoom ;
+
+
+(* Draw all players uses no player lock. *)
+
+PROCEDURE DrawAllPlayers ;
+VAR
+ pn,
+ Sx, Sy, dir, p: CARDINAL ;
+ x, y, r : CARDINAL ;
+ ok : BOOLEAN ;
+ ch : CHAR ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ Sx := ScreenX ;
+ Sy := ScreenY ;
+ r := RoomOfMan ;
+ dir := Direction ;
+ x := Xman-Sx ;
+ y := Yman-Sy ;
+ GetAccessToScreenNo(p) ;
+ DrawMan(FALSE, x, y, dir) ;
+ ReleaseAccessToScreenNo(p)
+ END ;
+
+ (* Now write all the other Players on the screen *)
+
+ FOR pn := 0 TO NextFreePlayer-1 DO
+ IF (pn#p) AND IsPlayerActive(pn)
+ THEN
+ WITH Player[pn] DO
+ IF r=RoomOfMan
+ THEN
+ x := Xman ;
+ y := Yman ;
+ dir := Direction ;
+ ClipPoint(x, y, Sx, Sy, ok) ;
+ IF ok
+ THEN
+ GetAccessToScreenNo( p ) ;
+ DrawMan(TRUE, x, y, dir) ;
+ ReleaseAccessToScreenNo( p )
+ END
+ END
+ END
+ END
+ END
+END DrawAllPlayers ;
+
+
+(* This procedure uses no player lock. *)
+
+PROCEDURE EraseAllPlayers ;
+VAR
+ pn,
+ Sx, Sy, p: CARDINAL ;
+ x, y, r : CARDINAL ;
+ ok : BOOLEAN ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ Sx := ScreenX ;
+ Sy := ScreenY ;
+ r := RoomOfMan ;
+ x := Xman-Sx ;
+ y := Yman-Sy ;
+ GetAccessToScreenNo(p) ;
+ Erase(x, y) ;
+ ReleaseAccessToScreenNo(p)
+ END ;
+
+ (* Now write all the other Players on the screen *)
+
+ FOR pn := 0 TO NextFreePlayer-1 DO
+ IF (pn#p) AND IsPlayerActive(pn)
+ THEN
+ WITH Player[pn] DO
+ IF r=RoomOfMan
+ THEN
+ x := Xman ;
+ y := Yman ;
+ ClipPoint(x, y, Sx, Sy, ok) ;
+ IF ok
+ THEN
+ GetAccessToScreenNo(p) ;
+ Erase(x, y) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ END
+ END
+ END
+ END
+END EraseAllPlayers ;
+
+
+(* Clears the Room specified of all treasures and all OTHER players. *)
+(* It uses NO lock on any Player. But uses Treasure Lock. *)
+
+PROCEDURE ClearRoom (r: CARDINAL) ;
+VAR
+ p, Sx, Sy,
+ x, y, pn,
+ x1, y1, i: CARDINAL ;
+ ok : BOOLEAN ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ Sx := ScreenX ;
+ Sy := ScreenY ;
+ GetReadAccessToTreasure ;
+ FOR i := 1 TO MaxNoOfTreasures DO
+ WITH Rooms[r] DO
+ IF i IN Treasures
+ THEN
+ x1 := Treasure[i].Xpos ;
+ y1 := Treasure[i].Ypos ;
+ ClipPoint(x1, y1, Sx, Sy, ok) ;
+ IF ok
+ THEN
+ GetAccessToScreenNo(p) ;
+ Erase(x1, y1) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ END
+ END
+ END ;
+ ReleaseReadAccessToTreasure
+ END ;
+
+ (* Now erase all the other Players on the screen *)
+
+ FOR pn := 0 TO NextFreePlayer-1 DO
+ IF p#pn
+ THEN
+ WITH Player[pn] DO
+ IF r=RoomOfMan
+ THEN
+ x := Xman ;
+ y := Yman ;
+ ClipPoint(x, y, Sx, Sy, ok) ;
+ IF ok
+ THEN
+ GetAccessToScreenNo(p) ;
+ Erase(x, y) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ END
+ END
+ END
+ END
+END ClearRoom ;
+
+
+PROCEDURE StrLine (a: ARRAY OF CHAR; x1, y1, x2, y2: CARDINAL) ;
+BEGIN
+ WriteString(a) ; Write(' ') ;
+ WriteCard(x1, 0) ; Write(' ') ;
+ WriteCard(y1, 0) ; Write(' ') ;
+ WriteCard(x2, 0) ; Write(' ') ;
+ WriteCard(y2, 0) ; WriteLn
+END StrLine ;
+
+
+PROCEDURE WLine (x1, y1, x2, y2: CARDINAL) ;
+BEGIN
+ IF y1=y2
+ THEN
+ StrLine('hwall', x1, y1, x2, y2)
+ ELSE
+ Assert(x1=x2) ;
+ StrLine('vwall', x1, y1, x2, y2)
+ END
+END WLine ;
+
+
+PROCEDURE DLine (x1, y1, x2, y2: CARDINAL; hinge: BOOLEAN; ds: DoorStatus) ;
+VAR
+ x, ys: CARDINAL ;
+BEGIN
+ IF y1=y2
+ THEN
+ CASE ds OF
+
+ Closed: IF hinge
+ THEN
+ WriteString('hhinge ') ; WriteCard(x1, 0) ; Write(' ') ; WriteCard(y1, 0) ; WriteLn ;
+ INC(x1)
+ END ;
+ IF x1<=x2
+ THEN
+ StrLine('hdoor', x1, y1, x2, y2)
+ END |
+ Open : StrLine('eL', x1, y1, x2, y2) |
+ Secret: WLine(x1, y1, x2, y2)
+
+ END
+ ELSE
+ CASE ds OF
+
+ Closed: IF hinge
+ THEN
+ WriteString('vhinge ') ; WriteCard(x1, 0) ; Write(' ') ; WriteCard(y2, 0) ; WriteLn ;
+ DEC(y2)
+ END ;
+ IF y1<=y2
+ THEN
+ StrLine('vdoor', x1, y1, x2, y2)
+ END |
+ Open : StrLine('eL', x1, y1, x2, y2) |
+ Secret: WLine(x1, y1, x2, y2)
+
+ END
+ END
+END DLine ;
+
+
+PROCEDURE StrPoint (a: ARRAY OF CHAR; x, y: CARDINAL) ;
+BEGIN
+ WriteString(a) ; Write(' ') ;
+ WriteCard(x, 0) ; Write(' ') ;
+ WriteCard(y, 0) ; WriteLn
+END StrPoint ;
+
+
+PROCEDURE DTreasure (x, y: CARDINAL) ;
+BEGIN
+ StrPoint('treasure', x, y)
+END DTreasure ;
+
+
+PROCEDURE Erase (x, y: CARDINAL) ;
+BEGIN
+ StrPoint('eL', x, y)
+END Erase ;
+
+
+PROCEDURE DrawMan (other: BOOLEAN; x, y, dir: CARDINAL) ;
+BEGIN
+ IF other
+ THEN
+ CASE dir OF
+
+ 0: StrPoint('Nman', x, y) |
+ 1: StrPoint('Wman', x, y) |
+ 2: StrPoint('Sman', x, y) |
+ 3: StrPoint('Eman', x, y)
+
+ ELSE
+ Halt(__FILE__, __LINE__, __FUNCTION__, 'unexpected direction')
+ END
+ ELSE
+ CASE dir OF
+
+ 0: StrPoint('nman', x, y) |
+ 1: StrPoint('wman', x, y) |
+ 2: StrPoint('sman', x, y) |
+ 3: StrPoint('eman', x, y)
+
+ ELSE
+ Halt(__FILE__, __LINE__, __FUNCTION__, 'unexpected direction')
+ END
+ END
+END DrawMan ;
+
+
+PROCEDURE DArrow (x, y, dir: CARDINAL) ;
+BEGIN
+ CASE dir OF
+
+ 0: StrPoint('nar', x, y) |
+ 1: StrPoint('war', x, y) |
+ 2: StrPoint('sar', x, y) |
+ 3: StrPoint('ear', x, y)
+
+ ELSE
+ Halt(__FILE__, __LINE__, __FUNCTION__, 'unexpected direction')
+ END
+END DArrow ;
+
+
+END DrawL.
+(*
+ * Local variables:
+ * compile-command: "make"
+ * End:
+ *)
--- /dev/null
+MODULE Dungeon ;
+(* *)
+
+FROM AdvIntroduction IMPORT StartGame ;
+FROM SArgs IMPORT GetArg ;
+FROM AdvParse IMPORT ParseMap ;
+FROM DynamicStrings IMPORT String, string ;
+FROM libc IMPORT printf, exit ;
+FROM Screen IMPORT AssignMapName ;
+
+
+VAR
+ s: String ;
+ r: INTEGER ;
+BEGIN
+ IF GetArg(s, 1)
+ THEN
+ r := ParseMap(string(s)) ;
+ IF r=0
+ THEN
+ AssignMapName(s) ;
+ StartGame
+ ELSE
+ exit(r)
+ END
+ ELSE
+ r := printf("usage: dungeon mapfile\n")
+ END
+END Dungeon.
+(*
+ * Local variables:
+ * compile-command: "make"
+ * End:
+ *)
--- /dev/null
+DEFINITION MODULE Lock ;
+
+(*
+ Author : Gaius Mulley
+ Title : Lock
+ Date : 12/2/86
+ Version : 1.0
+ Last Edit : 22/7/86
+ Description: Lock - Implements a Read / Write Lock
+*)
+
+EXPORT QUALIFIED LOCK,
+ GetReadAccess, ReleaseReadAccess,
+ GetWriteAccess, ReleaseWriteAccess,
+ InitLock ;
+
+TYPE
+ LOCK ;
+
+PROCEDURE GetReadAccess (l: LOCK) ;
+PROCEDURE ReleaseReadAccess (l: LOCK) ;
+PROCEDURE GetWriteAccess (l: LOCK) ;
+PROCEDURE ReleaseWriteAccess (l: LOCK) ;
+PROCEDURE InitLock (Name: ARRAY OF CHAR) : LOCK ;
+
+
+END Lock.
--- /dev/null
+IMPLEMENTATION MODULE Lock ;
+
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM Executive IMPORT Wait, Signal, InitSemaphore,
+ SEMAPHORE ;
+
+
+TYPE
+ LOCK = POINTER TO RECORD
+ Mutex : SEMAPHORE ;
+ ReadCount : CARDINAL ;
+ Wrt : SEMAPHORE ;
+ END ;
+
+
+PROCEDURE InitLock (Name: ARRAY OF CHAR) : LOCK ;
+VAR
+ l: LOCK ;
+BEGIN
+ NEW( l ) ;
+ WITH l^ DO
+ Mutex := InitSemaphore(1, Name) ;
+ Wrt := InitSemaphore(1, Name) ;
+ ReadCount := 0
+ END ;
+ RETURN( l )
+END InitLock ;
+
+
+PROCEDURE GetReadAccess (l: LOCK) ;
+BEGIN
+ WITH l^ DO
+ Wait( Mutex ) ;
+ INC( ReadCount ) ;
+ IF ReadCount=1
+ THEN
+ Wait( Wrt )
+ END ;
+ Signal( Mutex )
+ END
+END GetReadAccess ;
+
+
+PROCEDURE ReleaseReadAccess (l: LOCK) ;
+BEGIN
+ WITH l^ DO
+ Wait( Mutex ) ;
+ DEC( ReadCount ) ;
+ IF ReadCount=0
+ THEN
+ Signal( Wrt )
+ END ;
+ Signal( Mutex )
+ END
+END ReleaseReadAccess ;
+
+
+PROCEDURE GetWriteAccess (l: LOCK) ;
+BEGIN
+ WITH l^ DO
+ Wait( Wrt )
+ END
+END GetWriteAccess ;
+
+
+PROCEDURE ReleaseWriteAccess (l: LOCK) ;
+BEGIN
+ WITH l^ DO
+ Signal( Wrt )
+ END
+END ReleaseWriteAccess ;
+
+
+END Lock.
--- /dev/null
+DEFINITION MODULE ProcArgs ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT QUALIFIED ProcessArgs,
+ InitArgs, SetArgs, CollectArgs, KillArgs ;
+
+TYPE
+ ProcessArgs ;
+
+PROCEDURE InitArgs () : ProcessArgs ;
+PROCEDURE SetArgs (p: ProcessArgs; a: ADDRESS) : ADDRESS ;
+PROCEDURE CollectArgs (p: ProcessArgs) : ADDRESS ;
+PROCEDURE KillArgs (p: ProcessArgs) : ProcessArgs ;
+
+END ProcArgs.
--- /dev/null
+IMPLEMENTATION MODULE ProcArgs ;
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM Executive IMPORT SEMAPHORE, InitSemaphore, Wait, Signal ;
+
+TYPE
+ ProcessArgs = POINTER TO RECORD
+ argPtr: ADDRESS ;
+ taken,
+ given : SEMAPHORE ;
+ END ;
+
+PROCEDURE InitArgs () : ProcessArgs ;
+VAR
+ p: ProcessArgs ;
+BEGIN
+ NEW(p) ;
+ WITH p^ DO
+ taken := InitSemaphore(1, 'ProcArgs') ;
+ given := InitSemaphore(0, 'ProcArgs') ;
+ argPtr := NIL
+ END ;
+ RETURN( p )
+END InitArgs ;
+
+
+PROCEDURE SetArgs (p: ProcessArgs; a: ADDRESS) : ADDRESS ;
+BEGIN
+ WITH p^ DO
+ Wait(taken) ;
+ argPtr := a ;
+ Signal(given)
+ END ;
+ RETURN( NIL )
+END SetArgs ;
+
+
+PROCEDURE CollectArgs (p: ProcessArgs) : ADDRESS ;
+VAR
+ a: ADDRESS ;
+BEGIN
+ WITH p^ DO
+ Wait(given) ;
+ a := argPtr ;
+ Signal(taken)
+ END ;
+ RETURN( a )
+END CollectArgs ;
+
+
+PROCEDURE KillArgs (p: ProcessArgs) : ProcessArgs ;
+BEGIN
+ DISPOSE(p) ;
+ RETURN( NIL )
+END KillArgs ;
+
+
+END ProcArgs.
--- /dev/null
+DEFINITION MODULE Screen ;
+
+FROM DynamicStrings IMPORT String ;
+EXPORT QUALIFIED ClearScreen, WriteString, PromptString,
+ InitScreen, WriteName, WriteFloor, WriteRoom,
+ WriteWounds, WriteFatigue, WriteMagicArrows,
+ WriteArrows, WriteTime, WriteCommand, WriteWeight,
+ WriteCommentLine1, WriteCommentLine2, WriteCommentLine3,
+ DelCommentLine1, DelCommentLine2, DelCommentLine3,
+ Pause, AssignMapName, Quit, Flush,
+ Width, Height,
+ InnerX, OuterX, InnerY, OuterY, OffX, OffY ;
+
+
+CONST
+ Width = 29 ; (* 0..29 Horizontal Width *)
+ Height= 31 ; (* 0..31 Vertical Height *)
+
+ InnerX= 5 ; (* when do we adjust screen *)
+ OuterX= Width-InnerX ;
+ InnerY= 5 ;
+ OuterY= Height-InnerY ;
+
+ OffX = OuterX-InnerX ; (* To redraw screen +- Off *)
+ OffY = OuterY-InnerY ;
+
+
+PROCEDURE ClearScreen (p: CARDINAL) ;
+PROCEDURE WriteString (p: CARDINAL; a: ARRAY OF CHAR) ;
+PROCEDURE PromptString (p: CARDINAL; a: ARRAY OF CHAR) ;
+
+PROCEDURE InitScreen (p: CARDINAL) ;
+PROCEDURE WriteName (p: CARDINAL; a: ARRAY OF CHAR) ;
+PROCEDURE WriteFloor (p: CARDINAL) ;
+PROCEDURE WriteRoom (p: CARDINAL; x: CARDINAL) ;
+PROCEDURE WriteWeight (p: CARDINAL; x: CARDINAL) ;
+PROCEDURE WriteWounds (p: CARDINAL; x: CARDINAL) ;
+PROCEDURE WriteFatigue (p: CARDINAL; x: CARDINAL) ;
+PROCEDURE WriteMagicArrows (p: CARDINAL; x: CARDINAL) ;
+PROCEDURE WriteArrows (p: CARDINAL; x: CARDINAL) ;
+PROCEDURE WriteTime (p: CARDINAL) ;
+PROCEDURE WriteCommand (p: CARDINAL; ch: CHAR) ;
+PROCEDURE WriteCommentLine1 (p: CARDINAL; a: ARRAY OF CHAR) ;
+PROCEDURE WriteCommentLine2 (p: CARDINAL; a: ARRAY OF CHAR) ;
+PROCEDURE WriteCommentLine3 (p: CARDINAL; a: ARRAY OF CHAR) ;
+PROCEDURE DelCommentLine1 (p: CARDINAL) ;
+PROCEDURE DelCommentLine2 (p: CARDINAL) ;
+PROCEDURE DelCommentLine3 (p: CARDINAL) ;
+PROCEDURE Pause (p: CARDINAL) ;
+PROCEDURE AssignMapName (s: String) ;
+PROCEDURE Quit (p: CARDINAL) ;
+PROCEDURE Flush (p: CARDINAL) ;
+
+
+END Screen.
--- /dev/null
+IMPLEMENTATION MODULE Screen ;
+
+
+FROM ASCII IMPORT nul ;
+FROM StrLib IMPORT StrLen ;
+FROM TimerHandler IMPORT GetTicks, TicksPerSecond ;
+
+FROM AdvSystem IMPORT Player, PlayerNo, ClientRead,
+ GetAccessToScreenNo,
+ ReleaseAccessToScreenNo, AssignOutputTo ;
+
+FROM AdvMap IMPORT DoorStatus, FileName, MaxLengthOfFileName ;
+FROM DynamicStrings IMPORT CopyOut ;
+
+FROM StdIO IMPORT Write ;
+IMPORT NumberIO ;
+IMPORT StrIO ;
+
+
+VAR
+ mapname: ARRAY [0..12] OF CHAR ;
+
+
+PROCEDURE AssignMapName (s: String) ;
+BEGIN
+ CopyOut(mapname, s)
+END AssignMapName ;
+
+
+PROCEDURE WriteCommand (p: CARDINAL; ch: CHAR) ;
+BEGIN
+ GetAccessToScreenNo(p) ;
+ StrIO.WriteString('dCMD ') ; Write(ch) ;
+ Write(' ') ;
+ CASE ch OF
+
+ 'l' : StrIO.WriteString( 'Left ') |
+ 'r' : StrIO.WriteString( 'Right ') |
+ 'v' : StrIO.WriteString( 'Vault Turn ') |
+ '0'..'9' : StrIO.WriteString( 'Forward ') ; Write(ch) |
+ 't' : StrIO.WriteString( 'Thrust ') |
+ 'a' : StrIO.WriteString( 'Attack ') |
+ 'p' : StrIO.WriteString( 'Parry ') |
+ 'o' : StrIO.WriteString( 'Open Door ') |
+ 'c' : StrIO.WriteString( 'Close Door ') |
+ 'e' : StrIO.WriteString( 'Examine Door ') |
+ 'f' : StrIO.WriteString( 'Fire Arrow ') |
+ 'm' : StrIO.WriteString( 'Magic Arrow ') |
+ 'g' : StrIO.WriteString( 'Get Treasure ') |
+ 'd' : StrIO.WriteString( 'Drop Treasure') |
+ 'u' : StrIO.WriteString( 'Use Treasure ') |
+ 's' : StrIO.WriteString( 'Speak ') |
+ 'w' : StrIO.WriteString( 'Watch sayeth ') |
+ '|' : StrIO.WriteString( 'Exit Dungeon ')
+
+ ELSE StrIO.WriteString( 'No Command ')
+ END ;
+ StrIO.WriteLn ;
+ ReleaseAccessToScreenNo(p)
+END WriteCommand ;
+
+
+(*
+ Sync -
+*)
+
+PROCEDURE Sync (p: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('sync') ; StrIO.WriteLn
+END Sync ;
+
+
+(*
+ Flush -
+*)
+
+PROCEDURE Flush (p: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('fl') ; StrIO.WriteLn
+END Flush ;
+
+
+(*
+ ClearScreen -
+*)
+
+PROCEDURE ClearScreen (p: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('clear') ; StrIO.WriteLn
+END ClearScreen ;
+
+PROCEDURE WriteName (p: CARDINAL; n: ARRAY OF CHAR) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('dN ') ; StrIO.WriteString(n) ; StrIO.WriteLn
+END WriteName ;
+
+PROCEDURE WriteRoom (p: CARDINAL; r: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('dR ') ; NumberIO.WriteCard(r, 0) ; StrIO.WriteLn
+END WriteRoom ;
+
+PROCEDURE WriteWounds (p: CARDINAL; w: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('dW ') ; NumberIO.WriteCard(w, 0) ; StrIO.WriteLn
+END WriteWounds ;
+
+PROCEDURE WriteFatigue (p: CARDINAL; f: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('dF ') ; NumberIO.WriteCard(f, 0) ; StrIO.WriteLn
+END WriteFatigue ;
+
+PROCEDURE WriteMagicArrows (p: CARDINAL; m: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('dM ') ; NumberIO.WriteCard(m, 0) ; StrIO.WriteLn
+END WriteMagicArrows ;
+
+PROCEDURE WriteArrows (p: CARDINAL; a: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('dA ') ; NumberIO.WriteCard(a, 0) ; StrIO.WriteLn
+END WriteArrows ;
+
+PROCEDURE WriteWeight (p: CARDINAL; w: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('dw ') ; NumberIO.WriteCard(w, 0) ; StrIO.WriteLn
+END WriteWeight ;
+
+PROCEDURE WriteTime (p: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('dT ') ;
+ NumberIO.WriteCard((GetTicks() DIV TicksPerSecond) DIV 60, 0) ;
+ Write(':') ;
+ NumberIO.WriteCard((GetTicks() DIV TicksPerSecond) MOD 60, 0) ;
+ StrIO.WriteLn
+END WriteTime ;
+
+PROCEDURE WriteFloor (p: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('dMap ') ; StrIO.WriteString('mapname') ; StrIO.WriteLn
+END WriteFloor ;
+
+PROCEDURE InitScreen (p: CARDINAL) ;
+BEGIN
+ GetAccessToScreenNo(p) ;
+ Sync(p) ;
+ ClearScreen(p) ;
+
+ WITH Player[p] DO
+ WriteName(p, ManName) ;
+ WriteFloor(p) ;
+ WriteRoom(p, RoomOfMan) ;
+ WriteWounds(p, Wounds) ;
+ WriteFatigue(p, Fatigue) ;
+ WriteMagicArrows(p, NoOfMagic) ;
+ WriteArrows(p, NoOfNormal) ;
+ WriteWeight(p, Weight) ;
+ WriteTime(p)
+ END ;
+ ReleaseAccessToScreenNo(p)
+END InitScreen ;
+
+
+PROCEDURE WriteCommentLine1 (p: CARDINAL; a: ARRAY OF CHAR) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('dC1 ') ; StrIO.WriteString(a) ; StrIO.WriteLn
+END WriteCommentLine1 ;
+
+
+PROCEDURE WriteCommentLine2 (p: CARDINAL; a: ARRAY OF CHAR) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('dC2 ') ; StrIO.WriteString(a) ; StrIO.WriteLn
+END WriteCommentLine2 ;
+
+
+PROCEDURE WriteCommentLine3 (p: CARDINAL; a: ARRAY OF CHAR) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('dC3 ') ; StrIO.WriteString(a) ; StrIO.WriteLn
+END WriteCommentLine3 ;
+
+
+PROCEDURE DelCommentLine1 (p: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ WriteCommentLine1(p, '')
+END DelCommentLine1 ;
+
+
+PROCEDURE DelCommentLine2 (p: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ WriteCommentLine2(p, '')
+END DelCommentLine2 ;
+
+
+PROCEDURE DelCommentLine3 (p: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ WriteCommentLine3(p, '')
+END DelCommentLine3 ;
+
+
+(*
+ Pause - issues a pause message and waits for a character to be pressed.
+*)
+
+PROCEDURE Pause (p: CARDINAL) ;
+VAR
+ ch: CHAR ;
+BEGIN
+ AssignOutputTo(p) ;
+ WriteCommentLine2(p, 'Press any key') ;
+ WriteCommentLine3(p, 'to continue') ;
+ IF ClientRead(ch)
+ THEN
+ END
+END Pause ;
+
+
+PROCEDURE Quit (p: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('quit') ; StrIO.WriteLn
+END Quit ;
+
+
+(*
+ PromptString - writes a text message to the client console.
+ without the final 'newline'
+*)
+
+PROCEDURE PromptString (p: CARDINAL; a: ARRAY OF CHAR) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('dWriteStr ') ;
+ StrIO.WriteString(a) ;
+ StrIO.WriteLn
+END PromptString ;
+
+
+(*
+ WriteString - writes a text message to the client console.
+*)
+
+PROCEDURE WriteString (p: CARDINAL; a: ARRAY OF CHAR) ;
+VAR
+ start,
+ needEol: BOOLEAN ;
+ i, j, n: CARDINAL ;
+BEGIN
+ AssignOutputTo(p) ;
+ n := StrLen(a) ;
+ i := 0 ;
+ start := TRUE ;
+ needEol := FALSE ;
+ WHILE i<n DO
+ IF (a[i]='\') AND (a[i+1]='n')
+ THEN
+ IF start
+ THEN
+ StrIO.WriteString('dWriteLn ')
+ END ;
+ StrIO.WriteLn ;
+ start := TRUE ;
+ needEol := FALSE ;
+ INC(i)
+ ELSE
+ IF start
+ THEN
+ StrIO.WriteString('dWriteLn ') ;
+ start := FALSE
+ END ;
+ Write(a[i]) ;
+ needEol := TRUE
+ END ;
+ INC(i)
+ END ;
+ IF needEol
+ THEN
+ StrIO.WriteLn
+ END
+END WriteString ;
+
+
+END Screen.
+(*
+ * Local variables:
+ * compile-command: "make"
+ * End:
+ *)
--- /dev/null
+
+#include <unistd.h>
+#include <fcntl.h>
+#include <signal.h>
+
+
+int SocketControl_nonBlocking (int fd)
+{
+ return fcntl (fd, fcntl (fd, F_GETFL) | O_NONBLOCK);
+}
+
+int SocketControl_ignoreSignals (void)
+{
+ signal (SIGPIPE, SIG_IGN);
+}
+
+void _M2_SocketControl_init (int, char *, char *)
+{
+}
+
+void _M2_SocketControl_finish (int, char *, char *)
+{
+}
+
+void _M2_SocketControl_ctor ()
+{
+}
--- /dev/null
+DEFINITION MODULE SocketControl ;
+
+PROCEDURE nonBlocking (fd: INTEGER) : INTEGER ;
+PROCEDURE ignoreSignals ;
+
+END SocketControl.
--- /dev/null
+DEFINITION MODULE Window ;
+
+
+EXPORT QUALIFIED ClipPoint, Clip ;
+
+
+PROCEDURE ClipPoint (VAR x, y: CARDINAL ; Sx, Sy: CARDINAL ; VAR ok: BOOLEAN) ;
+
+
+PROCEDURE Clip (VAR x1,y1,x2,y2: CARDINAL ;
+ Sx,Sy: CARDINAL ;
+ VAR ok: BOOLEAN) ;
+
+
+END Window.
+
--- /dev/null
+IMPLEMENTATION MODULE Window ;
+
+
+FROM Screen IMPORT Width, Height ;
+
+
+
+PROCEDURE ClipPoint (VAR x, y: CARDINAL ; Sx, Sy: CARDINAL ; VAR ok: BOOLEAN) ;
+BEGIN
+ IF (x>=Sx) AND (x<=Sx+Width) AND
+ (y>=Sy) AND (y<=Sy+Height)
+ THEN
+ DEC(x, Sx) ;
+ DEC(y, Sy) ;
+ ok := TRUE
+ ELSE
+ ok := FALSE
+ END
+END ClipPoint ;
+
+
+PROCEDURE Clip (VAR x1, y1, x2, y2: CARDINAL ;
+ Sx, Sy: CARDINAL ;
+ VAR ok: BOOLEAN) ;
+BEGIN
+ IF (Sx>x2) OR (Sx+Width<x1)
+ THEN
+ ok := FALSE ;
+ ELSIF (Sy>y2) OR (Sy+Height<y1)
+ THEN
+ ok := FALSE
+ ELSE
+ ok := TRUE ;
+ IF Sx>x1
+ THEN
+ x1 := 0
+ ELSE
+ DEC(x1, Sx)
+ END ;
+ IF Sy>y1
+ THEN
+ y1 := 0
+ ELSE
+ DEC(y1, Sy)
+ END ;
+ IF x2-Sx>Width
+ THEN
+ x2 := Width
+ ELSE
+ DEC(x2, Sx)
+ END ;
+ IF y2-Sy>Height
+ THEN
+ y2 := Height
+ ELSE
+ DEC(y2, Sy)
+ END
+ END
+END Clip ;
+
+
+END Window.
--- /dev/null
+%{
+/* Copyright (C) 2022 Free Software Foundation, Inc.
+ This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 2, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING. If not, write to the Free Software
+Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ */
+
+ /*
+ * adv.flex - provides a lexical analyser for Dungeon
+ */
+
+ struct lineInfo {
+ char *linebuf; /* line contents */
+ int linelen; /* length */
+ int tokenpos; /* start position of token within line */
+ int toklen; /* a copy of yylen (length of token) */
+ int nextpos; /* position after token */
+ int actualline; /* line number of this line */
+ };
+
+ static int lineno =1; /* a running count of the file line number */
+ static char *filename =NULL;
+ static struct lineInfo *currentLine =NULL;
+
+ void advflex_error (const char *);
+static void finishedLine (void);
+static void resetpos (void);
+static void consumeLine (void);
+static void updatepos (void);
+static void skippos (void);
+static void poperrorskip (const char *);
+ int advflex_OpenSource (char *s);
+ int advflex_GetLineNo (void);
+ void advflex_CloseSource(void);
+ char *advflex_GetToken (void);
+ void _M2_advflex_init (int, char *, char *);
+ void _M2_advflex_finish (int, char *, char *);
+ void _M2_advflex_ctor (void);
+extern void yylex (void);
+
+#if !defined(TRUE)
+# define TRUE (1==1)
+#endif
+#if !defined(FALSE)
+# define FALSE (1==0)
+#endif
+
+typedef enum {eoftok, roomtok, doortok, walltok, treasuretok, attok,
+ leadstok, totok, statustok, closedtok, opentok, secrettok,
+ istok, endtok, enddottok, integertok, randomizetok} toktype ;
+
+toktype advflex_currenttoken;
+char *advflex_currentident;
+int advflex_currentinteger;
+
+
+#define YY_DECL void yylex (void)
+%}
+
+%%
+
+\n.* { consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ }
+[0-9]+ { updatepos();
+ advflex_currenttoken = integertok;
+ advflex_currentinteger = atoi(yytext);
+ return; }
+[ \t]* { updatepos(); }
+ROOM { updatepos(); advflex_currenttoken = roomtok; return; }
+END { updatepos(); advflex_currenttoken = endtok; return; }
+WALL { updatepos(); advflex_currenttoken = walltok; return; }
+DOOR { updatepos(); advflex_currenttoken = doortok; return; }
+STATUS { updatepos(); advflex_currenttoken = statustok; return; }
+CLOSED { updatepos(); advflex_currenttoken = closedtok; return; }
+OPEN { updatepos(); advflex_currenttoken = opentok; return; }
+SECRET { updatepos(); advflex_currenttoken = secrettok; return; }
+LEADS { updatepos(); advflex_currenttoken = leadstok; return; }
+TO { updatepos(); advflex_currenttoken = totok; return; }
+TREASURE { updatepos(); advflex_currenttoken = treasuretok; return; }
+AT { updatepos(); advflex_currenttoken = attok; return; }
+IS { updatepos(); advflex_currenttoken = istok; return; }
+END. { updatepos(); advflex_currenttoken = enddottok; return; }
+RANDOMIZE { updatepos(); advflex_currenttoken = randomizetok; return; }
+<<EOF>> { updatepos(); advflex_currenttoken = eoftok; return; }
+
+%%
+
+/*
+ * consumeLine - reads a line into a buffer, it then pushes back the whole
+ * line except the initial \n.
+ */
+
+static void consumeLine (void)
+{
+ if (currentLine->linelen<yyleng) {
+ currentLine->linebuf = (char *)realloc (currentLine->linebuf, yyleng);
+ currentLine->linelen = yyleng;
+ }
+ strcpy(currentLine->linebuf, yytext+1); /* copy all except the initial \n */
+ lineno++;
+ currentLine->actualline = lineno;
+ currentLine->tokenpos=0;
+ currentLine->nextpos=0;
+ yyless(1); /* push back all but the \n */
+}
+
+/*
+ * updatepos - updates the current token position.
+ * Should be used when a rule matches a token.
+ */
+
+static void updatepos (void)
+{
+ currentLine->nextpos = currentLine->tokenpos+yyleng;
+ currentLine->toklen = yyleng;
+}
+
+/*
+ * skippos - skips over this token. This function should be called
+ * if we are not returning and thus not calling getToken.
+ */
+
+static void skippos (void)
+{
+ currentLine->tokenpos = currentLine->nextpos;
+}
+
+/*
+ * initLine - initializes a currentLine
+ */
+
+static void initLine (void)
+{
+ currentLine = (struct lineInfo *)malloc (sizeof(struct lineInfo));
+
+ if (currentLine == NULL)
+ perror("malloc");
+ currentLine->linebuf = NULL;
+ currentLine->linelen = 0;
+ currentLine->tokenpos = 0;
+ currentLine->toklen = 0;
+ currentLine->nextpos = 0;
+ currentLine->actualline = lineno;
+}
+
+/*
+ * resetpos - resets the position of the next token to the start of the line.
+ */
+
+static void resetpos (void)
+{
+ if (currentLine != NULL)
+ currentLine->nextpos = 0;
+}
+
+/*
+ * advflex_GetToken - returns a new token.
+ */
+
+char *advflex_GetToken (void)
+{
+ if (currentLine == NULL)
+ initLine();
+ currentLine->tokenpos = currentLine->nextpos;
+ yylex();
+}
+
+void advflex_error (const char *s)
+{
+ if (currentLine != NULL) {
+ printf("%s:%d:%s\n", filename, currentLine->actualline, s);
+ printf("%s\n", currentLine->linebuf);
+# if 0
+ printf("%*s%*s\n", currentLine->nextpos, " ", currentLine->toklen, "^");
+# endif
+ }
+}
+
+/*
+ * OpenSource - returns TRUE if file, s, can be opened and
+ * all tokens are taken from this file.
+ */
+
+int advflex_OpenSource (char *s)
+{
+ FILE *f = fopen(s, "r");
+
+ if (f == NULL)
+ return FALSE;
+ else {
+ yy_delete_buffer(YY_CURRENT_BUFFER);
+ yy_switch_to_buffer(yy_create_buffer(f, YY_BUF_SIZE));
+ filename = strdup(s);
+ lineno =1;
+ if (currentLine != NULL)
+ currentLine->actualline = lineno;
+ return TRUE;
+ }
+}
+
+/*
+ * CloseSource - provided for semantic sugar
+ */
+
+void advflex_CloseSource (void)
+{
+}
+
+/*
+ * advflex_GetLineNo - returns the current line number.
+ */
+
+int advflex_GetLineNo (void)
+{
+ if (currentLine != NULL)
+ return currentLine->actualline;
+ else
+ return 0;
+}
+
+/*
+ * yywrap is called when end of file is seen. We push an eof token
+ * and tell the lexical analysis to stop.
+ */
+
+int yywrap (void)
+{
+ updatepos(); return 1;
+}
+
+void _M2_advflex_init (int, char *, char *)
+{
+}
+
+void _M2_advflex_finish (int, char *, char *)
+{
+}
+
+void _M2_advflex_ctor (void)
+{
+}
+
+#if 0
+main () {
+ char *s;
+
+ if (advflex_OpenSource("../maps/glover")) {
+ s = (char *)advflex_GetToken();
+ while (s != NULL) {
+ advflex_error(s);
+ s = (char *)advflex_GetToken();
+ }
+ }
+}
+#endif
--- /dev/null
+#line 2 "advflex.c"
+
+#line 4 "advflex.c"
+
+#define YY_INT_ALIGNED short int
+
+/* A lexical scanner generated by flex */
+
+#define FLEX_SCANNER
+#define YY_FLEX_MAJOR_VERSION 2
+#define YY_FLEX_MINOR_VERSION 6
+#define YY_FLEX_SUBMINOR_VERSION 4
+#if YY_FLEX_SUBMINOR_VERSION > 0
+#define FLEX_BETA
+#endif
+
+/* First, we deal with platform-specific or compiler-specific issues. */
+
+/* begin standard C headers. */
+#include <stdio.h>
+#include <string.h>
+#include <errno.h>
+#include <stdlib.h>
+
+/* end standard C headers. */
+
+/* flex integer type definitions */
+
+#ifndef FLEXINT_H
+#define FLEXINT_H
+
+/* C99 systems have <inttypes.h>. Non-C99 systems may or may not. */
+
+#if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L
+
+/* C99 says to define __STDC_LIMIT_MACROS before including stdint.h,
+ * if you want the limit (max/min) macros for int types.
+ */
+#ifndef __STDC_LIMIT_MACROS
+#define __STDC_LIMIT_MACROS 1
+#endif
+
+#include <inttypes.h>
+typedef int8_t flex_int8_t;
+typedef uint8_t flex_uint8_t;
+typedef int16_t flex_int16_t;
+typedef uint16_t flex_uint16_t;
+typedef int32_t flex_int32_t;
+typedef uint32_t flex_uint32_t;
+#else
+typedef signed char flex_int8_t;
+typedef short int flex_int16_t;
+typedef int flex_int32_t;
+typedef unsigned char flex_uint8_t;
+typedef unsigned short int flex_uint16_t;
+typedef unsigned int flex_uint32_t;
+
+/* Limits of integral types. */
+#ifndef INT8_MIN
+#define INT8_MIN (-128)
+#endif
+#ifndef INT16_MIN
+#define INT16_MIN (-32767-1)
+#endif
+#ifndef INT32_MIN
+#define INT32_MIN (-2147483647-1)
+#endif
+#ifndef INT8_MAX
+#define INT8_MAX (127)
+#endif
+#ifndef INT16_MAX
+#define INT16_MAX (32767)
+#endif
+#ifndef INT32_MAX
+#define INT32_MAX (2147483647)
+#endif
+#ifndef UINT8_MAX
+#define UINT8_MAX (255U)
+#endif
+#ifndef UINT16_MAX
+#define UINT16_MAX (65535U)
+#endif
+#ifndef UINT32_MAX
+#define UINT32_MAX (4294967295U)
+#endif
+
+#ifndef SIZE_MAX
+#define SIZE_MAX (~(size_t)0)
+#endif
+
+#endif /* ! C99 */
+
+#endif /* ! FLEXINT_H */
+
+/* begin standard C++ headers. */
+
+/* TODO: this is always defined, so inline it */
+#define yyconst const
+
+#if defined(__GNUC__) && __GNUC__ >= 3
+#define yynoreturn __attribute__((__noreturn__))
+#else
+#define yynoreturn
+#endif
+
+/* Returned upon end-of-file. */
+#define YY_NULL 0
+
+/* Promotes a possibly negative, possibly signed char to an
+ * integer in range [0..255] for use as an array index.
+ */
+#define YY_SC_TO_UI(c) ((YY_CHAR) (c))
+
+/* Enter a start condition. This macro really ought to take a parameter,
+ * but we do it the disgusting crufty way forced on us by the ()-less
+ * definition of BEGIN.
+ */
+#define BEGIN (yy_start) = 1 + 2 *
+/* Translate the current start state into a value that can be later handed
+ * to BEGIN to return to the state. The YYSTATE alias is for lex
+ * compatibility.
+ */
+#define YY_START (((yy_start) - 1) / 2)
+#define YYSTATE YY_START
+/* Action number for EOF rule of a given start state. */
+#define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1)
+/* Special action meaning "start processing a new file". */
+#define YY_NEW_FILE yyrestart( yyin )
+#define YY_END_OF_BUFFER_CHAR 0
+
+/* Size of default input buffer. */
+#ifndef YY_BUF_SIZE
+#ifdef __ia64__
+/* On IA-64, the buffer size is 16k, not 8k.
+ * Moreover, YY_BUF_SIZE is 2*YY_READ_BUF_SIZE in the general case.
+ * Ditto for the __ia64__ case accordingly.
+ */
+#define YY_BUF_SIZE 32768
+#else
+#define YY_BUF_SIZE 16384
+#endif /* __ia64__ */
+#endif
+
+/* The state buf must be large enough to hold one state per character in the main buffer.
+ */
+#define YY_STATE_BUF_SIZE ((YY_BUF_SIZE + 2) * sizeof(yy_state_type))
+
+#ifndef YY_TYPEDEF_YY_BUFFER_STATE
+#define YY_TYPEDEF_YY_BUFFER_STATE
+typedef struct yy_buffer_state *YY_BUFFER_STATE;
+#endif
+
+#ifndef YY_TYPEDEF_YY_SIZE_T
+#define YY_TYPEDEF_YY_SIZE_T
+typedef size_t yy_size_t;
+#endif
+
+extern int yyleng;
+
+extern FILE *yyin, *yyout;
+
+#define EOB_ACT_CONTINUE_SCAN 0
+#define EOB_ACT_END_OF_FILE 1
+#define EOB_ACT_LAST_MATCH 2
+
+ #define YY_LESS_LINENO(n)
+ #define YY_LINENO_REWIND_TO(ptr)
+
+/* Return all but the first "n" matched characters back to the input stream. */
+#define yyless(n) \
+ do \
+ { \
+ /* Undo effects of setting up yytext. */ \
+ int yyless_macro_arg = (n); \
+ YY_LESS_LINENO(yyless_macro_arg);\
+ *yy_cp = (yy_hold_char); \
+ YY_RESTORE_YY_MORE_OFFSET \
+ (yy_c_buf_p) = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \
+ YY_DO_BEFORE_ACTION; /* set up yytext again */ \
+ } \
+ while ( 0 )
+#define unput(c) yyunput( c, (yytext_ptr) )
+
+#ifndef YY_STRUCT_YY_BUFFER_STATE
+#define YY_STRUCT_YY_BUFFER_STATE
+struct yy_buffer_state
+ {
+ FILE *yy_input_file;
+
+ char *yy_ch_buf; /* input buffer */
+ char *yy_buf_pos; /* current position in input buffer */
+
+ /* Size of input buffer in bytes, not including room for EOB
+ * characters.
+ */
+ int yy_buf_size;
+
+ /* Number of characters read into yy_ch_buf, not including EOB
+ * characters.
+ */
+ int yy_n_chars;
+
+ /* Whether we "own" the buffer - i.e., we know we created it,
+ * and can realloc() it to grow it, and should free() it to
+ * delete it.
+ */
+ int yy_is_our_buffer;
+
+ /* Whether this is an "interactive" input source; if so, and
+ * if we're using stdio for input, then we want to use getc()
+ * instead of fread(), to make sure we stop fetching input after
+ * each newline.
+ */
+ int yy_is_interactive;
+
+ /* Whether we're considered to be at the beginning of a line.
+ * If so, '^' rules will be active on the next match, otherwise
+ * not.
+ */
+ int yy_at_bol;
+
+ int yy_bs_lineno; /**< The line count. */
+ int yy_bs_column; /**< The column count. */
+
+ /* Whether to try to fill the input buffer when we reach the
+ * end of it.
+ */
+ int yy_fill_buffer;
+
+ int yy_buffer_status;
+
+#define YY_BUFFER_NEW 0
+#define YY_BUFFER_NORMAL 1
+ /* When an EOF's been seen but there's still some text to process
+ * then we mark the buffer as YY_EOF_PENDING, to indicate that we
+ * shouldn't try reading from the input source any more. We might
+ * still have a bunch of tokens to match, though, because of
+ * possible backing-up.
+ *
+ * When we actually see the EOF, we change the status to "new"
+ * (via yyrestart()), so that the user can continue scanning by
+ * just pointing yyin at a new input file.
+ */
+#define YY_BUFFER_EOF_PENDING 2
+
+ };
+#endif /* !YY_STRUCT_YY_BUFFER_STATE */
+
+/* Stack of input buffers. */
+static size_t yy_buffer_stack_top = 0; /**< index of top of stack. */
+static size_t yy_buffer_stack_max = 0; /**< capacity of stack. */
+static YY_BUFFER_STATE * yy_buffer_stack = NULL; /**< Stack as an array. */
+
+/* We provide macros for accessing buffer states in case in the
+ * future we want to put the buffer states in a more general
+ * "scanner state".
+ *
+ * Returns the top of the stack, or NULL.
+ */
+#define YY_CURRENT_BUFFER ( (yy_buffer_stack) \
+ ? (yy_buffer_stack)[(yy_buffer_stack_top)] \
+ : NULL)
+/* Same as previous macro, but useful when we know that the buffer stack is not
+ * NULL or when we need an lvalue. For internal use only.
+ */
+#define YY_CURRENT_BUFFER_LVALUE (yy_buffer_stack)[(yy_buffer_stack_top)]
+
+/* yy_hold_char holds the character lost when yytext is formed. */
+static char yy_hold_char;
+static int yy_n_chars; /* number of characters read into yy_ch_buf */
+int yyleng;
+
+/* Points to current character in buffer. */
+static char *yy_c_buf_p = NULL;
+static int yy_init = 0; /* whether we need to initialize */
+static int yy_start = 0; /* start state number */
+
+/* Flag which is used to allow yywrap()'s to do buffer switches
+ * instead of setting up a fresh yyin. A bit of a hack ...
+ */
+static int yy_did_buffer_switch_on_eof;
+
+void yyrestart ( FILE *input_file );
+void yy_switch_to_buffer ( YY_BUFFER_STATE new_buffer );
+YY_BUFFER_STATE yy_create_buffer ( FILE *file, int size );
+void yy_delete_buffer ( YY_BUFFER_STATE b );
+void yy_flush_buffer ( YY_BUFFER_STATE b );
+void yypush_buffer_state ( YY_BUFFER_STATE new_buffer );
+void yypop_buffer_state ( void );
+
+static void yyensure_buffer_stack ( void );
+static void yy_load_buffer_state ( void );
+static void yy_init_buffer ( YY_BUFFER_STATE b, FILE *file );
+#define YY_FLUSH_BUFFER yy_flush_buffer( YY_CURRENT_BUFFER )
+
+YY_BUFFER_STATE yy_scan_buffer ( char *base, yy_size_t size );
+YY_BUFFER_STATE yy_scan_string ( const char *yy_str );
+YY_BUFFER_STATE yy_scan_bytes ( const char *bytes, int len );
+
+void *yyalloc ( yy_size_t );
+void *yyrealloc ( void *, yy_size_t );
+void yyfree ( void * );
+
+#define yy_new_buffer yy_create_buffer
+#define yy_set_interactive(is_interactive) \
+ { \
+ if ( ! YY_CURRENT_BUFFER ){ \
+ yyensure_buffer_stack (); \
+ YY_CURRENT_BUFFER_LVALUE = \
+ yy_create_buffer( yyin, YY_BUF_SIZE ); \
+ } \
+ YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \
+ }
+#define yy_set_bol(at_bol) \
+ { \
+ if ( ! YY_CURRENT_BUFFER ){\
+ yyensure_buffer_stack (); \
+ YY_CURRENT_BUFFER_LVALUE = \
+ yy_create_buffer( yyin, YY_BUF_SIZE ); \
+ } \
+ YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \
+ }
+#define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol)
+
+/* Begin user sect3 */
+typedef flex_uint8_t YY_CHAR;
+
+FILE *yyin = NULL, *yyout = NULL;
+
+typedef int yy_state_type;
+
+extern int yylineno;
+int yylineno = 1;
+
+extern char *yytext;
+#ifdef yytext_ptr
+#undef yytext_ptr
+#endif
+#define yytext_ptr yytext
+
+static yy_state_type yy_get_previous_state ( void );
+static yy_state_type yy_try_NUL_trans ( yy_state_type current_state );
+static int yy_get_next_buffer ( void );
+static void yynoreturn yy_fatal_error ( const char* msg );
+
+/* Done after the current pattern has been matched and before the
+ * corresponding action - sets up yytext.
+ */
+#define YY_DO_BEFORE_ACTION \
+ (yytext_ptr) = yy_bp; \
+ yyleng = (int) (yy_cp - yy_bp); \
+ (yy_hold_char) = *yy_cp; \
+ *yy_cp = '\0'; \
+ (yy_c_buf_p) = yy_cp;
+#define YY_NUM_RULES 19
+#define YY_END_OF_BUFFER 20
+/* This struct is not used in this scanner,
+ but its presence is necessary. */
+struct yy_trans_info
+ {
+ flex_int32_t yy_verify;
+ flex_int32_t yy_nxt;
+ };
+static const flex_int16_t yy_accept[75] =
+ { 0,
+ 3, 3, 20, 19, 3, 1, 2, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19, 3, 1,
+ 2, 15, 0, 0, 0, 16, 0, 0, 0, 0,
+ 0, 0, 13, 0, 0, 0, 0, 5, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 7, 17, 0,
+ 10, 0, 4, 0, 0, 0, 6, 0, 12, 0,
+ 0, 0, 0, 9, 0, 11, 8, 0, 0, 0,
+ 0, 14, 18, 0
+ } ;
+
+static const YY_CHAR yy_ec[256] =
+ { 0,
+ 1, 1, 1, 1, 1, 1, 1, 1, 2, 3,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 2, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 4, 4, 4,
+ 4, 4, 4, 4, 4, 4, 4, 1, 1, 1,
+ 1, 1, 1, 1, 5, 1, 6, 7, 8, 1,
+ 1, 1, 9, 1, 1, 10, 11, 12, 13, 14,
+ 1, 15, 16, 17, 18, 1, 19, 1, 1, 20,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1
+ } ;
+
+static const YY_CHAR yy_meta[21] =
+ { 0,
+ 1, 1, 2, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1
+ } ;
+
+static const flex_int16_t yy_base[77] =
+ { 0,
+ 0, 0, 78, 79, 75, 0, 72, 58, 64, 60,
+ 60, 55, 62, 55, 16, 14, 10, 63, 65, 0,
+ 62, 79, 52, 51, 56, 79, 57, 53, 48, 46,
+ 52, 52, 79, 48, 45, 38, 38, 0, 45, 39,
+ 43, 38, 33, 30, 41, 35, 36, 79, 79, 27,
+ 79, 29, 79, 33, 22, 23, 79, 31, 79, 26,
+ 19, 19, 16, 79, 24, 79, 79, 17, 10, 20,
+ 19, 79, 79, 79, 25, 23
+ } ;
+
+static const flex_int16_t yy_def[77] =
+ { 0,
+ 74, 1, 74, 74, 74, 75, 74, 74, 74, 74,
+ 74, 74, 74, 74, 74, 74, 74, 74, 74, 75,
+ 74, 74, 74, 74, 74, 74, 74, 74, 74, 74,
+ 74, 74, 74, 74, 74, 74, 74, 76, 74, 74,
+ 74, 74, 74, 74, 74, 74, 74, 74, 74, 74,
+ 74, 74, 74, 74, 74, 74, 74, 74, 74, 74,
+ 74, 74, 74, 74, 74, 74, 74, 74, 74, 74,
+ 74, 74, 74, 0, 74, 74
+ } ;
+
+static const flex_int16_t yy_nxt[100] =
+ { 0,
+ 4, 5, 6, 7, 8, 9, 10, 11, 12, 13,
+ 4, 4, 14, 4, 15, 16, 17, 4, 18, 4,
+ 29, 31, 33, 49, 34, 20, 73, 72, 30, 71,
+ 32, 70, 69, 68, 67, 66, 65, 64, 63, 62,
+ 61, 60, 59, 58, 57, 56, 55, 54, 53, 52,
+ 51, 50, 48, 47, 46, 45, 44, 43, 42, 41,
+ 40, 39, 38, 37, 36, 21, 19, 35, 28, 27,
+ 26, 25, 24, 23, 22, 21, 19, 74, 3, 74,
+ 74, 74, 74, 74, 74, 74, 74, 74, 74, 74,
+ 74, 74, 74, 74, 74, 74, 74, 74, 74
+
+ } ;
+
+static const flex_int16_t yy_chk[100] =
+ { 0,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 15, 16, 17, 76, 17, 75, 71, 70, 15, 69,
+ 16, 68, 65, 63, 62, 61, 60, 58, 56, 55,
+ 54, 52, 50, 47, 46, 45, 44, 43, 42, 41,
+ 40, 39, 37, 36, 35, 34, 32, 31, 30, 29,
+ 28, 27, 25, 24, 23, 21, 19, 18, 14, 13,
+ 12, 11, 10, 9, 8, 7, 5, 3, 74, 74,
+ 74, 74, 74, 74, 74, 74, 74, 74, 74, 74,
+ 74, 74, 74, 74, 74, 74, 74, 74, 74
+
+ } ;
+
+static yy_state_type yy_last_accepting_state;
+static char *yy_last_accepting_cpos;
+
+extern int yy_flex_debug;
+int yy_flex_debug = 0;
+
+/* The intent behind this definition is that it'll catch
+ * any uses of REJECT which flex missed.
+ */
+#define REJECT reject_used_but_not_detected
+#define yymore() yymore_used_but_not_detected
+#define YY_MORE_ADJ 0
+#define YY_RESTORE_YY_MORE_OFFSET
+char *yytext;
+#line 1 "adv.flex"
+#line 2 "adv.flex"
+/* Copyright (C) 2022 Free Software Foundation, Inc.
+ This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 2, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING. If not, write to the Free Software
+Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ */
+
+ /*
+ * adv.flex - provides a lexical analyser for Dungeon
+ */
+
+ struct lineInfo {
+ char *linebuf; /* line contents */
+ int linelen; /* length */
+ int tokenpos; /* start position of token within line */
+ int toklen; /* a copy of yylen (length of token) */
+ int nextpos; /* position after token */
+ int actualline; /* line number of this line */
+ };
+
+ static int lineno =1; /* a running count of the file line number */
+ static char *filename =NULL;
+ static struct lineInfo *currentLine =NULL;
+
+ void advflex_error (const char *);
+static void finishedLine (void);
+static void resetpos (void);
+static void consumeLine (void);
+static void updatepos (void);
+static void skippos (void);
+static void poperrorskip (const char *);
+ int advflex_OpenSource (char *s);
+ int advflex_GetLineNo (void);
+ void advflex_CloseSource(void);
+ char *advflex_GetToken (void);
+ void _M2_advflex_init (int, char *, char *);
+ void _M2_advflex_finish (int, char *, char *);
+ void _M2_advflex_ctor (void);
+extern void yylex (void);
+
+#if !defined(TRUE)
+# define TRUE (1==1)
+#endif
+#if !defined(FALSE)
+# define FALSE (1==0)
+#endif
+
+typedef enum {eoftok, roomtok, doortok, walltok, treasuretok, attok,
+ leadstok, totok, statustok, closedtok, opentok, secrettok,
+ istok, endtok, enddottok, integertok, randomizetok} toktype ;
+
+toktype advflex_currenttoken;
+char *advflex_currentident;
+int advflex_currentinteger;
+
+
+#define YY_DECL void yylex (void)
+#line 553 "advflex.c"
+#line 554 "advflex.c"
+
+#define INITIAL 0
+
+#ifndef YY_NO_UNISTD_H
+/* Special case for "unistd.h", since it is non-ANSI. We include it way
+ * down here because we want the user's section 1 to have been scanned first.
+ * The user has a chance to override it with an option.
+ */
+#include <unistd.h>
+#endif
+
+#ifndef YY_EXTRA_TYPE
+#define YY_EXTRA_TYPE void *
+#endif
+
+static int yy_init_globals ( void );
+
+/* Accessor methods to globals.
+ These are made visible to non-reentrant scanners for convenience. */
+
+int yylex_destroy ( void );
+
+int yyget_debug ( void );
+
+void yyset_debug ( int debug_flag );
+
+YY_EXTRA_TYPE yyget_extra ( void );
+
+void yyset_extra ( YY_EXTRA_TYPE user_defined );
+
+FILE *yyget_in ( void );
+
+void yyset_in ( FILE * _in_str );
+
+FILE *yyget_out ( void );
+
+void yyset_out ( FILE * _out_str );
+
+ int yyget_leng ( void );
+
+char *yyget_text ( void );
+
+int yyget_lineno ( void );
+
+void yyset_lineno ( int _line_number );
+
+/* Macros after this point can all be overridden by user definitions in
+ * section 1.
+ */
+
+#ifndef YY_SKIP_YYWRAP
+#ifdef __cplusplus
+extern "C" int yywrap ( void );
+#else
+extern int yywrap ( void );
+#endif
+#endif
+
+#ifndef YY_NO_UNPUT
+
+ static void yyunput ( int c, char *buf_ptr );
+
+#endif
+
+#ifndef yytext_ptr
+static void yy_flex_strncpy ( char *, const char *, int );
+#endif
+
+#ifdef YY_NEED_STRLEN
+static int yy_flex_strlen ( const char * );
+#endif
+
+#ifndef YY_NO_INPUT
+#ifdef __cplusplus
+static int yyinput ( void );
+#else
+static int input ( void );
+#endif
+
+#endif
+
+/* Amount of stuff to slurp up with each read. */
+#ifndef YY_READ_BUF_SIZE
+#ifdef __ia64__
+/* On IA-64, the buffer size is 16k, not 8k */
+#define YY_READ_BUF_SIZE 16384
+#else
+#define YY_READ_BUF_SIZE 8192
+#endif /* __ia64__ */
+#endif
+
+/* Copy whatever the last rule matched to the standard output. */
+#ifndef ECHO
+/* This used to be an fputs(), but since the string might contain NUL's,
+ * we now use fwrite().
+ */
+#define ECHO do { if (fwrite( yytext, (size_t) yyleng, 1, yyout )) {} } while (0)
+#endif
+
+/* Gets input and stuffs it into "buf". number of characters read, or YY_NULL,
+ * is returned in "result".
+ */
+#ifndef YY_INPUT
+#define YY_INPUT(buf,result,max_size) \
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \
+ { \
+ int c = '*'; \
+ int n; \
+ for ( n = 0; n < max_size && \
+ (c = getc( yyin )) != EOF && c != '\n'; ++n ) \
+ buf[n] = (char) c; \
+ if ( c == '\n' ) \
+ buf[n++] = (char) c; \
+ if ( c == EOF && ferror( yyin ) ) \
+ YY_FATAL_ERROR( "input in flex scanner failed" ); \
+ result = n; \
+ } \
+ else \
+ { \
+ errno=0; \
+ while ( (result = (int) fread(buf, 1, (yy_size_t) max_size, yyin)) == 0 && ferror(yyin)) \
+ { \
+ if( errno != EINTR) \
+ { \
+ YY_FATAL_ERROR( "input in flex scanner failed" ); \
+ break; \
+ } \
+ errno=0; \
+ clearerr(yyin); \
+ } \
+ }\
+\
+
+#endif
+
+/* No semi-colon after return; correct usage is to write "yyterminate();" -
+ * we don't want an extra ';' after the "return" because that will cause
+ * some compilers to complain about unreachable statements.
+ */
+#ifndef yyterminate
+#define yyterminate() return YY_NULL
+#endif
+
+/* Number of entries by which start-condition stack grows. */
+#ifndef YY_START_STACK_INCR
+#define YY_START_STACK_INCR 25
+#endif
+
+/* Report a fatal error. */
+#ifndef YY_FATAL_ERROR
+#define YY_FATAL_ERROR(msg) yy_fatal_error( msg )
+#endif
+
+/* end tables serialization structures and prototypes */
+
+/* Default declaration of generated scanner - a define so the user can
+ * easily add parameters.
+ */
+#ifndef YY_DECL
+#define YY_DECL_IS_OURS 1
+
+extern int yylex (void);
+
+#define YY_DECL int yylex (void)
+#endif /* !YY_DECL */
+
+/* Code executed at the beginning of each rule, after yytext and yyleng
+ * have been set up.
+ */
+#ifndef YY_USER_ACTION
+#define YY_USER_ACTION
+#endif
+
+/* Code executed at the end of each rule. */
+#ifndef YY_BREAK
+#define YY_BREAK /*LINTED*/break;
+#endif
+
+#define YY_RULE_SETUP \
+ YY_USER_ACTION
+
+/** The main scanner function which does all the work.
+ */
+YY_DECL
+{
+ yy_state_type yy_current_state;
+ char *yy_cp, *yy_bp;
+ int yy_act;
+
+ if ( !(yy_init) )
+ {
+ (yy_init) = 1;
+
+#ifdef YY_USER_INIT
+ YY_USER_INIT;
+#endif
+
+ if ( ! (yy_start) )
+ (yy_start) = 1; /* first start state */
+
+ if ( ! yyin )
+ yyin = stdin;
+
+ if ( ! yyout )
+ yyout = stdout;
+
+ if ( ! YY_CURRENT_BUFFER ) {
+ yyensure_buffer_stack ();
+ YY_CURRENT_BUFFER_LVALUE =
+ yy_create_buffer( yyin, YY_BUF_SIZE );
+ }
+
+ yy_load_buffer_state( );
+ }
+
+ {
+#line 72 "adv.flex"
+
+
+#line 774 "advflex.c"
+
+ while ( /*CONSTCOND*/1 ) /* loops until end-of-file is reached */
+ {
+ yy_cp = (yy_c_buf_p);
+
+ /* Support of yytext. */
+ *yy_cp = (yy_hold_char);
+
+ /* yy_bp points to the position in yy_ch_buf of the start of
+ * the current run.
+ */
+ yy_bp = yy_cp;
+
+ yy_current_state = (yy_start);
+yy_match:
+ do
+ {
+ YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)] ;
+ if ( yy_accept[yy_current_state] )
+ {
+ (yy_last_accepting_state) = yy_current_state;
+ (yy_last_accepting_cpos) = yy_cp;
+ }
+ while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+ {
+ yy_current_state = (int) yy_def[yy_current_state];
+ if ( yy_current_state >= 75 )
+ yy_c = yy_meta[yy_c];
+ }
+ yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c];
+ ++yy_cp;
+ }
+ while ( yy_base[yy_current_state] != 79 );
+
+yy_find_action:
+ yy_act = yy_accept[yy_current_state];
+ if ( yy_act == 0 )
+ { /* have to back up */
+ yy_cp = (yy_last_accepting_cpos);
+ yy_current_state = (yy_last_accepting_state);
+ yy_act = yy_accept[yy_current_state];
+ }
+
+ YY_DO_BEFORE_ACTION;
+
+do_action: /* This label is used only to access EOF actions. */
+
+ switch ( yy_act )
+ { /* beginning of action switch */
+ case 0: /* must back up */
+ /* undo the effects of YY_DO_BEFORE_ACTION */
+ *yy_cp = (yy_hold_char);
+ yy_cp = (yy_last_accepting_cpos);
+ yy_current_state = (yy_last_accepting_state);
+ goto yy_find_action;
+
+case 1:
+/* rule 1 can match eol */
+YY_RULE_SETUP
+#line 74 "adv.flex"
+{ consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ }
+ YY_BREAK
+case 2:
+YY_RULE_SETUP
+#line 75 "adv.flex"
+{ updatepos();
+ advflex_currenttoken = integertok;
+ advflex_currentinteger = atoi(yytext);
+ return; }
+ YY_BREAK
+case 3:
+YY_RULE_SETUP
+#line 79 "adv.flex"
+{ updatepos(); }
+ YY_BREAK
+case 4:
+YY_RULE_SETUP
+#line 80 "adv.flex"
+{ updatepos(); advflex_currenttoken = roomtok; return; }
+ YY_BREAK
+case 5:
+YY_RULE_SETUP
+#line 81 "adv.flex"
+{ updatepos(); advflex_currenttoken = endtok; return; }
+ YY_BREAK
+case 6:
+YY_RULE_SETUP
+#line 82 "adv.flex"
+{ updatepos(); advflex_currenttoken = walltok; return; }
+ YY_BREAK
+case 7:
+YY_RULE_SETUP
+#line 83 "adv.flex"
+{ updatepos(); advflex_currenttoken = doortok; return; }
+ YY_BREAK
+case 8:
+YY_RULE_SETUP
+#line 84 "adv.flex"
+{ updatepos(); advflex_currenttoken = statustok; return; }
+ YY_BREAK
+case 9:
+YY_RULE_SETUP
+#line 85 "adv.flex"
+{ updatepos(); advflex_currenttoken = closedtok; return; }
+ YY_BREAK
+case 10:
+YY_RULE_SETUP
+#line 86 "adv.flex"
+{ updatepos(); advflex_currenttoken = opentok; return; }
+ YY_BREAK
+case 11:
+YY_RULE_SETUP
+#line 87 "adv.flex"
+{ updatepos(); advflex_currenttoken = secrettok; return; }
+ YY_BREAK
+case 12:
+YY_RULE_SETUP
+#line 88 "adv.flex"
+{ updatepos(); advflex_currenttoken = leadstok; return; }
+ YY_BREAK
+case 13:
+YY_RULE_SETUP
+#line 89 "adv.flex"
+{ updatepos(); advflex_currenttoken = totok; return; }
+ YY_BREAK
+case 14:
+YY_RULE_SETUP
+#line 90 "adv.flex"
+{ updatepos(); advflex_currenttoken = treasuretok; return; }
+ YY_BREAK
+case 15:
+YY_RULE_SETUP
+#line 91 "adv.flex"
+{ updatepos(); advflex_currenttoken = attok; return; }
+ YY_BREAK
+case 16:
+YY_RULE_SETUP
+#line 92 "adv.flex"
+{ updatepos(); advflex_currenttoken = istok; return; }
+ YY_BREAK
+case 17:
+YY_RULE_SETUP
+#line 93 "adv.flex"
+{ updatepos(); advflex_currenttoken = enddottok; return; }
+ YY_BREAK
+case 18:
+YY_RULE_SETUP
+#line 94 "adv.flex"
+{ updatepos(); advflex_currenttoken = randomizetok; return; }
+ YY_BREAK
+case YY_STATE_EOF(INITIAL):
+#line 95 "adv.flex"
+{ updatepos(); advflex_currenttoken = eoftok; return; }
+ YY_BREAK
+case 19:
+YY_RULE_SETUP
+#line 97 "adv.flex"
+ECHO;
+ YY_BREAK
+#line 934 "advflex.c"
+
+ case YY_END_OF_BUFFER:
+ {
+ /* Amount of text matched not including the EOB char. */
+ int yy_amount_of_matched_text = (int) (yy_cp - (yytext_ptr)) - 1;
+
+ /* Undo the effects of YY_DO_BEFORE_ACTION. */
+ *yy_cp = (yy_hold_char);
+ YY_RESTORE_YY_MORE_OFFSET
+
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW )
+ {
+ /* We're scanning a new file or input source. It's
+ * possible that this happened because the user
+ * just pointed yyin at a new source and called
+ * yylex(). If so, then we have to assure
+ * consistency between YY_CURRENT_BUFFER and our
+ * globals. Here is the right place to do so, because
+ * this is the first action (other than possibly a
+ * back-up) that will match for the new input source.
+ */
+ (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
+ YY_CURRENT_BUFFER_LVALUE->yy_input_file = yyin;
+ YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL;
+ }
+
+ /* Note that here we test for yy_c_buf_p "<=" to the position
+ * of the first EOB in the buffer, since yy_c_buf_p will
+ * already have been incremented past the NUL character
+ * (since all states make transitions on EOB to the
+ * end-of-buffer state). Contrast this with the test
+ * in input().
+ */
+ if ( (yy_c_buf_p) <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
+ { /* This was really a NUL. */
+ yy_state_type yy_next_state;
+
+ (yy_c_buf_p) = (yytext_ptr) + yy_amount_of_matched_text;
+
+ yy_current_state = yy_get_previous_state( );
+
+ /* Okay, we're now positioned to make the NUL
+ * transition. We couldn't have
+ * yy_get_previous_state() go ahead and do it
+ * for us because it doesn't know how to deal
+ * with the possibility of jamming (and we don't
+ * want to build jamming into it because then it
+ * will run more slowly).
+ */
+
+ yy_next_state = yy_try_NUL_trans( yy_current_state );
+
+ yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+
+ if ( yy_next_state )
+ {
+ /* Consume the NUL. */
+ yy_cp = ++(yy_c_buf_p);
+ yy_current_state = yy_next_state;
+ goto yy_match;
+ }
+
+ else
+ {
+ yy_cp = (yy_c_buf_p);
+ goto yy_find_action;
+ }
+ }
+
+ else switch ( yy_get_next_buffer( ) )
+ {
+ case EOB_ACT_END_OF_FILE:
+ {
+ (yy_did_buffer_switch_on_eof) = 0;
+
+ if ( yywrap( ) )
+ {
+ /* Note: because we've taken care in
+ * yy_get_next_buffer() to have set up
+ * yytext, we can now set up
+ * yy_c_buf_p so that if some total
+ * hoser (like flex itself) wants to
+ * call the scanner after we return the
+ * YY_NULL, it'll still work - another
+ * YY_NULL will get returned.
+ */
+ (yy_c_buf_p) = (yytext_ptr) + YY_MORE_ADJ;
+
+ yy_act = YY_STATE_EOF(YY_START);
+ goto do_action;
+ }
+
+ else
+ {
+ if ( ! (yy_did_buffer_switch_on_eof) )
+ YY_NEW_FILE;
+ }
+ break;
+ }
+
+ case EOB_ACT_CONTINUE_SCAN:
+ (yy_c_buf_p) =
+ (yytext_ptr) + yy_amount_of_matched_text;
+
+ yy_current_state = yy_get_previous_state( );
+
+ yy_cp = (yy_c_buf_p);
+ yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+ goto yy_match;
+
+ case EOB_ACT_LAST_MATCH:
+ (yy_c_buf_p) =
+ &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)];
+
+ yy_current_state = yy_get_previous_state( );
+
+ yy_cp = (yy_c_buf_p);
+ yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+ goto yy_find_action;
+ }
+ break;
+ }
+
+ default:
+ YY_FATAL_ERROR(
+ "fatal flex scanner internal error--no action found" );
+ } /* end of action switch */
+ } /* end of scanning one token */
+ } /* end of user's declarations */
+} /* end of yylex */
+
+/* yy_get_next_buffer - try to read in a new buffer
+ *
+ * Returns a code representing an action:
+ * EOB_ACT_LAST_MATCH -
+ * EOB_ACT_CONTINUE_SCAN - continue scanning from current position
+ * EOB_ACT_END_OF_FILE - end of file
+ */
+static int yy_get_next_buffer (void)
+{
+ char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf;
+ char *source = (yytext_ptr);
+ int number_to_move, i;
+ int ret_val;
+
+ if ( (yy_c_buf_p) > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] )
+ YY_FATAL_ERROR(
+ "fatal flex scanner internal error--end of buffer missed" );
+
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 )
+ { /* Don't try to fill the buffer, so this is an EOF. */
+ if ( (yy_c_buf_p) - (yytext_ptr) - YY_MORE_ADJ == 1 )
+ {
+ /* We matched a single character, the EOB, so
+ * treat this as a final EOF.
+ */
+ return EOB_ACT_END_OF_FILE;
+ }
+
+ else
+ {
+ /* We matched some text prior to the EOB, first
+ * process it.
+ */
+ return EOB_ACT_LAST_MATCH;
+ }
+ }
+
+ /* Try to read more data. */
+
+ /* First move last chars to start of buffer. */
+ number_to_move = (int) ((yy_c_buf_p) - (yytext_ptr) - 1);
+
+ for ( i = 0; i < number_to_move; ++i )
+ *(dest++) = *(source++);
+
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING )
+ /* don't do the read, it's not guaranteed to return an EOF,
+ * just force an EOF
+ */
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars) = 0;
+
+ else
+ {
+ int num_to_read =
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1;
+
+ while ( num_to_read <= 0 )
+ { /* Not enough room in the buffer - grow it. */
+
+ /* just a shorter name for the current buffer */
+ YY_BUFFER_STATE b = YY_CURRENT_BUFFER_LVALUE;
+
+ int yy_c_buf_p_offset =
+ (int) ((yy_c_buf_p) - b->yy_ch_buf);
+
+ if ( b->yy_is_our_buffer )
+ {
+ int new_size = b->yy_buf_size * 2;
+
+ if ( new_size <= 0 )
+ b->yy_buf_size += b->yy_buf_size / 8;
+ else
+ b->yy_buf_size *= 2;
+
+ b->yy_ch_buf = (char *)
+ /* Include room in for 2 EOB chars. */
+ yyrealloc( (void *) b->yy_ch_buf,
+ (yy_size_t) (b->yy_buf_size + 2) );
+ }
+ else
+ /* Can't grow it, we don't own it. */
+ b->yy_ch_buf = NULL;
+
+ if ( ! b->yy_ch_buf )
+ YY_FATAL_ERROR(
+ "fatal error - scanner input buffer overflow" );
+
+ (yy_c_buf_p) = &b->yy_ch_buf[yy_c_buf_p_offset];
+
+ num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size -
+ number_to_move - 1;
+
+ }
+
+ if ( num_to_read > YY_READ_BUF_SIZE )
+ num_to_read = YY_READ_BUF_SIZE;
+
+ /* Read in more data. */
+ YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]),
+ (yy_n_chars), num_to_read );
+
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+ }
+
+ if ( (yy_n_chars) == 0 )
+ {
+ if ( number_to_move == YY_MORE_ADJ )
+ {
+ ret_val = EOB_ACT_END_OF_FILE;
+ yyrestart( yyin );
+ }
+
+ else
+ {
+ ret_val = EOB_ACT_LAST_MATCH;
+ YY_CURRENT_BUFFER_LVALUE->yy_buffer_status =
+ YY_BUFFER_EOF_PENDING;
+ }
+ }
+
+ else
+ ret_val = EOB_ACT_CONTINUE_SCAN;
+
+ if (((yy_n_chars) + number_to_move) > YY_CURRENT_BUFFER_LVALUE->yy_buf_size) {
+ /* Extend the array by 50%, plus the number we really need. */
+ int new_size = (yy_n_chars) + number_to_move + ((yy_n_chars) >> 1);
+ YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) yyrealloc(
+ (void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf, (yy_size_t) new_size );
+ if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" );
+ /* "- 2" to take care of EOB's */
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_size = (int) (new_size - 2);
+ }
+
+ (yy_n_chars) += number_to_move;
+ YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] = YY_END_OF_BUFFER_CHAR;
+ YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] = YY_END_OF_BUFFER_CHAR;
+
+ (yytext_ptr) = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0];
+
+ return ret_val;
+}
+
+/* yy_get_previous_state - get the state just before the EOB char was reached */
+
+ static yy_state_type yy_get_previous_state (void)
+{
+ yy_state_type yy_current_state;
+ char *yy_cp;
+
+ yy_current_state = (yy_start);
+
+ for ( yy_cp = (yytext_ptr) + YY_MORE_ADJ; yy_cp < (yy_c_buf_p); ++yy_cp )
+ {
+ YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1);
+ if ( yy_accept[yy_current_state] )
+ {
+ (yy_last_accepting_state) = yy_current_state;
+ (yy_last_accepting_cpos) = yy_cp;
+ }
+ while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+ {
+ yy_current_state = (int) yy_def[yy_current_state];
+ if ( yy_current_state >= 75 )
+ yy_c = yy_meta[yy_c];
+ }
+ yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c];
+ }
+
+ return yy_current_state;
+}
+
+/* yy_try_NUL_trans - try to make a transition on the NUL character
+ *
+ * synopsis
+ * next_state = yy_try_NUL_trans( current_state );
+ */
+ static yy_state_type yy_try_NUL_trans (yy_state_type yy_current_state )
+{
+ int yy_is_jam;
+ char *yy_cp = (yy_c_buf_p);
+
+ YY_CHAR yy_c = 1;
+ if ( yy_accept[yy_current_state] )
+ {
+ (yy_last_accepting_state) = yy_current_state;
+ (yy_last_accepting_cpos) = yy_cp;
+ }
+ while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+ {
+ yy_current_state = (int) yy_def[yy_current_state];
+ if ( yy_current_state >= 75 )
+ yy_c = yy_meta[yy_c];
+ }
+ yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c];
+ yy_is_jam = (yy_current_state == 74);
+
+ return yy_is_jam ? 0 : yy_current_state;
+}
+
+#ifndef YY_NO_UNPUT
+
+ static void yyunput (int c, char * yy_bp )
+{
+ char *yy_cp;
+
+ yy_cp = (yy_c_buf_p);
+
+ /* undo effects of setting up yytext */
+ *yy_cp = (yy_hold_char);
+
+ if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
+ { /* need to shift things up to make room */
+ /* +2 for EOB chars. */
+ int number_to_move = (yy_n_chars) + 2;
+ char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2];
+ char *source =
+ &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move];
+
+ while ( source > YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
+ *--dest = *--source;
+
+ yy_cp += (int) (dest - source);
+ yy_bp += (int) (dest - source);
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars =
+ (yy_n_chars) = (int) YY_CURRENT_BUFFER_LVALUE->yy_buf_size;
+
+ if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
+ YY_FATAL_ERROR( "flex scanner push-back overflow" );
+ }
+
+ *--yy_cp = (char) c;
+
+ (yytext_ptr) = yy_bp;
+ (yy_hold_char) = *yy_cp;
+ (yy_c_buf_p) = yy_cp;
+}
+
+#endif
+
+#ifndef YY_NO_INPUT
+#ifdef __cplusplus
+ static int yyinput (void)
+#else
+ static int input (void)
+#endif
+
+{
+ int c;
+
+ *(yy_c_buf_p) = (yy_hold_char);
+
+ if ( *(yy_c_buf_p) == YY_END_OF_BUFFER_CHAR )
+ {
+ /* yy_c_buf_p now points to the character we want to return.
+ * If this occurs *before* the EOB characters, then it's a
+ * valid NUL; if not, then we've hit the end of the buffer.
+ */
+ if ( (yy_c_buf_p) < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
+ /* This was really a NUL. */
+ *(yy_c_buf_p) = '\0';
+
+ else
+ { /* need more input */
+ int offset = (int) ((yy_c_buf_p) - (yytext_ptr));
+ ++(yy_c_buf_p);
+
+ switch ( yy_get_next_buffer( ) )
+ {
+ case EOB_ACT_LAST_MATCH:
+ /* This happens because yy_g_n_b()
+ * sees that we've accumulated a
+ * token and flags that we need to
+ * try matching the token before
+ * proceeding. But for input(),
+ * there's no matching to consider.
+ * So convert the EOB_ACT_LAST_MATCH
+ * to EOB_ACT_END_OF_FILE.
+ */
+
+ /* Reset buffer status. */
+ yyrestart( yyin );
+
+ /*FALLTHROUGH*/
+
+ case EOB_ACT_END_OF_FILE:
+ {
+ if ( yywrap( ) )
+ return 0;
+
+ if ( ! (yy_did_buffer_switch_on_eof) )
+ YY_NEW_FILE;
+#ifdef __cplusplus
+ return yyinput();
+#else
+ return input();
+#endif
+ }
+
+ case EOB_ACT_CONTINUE_SCAN:
+ (yy_c_buf_p) = (yytext_ptr) + offset;
+ break;
+ }
+ }
+ }
+
+ c = *(unsigned char *) (yy_c_buf_p); /* cast for 8-bit char's */
+ *(yy_c_buf_p) = '\0'; /* preserve yytext */
+ (yy_hold_char) = *++(yy_c_buf_p);
+
+ return c;
+}
+#endif /* ifndef YY_NO_INPUT */
+
+/** Immediately switch to a different input stream.
+ * @param input_file A readable stream.
+ *
+ * @note This function does not reset the start condition to @c INITIAL .
+ */
+ void yyrestart (FILE * input_file )
+{
+
+ if ( ! YY_CURRENT_BUFFER ){
+ yyensure_buffer_stack ();
+ YY_CURRENT_BUFFER_LVALUE =
+ yy_create_buffer( yyin, YY_BUF_SIZE );
+ }
+
+ yy_init_buffer( YY_CURRENT_BUFFER, input_file );
+ yy_load_buffer_state( );
+}
+
+/** Switch to a different input buffer.
+ * @param new_buffer The new input buffer.
+ *
+ */
+ void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer )
+{
+
+ /* TODO. We should be able to replace this entire function body
+ * with
+ * yypop_buffer_state();
+ * yypush_buffer_state(new_buffer);
+ */
+ yyensure_buffer_stack ();
+ if ( YY_CURRENT_BUFFER == new_buffer )
+ return;
+
+ if ( YY_CURRENT_BUFFER )
+ {
+ /* Flush out information for old buffer. */
+ *(yy_c_buf_p) = (yy_hold_char);
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+ }
+
+ YY_CURRENT_BUFFER_LVALUE = new_buffer;
+ yy_load_buffer_state( );
+
+ /* We don't actually know whether we did this switch during
+ * EOF (yywrap()) processing, but the only time this flag
+ * is looked at is after yywrap() is called, so it's safe
+ * to go ahead and always set it.
+ */
+ (yy_did_buffer_switch_on_eof) = 1;
+}
+
+static void yy_load_buffer_state (void)
+{
+ (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
+ (yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos;
+ yyin = YY_CURRENT_BUFFER_LVALUE->yy_input_file;
+ (yy_hold_char) = *(yy_c_buf_p);
+}
+
+/** Allocate and initialize an input buffer state.
+ * @param file A readable stream.
+ * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE.
+ *
+ * @return the allocated buffer state.
+ */
+ YY_BUFFER_STATE yy_create_buffer (FILE * file, int size )
+{
+ YY_BUFFER_STATE b;
+
+ b = (YY_BUFFER_STATE) yyalloc( sizeof( struct yy_buffer_state ) );
+ if ( ! b )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );
+
+ b->yy_buf_size = size;
+
+ /* yy_ch_buf has to be 2 characters longer than the size given because
+ * we need to put in 2 end-of-buffer characters.
+ */
+ b->yy_ch_buf = (char *) yyalloc( (yy_size_t) (b->yy_buf_size + 2) );
+ if ( ! b->yy_ch_buf )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );
+
+ b->yy_is_our_buffer = 1;
+
+ yy_init_buffer( b, file );
+
+ return b;
+}
+
+/** Destroy the buffer.
+ * @param b a buffer created with yy_create_buffer()
+ *
+ */
+ void yy_delete_buffer (YY_BUFFER_STATE b )
+{
+
+ if ( ! b )
+ return;
+
+ if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */
+ YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0;
+
+ if ( b->yy_is_our_buffer )
+ yyfree( (void *) b->yy_ch_buf );
+
+ yyfree( (void *) b );
+}
+
+/* Initializes or reinitializes a buffer.
+ * This function is sometimes called more than once on the same buffer,
+ * such as during a yyrestart() or at EOF.
+ */
+ static void yy_init_buffer (YY_BUFFER_STATE b, FILE * file )
+
+{
+ int oerrno = errno;
+
+ yy_flush_buffer( b );
+
+ b->yy_input_file = file;
+ b->yy_fill_buffer = 1;
+
+ /* If b is the current buffer, then yy_init_buffer was _probably_
+ * called from yyrestart() or through yy_get_next_buffer.
+ * In that case, we don't want to reset the lineno or column.
+ */
+ if (b != YY_CURRENT_BUFFER){
+ b->yy_bs_lineno = 1;
+ b->yy_bs_column = 0;
+ }
+
+ b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0;
+
+ errno = oerrno;
+}
+
+/** Discard all buffered characters. On the next scan, YY_INPUT will be called.
+ * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER.
+ *
+ */
+ void yy_flush_buffer (YY_BUFFER_STATE b )
+{
+ if ( ! b )
+ return;
+
+ b->yy_n_chars = 0;
+
+ /* We always need two end-of-buffer characters. The first causes
+ * a transition to the end-of-buffer state. The second causes
+ * a jam in that state.
+ */
+ b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR;
+ b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR;
+
+ b->yy_buf_pos = &b->yy_ch_buf[0];
+
+ b->yy_at_bol = 1;
+ b->yy_buffer_status = YY_BUFFER_NEW;
+
+ if ( b == YY_CURRENT_BUFFER )
+ yy_load_buffer_state( );
+}
+
+/** Pushes the new state onto the stack. The new state becomes
+ * the current state. This function will allocate the stack
+ * if necessary.
+ * @param new_buffer The new state.
+ *
+ */
+void yypush_buffer_state (YY_BUFFER_STATE new_buffer )
+{
+ if (new_buffer == NULL)
+ return;
+
+ yyensure_buffer_stack();
+
+ /* This block is copied from yy_switch_to_buffer. */
+ if ( YY_CURRENT_BUFFER )
+ {
+ /* Flush out information for old buffer. */
+ *(yy_c_buf_p) = (yy_hold_char);
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+ }
+
+ /* Only push if top exists. Otherwise, replace top. */
+ if (YY_CURRENT_BUFFER)
+ (yy_buffer_stack_top)++;
+ YY_CURRENT_BUFFER_LVALUE = new_buffer;
+
+ /* copied from yy_switch_to_buffer. */
+ yy_load_buffer_state( );
+ (yy_did_buffer_switch_on_eof) = 1;
+}
+
+/** Removes and deletes the top of the stack, if present.
+ * The next element becomes the new top.
+ *
+ */
+void yypop_buffer_state (void)
+{
+ if (!YY_CURRENT_BUFFER)
+ return;
+
+ yy_delete_buffer(YY_CURRENT_BUFFER );
+ YY_CURRENT_BUFFER_LVALUE = NULL;
+ if ((yy_buffer_stack_top) > 0)
+ --(yy_buffer_stack_top);
+
+ if (YY_CURRENT_BUFFER) {
+ yy_load_buffer_state( );
+ (yy_did_buffer_switch_on_eof) = 1;
+ }
+}
+
+/* Allocates the stack if it does not exist.
+ * Guarantees space for at least one push.
+ */
+static void yyensure_buffer_stack (void)
+{
+ yy_size_t num_to_alloc;
+
+ if (!(yy_buffer_stack)) {
+
+ /* First allocation is just for 2 elements, since we don't know if this
+ * scanner will even need a stack. We use 2 instead of 1 to avoid an
+ * immediate realloc on the next call.
+ */
+ num_to_alloc = 1; /* After all that talk, this was set to 1 anyways... */
+ (yy_buffer_stack) = (struct yy_buffer_state**)yyalloc
+ (num_to_alloc * sizeof(struct yy_buffer_state*)
+ );
+ if ( ! (yy_buffer_stack) )
+ YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" );
+
+ memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*));
+
+ (yy_buffer_stack_max) = num_to_alloc;
+ (yy_buffer_stack_top) = 0;
+ return;
+ }
+
+ if ((yy_buffer_stack_top) >= ((yy_buffer_stack_max)) - 1){
+
+ /* Increase the buffer to prepare for a possible push. */
+ yy_size_t grow_size = 8 /* arbitrary grow size */;
+
+ num_to_alloc = (yy_buffer_stack_max) + grow_size;
+ (yy_buffer_stack) = (struct yy_buffer_state**)yyrealloc
+ ((yy_buffer_stack),
+ num_to_alloc * sizeof(struct yy_buffer_state*)
+ );
+ if ( ! (yy_buffer_stack) )
+ YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" );
+
+ /* zero only the new slots.*/
+ memset((yy_buffer_stack) + (yy_buffer_stack_max), 0, grow_size * sizeof(struct yy_buffer_state*));
+ (yy_buffer_stack_max) = num_to_alloc;
+ }
+}
+
+/** Setup the input buffer state to scan directly from a user-specified character buffer.
+ * @param base the character buffer
+ * @param size the size in bytes of the character buffer
+ *
+ * @return the newly allocated buffer state object.
+ */
+YY_BUFFER_STATE yy_scan_buffer (char * base, yy_size_t size )
+{
+ YY_BUFFER_STATE b;
+
+ if ( size < 2 ||
+ base[size-2] != YY_END_OF_BUFFER_CHAR ||
+ base[size-1] != YY_END_OF_BUFFER_CHAR )
+ /* They forgot to leave room for the EOB's. */
+ return NULL;
+
+ b = (YY_BUFFER_STATE) yyalloc( sizeof( struct yy_buffer_state ) );
+ if ( ! b )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_scan_buffer()" );
+
+ b->yy_buf_size = (int) (size - 2); /* "- 2" to take care of EOB's */
+ b->yy_buf_pos = b->yy_ch_buf = base;
+ b->yy_is_our_buffer = 0;
+ b->yy_input_file = NULL;
+ b->yy_n_chars = b->yy_buf_size;
+ b->yy_is_interactive = 0;
+ b->yy_at_bol = 1;
+ b->yy_fill_buffer = 0;
+ b->yy_buffer_status = YY_BUFFER_NEW;
+
+ yy_switch_to_buffer( b );
+
+ return b;
+}
+
+/** Setup the input buffer state to scan a string. The next call to yylex() will
+ * scan from a @e copy of @a str.
+ * @param yystr a NUL-terminated string to scan
+ *
+ * @return the newly allocated buffer state object.
+ * @note If you want to scan bytes that may contain NUL values, then use
+ * yy_scan_bytes() instead.
+ */
+YY_BUFFER_STATE yy_scan_string (const char * yystr )
+{
+
+ return yy_scan_bytes( yystr, (int) strlen(yystr) );
+}
+
+/** Setup the input buffer state to scan the given bytes. The next call to yylex() will
+ * scan from a @e copy of @a bytes.
+ * @param yybytes the byte buffer to scan
+ * @param _yybytes_len the number of bytes in the buffer pointed to by @a bytes.
+ *
+ * @return the newly allocated buffer state object.
+ */
+YY_BUFFER_STATE yy_scan_bytes (const char * yybytes, int _yybytes_len )
+{
+ YY_BUFFER_STATE b;
+ char *buf;
+ yy_size_t n;
+ int i;
+
+ /* Get memory for full buffer, including space for trailing EOB's. */
+ n = (yy_size_t) (_yybytes_len + 2);
+ buf = (char *) yyalloc( n );
+ if ( ! buf )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_scan_bytes()" );
+
+ for ( i = 0; i < _yybytes_len; ++i )
+ buf[i] = yybytes[i];
+
+ buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR;
+
+ b = yy_scan_buffer( buf, n );
+ if ( ! b )
+ YY_FATAL_ERROR( "bad buffer in yy_scan_bytes()" );
+
+ /* It's okay to grow etc. this buffer, and we should throw it
+ * away when we're done.
+ */
+ b->yy_is_our_buffer = 1;
+
+ return b;
+}
+
+#ifndef YY_EXIT_FAILURE
+#define YY_EXIT_FAILURE 2
+#endif
+
+static void yynoreturn yy_fatal_error (const char* msg )
+{
+ fprintf( stderr, "%s\n", msg );
+ exit( YY_EXIT_FAILURE );
+}
+
+/* Redefine yyless() so it works in section 3 code. */
+
+#undef yyless
+#define yyless(n) \
+ do \
+ { \
+ /* Undo effects of setting up yytext. */ \
+ int yyless_macro_arg = (n); \
+ YY_LESS_LINENO(yyless_macro_arg);\
+ yytext[yyleng] = (yy_hold_char); \
+ (yy_c_buf_p) = yytext + yyless_macro_arg; \
+ (yy_hold_char) = *(yy_c_buf_p); \
+ *(yy_c_buf_p) = '\0'; \
+ yyleng = yyless_macro_arg; \
+ } \
+ while ( 0 )
+
+/* Accessor methods (get/set functions) to struct members. */
+
+/** Get the current line number.
+ *
+ */
+int yyget_lineno (void)
+{
+
+ return yylineno;
+}
+
+/** Get the input stream.
+ *
+ */
+FILE *yyget_in (void)
+{
+ return yyin;
+}
+
+/** Get the output stream.
+ *
+ */
+FILE *yyget_out (void)
+{
+ return yyout;
+}
+
+/** Get the length of the current token.
+ *
+ */
+int yyget_leng (void)
+{
+ return yyleng;
+}
+
+/** Get the current token.
+ *
+ */
+
+char *yyget_text (void)
+{
+ return yytext;
+}
+
+/** Set the current line number.
+ * @param _line_number line number
+ *
+ */
+void yyset_lineno (int _line_number )
+{
+
+ yylineno = _line_number;
+}
+
+/** Set the input stream. This does not discard the current
+ * input buffer.
+ * @param _in_str A readable stream.
+ *
+ * @see yy_switch_to_buffer
+ */
+void yyset_in (FILE * _in_str )
+{
+ yyin = _in_str ;
+}
+
+void yyset_out (FILE * _out_str )
+{
+ yyout = _out_str ;
+}
+
+int yyget_debug (void)
+{
+ return yy_flex_debug;
+}
+
+void yyset_debug (int _bdebug )
+{
+ yy_flex_debug = _bdebug ;
+}
+
+static int yy_init_globals (void)
+{
+ /* Initialization is the same as for the non-reentrant scanner.
+ * This function is called from yylex_destroy(), so don't allocate here.
+ */
+
+ (yy_buffer_stack) = NULL;
+ (yy_buffer_stack_top) = 0;
+ (yy_buffer_stack_max) = 0;
+ (yy_c_buf_p) = NULL;
+ (yy_init) = 0;
+ (yy_start) = 0;
+
+/* Defined in main.c */
+#ifdef YY_STDINIT
+ yyin = stdin;
+ yyout = stdout;
+#else
+ yyin = NULL;
+ yyout = NULL;
+#endif
+
+ /* For future reference: Set errno on error, since we are called by
+ * yylex_init()
+ */
+ return 0;
+}
+
+/* yylex_destroy is for both reentrant and non-reentrant scanners. */
+int yylex_destroy (void)
+{
+
+ /* Pop the buffer stack, destroying each element. */
+ while(YY_CURRENT_BUFFER){
+ yy_delete_buffer( YY_CURRENT_BUFFER );
+ YY_CURRENT_BUFFER_LVALUE = NULL;
+ yypop_buffer_state();
+ }
+
+ /* Destroy the stack itself. */
+ yyfree((yy_buffer_stack) );
+ (yy_buffer_stack) = NULL;
+
+ /* Reset the globals. This is important in a non-reentrant scanner so the next time
+ * yylex() is called, initialization will occur. */
+ yy_init_globals( );
+
+ return 0;
+}
+
+/*
+ * Internal utility routines.
+ */
+
+#ifndef yytext_ptr
+static void yy_flex_strncpy (char* s1, const char * s2, int n )
+{
+
+ int i;
+ for ( i = 0; i < n; ++i )
+ s1[i] = s2[i];
+}
+#endif
+
+#ifdef YY_NEED_STRLEN
+static int yy_flex_strlen (const char * s )
+{
+ int n;
+ for ( n = 0; s[n]; ++n )
+ ;
+
+ return n;
+}
+#endif
+
+void *yyalloc (yy_size_t size )
+{
+ return malloc(size);
+}
+
+void *yyrealloc (void * ptr, yy_size_t size )
+{
+
+ /* The cast to (char *) in the following accommodates both
+ * implementations that use char* generic pointers, and those
+ * that use void* generic pointers. It works with the latter
+ * because both ANSI C and C++ allow castless assignment from
+ * any pointer type to void*, and deal with argument conversions
+ * as though doing an assignment.
+ */
+ return realloc(ptr, size);
+}
+
+void yyfree (void * ptr )
+{
+ free( (char *) ptr ); /* see yyrealloc() for (char *) cast */
+}
+
+#define YYTABLES_NAME "yytables"
+
+#line 97 "adv.flex"
+
+
+/*
+ * consumeLine - reads a line into a buffer, it then pushes back the whole
+ * line except the initial \n.
+ */
+
+static void consumeLine (void)
+{
+ if (currentLine->linelen<yyleng) {
+ currentLine->linebuf = (char *)realloc (currentLine->linebuf, yyleng);
+ currentLine->linelen = yyleng;
+ }
+ strcpy(currentLine->linebuf, yytext+1); /* copy all except the initial \n */
+ lineno++;
+ currentLine->actualline = lineno;
+ currentLine->tokenpos=0;
+ currentLine->nextpos=0;
+ yyless(1); /* push back all but the \n */
+}
+
+/*
+ * updatepos - updates the current token position.
+ * Should be used when a rule matches a token.
+ */
+
+static void updatepos (void)
+{
+ currentLine->nextpos = currentLine->tokenpos+yyleng;
+ currentLine->toklen = yyleng;
+}
+
+/*
+ * skippos - skips over this token. This function should be called
+ * if we are not returning and thus not calling getToken.
+ */
+
+static void skippos (void)
+{
+ currentLine->tokenpos = currentLine->nextpos;
+}
+
+/*
+ * initLine - initializes a currentLine
+ */
+
+static void initLine (void)
+{
+ currentLine = (struct lineInfo *)malloc (sizeof(struct lineInfo));
+
+ if (currentLine == NULL)
+ perror("malloc");
+ currentLine->linebuf = NULL;
+ currentLine->linelen = 0;
+ currentLine->tokenpos = 0;
+ currentLine->toklen = 0;
+ currentLine->nextpos = 0;
+ currentLine->actualline = lineno;
+}
+
+/*
+ * resetpos - resets the position of the next token to the start of the line.
+ */
+
+static void resetpos (void)
+{
+ if (currentLine != NULL)
+ currentLine->nextpos = 0;
+}
+
+/*
+ * advflex_GetToken - returns a new token.
+ */
+
+char *advflex_GetToken (void)
+{
+ if (currentLine == NULL)
+ initLine();
+ currentLine->tokenpos = currentLine->nextpos;
+ yylex();
+}
+
+void advflex_error (const char *s)
+{
+ if (currentLine != NULL) {
+ printf("%s:%d:%s\n", filename, currentLine->actualline, s);
+ printf("%s\n", currentLine->linebuf);
+# if 0
+ printf("%*s%*s\n", currentLine->nextpos, " ", currentLine->toklen, "^");
+# endif
+ }
+}
+
+/*
+ * OpenSource - returns TRUE if file, s, can be opened and
+ * all tokens are taken from this file.
+ */
+
+int advflex_OpenSource (char *s)
+{
+ FILE *f = fopen(s, "r");
+
+ if (f == NULL)
+ return FALSE;
+ else {
+ yy_delete_buffer(YY_CURRENT_BUFFER);
+ yy_switch_to_buffer(yy_create_buffer(f, YY_BUF_SIZE));
+ filename = strdup(s);
+ lineno =1;
+ if (currentLine != NULL)
+ currentLine->actualline = lineno;
+ return TRUE;
+ }
+}
+
+/*
+ * CloseSource - provided for semantic sugar
+ */
+
+void advflex_CloseSource (void)
+{
+}
+
+/*
+ * advflex_GetLineNo - returns the current line number.
+ */
+
+int advflex_GetLineNo (void)
+{
+ if (currentLine != NULL)
+ return currentLine->actualline;
+ else
+ return 0;
+}
+
+/*
+ * yywrap is called when end of file is seen. We push an eof token
+ * and tell the lexical analysis to stop.
+ */
+
+int yywrap (void)
+{
+ updatepos(); return 1;
+}
+
+void _M2_advflex_init (int, char *, char *)
+{
+}
+
+void _M2_advflex_finish (int, char *, char *)
+{
+}
+
+void _M2_advflex_ctor (void)
+{
+}
+
+#if 0
+main () {
+ char *s;
+
+ if (advflex_OpenSource("../maps/glover")) {
+ s = (char *)advflex_GetToken();
+ while (s != NULL) {
+ advflex_error(s);
+ s = (char *)advflex_GetToken();
+ }
+ }
+}
+#endif
+
--- /dev/null
+DEFINITION MODULE advflex ;
+
+(*
+ Title : advflex
+ Author : Gaius Mulley
+ System : GNU Modula-2
+ Date : Sun Jul 17 12:32:58 2005
+ Revision : $Version$
+ Description: provides access to basic lexical functions.
+*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT QUALIFIED toktype, OpenSource, CloseSource, error, GetToken, GetLineNo,
+ currenttoken, currentinteger ;
+
+TYPE
+ toktype = (eoftok, roomtok, doortok, walltok, treasuretok, attok,
+ leadstok, totok, statustok, closedtok, opentok, secrettok,
+ istok, endtok, enddottok, integertok, randomizetok) ;
+
+VAR
+ currenttoken : toktype ;
+ currentinteger: INTEGER ;
+
+PROCEDURE OpenSource (s: ADDRESS) : BOOLEAN ;
+PROCEDURE CloseSource ;
+PROCEDURE GetLineNo () : CARDINAL ;
+PROCEDURE error (s: ADDRESS) ;
+PROCEDURE GetToken ;
+
+
+END advflex.
--- /dev/null
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2023 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GCC; see the file COPYING3. If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+ strace $tracelevel
+}
+
+# load support procs
+# load_lib gm2-torture.exp
+load_lib gm2-simple.exp
+
+gm2_init_cor "${srcdir}/${subdir}" -g
+gm2_link_obj "advflex.o AdvCmd.o AdvIntroduction.o AdvMap.o AdvMath.o AdvParse.o AdvSound.o AdvSystem.o AdvTreasure.o AdvUtil.o DrawG.o DrawL.o Lock.o ProcArgs.o Screen.o Window.o SocketControl.o"
+
+
+proc gm2-local-exec { testcase execname mapfile } {
+ global tool;
+ # puts stderr "about to run: ${execname} ${mapfile}"
+
+ set pid [fork]
+ switch $pid {
+ -1 {
+ puts stderr "fork failed."
+ }
+ 0 {
+ # puts stderr "child running ${execname} ${mapfile}"
+ set result [gm2_load "$execname" "$mapfile" ""];
+ exit 0
+ }
+ default {
+ # puts stderr "parent attempting to connect to the child"
+ set port 7000;
+ # wait for 3 seconds before attempting to connect.
+ sleep 3
+ # verbose "parent attempting to connect to ${execname} ${mapfile}" 1
+ if {[catch {set chan [socket 127.0.0.1 ${port}]
+ puts ${chan} "quit\r"
+ flush ${chan}
+ close ${chan} }]} {
+ verbose "parent unable to connect to ${execname} ${mapfile}" 1
+ puts stderr "parent unable to connect to ${execname} ${mapfile}"
+ ${tool}_fail ${testcase} ${mapfile}
+ } else {
+ # verbose "parent successfully able to connect to ${execname} ${mapfile}" 1
+ # puts stderr "parent successfully connected to ${execname} ${mapfile}"
+ ${tool}_pass ${testcase} ${mapfile}
+ }
+ remote_file build delete $execname;
+ # verbose "killing off child after successful test" 1
+ puts stderr "parent successfully connected to child"
+ puts stderr "now tidying up by killing the child"
+ puts stderr "ignore next warning about sig term"
+ set res [exec kill ${pid}];
+ }
+ }
+}
+
+# If we want these to be re-built for each torture option we need some different
+#Â logic.
+gm2_target_compile $srcdir/$subdir/AdvCmd.mod AdvCmd.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/AdvIntroduction.mod AdvIntroduction.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/AdvMap.mod AdvMap.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/AdvMath.mod AdvMath.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/AdvParse.mod AdvParse.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/AdvSound.mod AdvSound.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/AdvSystem.mod AdvSystem.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/AdvTreasure.mod AdvTreasure.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/AdvUtil.mod AdvUtil.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/DrawG.mod DrawG.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/DrawL.mod DrawL.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/Lock.mod Lock.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/ProcArgs.mod ProcArgs.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/Screen.mod Screen.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/Window.mod Window.o object "-c -g -I$srcdir/$subdir/"
+
+set output [target_compile $srcdir/$subdir/SocketControl.c SocketControl.o object "-g"]
+set output [target_compile $srcdir/$subdir/advflex.c advflex.o object "-g"]
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/Dungeon.mod]] {
+ # If we're only testing specific files and this isn't one of them, skip it.
+ if ![runtest_file_p $runtests $testcase] then {
+ continue
+ }
+ set gm2_keep_executable 1
+ # gm2-torture-execute $testcase "" "pass"
+ gm2-simple-execute $testcase "" ""
+ set gm2_keep_executable 0
+
+ global tmpdir;
+ set executable $tmpdir/[file tail [file rootname $testcase].x];
+ gm2-local-exec ${testcase} ${executable} $srcdir/$subdir/star
+ remote_file build delete ${executable};
+}
--- /dev/null
+ROOM 1
+
+WALL 1 1 1 20
+WALL 1 20 20 20
+WALL 20 20 20 1
+WALL 20 1 1 1
+
+DOOR 9 20 12 20 STATUS CLOSED LEADS TO 5
+DOOR 20 9 20 12 STATUS CLOSED LEADS TO 5
+END
+
+ROOM 2
+
+WALL 26 1 45 1
+WALL 45 1 45 20
+WALL 45 20 26 20
+WALL 26 20 26 1
+
+DOOR 26 9 26 12 STATUS CLOSED LEADS TO 5
+DOOR 34 20 37 20 STATUS CLOSED LEADS TO 5
+END
+
+
+ROOM 3
+
+WALL 1 26 20 26
+WALL 20 26 20 45
+WALL 20 45 1 45
+WALL 1 45 1 26
+
+DOOR 9 26 12 26 STATUS CLOSED LEADS TO 5
+DOOR 20 34 20 37 STATUS CLOSED LEADS TO 5
+END
+
+ROOM 4
+
+WALL 26 26 45 26
+WALL 45 26 45 45
+WALL 45 45 26 45
+WALL 26 45 26 26
+
+DOOR 34 26 37 26 STATUS CLOSED LEADS TO 5
+DOOR 26 34 26 37 STATUS CLOSED LEADS TO 5
+END
+
+ROOM 5
+
+WALL 1 20 1 26
+ 1 26 20 26
+ 20 26 20 45
+ 20 45 26 45
+ 26 45 26 26
+ 26 26 45 26
+ 45 26 45 20
+ 45 20 26 20
+ 26 20 26 1
+ 26 1 20 1
+ 20 1 20 20
+ 20 20 1 20
+
+DOOR 9 20 12 20 STATUS CLOSED LEADS TO 1
+DOOR 20 9 20 12 STATUS CLOSED LEADS TO 1
+DOOR 26 9 26 12 STATUS CLOSED LEADS TO 2
+DOOR 34 20 37 20 STATUS CLOSED LEADS TO 2
+DOOR 9 26 12 26 STATUS CLOSED LEADS TO 3
+DOOR 20 34 20 37 STATUS CLOSED LEADS TO 3
+DOOR 34 26 37 26 STATUS CLOSED LEADS TO 4
+DOOR 26 34 26 37 STATUS CLOSED LEADS TO 4
+END
+RANDOMIZE TREASURE 1 3 4 6 7 8 9 10 11 12 14 16 17 18
+END.
# load support procs
load_lib gm2-torture.exp
-gm2_init_pim2 "${srcdir}/gm2/switches/auto-init/fail" -fsoft-check-all -O2 -fauto-init
+gm2_init_pim2 "${srcdir}/gm2/switches/auto-init/fail" -fsoft-check-all -O2 -fauto-init -fm2-pathname=- -I${srcdir}/gm2/switches/auto-init/fail
foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
# If we're only testing specific files and this isn't one of them, skip it.
# load support procs
load_lib gm2-torture.exp
-gm2_init_pim2 "${srcdir}/gm2/switches/check-all/pim2/fail" -fsoft-check-all -O2
+gm2_init_pim2 "${srcdir}/gm2/switches/check-all/pim2/fail" -fsoft-check-all -O2 -g -fm2-pathname=- -I${srcdir}/gm2/switches/check-all/pim2/fail
foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
# If we're only testing specific files and this isn't one of them, skip it.
# attempts to use gm2 -fmakeall to build a syntactally incorrect program.
#
-gm2_init "$srcdir/../gm2/gm2-libs $srcdir/gm2/switches/makeall/fail" -fmakeall
+gm2_init "${srcdir}/../gm2/gm2-libs $srcdir/gm2/switches/makeall/fail" -fmakeall
foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
# load support procs
load_lib gm2-torture.exp
-gm2_init "${srcdir}/gm2/switches/makeall/pass" -fmakeall
gm2_init_pim4 "${srcdir}/gm2/switches/makeall/pass"
foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
load_lib file-format.exp
load_lib gm2.exp
+set gm2_keep_executable 0
+
#
# gm2-simple-compile -- runs the compiler
#
global gm2_link_libraries;
global gm2_link_path;
global gm2_link_objects;
+ global gm2_keep_executable;
# Use the first source filename given as the filename under test.
set src [lindex $sources 0];
# now append path -fno-libs=- and objects
set options [concat "{additional_flags=$gm2_link_path} " $options]
set options [concat "{additional_flags=-fno-libs=-} " $options]
- set options [concat "{additional_flags=$gm2_link_objects} " $options]
set comp_output [gm2_target_compile "${sources}" "${execname}" executable ${options}];
}
if { $status == "pass" } {
${tool}_pass $testcase $option
- remote_file build delete $execname;
+ # puts stderr $execname
+ if { ! $gm2_keep_executable } {
+ remote_file build delete $execname;
+ }
}
return 1
}
# OPTION is the specific compiler flag we're testing (eg: -O2).
#
proc gm2-torture-compile { src option } {
- global output
- global srcdir tmpdir
- global host_triplet
+ global output;
+ global srcdir tmpdir;
+ global host_triplet;
set output "$tmpdir/[file tail [file rootname $src]].o"
#
proc gm2_check_compile_fail {testcase option objname gcc_output} {
- global tool
+ global tool;
set fatal_signal "*cc: Internal compiler error: program*got fatal signal"
if [string match "$fatal_signal 6" $gcc_output] then {
# OPTION is the specific compiler flag we're testing (eg: -O2).
#
proc gm2-torture-compile-fail { src option } {
- global output
- global srcdir tmpdir
- global host_triplet
+ global output;
+ global srcdir tmpdir;
+ global host_triplet;
# puts stderr "gm2-torture-compile-fail: ${option}\n"
set output "$tmpdir/[file tail [file rootname $src]].o"
# to more than 14 chars.
#
proc gm2-torture { args } {
- global srcdir subdir compiler_conditional_xfail_data TORTURE_OPTIONS
+ global srcdir subdir compiler_conditional_xfail_data TORTURE_OPTIONS;
set src [lindex $args 0];
if { [llength $args] > 1 } {
# to more than 14 chars.
#
proc gm2-torture-fail { args } {
- global srcdir subdir compiler_conditional_xfail_data TORTURE_OPTIONS
+ global srcdir subdir compiler_conditional_xfail_data TORTURE_OPTIONS;
set src [lindex $args 0];
if { [llength $args] > 1 } {
send_log "gccpath is $gccpath\n"
send_log "gm2src is $gm2src\n"
- set theIpath -I${gccpath}/libgm2/libm2pim
+ set theIpath -fm2-pathname=m2pim
+ lappend theIpath -I${gccpath}/libgm2/libm2pim
+ lappend theIpath -fm2-pathname=m2log
lappend theIpath -I${gm2src}/gm2-libs-log
#Â NOTE:
+ lappend theIpath -fm2-pathname=m2pim
lappend theIpath -I${gm2src}/gm2-libs
set theLpath -L${gccpath}/libgm2/libm2pim/.libs
+ lappend theIpath -fm2-pathname=m2iso
lappend theIpath -I${gccpath}/libgm2/libm2iso
lappend theIpath -I${gm2src}/gm2-libs-iso
lappend theLpath -L${gccpath}/libgm2/libm2iso/.libs
+ lappend theIpath -fm2-pathname=-
foreach p $paths {
lappend theIpath -I$p
}
+ lappend theIpath -fm2-pathname=-
gm2_link_lib "m2pim m2iso"
lappend args -fno-libs=-
set gm2src ${srcdir}/../m2
- set theIpath -I${gccpath}/libgm2/libm2iso
+ set theIpath -fm2-pathname=m2iso
+ lappend theIpath -I${gccpath}/libgm2/libm2iso
lappend theIpath -I${gm2src}/gm2-libs-iso
set theLpath -L${gccpath}/libgm2/libm2iso/.libs
+ lappend theIpath -fm2-pathname=m2pim
lappend theIpath -I${gccpath}/libgm2/libm2pim
+
+ lappend theIpath -fm2-pathname=m2log
lappend theIpath -I${gm2src}/gm2-libs-log
#Â NOTE:
+ lappend theIpath -fm2-pathname=m2pim
lappend theIpath -I${gm2src}/gm2-libs
lappend theLpath -L${gccpath}/libgm2/libm2pim/.libs
+ lappend theIpath -fm2-pathname=m2cor
lappend theIpath -I${gccpath}/libgm2/libm2cor
lappend theIpath -I${gm2src}/gm2-libs-coroutines
lappend theLpath -L${gccpath}/libgm2/libm2cor/.libs
+ lappend theIpath -fm2-pathname=-
foreach p $paths {
lappend theIpath -I$p
}
+ lappend theIpath -fm2-pathname=-
gm2_link_lib "m2iso m2pim m2cor"
lappend args -fno-libs=-
set gm2src ${srcdir}/../m2
- set theIpath -I${gccpath}/libgm2/libm2ulm
+ set theIpath -fm2-pathname=m2ulm
+ lappend theIpath -I${gccpath}/libgm2/libm2ulm
lappend theIpath -I${gm2src}/ulm-lib-gm2/std
lappend theIpath -I${gm2src}/ulm-lib-gm2/sys
set theLpath -L${gccpath}/libgm2/libm2ulm/.libs
+ lappend theIpath -fm2-pathname=m2pim
lappend theIpath -I${gccpath}/libgm2/libm2pim
+ lappend theIpath -fm2-pathname=m2log
lappend theIpath -I${gm2src}/gm2-libs-log
#Â NOTE:
+ lappend theIpath -fm2-pathname=m2pim
lappend theIpath -I${gm2src}/gm2-libs
lappend theLpath -L${gccpath}/libgm2/libm2pim/.libs
+ lappend theIpath -fm2-pathname=-
foreach p $paths {
lappend theIpath -I$p
}
+ lappend theIpath -fm2-pathname=-
gm2_link_lib "m2ulm m2pim"
lappend args -fno-libs=-
send_log "gm2src is $gm2src\n"
# FIXME: this seems to interleave the library defs.
- set theIpath -I${gccpath}/libgm2/libm2log
+ set theIpath -fm2-pathname=m2log
+ lappend theIpath -I${gccpath}/libgm2/libm2log
lappend theIpath -I${gm2src}/gm2-libs-log
set theLpath -L${gccpath}/libgm2/libm2log/.libs
+ lappend theIpath -fm2-pathname=m2pim
lappend theIpath -I${gccpath}/libgm2/libm2pim
lappend theIpath -I${gm2src}/gm2-libs
lappend theLpath -L${gccpath}/libgm2/libm2pim/.libs
+ lappend theIpath -fm2-pathname=m2iso
lappend theIpath -I${gccpath}/libgm2/libm2iso
lappend theIpath -I${gm2src}/gm2-libs-iso
# ??? lappend theIpath -I${gm2src}/gm2-libs
lappend theLpath -L${gccpath}/libgm2/libm2iso/.libs
+ lappend theIpath -fm2-pathname=-
foreach p $paths {
lappend theIpath -I$p
}
+ lappend theIpath -fm2-pathname=-
gm2_link_lib "m2log m2pim m2iso"
lappend args -fno-libs=-
send_log "gccpath is $gccpath\n"
send_log "gm2src is $gm2src\n"
- set theIpath -I${gccpath}/libgm2/libm2cor
+ set theIpath -fm2-pathname=m2cor
+ lappend theIpath -I${gccpath}/libgm2/libm2cor
lappend theIpath -I${gm2src}/gm2-libs-coroutines
set theLpath -L${gccpath}/libgm2/libm2cor/.libs
+ lappend theIpath -fm2-pathname=m2pim
lappend theIpath -I${gccpath}/libgm2/libm2pim
+
+ lappend theIpath -fm2-pathname=m2log
lappend theIpath -I${gm2src}/gm2-libs-log
+ lappend theIpath -fm2-pathname=m2pim
lappend theLpath -L${gccpath}/libgm2/libm2pim/.libs
+ lappend theIpath -fm2-pathname=m2log
lappend theIpath -I${gccpath}/libgm2/libm2log
+
+ lappend theIpath -fm2-pathname=m2pim
lappend theIpath -I${gm2src}/gm2-libs
+ lappend theIpath -fm2-pathname=m2log
lappend theLpath -L${gccpath}/libgm2/libm2log/.libs
+ lappend theIpath -fm2-pathname=m2iso
lappend theIpath -I${gccpath}/libgm2/libm2iso
lappend theIpath -I${gm2src}/gm2-libs-iso
lappend theLpath -L${gccpath}/libgm2/libm2iso/.libs
+ lappend theIpath -fm2-pathname=-
foreach p $paths {
lappend theIpath -I$p
}
+ lappend theIpath -fm2-pathname=-
gm2_link_lib "m2cor m2pim m2log m2iso"
append args " -fno-libs=- "
send_log "gccpath is $gccpath\n"
send_log "gm2src is $gm2src\n"
- set theIpath -I${gccpath}/libgm2/libm2min
+ set theIpath -fm2-pathname=m2min
+ lappend theIpath -I${gccpath}/libgm2/libm2min
lappend theIpath -I${gm2src}/gm2-libs-min
set theLpath -L${gccpath}/libgm2/libm2min/.libs
+ lappend theIpath -fm2-pathname=-
foreach p $paths {
lappend theIpath -I$p
}
+ lappend theIpath -fm2-pathname=-
gm2_link_lib "m2min"
lappend args -fno-exceptions
#include <config.h>
#include <m2rts.h>
+#define EXPORT(FUNC) m2cor ## _KeyBoardLEDs_ ## FUNC
+#define M2EXPORT(FUNC) m2cor ## _M2_KeyBoardLEDs_ ## FUNC
+#define M2LIBNAME "m2cor"
+
#if defined(linux)
#include <sys/types.h>
extern "C" void
-KeyBoardLEDs_SwitchScroll (int scrolllock)
+EXPORT(SwitchScroll) (int scrolllock)
{
unsigned char leds;
int r = ioctl (fd, KDGETLED, &leds);
}
extern "C" void
-KeyBoardLEDs_SwitchNum (int numlock)
+EXPORT(SwitchNum) (int numlock)
{
unsigned char leds;
int r = ioctl (fd, KDGETLED, &leds);
}
extern "C" void
-KeyBoardLEDs_SwitchCaps (int capslock)
+EXPORT(SwitchCaps) (int capslock)
{
unsigned char leds;
int r = ioctl (fd, KDGETLED, &leds);
}
extern "C" void
-KeyBoardLEDs_SwitchLeds (int numlock, int capslock, int scrolllock)
+EXPORT(SwitchLeds) (int numlock, int capslock, int scrolllock)
{
- KeyBoardLEDs_SwitchScroll (scrolllock);
- KeyBoardLEDs_SwitchNum (numlock);
- KeyBoardLEDs_SwitchCaps (capslock);
+ EXPORT(SwitchScroll) (scrolllock);
+ EXPORT(SwitchNum) (numlock);
+ EXPORT(SwitchCaps) (capslock);
}
extern "C" void
-_M2_KeyBoardLEDs_init (int, char **, char **)
+M2EXPORT(init) (int, char **, char **)
{
if (! initialized)
{
#else
extern "C" void
-KeyBoardLEDs_SwitchLeds (int numlock, int capslock, int scrolllock)
+EXPORT(SwitchLeds) (int numlock, int capslock, int scrolllock)
{
}
extern "C" void
-KeyBoardLEDs_SwitchScroll (int scrolllock)
+EXPORT(SwitchScroll) (int scrolllock)
{
}
extern "C" void
-KeyBoardLEDs_SwitchNum (int numlock)
+EXPORT(SwitchNum) (int numlock)
{
}
extern "C" void
-KeyBoardLEDs_SwitchCaps (int capslock)
+EXPORT(SwitchCaps) (int capslock)
{
}
extern "C" void
-_M2_KeyBoardLEDs_init (int, char **, char **)
+M2EXPORT(init) (int, char **, char **)
{
}
-
#endif
/* GNU Modula-2 linking hooks. */
extern "C" void
-_M2_KeyBoardLEDs_finish (int, char **, char **)
+M2EXPORT(fini) (int, char **, char **)
{
}
extern "C" void
-_M2_KeyBoardLEDs_dep (void)
+M2EXPORT(dep) (void)
{
}
extern "C" void __attribute__((__constructor__))
- _M2_KeyBoardLEDs_ctor (void)
+M2EXPORT(ctor) (void)
{
- M2RTS_RegisterModule ("KeyBoardLEDs", _M2_KeyBoardLEDs_init, _M2_KeyBoardLEDs_finish,
- _M2_KeyBoardLEDs_dep);
+ m2pim_M2RTS_RegisterModule ("KeyBoardLEDs", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini),
+ M2EXPORT(dep));
}
libm2cordir = libm2cor
libm2cor_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2cor_la_SOURCES)))
libm2cor_la_CFLAGS = -I. -I.. -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -DBUILD_GM2_LIBS -I@srcdir@/../ -I@srcdir@/../libm2iso
-libm2cor_la_M2FLAGS = -I. -I$(GM2_SRC)/gm2-libs-coroutines -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -fm2-g -g -Wreturn-type -fcase
+libm2cor_la_M2FLAGS = \
+ -fm2-pathname=m2cor -I. -I$(GM2_SRC)/gm2-libs-coroutines \
+ -fm2-pathname=m2pim -I$(GM2_SRC)/gm2-libs \
+ -fm2-pathname=m2iso -I$(GM2_SRC)/gm2-libs-iso \
+ -fm2-g -g -Wreturn-type -fcase -fm2-prefix=m2cor
if TARGET_DARWIN
libm2cor_la_link_flags = -Wl,-undefined,dynamic_lookup
else
@BUILD_CORLIB_TRUE@libm2cordir = libm2cor
@BUILD_CORLIB_TRUE@libm2cor_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2cor_la_SOURCES)))
@BUILD_CORLIB_TRUE@libm2cor_la_CFLAGS = -I. -I.. -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -DBUILD_GM2_LIBS -I@srcdir@/../ -I@srcdir@/../libm2iso
-@BUILD_CORLIB_TRUE@libm2cor_la_M2FLAGS = -I. -I$(GM2_SRC)/gm2-libs-coroutines -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -fm2-g -g -Wreturn-type -fcase
+@BUILD_CORLIB_TRUE@libm2cor_la_M2FLAGS = \
+@BUILD_CORLIB_TRUE@ -fm2-pathname=m2cor -I. -I$(GM2_SRC)/gm2-libs-coroutines \
+@BUILD_CORLIB_TRUE@ -fm2-pathname=m2pim -I$(GM2_SRC)/gm2-libs \
+@BUILD_CORLIB_TRUE@ -fm2-pathname=m2iso -I$(GM2_SRC)/gm2-libs-iso \
+@BUILD_CORLIB_TRUE@ -fm2-g -g -Wreturn-type -fcase -fm2-prefix=m2cor
+
@BUILD_CORLIB_TRUE@@TARGET_DARWIN_FALSE@libm2cor_la_link_flags =
@BUILD_CORLIB_TRUE@@TARGET_DARWIN_TRUE@libm2cor_la_link_flags = -Wl,-undefined,dynamic_lookup
@BUILD_CORLIB_TRUE@libm2cor_la_LINK = $(LINK) -version-info $(libtool_VERSION) $(libm2cor_la_link_flags)
<http://www.gnu.org/licenses/>. */
#include "config.h"
-
#include "ChanConsts.h"
#if defined(HAVE_ERRNO_H)
#include "m2rts.h"
+#define EXPORT(FUNC) m2iso ## _ErrnoCategory_ ## FUNC
+#define M2EXPORT(FUNC) m2iso ## _M2_ErrnoCategory_ ## FUNC
+#define M2LIBNAME "m2iso"
+
+
#if !defined(FALSE)
#define FALSE (1 == 0)
#endif
with a hard device error. */
extern "C" int
-ErrnoCategory_IsErrnoHard (int e)
+EXPORT(IsErrnoHard) (int e)
{
#if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H)
return ((e == EPERM) || (e == ENOENT) || (e == EIO) || (e == ENXIO)
with a soft device error. */
extern "C" int
-ErrnoCategory_IsErrnoSoft (int e)
+EXPORT(IsErrnoSoft) (int e)
{
#if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H)
return ((e == ESRCH) || (e == EINTR) || (e == E2BIG) || (e == ENOEXEC)
}
extern "C" int
-ErrnoCategory_UnAvailable (int e)
+EXPORT(UnAvailable) (int e)
{
#if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H)
return ((e == ENOENT) || (e == ESRCH) || (e == ENXIO) || (e == ECHILD)
OpenResults. */
extern "C" openResults
-ErrnoCategory_GetOpenResults (int e)
+EXPORT(GetOpenResults) (int e)
{
if (e == 0)
return opened;
/* GNU Modula-2 linking fodder. */
extern "C" void
-_M2_ErrnoCategory_init (int, char *argv[], char *env[])
+M2EXPORT(init) (int, char **, char **)
{
}
extern "C" void
-_M2_ErrnoCategory_fini (int, char *argv[], char *env[])
+M2EXPORT(fini) (int, char **, char **)
{
}
extern "C" void
-_M2_ErrnoCategory_dep (void)
+M2EXPORT(dep) (void)
{
}
extern "C" void __attribute__((__constructor__))
-_M2_ErrnoCategory_ctor (void)
+M2EXPORT(ctor) (void)
{
- M2RTS_RegisterModule ("ErrnoCategory", _M2_ErrnoCategory_init, _M2_ErrnoCategory_fini,
- _M2_ErrnoCategory_dep);
+ m2iso_M2RTS_RegisterModule ("ErrnoCategory", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini),
+ M2EXPORT(dep));
}
# along with this program; see the file COPYING3. If not see
# <http://www.gnu.org/licenses/>.
-SUFFIXES = .c .mod .def .o .obj .lo .a .la
+SUFFIXES = .c .cc .mod .def .o .obj .lo .a .la
ACLOCAL_AMFLAGS = -I . -I .. -I ../config
toolexeclib_LTLIBRARIES = libm2iso.la
libm2iso_la_SOURCES = $(M2MODS) \
- ErrnoCategory.cc wrapsock.c \
- wraptime.c RTco.cc
+ ErrnoCategory.cc wraptime.cc RTco.cc wrapsock.c
+# wrapsock.cc
C_INCLUDES = -I.. -I$(toplevel_srcdir)/libiberty -I$(toplevel_srcdir)/include
libm2isodir = libm2iso
libm2iso_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2iso_la_SOURCES)))
libm2iso_la_CFLAGS = $(C_INCLUDES) -I. -I.. -I$(GM2_SRC)/gm2-libs-iso -I$(GM2_SRC)/gm2-libs -DBUILD_GM2_LIBS -I@srcdir@/../ -I../../../gcc -I$(GCC_DIR) -I$(GCC_DIR)/../include -I../../libgcc -I$(GCC_DIR)/../libgcc -I$(MULTIBUILDTOP)../../gcc/include
-libm2iso_la_M2FLAGS = -I. -Ilibm2iso -I$(GM2_SRC)/gm2-libs-iso -I$(GM2_SRC)/gm2-libs -fiso -fextended-opaque -fm2-g -g -Wreturn-type -fcase
+libm2iso_la_M2FLAGS = \
+ -fm2-pathname=m2iso -I. -Ilibm2iso -I$(GM2_SRC)/gm2-libs-iso \
+ -fm2-pathname=m2pim -I$(GM2_SRC)/gm2-libs \
+ -fiso -fextended-opaque -fm2-g -g -Wreturn-type -fcase -fm2-prefix=m2iso
if TARGET_DARWIN
libm2iso_la_link_flags = -Wl,-undefined,dynamic_lookup
else
-I$(GM2_SRC)/gm2-libs-iso -I$(GM2_SRC)/gm2-libs \
"$(GM2_FOR_TARGET)" $@
-## add these to the .mod.o rule when optimization is fixed $(CFLAGS_FOR_TARGET) $(LIBCFLAGS)
-
.mod.lo:
$(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(GM2_FOR_TARGET) -c $(CFLAGS_FOR_TARGET) $(LIBCFLAGS) $(libm2iso_la_M2FLAGS) $< -o $@
-.c.lo:
- $(LIBTOOL) --tag=CC --mode=compile $(CC) -c $(CFLAGS) $(LIBCFLAGS) $(libm2iso_la_CFLAGS) $< -o $@
-
.cc.lo:
$(LIBTOOL) --tag=CXX --mode=compile $(CXX) -c -I$(srcdir) $(CXXFLAGS) $(LIBCFLAGS) $(libm2iso_la_CFLAGS) $< -o $@
+.c.lo:
+ $(LIBTOOL) --tag=CC --mode=compile $(CC) -c -I$(srcdir) $(CFLAGS) $(LIBCFLAGS) $(libm2iso_la_CFLAGS) $< -o $@
+
install-data-local: force
mkdir -p $(DESTDIR)$(inst_libdir)/$(M2LIBDIR)
for i in $(M2DEFS) $(M2MODS) ; do \
@BUILD_ISOLIB_TRUE@ TextIO.lo WholeConv.lo WholeIO.lo \
@BUILD_ISOLIB_TRUE@ WholeStr.lo
@BUILD_ISOLIB_TRUE@am_libm2iso_la_OBJECTS = $(am__objects_1) \
-@BUILD_ISOLIB_TRUE@ ErrnoCategory.lo libm2iso_la-wrapsock.lo \
-@BUILD_ISOLIB_TRUE@ libm2iso_la-wraptime.lo RTco.lo
+@BUILD_ISOLIB_TRUE@ ErrnoCategory.lo wraptime.lo RTco.lo \
+@BUILD_ISOLIB_TRUE@ libm2iso_la-wrapsock.lo
libm2iso_la_OBJECTS = $(am_libm2iso_la_OBJECTS)
@BUILD_ISOLIB_TRUE@am_libm2iso_la_rpath = -rpath $(toolexeclibdir)
AM_V_P = $(am__v_P_@AM_V@)
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
-SUFFIXES = .c .mod .def .o .obj .lo .a .la
+SUFFIXES = .c .cc .mod .def .o .obj .lo .a .la
ACLOCAL_AMFLAGS = -I . -I .. -I ../config
# Multilib support.
@BUILD_ISOLIB_TRUE@toolexeclib_LTLIBRARIES = libm2iso.la
@BUILD_ISOLIB_TRUE@libm2iso_la_SOURCES = $(M2MODS) \
-@BUILD_ISOLIB_TRUE@ ErrnoCategory.cc wrapsock.c \
-@BUILD_ISOLIB_TRUE@ wraptime.c RTco.cc
+@BUILD_ISOLIB_TRUE@ ErrnoCategory.cc wraptime.cc RTco.cc wrapsock.c
+# wrapsock.cc
@BUILD_ISOLIB_TRUE@C_INCLUDES = -I.. -I$(toplevel_srcdir)/libiberty -I$(toplevel_srcdir)/include
@BUILD_ISOLIB_TRUE@libm2isodir = libm2iso
@BUILD_ISOLIB_TRUE@libm2iso_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2iso_la_SOURCES)))
@BUILD_ISOLIB_TRUE@libm2iso_la_CFLAGS = $(C_INCLUDES) -I. -I.. -I$(GM2_SRC)/gm2-libs-iso -I$(GM2_SRC)/gm2-libs -DBUILD_GM2_LIBS -I@srcdir@/../ -I../../../gcc -I$(GCC_DIR) -I$(GCC_DIR)/../include -I../../libgcc -I$(GCC_DIR)/../libgcc -I$(MULTIBUILDTOP)../../gcc/include
-@BUILD_ISOLIB_TRUE@libm2iso_la_M2FLAGS = -I. -Ilibm2iso -I$(GM2_SRC)/gm2-libs-iso -I$(GM2_SRC)/gm2-libs -fiso -fextended-opaque -fm2-g -g -Wreturn-type -fcase
+@BUILD_ISOLIB_TRUE@libm2iso_la_M2FLAGS = \
+@BUILD_ISOLIB_TRUE@ -fm2-pathname=m2iso -I. -Ilibm2iso -I$(GM2_SRC)/gm2-libs-iso \
+@BUILD_ISOLIB_TRUE@ -fm2-pathname=m2pim -I$(GM2_SRC)/gm2-libs \
+@BUILD_ISOLIB_TRUE@ -fiso -fextended-opaque -fm2-g -g -Wreturn-type -fcase -fm2-prefix=m2iso
+
@BUILD_ISOLIB_TRUE@@TARGET_DARWIN_FALSE@libm2iso_la_link_flags =
@BUILD_ISOLIB_TRUE@@TARGET_DARWIN_TRUE@libm2iso_la_link_flags = -Wl,-undefined,dynamic_lookup
@BUILD_ISOLIB_TRUE@libm2iso_la_LINK = $(LINK) -version-info $(libtool_VERSION) $(libm2iso_la_link_flags)
$(MAKE) $(AM_MAKEFLAGS) all-am
.SUFFIXES:
-.SUFFIXES: .c .mod .def .o .obj .lo .a .la .cc
+.SUFFIXES: .c .cc .mod .def .o .obj .lo .a .la
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ErrnoCategory.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/RTco.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libm2iso_la-wrapsock.Plo@am__quote@
-@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libm2iso_la-wraptime.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/wraptime.Plo@am__quote@
.c.o:
@am__fastdepCC_TRUE@ $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libm2iso_la_CFLAGS) $(CFLAGS) -c -o libm2iso_la-wrapsock.lo `test -f 'wrapsock.c' || echo '$(srcdir)/'`wrapsock.c
-libm2iso_la-wraptime.lo: wraptime.c
-@am__fastdepCC_TRUE@ $(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libm2iso_la_CFLAGS) $(CFLAGS) -MT libm2iso_la-wraptime.lo -MD -MP -MF $(DEPDIR)/libm2iso_la-wraptime.Tpo -c -o libm2iso_la-wraptime.lo `test -f 'wraptime.c' || echo '$(srcdir)/'`wraptime.c
-@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/libm2iso_la-wraptime.Tpo $(DEPDIR)/libm2iso_la-wraptime.Plo
-@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='wraptime.c' object='libm2iso_la-wraptime.lo' libtool=yes @AMDEPBACKSLASH@
-@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
-@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libm2iso_la_CFLAGS) $(CFLAGS) -c -o libm2iso_la-wraptime.lo `test -f 'wraptime.c' || echo '$(srcdir)/'`wraptime.c
-
.cc.o:
@am__fastdepCXX_TRUE@ $(AM_V_CXX)$(CXXCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
@am__fastdepCXX_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
@BUILD_ISOLIB_TRUE@.mod.lo:
@BUILD_ISOLIB_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(GM2_FOR_TARGET) -c $(CFLAGS_FOR_TARGET) $(LIBCFLAGS) $(libm2iso_la_M2FLAGS) $< -o $@
-@BUILD_ISOLIB_TRUE@.c.lo:
-@BUILD_ISOLIB_TRUE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) -c $(CFLAGS) $(LIBCFLAGS) $(libm2iso_la_CFLAGS) $< -o $@
-
@BUILD_ISOLIB_TRUE@.cc.lo:
@BUILD_ISOLIB_TRUE@ $(LIBTOOL) --tag=CXX --mode=compile $(CXX) -c -I$(srcdir) $(CXXFLAGS) $(LIBCFLAGS) $(libm2iso_la_CFLAGS) $< -o $@
+@BUILD_ISOLIB_TRUE@.c.lo:
+@BUILD_ISOLIB_TRUE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) -c -I$(srcdir) $(CFLAGS) $(LIBCFLAGS) $(libm2iso_la_CFLAGS) $< -o $@
+
@BUILD_ISOLIB_TRUE@install-data-local: force
@BUILD_ISOLIB_TRUE@ mkdir -p $(DESTDIR)$(inst_libdir)/$(M2LIBDIR)
@BUILD_ISOLIB_TRUE@ for i in $(M2DEFS) $(M2MODS) ; do \
#include <m2rts.h>
#include <cstdio>
-#define EXPORT(FUNC) RTco_ ## FUNC
-#define M2EXPORT(FUNC) _M2_RTco_ ## FUNC
+#define EXPORT(FUNC) m2iso ## _RTco_ ## FUNC
+#define M2EXPORT(FUNC) m2iso ## _M2_RTco_ ## FUNC
+#define M2LIBNAME "m2iso"
/* This implementation of RTco.cc uses a single lock for mutex across
the whole module. It also forces context switching between threads
static __gthread_mutex_t lock; /* This is the only mutex for
the whole module. */
static int initialized = FALSE;
-static int currentThread = 0;
-
extern "C" int EXPORT(init) (void);
-
extern "C" void
M2EXPORT(dep) (void)
{
= (threadSem *)malloc (sizeof (threadSem));
nSemaphores += 1;
if (nSemaphores == SEM_POOL)
- M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
- "too many semaphores created");
+ m2iso_M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
+ "too many semaphores created");
#else
threadSem *sem
= (threadSem *)malloc (sizeof (threadSem));
return sid;
}
+static int
+currentThread (void)
+{
+ int tid;
+
+ for (tid = 0; tid < nThreads; tid++)
+ if (pthread_self () == threadArray[tid].p)
+ return tid;
+ m2iso_M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
+ "failed to find currentThread");
+}
+
extern "C" int
EXPORT(currentThread) (void)
{
EXPORT(init) ();
__gthread_mutex_lock (&lock);
- tid = currentThread;
+ tid = currentThread ();
tprintf ("currentThread %d\n", tid);
__gthread_mutex_unlock (&lock);
return tid;
{
EXPORT(init) ();
__gthread_mutex_lock (&lock);
+ int current = currentThread ();
tprintf ("currentInterruptLevel %d\n",
- threadArray[currentThread].interruptLevel);
- int level = threadArray[currentThread].interruptLevel;
+ threadArray[current].interruptLevel);
+ int level = threadArray[current].interruptLevel;
__gthread_mutex_unlock (&lock);
return level;
}
{
EXPORT(init) ();
__gthread_mutex_lock (&lock);
- unsigned int old = threadArray[currentThread].interruptLevel;
+ int current = currentThread ();
+ unsigned int old = threadArray[current].interruptLevel;
tprintf ("turnInterrupts from %d to %d\n", old, newLevel);
- threadArray[currentThread].interruptLevel = newLevel;
+ threadArray[current].interruptLevel = newLevel;
__gthread_mutex_unlock (&lock);
return old;
}
static void
never (void)
{
- M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
- "the main thread should never call here");
+ m2iso_M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
+ "the main thread should never call here");
}
static void *
__gthread_mutex_unlock (&lock);
tp->proc (); /* Now execute user procedure. */
#if 0
- M2RTS_CoroutineException ( __FILE__, __LINE__, __COLUMN__, __FUNCTION__, "coroutine finishing");
+ m2iso_M2RTS_CoroutineException ( __FILE__, __LINE__, __COLUMN__, __FUNCTION__, "coroutine finishing");
#endif
- M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
- "execThread should never finish");
+ m2iso_M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
+ "execThread should never finish");
return NULL;
}
#if defined(POOL)
nThreads += 1;
if (nThreads == THREAD_POOL)
- M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
- "too many threads created");
+ m2iso_M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
+ "too many threads created");
return nThreads - 1;
#else
if (nThreads == 0)
/* Set thread creation attributes. */
result = pthread_attr_init (&attr);
if (result != 0)
- M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
- "failed to create thread attribute");
+ m2iso_M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
+ "failed to create thread attribute");
if (stackSize > 0)
{
result = pthread_attr_setstacksize (&attr, stackSize);
if (result != 0)
- M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
- "failed to set stack size attribute");
+ m2iso_M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
+ "failed to set stack size attribute");
}
tprintf ("initThread [%d] function = 0x%p (arg = 0x%p)\n", tid, proc,
result = pthread_create (&threadArray[tid].p, &attr, execThread,
(void *)&threadArray[tid]);
if (result != 0)
- M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__, "thread_create failed");
+ m2iso_M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__, "thread_create failed");
tprintf (" created thread [%d] function = 0x%p 0x%p\n", tid, proc,
(void *)&threadArray[tid]);
return tid;
{
__gthread_mutex_lock (&lock);
{
+ int current = currentThread ();
if (!initialized)
- M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
- "cannot transfer to a process before the process has been created");
- if (currentThread == p2)
+ m2iso_M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
+ "cannot transfer to a process before the process has been created");
+ if (current == p2)
{
/* Error. */
- M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
- "attempting to transfer to ourself");
+ m2iso_M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
+ "attempting to transfer to ourself");
}
else
{
- *p1 = currentThread;
- int old = currentThread;
- tprintf ("start, context switching from: %d to %d\n", currentThread, p2);
+ *p1 = current;
+ int old = current;
+ tprintf ("start, context switching from: %d to %d\n", current, p2);
/* Perform signal (p2 sem). Without the mutex lock as we have
already obtained it above. */
if (threadArray[p2].waiting)
{
/* p2 is blocked on the condition variable, release it. */
- tprintf ("p1 = %d cond_signal to p2 (%d)\n", currentThread, p2);
+ tprintf ("p1 = %d cond_signal to p2 (%d)\n", current, p2);
__gthread_cond_signal (&threadArray[p2].run_counter);
- tprintf ("after p1 = %d cond_signal to p2 (%d)\n", currentThread, p2);
+ tprintf ("after p1 = %d cond_signal to p2 (%d)\n", current, p2);
}
else
{
/* p2 hasn't reached the condition variable, so bump value
ready for p2 to test. */
tprintf ("no need for thread %d to cond_signal - bump %d value (pre) = %d\n",
- currentThread, p2, threadArray[p2].value);
+ current, p2, threadArray[p2].value);
threadArray[p2].value++;
}
/* Perform wait (old sem). Again without obtaining mutex as
we've already claimed it. */
if (threadArray[old].value == 0)
{
- currentThread = p2;
/* Record we are about to wait on the condition variable. */
threadArray[old].waiting = true;
__gthread_cond_wait (&threadArray[old].run_counter, &lock);
threadArray[old].waiting = false;
/* We are running again. */
- currentThread = old;
}
else
{
tprintf ("(currentThread = %d) no need for thread %d to cond_wait - taking value (pre) = %d\n",
- currentThread, old, threadArray[old].value);
+ current, old, threadArray[old].value);
/* No need to block as we have been told a signal has
effectively already been recorded. We remove the signal
notification without blocking. */
threadArray[old].value--;
}
- tprintf ("end, context back to %d\n", currentThread);
- if (currentThread != old)
- M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
- "wrong process id");
+ tprintf ("end, context back to %d\n", current);
+ if (current != old)
+ m2iso_M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
+ "wrong process id");
}
}
__gthread_mutex_unlock (&lock);
semArray = (threadSem **)malloc (sizeof (threadSem *) * SEM_POOL);
#endif
/* Create a thread control block for the main program (or process). */
- currentThread = newThread (); /* For the current initial thread. */
- threadArray[currentThread].p = pthread_self ();
- threadArray[currentThread].tid = currentThread;
- __GTHREAD_COND_INIT_FUNCTION (&threadArray[currentThread].run_counter);
- threadArray[currentThread].interruptLevel = 0;
+ int tid = newThread (); /* For the current initial thread. */
+ threadArray[tid].p = pthread_self ();
+ threadArray[tid].tid = tid;
+ __GTHREAD_COND_INIT_FUNCTION (&threadArray[tid].run_counter);
+ threadArray[tid].interruptLevel = 0;
/* The line below shouldn't be necessary as we are already running. */
- threadArray[currentThread].proc = never;
- threadArray[currentThread].waiting = false; /* We are running. */
- threadArray[currentThread].value = 0; /* No signal from anyone yet. */
+ threadArray[tid].proc = never;
+ threadArray[tid].waiting = false; /* We are running. */
+ threadArray[tid].value = 0; /* No signal from anyone yet. */
tprintf ("RTco initialized completed\n");
__gthread_mutex_unlock (&lock);
}
extern "C" void __attribute__((__constructor__))
M2EXPORT(ctor) (void)
{
- M2RTS_RegisterModule ("RTco",
- M2EXPORT(init), M2EXPORT(fini),
- M2EXPORT(dep));
+ m2iso_M2RTS_RegisterModule ("RTco", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini),
+ M2EXPORT(dep));
}
<http://www.gnu.org/licenses/>. */
+#define str(X) #X
+
typedef void (*proc_con) (int, char **, char **);
typedef void (*proc_dep) (void);
-extern "C" void M2RTS_RequestDependant (const char *modulename, const char *dependancy);
-extern "C" void M2RTS_RegisterModule (const char *modulename,
+extern "C" void m2iso_M2RTS_RequestDependant (const char *modulename, const char *libname, const char *dependancy);
+extern "C" void m2iso_M2RTS_RegisterModule (const char *modulename, const char *libname,
+ proc_con init, proc_con fini, proc_dep dependencies);
+extern "C" void m2pim_M2RTS_RegisterModule (const char *modulename, const char *libname,
+ proc_con init, proc_con fini, proc_dep dependencies);
+extern "C" void M2RTS_RegisterModule (const char *modulename, const char *libname,
proc_con init, proc_con fini, proc_dep dependencies);
-extern "C" void _M2_M2RTS_init (void);
+extern "C" void m2iso_M2_M2RTS_init (void);
-extern "C" void M2RTS_ConstructModules (const char *,
- int argc, char *argv[], char *envp[]);
-extern "C" void M2RTS_Terminate (void);
-extern "C" void M2RTS_DeconstructModules (void);
+extern "C" void m2iso_M2RTS_ConstructModules (const char *modulename, const char *libname,
+ int argc, char *argv[], char *envp[]);
+extern "C" void m2iso_M2RTS_Terminate (void);
+extern "C" void m2iso_M2RTS_DeconstructModules (void);
-extern "C" void M2RTS_HaltC (const char *filename, int line,
- const char *functionname, const char *desc)
- __attribute__ ((noreturn));
+extern "C" void m2iso_M2RTS_HaltC (const char *filename, int line,
+ const char *functionname, const char *desc)
+ __attribute__ ((noreturn));
#include "config.h"
+#define EXPORT(FUNC) m2iso ## _wrapsock_ ## FUNC
+#define IMPORT(MODULE,FUNC) m2iso ## _ ## MODULE ## _ ## FUNC
+#define M2EXPORT(FUNC) m2iso ## _M2_wrapsock_ ## FUNC
+#define M2LIBNAME "m2iso"
+
+/* This module should be rewritten to use C++. */
+
+typedef void (*proc_con) (int, char **, char **);
+typedef void (*proc_dep) (void);
+
+extern void m2iso_M2RTS_RequestDependant (const char *modulename, const char *libname, const char *dependancy);
+extern void m2iso_M2RTS_RegisterModule (const char *modulename, const char *libname,
+ proc_con init, proc_con fini, proc_dep dependencies);
+
#if defined(HAVE_SYS_TYPES_H)
#include "sys/types.h"
#endif
structure, c, will have its fields initialized. */
openResults
-wrapsock_clientOpen (clientInfo *c, char *hostname, unsigned int length,
+EXPORT(clientOpen) (clientInfo *c, char *hostname, unsigned int length,
int portNo)
{
/* remove SIGPIPE which is raised on the server if the client is killed. */
structure, c, will have its fields initialized. */
openResults
-wrapsock_clientOpenIP (clientInfo *c, unsigned int ip, int portNo)
+EXPORT(clientOpenIP) (clientInfo *c, unsigned int ip, int portNo)
{
/* remove SIGPIPE which is raised on the server if the client is killed. */
signal (SIGPIPE, SIG_IGN);
/* getClientPortNo - returns the portNo from structure, c. */
int
-wrapsock_getClientPortNo (clientInfo *c)
+EXPORT(getClientPortNo) (clientInfo *c)
{
return c->portNo;
}
which the client is connecting. */
void
-wrapsock_getClientHostname (clientInfo *c, char *hostname, unsigned int high)
+EXPORT(getClientHostname) (clientInfo *c, char *hostname, unsigned int high)
{
strncpy (hostname, c->hostname, high + 1);
}
/* getClientSocketFd - returns the sockFd from structure, c. */
int
-wrapsock_getClientSocketFd (clientInfo *c)
+EXPORT(getClientSocketFd) (clientInfo *c)
{
return c->sockFd;
}
/* getClientIP - returns the sockFd from structure, s. */
unsigned int
-wrapsock_getClientIP (clientInfo *c)
+EXPORT(getClientIP) (clientInfo *c)
{
#if 0
printf("client ip = %s\n", inet_ntoa (c->sa.sin_addr.s_addr));
available. */
unsigned int
-wrapsock_getPushBackChar (clientInfo *c, char *ch)
+EXPORT(getPushBackChar) (clientInfo *c, char *ch)
{
if (c->hasChar > 0)
{
character. */
unsigned int
-wrapsock_setPushBackChar (clientInfo *c, char ch)
+EXPORT(setPushBackChar) (clientInfo *c, char ch)
{
if (c->hasChar == MAXPBBUF)
return FALSE;
/* getSizeOfClientInfo - returns the sizeof (opaque data type). */
unsigned int
-wrapsock_getSizeOfClientInfo (void)
+EXPORT(getSizeOfClientInfo) (void)
{
return sizeof (clientInfo);
}
#endif
-/* GNU Modula-2 link fodder. */
+
+/* GNU Modula-2 linking hooks. */
+
+void
+M2EXPORT(init) (int, char **, char **)
+{
+}
void
-_M2_wrapsock_init (void)
+M2EXPORT(fini) (int, char **, char **)
{
}
void
-_M2_wrapsock_fini (void)
+M2EXPORT(dep) (void)
+{
+}
+
+void __attribute__((__constructor__))
+M2EXPORT(ctor) (void)
{
+ m2iso_M2RTS_RegisterModule ("wrapsock", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini),
+ M2EXPORT(dep));
}
<http://www.gnu.org/licenses/>. */
#include "config.h"
+#include <m2rts.h>
+
+#define EXPORT(FUNC) m2iso ## _wraptime_ ## FUNC
+#define M2EXPORT(FUNC) m2iso ## _M2_wraptime_ ## FUNC
+#define M2LIBNAME "m2iso"
#if defined(HAVE_SYS_TYPES_H)
#include "sys/types.h"
/* InitTimeval returns a newly created opaque type. */
#if defined(HAVE_TIMEVAL) && defined(HAVE_MALLOC_H)
-struct timeval *
-wraptime_InitTimeval (void)
+extern "C" struct timeval *
+EXPORT(InitTimeval) (void)
{
return (struct timeval *)malloc (sizeof (struct timeval));
}
#else
-void *
-wraptime_InitTimeval (void)
+extern "C" void *
+EXPORT(InitTimeval) (void)
{
return NULL;
}
/* KillTimeval deallocates the memory associated with an opaque type. */
-struct timeval *
-wraptime_KillTimeval (void *tv)
+extern "C" struct timeval *
+EXPORT(KillTimeval) (void *tv)
{
#if defined(HAVE_MALLOC_H)
free (tv);
/* InitTimezone returns a newly created opaque type. */
#if defined(HAVE_STRUCT_TIMEZONE) && defined(HAVE_MALLOC_H)
-struct timezone *
-wraptime_InitTimezone (void)
+extern "C" struct timezone *
+EXPORT(InitTimezone) (void)
{
return (struct timezone *)malloc (sizeof (struct timezone));
}
#else
-void *
-wraptime_InitTimezone (void)
+extern "C" void *
+EXPORT(InitTimezone) (void)
{
return NULL;
}
/* KillTimezone - deallocates the memory associated with an opaque
type. */
-struct timezone *
-wraptime_KillTimezone (struct timezone *tv)
+extern "C" struct timezone *
+EXPORT(KillTimezone) (struct timezone *tv)
{
#if defined(HAVE_MALLOC_H)
free (tv);
/* InitTM - returns a newly created opaque type. */
#if defined(HAVE_STRUCT_TM) && defined(HAVE_MALLOC_H)
-struct tm *
-wraptime_InitTM (void)
+extern "C" struct tm *
+EXPORT(InitTM) (void)
{
return (struct tm *)malloc (sizeof (struct tm));
}
#else
-void *
-wraptime_InitTM (void)
+extern "C" void *
+EXPORT(InitTM) (void)
{
return NULL;
}
/* KillTM - deallocates the memory associated with an opaque type. */
-struct tm *
-wraptime_KillTM (struct tm *tv)
+extern "C" struct tm *
+EXPORT(KillTM) (struct tm *tv)
{
#if defined(HAVE_MALLOC_H)
free (tv);
and, tz. It returns 0 on success. */
#if defined(HAVE_STRUCT_TIMEZONE) && defined(HAVE_GETTIMEOFDAY)
-int
-wraptime_gettimeofday (void *tv, struct timezone *tz)
+extern "C" int
+EXPORT(gettimeofday) (void *tv, struct timezone *tz)
{
return gettimeofday (tv, tz);
}
#else
-int
-wraptime_gettimeofday (void *tv, void *tz)
+extern "C" int
+EXPORT(gettimeofday) (void *tv, void *tz)
{
return -1;
}
and, tz. It returns 0 on success. */
#if defined(HAVE_STRUCT_TIMEZONE) && defined(HAVE_SETTIMEOFDAY)
-int
-wraptime_settimeofday (void *tv, struct timezone *tz)
+extern "C" int
+EXPORT(settimeofday) (void *tv, struct timezone *tz)
{
return settimeofday (tv, tz);
}
#else
-int
-wraptime_settimeofday (void *tv, void *tz)
+extern "C" int
+EXPORT(settimeofday) (void *tv, void *tz)
{
return -1;
}
timeval structure. */
#if defined(HAVE_TIMEVAL)
-unsigned int
-wraptime_GetFractions (struct timeval *tv)
+extern "C" unsigned int
+EXPORT(GetFractions) (struct timeval *tv)
{
return (unsigned int)tv->tv_usec;
}
#else
-unsigned int
-wraptime_GetFractions (void *tv)
+extern "C" unsigned int
+EXPORT(GetFractions) (void *tv)
{
return (unsigned int)-1;
}
and not a time_t (as expected by the posix equivalent). */
#if defined(HAVE_TIMEVAL)
-struct tm *
-wraptime_localtime_r (struct timeval *tv, struct tm *m)
+extern "C" struct tm *
+EXPORT(localtime_r) (struct timeval *tv, struct tm *m)
{
return localtime_r (&tv->tv_sec, m);
}
#else
-struct tm *
-wraptime_localtime_r (void *tv, struct tm *m)
+extern "C" struct tm *
+EXPORT(localtime_r) (void *tv, struct tm *m)
{
return m;
}
/* wraptime_GetYear - returns the year from the structure, m. */
#if defined(HAVE_STRUCT_TM)
-unsigned int
-wraptime_GetYear (struct tm *m)
+extern "C" unsigned int
+EXPORT(GetYear) (struct tm *m)
{
return m->tm_year;
}
#else
-unsigned int
-wraptime_GetYear (void *m)
+extern "C" unsigned int
+EXPORT(GetYear) (void *m)
{
return (unsigned int)-1;
}
/* wraptime_GetMonth - returns the month from the structure, m. */
#if defined(HAVE_STRUCT_TM)
-unsigned int
-wraptime_GetMonth (struct tm *m)
+extern "C" unsigned int
+EXPORT(GetMonth) (struct tm *m)
{
return m->tm_mon;
}
#else
-unsigned int
-wraptime_GetMonth (void *m)
+extern "C" unsigned int
+EXPORT(GetMonth) (void *m)
{
return (unsigned int)-1;
}
m. */
#if defined(HAVE_STRUCT_TM)
-unsigned int
-wraptime_GetDay (struct tm *m)
+extern "C" unsigned int
+EXPORT(GetDay) (struct tm *m)
{
return m->tm_mday;
}
#else
-unsigned int
-wraptime_GetDay (void *m)
+extern "C" unsigned int
+EXPORT(GetDay) (void *m)
{
return (unsigned int)-1;
}
m. */
#if defined(HAVE_STRUCT_TM)
-unsigned int
-wraptime_GetHour (struct tm *m)
+extern "C" unsigned int
+EXPORT(GetHour) (struct tm *m)
{
return m->tm_hour;
}
#else
-unsigned int
-wraptime_GetHour (void *m)
+extern "C" unsigned int
+EXPORT(GetHour) (void *m)
{
return (unsigned int)-1;
}
structure, m. */
#if defined(HAVE_STRUCT_TM)
-unsigned int
-wraptime_GetMinute (struct tm *m)
+extern "C" unsigned int
+EXPORT(GetMinute) (struct tm *m)
{
return m->tm_min;
}
#else
-unsigned int
-wraptime_GetMinute (void *m)
+extern "C" unsigned int
+EXPORT(GetMinute) (void *m)
{
return (unsigned int)-1;
}
A leap minute of value 60 will be truncated to 59. */
#if defined(HAVE_STRUCT_TM)
-unsigned int
-wraptime_GetSecond (struct tm *m)
+extern "C" unsigned int
+EXPORT(GetSecond) (struct tm *m)
{
if (m->tm_sec == 60)
return 59;
return m->tm_sec;
}
#else
-unsigned int
-wraptime_GetSecond (void *m)
+extern "C" unsigned int
+EXPORT(GetSecond) (void *m)
{
return (unsigned int)-1;
}
/* wraptime_GetSummerTime - returns true if summer time is in effect. */
#if defined(HAVE_STRUCT_TIMEZONE)
-unsigned int
-wraptime_GetSummerTime (struct timezone *tz)
+extern "C" unsigned int
+EXPORT(GetSummerTime) (struct timezone *tz)
{
return tz->tz_dsttime != 0;
}
#else
-unsigned int
-wraptime_GetSummerTime (void *tz)
+extern "C" unsigned int
+EXPORT(GetSummerTime) (void *tz)
{
return FALSE;
}
/* wraptime_GetDST - returns the number of minutes west of GMT. */
#if defined(HAVE_STRUCT_TIMEZONE)
-int
-wraptime_GetDST (struct timezone *tz)
+extern "C" int
+EXPORT(GetDST) (struct timezone *tz)
{
return tz->tz_minuteswest;
}
#else
-int
-wraptime_GetDST (void *tz)
+extern "C" int
+EXPORT(GetDST) (void *tz)
{
#if defined(INT_MIN)
return INT_MIN;
/* SetTimezone - set the timezone field inside timeval, tv. */
#if defined(HAVE_STRUCT_TIMEZONE)
-void
-wraptime_SetTimezone (struct timezone *tz, int zone, int minuteswest)
+extern "C" void
+EXPORT(SetTimezone) (struct timezone *tz, int zone, int minuteswest)
{
tz->tz_dsttime = zone;
tz->tz_minuteswest = minuteswest;
}
#else
-void
-wraptime_SetTimezone (void *tz, int zone, int minuteswest)
+extern "C" void
+EXPORT(SetTimezone) (void *tz, int zone, int minuteswest)
{
}
#endif
day, month, year, fractions. */
#if defined(HAVE_TIMEVAL)
-void
-wraptime_SetTimeval (struct tm *t, unsigned int second, unsigned int minute,
- unsigned int hour, unsigned int day, unsigned int month,
- unsigned int year, unsigned int yday, unsigned int wday,
- unsigned int isdst)
+extern "C" void
+EXPORT(SetTimeval) (struct tm *t, unsigned int second, unsigned int minute,
+ unsigned int hour, unsigned int day, unsigned int month,
+ unsigned int year, unsigned int yday, unsigned int wday,
+ unsigned int isdst)
{
t->tm_sec = second;
t->tm_min = minute;
t->tm_isdst = isdst;
}
#else
-void
-wraptime_SetTimeval (void *t, unsigned int second, unsigned int minute,
- unsigned int hour, unsigned int day, unsigned int month,
- unsigned int year, unsigned int yday, unsigned int wday,
- unsigned int isdst)
+extern "C" void
+EXPORT(SetTimeval) (void *t, unsigned int second, unsigned int minute,
+ unsigned int hour, unsigned int day, unsigned int month,
+ unsigned int year, unsigned int yday, unsigned int wday,
+ unsigned int isdst)
{
}
#endif
/* init - init/finish functions for the module */
-void
-_M2_wraptime_init ()
+/* GNU Modula-2 linking hooks. */
+
+extern "C" void
+M2EXPORT(init) (int, char **, char **)
+{
+}
+
+extern "C" void
+M2EXPORT(fini) (int, char **, char **)
{
}
-void
-_M2_wraptime_fini ()
+
+extern "C" void
+M2EXPORT(dep) (void)
+{
+}
+
+extern "C" void __attribute__((__constructor__))
+M2EXPORT(ctor) (void)
{
+ m2iso_M2RTS_RegisterModule ("wraptime", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini),
+ M2EXPORT(dep));
}
libm2log_la_DEPENDENCIES = ../libm2pim/SYSTEM.def $(addsuffix .lo, $(basename $(libm2log_la_SOURCES)))
libm2log_la_CFLAGS = -I. -DBUILD_GM2_LIBS -I@srcdir@/../
-libm2log_la_M2FLAGS = -I../libm2pim -I$(GM2_SRC)/gm2-libs-log -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -Wreturn-type -fcase
+libm2log_la_M2FLAGS = \
+ -fm2-pathname=m2pim -I../libm2pim \
+ -fm2-pathname=m2log -I$(GM2_SRC)/gm2-libs-log \
+ -fm2-pathname=m2pim -I$(GM2_SRC)/gm2-libs \
+ -fm2-pathname=m2iso -I$(GM2_SRC)/gm2-libs-iso \
+ -Wreturn-type -fcase -fm2-prefix=m2log
if TARGET_DARWIN
libm2log_la_link_flags = -Wl,-undefined,dynamic_lookup
else
@BUILD_LOGLIB_TRUE@libm2log_la_SOURCES = $(M2MODS) Break.c
@BUILD_LOGLIB_TRUE@libm2log_la_DEPENDENCIES = ../libm2pim/SYSTEM.def $(addsuffix .lo, $(basename $(libm2log_la_SOURCES)))
@BUILD_LOGLIB_TRUE@libm2log_la_CFLAGS = -I. -DBUILD_GM2_LIBS -I@srcdir@/../
-@BUILD_LOGLIB_TRUE@libm2log_la_M2FLAGS = -I../libm2pim -I$(GM2_SRC)/gm2-libs-log -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -Wreturn-type -fcase
+@BUILD_LOGLIB_TRUE@libm2log_la_M2FLAGS = \
+@BUILD_LOGLIB_TRUE@ -fm2-pathname=m2pim -I../libm2pim \
+@BUILD_LOGLIB_TRUE@ -fm2-pathname=m2log -I$(GM2_SRC)/gm2-libs-log \
+@BUILD_LOGLIB_TRUE@ -fm2-pathname=m2pim -I$(GM2_SRC)/gm2-libs \
+@BUILD_LOGLIB_TRUE@ -fm2-pathname=m2iso -I$(GM2_SRC)/gm2-libs-iso \
+@BUILD_LOGLIB_TRUE@ -Wreturn-type -fcase -fm2-prefix=m2log
+
@BUILD_LOGLIB_TRUE@@TARGET_DARWIN_FALSE@libm2log_la_link_flags =
@BUILD_LOGLIB_TRUE@@TARGET_DARWIN_TRUE@libm2log_la_link_flags = -Wl,-undefined,dynamic_lookup
@BUILD_LOGLIB_TRUE@libm2log_la_LINK = $(LINK) -version-info $(libtool_VERSION) $(libm2log_la_link_flags)
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 -fno-scaffold-dynamic -fno-scaffold-main
+libm2min_la_M2FLAGS = \
+ -fm2-pathname=m2min -I. -I$(GM2_SRC)/gm2-libs-min \
+ -fm2-pathname=m2pim -I$(GM2_SRC)/gm2-libs -fno-exceptions \
+ -fno-m2-plugin -fno-scaffold-dynamic -fno-scaffold-main -fm2-prefix=m2min
if TARGET_DARWIN
libm2min_la_link_flags = -Wl,-undefined,dynamic_lookup
else
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 -fno-scaffold-dynamic -fno-scaffold-main
+libm2min_la_M2FLAGS = \
+ -fm2-pathname=m2min -I. -I$(GM2_SRC)/gm2-libs-min \
+ -fm2-pathname=m2pim -I$(GM2_SRC)/gm2-libs -fno-exceptions \
+ -fno-m2-plugin -fno-scaffold-dynamic -fno-scaffold-main -fm2-prefix=m2min
@TARGET_DARWIN_FALSE@libm2min_la_link_flags =
@TARGET_DARWIN_TRUE@libm2min_la_link_flags = -Wl,-undefined,dynamic_lookup
errno.cc dtoa.cc \
ldtoa.cc termios.cc \
SysExceptions.cc target.c \
- wrapc.c cgetopt.cc
+ wrapc.cc cgetopt.cc
libm2pimdir = libm2pim
libm2pim_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2pim_la_SOURCES)))
libm2pim_la_CFLAGS = -I. -I.. -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -DBUILD_GM2_LIBS -I@srcdir@/../ -I@srcdir@/../libm2iso
-libm2pim_la_M2FLAGS = -I. -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -fm2-g -g -Wreturn-type -fcase
+libm2pim_la_M2FLAGS = \
+ -fm2-pathname=m2pim -I. -I$(GM2_SRC)/gm2-libs \
+ -fm2-pathname=m2iso -I$(GM2_SRC)/gm2-libs-iso \
+ -fm2-g -g -Wreturn-type -fcase -fm2-prefix=m2pim
if TARGET_DARWIN
libm2pim_la_link_flags = -Wl,-undefined,dynamic_lookup
else
@BUILD_PIMLIB_TRUE@ UnixArgs.lo Selective.lo sckt.lo errno.lo \
@BUILD_PIMLIB_TRUE@ dtoa.lo ldtoa.lo termios.lo \
@BUILD_PIMLIB_TRUE@ SysExceptions.lo libm2pim_la-target.lo \
-@BUILD_PIMLIB_TRUE@ libm2pim_la-wrapc.lo cgetopt.lo
+@BUILD_PIMLIB_TRUE@ wrapc.lo cgetopt.lo
libm2pim_la_OBJECTS = $(am_libm2pim_la_OBJECTS)
@BUILD_PIMLIB_TRUE@am_libm2pim_la_rpath = -rpath $(toolexeclibdir)
AM_V_P = $(am__v_P_@AM_V@)
@BUILD_PIMLIB_TRUE@ errno.cc dtoa.cc \
@BUILD_PIMLIB_TRUE@ ldtoa.cc termios.cc \
@BUILD_PIMLIB_TRUE@ SysExceptions.cc target.c \
-@BUILD_PIMLIB_TRUE@ wrapc.c cgetopt.cc
+@BUILD_PIMLIB_TRUE@ wrapc.cc cgetopt.cc
@BUILD_PIMLIB_TRUE@libm2pimdir = libm2pim
@BUILD_PIMLIB_TRUE@libm2pim_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2pim_la_SOURCES)))
@BUILD_PIMLIB_TRUE@libm2pim_la_CFLAGS = -I. -I.. -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -DBUILD_GM2_LIBS -I@srcdir@/../ -I@srcdir@/../libm2iso
-@BUILD_PIMLIB_TRUE@libm2pim_la_M2FLAGS = -I. -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -fm2-g -g -Wreturn-type -fcase
+@BUILD_PIMLIB_TRUE@libm2pim_la_M2FLAGS = \
+@BUILD_PIMLIB_TRUE@ -fm2-pathname=m2pim -I. -I$(GM2_SRC)/gm2-libs \
+@BUILD_PIMLIB_TRUE@ -fm2-pathname=m2iso -I$(GM2_SRC)/gm2-libs-iso \
+@BUILD_PIMLIB_TRUE@ -fm2-g -g -Wreturn-type -fcase -fm2-prefix=m2pim
+
@BUILD_PIMLIB_TRUE@@TARGET_DARWIN_FALSE@libm2pim_la_link_flags =
@BUILD_PIMLIB_TRUE@@TARGET_DARWIN_TRUE@libm2pim_la_link_flags = -Wl,-undefined,dynamic_lookup
@BUILD_PIMLIB_TRUE@libm2pim_la_LINK = $(LINK) -version-info $(libtool_VERSION) $(libm2pim_la_link_flags)
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/errno.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ldtoa.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libm2pim_la-target.Plo@am__quote@
-@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libm2pim_la-wrapc.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sckt.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/termios.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/wrapc.Plo@am__quote@
.c.o:
@am__fastdepCC_TRUE@ $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libm2pim_la_CFLAGS) $(CFLAGS) -c -o libm2pim_la-target.lo `test -f 'target.c' || echo '$(srcdir)/'`target.c
-libm2pim_la-wrapc.lo: wrapc.c
-@am__fastdepCC_TRUE@ $(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libm2pim_la_CFLAGS) $(CFLAGS) -MT libm2pim_la-wrapc.lo -MD -MP -MF $(DEPDIR)/libm2pim_la-wrapc.Tpo -c -o libm2pim_la-wrapc.lo `test -f 'wrapc.c' || echo '$(srcdir)/'`wrapc.c
-@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/libm2pim_la-wrapc.Tpo $(DEPDIR)/libm2pim_la-wrapc.Plo
-@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='wrapc.c' object='libm2pim_la-wrapc.lo' libtool=yes @AMDEPBACKSLASH@
-@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
-@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libm2pim_la_CFLAGS) $(CFLAGS) -c -o libm2pim_la-wrapc.lo `test -f 'wrapc.c' || echo '$(srcdir)/'`wrapc.c
-
.cc.o:
@am__fastdepCXX_TRUE@ $(AM_V_CXX)$(CXXCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
@am__fastdepCXX_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
#include <config.h>
#include <m2rts.h>
+#define EXPORT(FUNC) m2pim ## _Selective_ ## FUNC
+#define M2EXPORT(FUNC) m2pim ## _M2_Selective_ ## FUNC
+#define M2LIBNAME "m2pim"
+
#if defined(HAVE_STDDEF_H)
/* Obtain a definition for NULL. */
#include <stddef.h>
#if defined(HAVE_STRUCT_TIMEVAL)
extern "C" int
-Selective_Select (int nooffds, fd_set *readfds, fd_set *writefds,
- fd_set *exceptfds, struct timeval *timeout)
+EXPORT(Select) (int nooffds, fd_set *readfds, fd_set *writefds,
+ fd_set *exceptfds, struct timeval *timeout)
{
return select (nooffds, readfds, writefds, exceptfds, timeout);
}
#else
extern "C" int
-Selective_Select (int nooffds, void *readfds, void *writefds, void *exceptfds,
- void *timeout)
+EXPORT(Select) (int nooffds, void *readfds, void *writefds, void *exceptfds,
+ void *timeout)
{
return 0;
}
#if defined(HAVE_STRUCT_TIMEVAL)
extern "C" struct timeval *
-Selective_InitTime (unsigned int sec, unsigned int usec)
+EXPORT(InitTime) (unsigned int sec, unsigned int usec)
{
struct timeval *t = (struct timeval *)malloc (sizeof (struct timeval));
}
extern "C" void
-Selective_GetTime (struct timeval *t, unsigned int *sec, unsigned int *usec)
+EXPORT(GetTime) (struct timeval *t, unsigned int *sec, unsigned int *usec)
{
*sec = (unsigned int)t->tv_sec;
*usec = (unsigned int)t->tv_usec;
}
extern "C" void
-Selective_SetTime (struct timeval *t, unsigned int sec, unsigned int usec)
+EXPORT(SetTime) (struct timeval *t, unsigned int sec, unsigned int usec)
{
t->tv_sec = sec;
t->tv_usec = usec;
/* KillTime frees the timeval structure and returns NULL. */
extern "C" struct timeval *
-Selective_KillTime (struct timeval *t)
+EXPORT(KillTime) (struct timeval *t)
{
#if defined(HAVE_STDLIB_H)
free (t);
/* InitSet returns a pointer to a FD_SET. */
extern "C" FDSET_T *
-Selective_InitSet (void)
+EXPORT(InitSet) (void)
{
#if defined(HAVE_STDLIB_H)
FDSET_T *s = (FDSET_T *)malloc (sizeof (FDSET_T));
/* KillSet frees the FD_SET and returns NULL. */
extern "C" FDSET_T *
-Selective_KillSet (FDSET_T *s)
+EXPORT(KillSet) (FDSET_T *s)
{
#if defined(HAVE_STDLIB_H)
free (s);
/* FdZero generate an empty set. */
extern "C" void
-Selective_FdZero (FDSET_T *s)
+EXPORT(FdZero) (FDSET_T *s)
{
FD_ZERO (s);
}
/* FS_Set include an element, fd, into set, s. */
extern "C" void
-Selective_FdSet (int fd, FDSET_T *s)
+EXPORT(FdSet) (int fd, FDSET_T *s)
{
FD_SET (fd, s);
}
/* FdClr exclude an element, fd, from the set, s. */
extern "C" void
-Selective_FdClr (int fd, FDSET_T *s)
+EXPORT(FdClr) (int fd, FDSET_T *s)
{
FD_CLR (fd, s);
}
/* FdIsSet return TRUE if, fd, is present in set, s. */
extern "C" int
-Selective_FdIsSet (int fd, FDSET_T *s)
+EXPORT(FdIsSet) (int fd, FDSET_T *s)
{
return FD_ISSET (fd, s);
}
It returns zero (see man 3p gettimeofday). */
extern "C" int
-Selective_GetTimeOfDay (struct timeval *t)
+EXPORT(GetTimeOfDay) (struct timeval *t)
{
return gettimeofday (t, NULL);
}
#else
extern "C" void *
-Selective_InitTime (unsigned int sec, unsigned int usec)
+EXPORT(InitTime) (unsigned int sec, unsigned int usec)
{
return NULL;
}
extern "C" void *
-Selective_KillTime (void *t)
+EXPORT(KillTime) (void *t)
{
return NULL;
}
extern "C" void
-Selective_GetTime (void *t, unsigned int *sec, unsigned int *usec)
+EXPORT(GetTime) (void *t, unsigned int *sec, unsigned int *usec)
{
}
extern "C" void
-Selective_SetTime (void *t, unsigned int sec, unsigned int usec)
+EXPORT(SetTime) (void *t, unsigned int sec, unsigned int usec)
{
}
extern "C" FDSET_T *
-Selective_InitSet (void)
+EXPORT(InitSet) (void)
{
return NULL;
}
extern "C" FDSET_T *
-Selective_KillSet (void)
+EXPORT(KillSet) (void)
{
return NULL;
}
extern "C" void
-Selective_FdZero (void *s)
+EXPORT(FdZero) (void *s)
{
}
extern "C" void
-Selective_FdSet (int fd, void *s)
+EXPORT(FdSet) (int fd, void *s)
{
}
extern "C" void
-Selective_FdClr (int fd, void *s)
+EXPORT(FdClr) (int fd, void *s)
{
}
extern "C" int
-Selective_FdIsSet (int fd, void *s)
+EXPORT(FdIsSet) (int fd, void *s)
{
return 0;
}
extern "C" int
-Selective_GetTimeOfDay (void *t)
+EXPORT(GetTimeOfDay) (void *t)
{
return -1;
}
/* MaxFdsPlusOne returns max (a + 1, b + 1). */
extern "C" int
-Selective_MaxFdsPlusOne (int a, int b)
+EXPORT(MaxFdsPlusOne) (int a, int b)
{
if (a > b)
return a + 1;
/* WriteCharRaw writes a single character to the file descriptor. */
extern "C" void
-Selective_WriteCharRaw (int fd, char ch)
+EXPORT(WriteCharRaw) (int fd, char ch)
{
write (fd, &ch, 1);
}
/* ReadCharRaw read and return a single char from file descriptor, fd. */
extern "C" char
-Selective_ReadCharRaw (int fd)
+EXPORT(ReadCharRaw) (int fd)
{
char ch;
return ch;
}
+/* GNU Modula-2 linking hooks. */
+
extern "C" void
-_M2_Selective_init (int argc, char *argv[], char *envp[])
+M2EXPORT(init) (int, char **, char **)
{
}
extern "C" void
-_M2_Selective_fini (int argc, char *argv[], char *envp[])
+M2EXPORT(fini) (int, char **, char **)
{
}
extern "C" void
-_M2_Selective_dep (void)
+M2EXPORT(dep) (void)
{
}
extern "C" void __attribute__((__constructor__))
-_M2_Selective_ctor (void)
+M2EXPORT(ctor) (void)
{
- M2RTS_RegisterModule ("Selective", _M2_Selective_init, _M2_Selective_fini,
- _M2_Selective_dep);
+ m2pim_M2RTS_RegisterModule ("Selective", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini),
+ M2EXPORT(dep));
}
<http://www.gnu.org/licenses/>. */
#include <config.h>
+#include "m2rts.h"
+
+#define EXPORT(FUNC) m2pim ## _SysExceptions_ ## FUNC
+#define M2EXPORT(FUNC) m2pim ## _M2_SysExceptions_ ## FUNC
+#define M2LIBNAME "m2pim"
#if defined(HAVE_SIGNAL_H)
#include <signal.h>
}
extern "C" void
-SysExceptions_InitExceptionHandlers (
+EXPORT(InitExceptionHandlers) (
void (*indexf) (void *), void (*range) (void *), void (*casef) (void *),
void (*invalidloc) (void *), void (*function) (void *),
void (*wholevalue) (void *), void (*wholediv) (void *),
#else
extern "C" void
-SysExceptions_InitExceptionHandlers (void *indexf, void *range, void *casef,
+EXPORT(InitExceptionHandlers) (void *indexf, void *range, void *casef,
void *invalidloc, void *function,
void *wholevalue, void *wholediv,
void *realvalue, void *realdiv,
extern "C" void
-_M2_SysExceptions_init (int, char *[], char *[])
+M2EXPORT(init) (int, char **, char **)
{
}
extern "C" void
-_M2_SysExceptions_fini (int, char *[], char *[])
+M2EXPORT(fini) (int, char **, char **)
{
}
extern "C" void
-_M2_SysExceptions_dep (void)
+M2EXPORT(dep) (void)
{
}
extern "C" void __attribute__((__constructor__))
-_M2_SysExceptions_ctor (void)
+M2EXPORT(ctor) (void)
{
- M2RTS_RegisterModule ("SysExceptions", _M2_SysExceptions_init, _M2_SysExceptions_fini,
- _M2_SysExceptions_dep);
+ m2pim_M2RTS_RegisterModule ("SysExceptions", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini),
+ M2EXPORT(dep));
}
#include <config.h>
#include <m2rts.h>
+#define EXPORT(FUNC) m2pim ## _UnixArgs_ ## FUNC
+#define M2EXPORT(FUNC) m2pim ## _M2_UnixArgs_ ## FUNC
+#define M2LIBNAME "m2pim"
-extern "C" int UnixArgs_GetArgC (void);
-extern "C" char **UnixArgs_GetArgV (void);
-extern "C" char **UnixArgs_GetEnvV (void);
+extern "C" int EXPORT(GetArgC) (void);
+extern "C" char **EXPORT(GetArgV) (void);
+extern "C" char **EXPORT(GetEnvV) (void);
static int UnixArgs_ArgC;
static char **UnixArgs_ArgV;
/* GetArgC returns argc. */
extern "C" int
-UnixArgs_GetArgC (void)
+EXPORT(GetArgC) (void)
{
return UnixArgs_ArgC;
}
/* GetArgV returns argv. */
extern "C" char **
-UnixArgs_GetArgV (void)
+EXPORT(GetArgV) (void)
{
return UnixArgs_ArgV;
}
/* GetEnvV returns envv. */
extern "C" char **
-UnixArgs_GetEnvV (void)
+EXPORT(GetEnvV) (void)
{
return UnixArgs_EnvV;
}
+/* GNU Modula-2 linking hooks. */
+
extern "C" void
-_M2_UnixArgs_init (int argc, char *argv[], char *envp[])
+M2EXPORT(init) (int argc, char **argv, char **envp)
{
UnixArgs_ArgC = argc;
UnixArgs_ArgV = argv;
}
extern "C" void
-_M2_UnixArgs_fini (int argc, char *argv[], char *envp[])
+M2EXPORT(fini) (int, char **, char **)
{
}
extern "C" void
-_M2_UnixArgs_dep (void)
+M2EXPORT(dep) (void)
{
}
extern "C" void __attribute__((__constructor__))
-_M2_UnixArgs_ctor (void)
+M2EXPORT(ctor) (void)
{
- M2RTS_RegisterModule ("UnixArgs", _M2_UnixArgs_init, _M2_UnixArgs_fini,
- _M2_UnixArgs_dep);
+ m2pim_M2RTS_RegisterModule ("UnixArgs", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini),
+ M2EXPORT(dep));
}
#include <getopt.h>
#include <m2rts.h>
-extern "C" {char *cgetopt_optarg;}
-extern "C" {int cgetopt_optind;}
-extern "C" {int cgetopt_opterr;}
-extern "C" {int cgetopt_optopt;}
+#define EXPORT(FUNC) m2pim ## _cgetopt_ ## FUNC
+#define M2EXPORT(FUNC) m2pim ## _M2_cgetopt_ ## FUNC
+#define M2LIBNAME "m2pim"
+
+extern "C" {char *EXPORT(optarg);}
+extern "C" {int EXPORT(optind);}
+extern "C" {int EXPORT(opterr);}
+extern "C" {int EXPORT(optopt);}
extern "C" char
-cgetopt_getopt (int argc, char *argv[], char *optstring)
+EXPORT(getopt) (int argc, char *argv[], char *optstring)
{
char r = getopt (argc, argv, optstring);
- cgetopt_optarg = optarg;
- cgetopt_optind = optind;
- cgetopt_opterr = opterr;
- cgetopt_optopt = optopt;
+ EXPORT(optarg) = optarg;
+ EXPORT(optind) = optind;
+ EXPORT(opterr) = opterr;
+ EXPORT(optopt) = optopt;
if (r == (char)-1)
return (char)0;
}
extern "C" int
-cgetopt_getopt_long (int argc, char *argv[], char *optstring,
+EXPORT(getopt_long) (int argc, char *argv[], char *optstring,
const struct option *longopts, int *longindex)
{
int r = getopt_long (argc, argv, optstring, longopts, longindex);
- cgetopt_optarg = optarg;
- cgetopt_optind = optind;
- cgetopt_opterr = opterr;
- cgetopt_optopt = optopt;
+ EXPORT(optarg) = optarg;
+ EXPORT(optind) = optind;
+ EXPORT(opterr) = opterr;
+ EXPORT(optopt) = optopt;
return r;
}
extern "C" int
-cgetopt_getopt_long_only (int argc, char *argv[], char *optstring,
+EXPORT(getopt_long_only) (int argc, char *argv[], char *optstring,
const struct option *longopts, int *longindex)
{
int r = getopt_long_only (argc, argv, optstring, longopts, longindex);
- cgetopt_optarg = optarg;
- cgetopt_optind = optind;
- cgetopt_opterr = opterr;
- cgetopt_optopt = optopt;
+ EXPORT(optarg) = optarg;
+ EXPORT(optind) = optind;
+ EXPORT(opterr) = opterr;
+ EXPORT(optopt) = optopt;
return r;
}
/* InitOptions a constructor for Options. */
extern "C" cgetopt_Options *
-cgetopt_InitOptions (void)
+EXPORT(InitOptions) (void)
{
cgetopt_Options *o = (cgetopt_Options *)malloc (sizeof (cgetopt_Options));
o->cinfo = (struct option *)malloc (sizeof (struct option));
up all allocated memory associated with o. */
extern "C" cgetopt_Options *
-cgetopt_KillOptions (cgetopt_Options *o)
+EXPORT(KillOptions) (cgetopt_Options *o)
{
free (o->cinfo);
free (o);
/* SetOption set option[index] with {name, has_arg, flag, val}. */
extern "C" void
-cgetopt_SetOption (cgetopt_Options *o, unsigned int index, char *name,
+EXPORT(SetOption) (cgetopt_Options *o, unsigned int index, char *name,
unsigned int has_arg, int *flag, int val)
{
if (index > o->high)
long options. */
extern "C" struct option *
-cgetopt_GetLongOptionArray (cgetopt_Options *o)
+EXPORT(GetLongOptionArray) (cgetopt_Options *o)
{
return o->cinfo;
}
/* GNU Modula-2 linking fodder. */
extern "C" void
-_M2_cgetopt_init (int, char *argv[], char *env[])
+M2EXPORT(init) (int, char *argv[], char *env[])
{
}
extern "C" void
-_M2_cgetopt_fini (int, char *argv[], char *env[])
+M2EXPORT(fini) (int, char *argv[], char *env[])
{
}
extern "C" void
-_M2_cgetopt_dep (void)
+M2EXPORT(dep) (void)
{
}
extern "C" void __attribute__((__constructor__))
-_M2_cgetopt_ctor (void)
+M2EXPORT(ctor) (void)
{
- M2RTS_RegisterModule ("cgetopt", _M2_cgetopt_init, _M2_cgetopt_fini,
- _M2_cgetopt_dep);
+ m2pim_M2RTS_RegisterModule ("cgetopt", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini),
+ M2EXPORT(dep));
}
#include <config.h>
#include <m2rts.h>
+#define EXPORT(FUNC) m2pim ## _dtoa_ ## FUNC
+#define M2EXPORT(FUNC) m2pim ## _M2_dtoa_ ## FUNC
+#define M2LIBNAME "m2pim"
+
#if defined(HAVE_STRINGS)
#include <strings.h>
#endif
contain ndigits past the decimal point (ndigits may be negative). */
extern "C" double
-dtoa_strtod (const char *s, int *error)
+EXPORT(strtod) (const char *s, int *error)
{
char *endp;
double d;
it also removes the decimal point and exponent from string, p. */
extern "C" int
-dtoa_calcmaxsig (char *p, int ndigits)
+EXPORT(calcmaxsig) (char *p, int ndigits)
{
char *e;
char *o;
Ie ndigits is the number of digits after the '.'. */
extern "C" int
-dtoa_calcdecimal (char *p, int str_size, int ndigits)
+EXPORT(calcdecimal) (char *p, int str_size, int ndigits)
{
char *e;
char *o;
}
extern "C" int
-dtoa_calcsign (char *p, int str_size)
+EXPORT(calcsign) (char *p, int str_size)
{
if (p[0] == '-')
{
}
extern "C" char *
-dtoa_dtoa (double d, int mode, int ndigits, int *decpt, int *sign)
+EXPORT(dtoa) (double d, int mode, int ndigits, int *decpt, int *sign)
{
char format[50];
char *p;
p = (char *) malloc (ndigits);
snprintf (format, 50, "%s%d%s", "%.", ndigits - 20, "E");
snprintf (p, ndigits, format, d);
- *sign = dtoa_calcsign (p, ndigits);
- *decpt = dtoa_calcmaxsig (p, ndigits);
+ *sign = EXPORT(calcsign) (p, ndigits);
+ *decpt = EXPORT(calcmaxsig) (p, ndigits);
return p;
case decimaldigits:
p = (char *) malloc (MAX_FP_DIGITS + 20);
snprintf (format, 50, "%s%d%s", "%.", MAX_FP_DIGITS, "E");
snprintf (p, MAX_FP_DIGITS + 20, format, d);
- *sign = dtoa_calcsign (p, MAX_FP_DIGITS + 20);
- *decpt = dtoa_calcdecimal (p, MAX_FP_DIGITS + 20, ndigits);
+ *sign = EXPORT(calcsign) (p, MAX_FP_DIGITS + 20);
+ *decpt = EXPORT(calcdecimal) (p, MAX_FP_DIGITS + 20, ndigits);
return p;
default:
abort ();
/* GNU Modula-2 linking hooks. */
extern "C" void
-_M2_dtoa_init (int, char **, char **)
+M2EXPORT(init) (int, char **, char **)
{
}
extern "C" void
-_M2_dtoa_fini (int, char **, char **)
+M2EXPORT(fini) (int, char **, char **)
{
}
extern "C" void
-_M2_dtoa_dep (void)
+M2EXPORT(dep) (void)
{
}
extern "C" void __attribute__((__constructor__))
-_M2_dtoa_ctor (void)
+M2EXPORT(ctor) (void)
{
- M2RTS_RegisterModule ("dtoa", _M2_dtoa_init, _M2_dtoa_fini,
- _M2_dtoa_dep);
+ m2pim_M2RTS_RegisterModule ("dtoa", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini),
+ M2EXPORT(dep));
}
#endif
#include "m2rts.h"
+#define EXPORT(FUNC) m2pim ## _errno_ ## FUNC
+#define M2EXPORT(FUNC) m2pim ## _M2_errno_ ## FUNC
+#define M2LIBNAME "m2pim"
+
extern "C" int
-errno_geterrno (void)
+EXPORT(geterrno) (void)
{
#if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H)
return errno;
}
extern "C" void
-_M2_errno_init (int, char *[], char *[])
+M2EXPORT(init) (int, char **, char **)
{
}
extern "C" void
-_M2_errno_fini (int, char *[], char *[])
+M2EXPORT(fini) (int, char **, char **)
{
}
extern "C" void
-_M2_errno_dep (void)
+M2EXPORT(dep) (void)
{
}
extern "C" void __attribute__((__constructor__))
-_M2_errno_ctor (void)
+M2EXPORT(ctor) (void)
{
- M2RTS_RegisterModule ("errno", _M2_errno_init, _M2_errno_fini,
- _M2_errno_dep);
+ m2pim_M2RTS_RegisterModule ("errno", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini),
+ M2EXPORT(dep));
}
#include <config.h>
#include <m2rts.h>
+#define EXPORT(FUNC) m2pim ## _ldtoa_ ## FUNC
+#define IMPORT(MODULE,FUNC) m2pim ## _ ## MODULE ## _ ## FUNC
+#define M2EXPORT(FUNC) m2pim ## _M2_ldtoa_ ## FUNC
+#define M2LIBNAME "m2pim"
+
#if defined(HAVE_STRINGS)
#include <strings.h>
#endif
typedef enum Mode { maxsignicant, decimaldigits } Mode;
-extern "C" int dtoa_calcmaxsig (char *p, int ndigits);
-extern "C" int dtoa_calcdecimal (char *p, int str_size, int ndigits);
-extern "C" int dtoa_calcsign (char *p, int str_size);
+extern "C" int IMPORT(dtoa,calcmaxsig) (char *p, int ndigits);
+extern "C" int IMPORT(dtoa,calcdecimal) (char *p, int str_size, int ndigits);
+extern "C" int IMPORT(dtoa,calcsign) (char *p, int str_size);
/* maxsignicant return a string containing max(1,ndigits) significant
digits. The return string contains the string produced by snprintf.
contain ndigits past the decimal point (ndigits may be negative). */
extern "C" long double
-ldtoa_strtold (const char *s, int *error)
+EXPORT(strtold) (const char *s, int *error)
{
char *endp;
long double d;
}
extern "C" char *
-ldtoa_ldtoa (long double d, int mode, int ndigits, int *decpt, int *sign)
+EXPORT(ldtoa) (long double d, int mode, int ndigits, int *decpt, int *sign)
{
char format[50];
char *p;
p = (char *) malloc (ndigits);
snprintf (format, 50, "%s%d%s", "%.", ndigits - 20, "LE");
snprintf (p, ndigits, format, d);
- *sign = dtoa_calcsign (p, ndigits);
- *decpt = dtoa_calcmaxsig (p, ndigits);
+ *sign = IMPORT(dtoa,calcsign) (p, ndigits);
+ *decpt = IMPORT(dtoa,calcmaxsig) (p, ndigits);
return p;
case decimaldigits:
p = (char *) malloc (MAX_FP_DIGITS + 20);
snprintf (format, 50, "%s%d%s", "%.", MAX_FP_DIGITS, "LE");
snprintf (p, MAX_FP_DIGITS + 20, format, d);
- *sign = dtoa_calcsign (p, MAX_FP_DIGITS + 20);
- *decpt = dtoa_calcdecimal (p, MAX_FP_DIGITS + 20, ndigits);
+ *sign = IMPORT(dtoa,calcsign) (p, MAX_FP_DIGITS + 20);
+ *decpt = IMPORT(dtoa,calcdecimal) (p, MAX_FP_DIGITS + 20, ndigits);
return p;
default:
abort ();
/* GNU Modula-2 linking hooks. */
extern "C" void
-_M2_ldtoa_init (int, char **, char **)
+M2EXPORT(init) (int, char **, char **)
{
}
extern "C" void
-_M2_ldtoa_fini (int, char **, char **)
+M2EXPORT(fini) (int, char **, char **)
{
}
extern "C" void
-_M2_ldtoa_dep (void)
+M2EXPORT(dep) (void)
{
}
extern "C" void __attribute__((__constructor__))
-_M2_ldtoa_ctor (void)
+M2EXPORT(ctor) (void)
{
- M2RTS_RegisterModule ("ldtoa", _M2_ldtoa_init, _M2_ldtoa_fini,
- _M2_ldtoa_dep);
+ m2pim_M2RTS_RegisterModule ("ldtoa", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini),
+ M2EXPORT(dep));
}
#endif
#include <config.h>
#include <m2rts.h>
+#define EXPORT(FUNC) m2pim ## _sckt_ ## FUNC
+#define M2EXPORT(FUNC) m2pim ## _M2_sckt_ ## FUNC
+#define M2LIBNAME "m2pim"
+
#if defined(HAVE_SYS_TYPES_H)
#include <sys/types.h>
#endif
This method attempts to use the port specified by the parameter. */
extern "C" tcpServerState *
-tcpServerEstablishPort (int portNo)
+EXPORT(tcpServerEstablishPort) (int portNo)
{
tcpServerState *s = (tcpServerState *)malloc (sizeof (tcpServerState));
int b, p, n;
information about a socket declared to receive tcp connections. */
extern "C" tcpServerState *
-tcpServerEstablish (void)
+EXPORT(tcpServerEstablish) (void)
{
- return tcpServerEstablishPort (PORTSTART);
+ return EXPORT(tcpServerEstablishPort) (PORTSTART);
}
/* tcpServerAccept returns a file descriptor once a client has connected and
been accepted. */
extern "C" int
-tcpServerAccept (tcpServerState *s)
+EXPORT(tcpServerAccept) (tcpServerState *s)
{
socklen_t i = sizeof (s->isa);
int t;
/* tcpServerPortNo returns the portNo from structure, s. */
extern "C" int
-tcpServerPortNo (tcpServerState *s)
+EXPORT(tcpServerPortNo) (tcpServerState *s)
{
return s->portNo;
}
/* tcpServerSocketFd returns the sockFd from structure, s. */
extern "C" int
-tcpServerSocketFd (tcpServerState *s)
+EXPORT(tcpServerSocketFd) (tcpServerState *s)
{
return s->sockFd;
}
/* getLocalIP returns the IP address of this machine. */
extern "C" unsigned int
-getLocalIP (tcpServerState *s)
+EXPORT(getLocalIP) (tcpServerState *s)
{
char hostname[1024];
struct hostent *hp;
/* tcpServerIP returns the IP address from structure s. */
extern "C" int
-tcpServerIP (tcpServerState *s)
+EXPORT(tcpServerIP) (tcpServerState *s)
{
return *((int *)s->hp->h_addr_list[0]);
}
has connected to server s. */
extern "C" unsigned int
-tcpServerClientIP (tcpServerState *s)
+EXPORT(tcpServerClientIP) (tcpServerState *s)
{
unsigned int ip;
has connected to server s. */
extern "C" unsigned int
-tcpServerClientPortNo (tcpServerState *s)
+EXPORT(tcpServerClientPortNo) (tcpServerState *s)
{
return s->isa.sin_port;
}
connected to, serverName:portNo. */
extern "C" tcpClientState *
-tcpClientSocket (char *serverName, int portNo)
+EXPORT(tcpClientSocket) (char *serverName, int portNo)
{
tcpClientState *s = (tcpClientState *)malloc (sizeof (tcpClientState));
connected to, ip:portNo. */
extern "C" tcpClientState *
-tcpClientSocketIP (unsigned int ip, int portNo)
+EXPORT(tcpClientSocketIP) (unsigned int ip, int portNo)
{
tcpClientState *s = (tcpClientState *)malloc (sizeof (tcpClientState));
once a connect has been performed. */
extern "C" int
-tcpClientConnect (tcpClientState *s)
+EXPORT(tcpClientConnect) (tcpClientState *s)
{
if (connect (s->sockFd, (struct sockaddr *)&s->sa, sizeof (s->sa)) < 0)
ERROR ("failed to connect to the TCP server");
/* tcpClientPortNo returns the portNo from structure s. */
extern "C" int
-tcpClientPortNo (tcpClientState *s)
+EXPORT(tcpClientPortNo) (tcpClientState *s)
{
return s->portNo;
}
/* tcpClientSocketFd returns the sockFd from structure s. */
extern "C" int
-tcpClientSocketFd (tcpClientState *s)
+EXPORT(tcpClientSocketFd) (tcpClientState *s)
{
return s->sockFd;
}
/* tcpClientIP returns the sockFd from structure s. */
extern "C" int
-tcpClientIP (tcpClientState *s)
+EXPORT(tcpClientIP) (tcpClientState *s)
{
#if defined(DEBUGGING)
printf ("client ip = %s\n", inet_ntoa (s->sa.sin_addr.s_addr));
/* GNU Modula-2 link fodder. */
extern "C" void
-_M2_sckt_init (int, char *[], char *[])
+M2EXPORT(init) (int, char *[], char *[])
{
}
extern "C" void
-_M2_sckt_finish (int, char *[], char *[])
+M2EXPORT(finish) (int, char *[], char *[])
{
}
extern "C" void
-_M2_sckt_dep (void)
+M2EXPORT(dep) (void)
{
}
extern "C" void __attribute__((__constructor__))
-_M2_sckt_ctor (void)
+M2EXPORT(ctor) (void)
{
- M2RTS_RegisterModule ("sckt", _M2_sckt_init, _M2_sckt_finish,
- _M2_sckt_dep);
+ m2pim_M2RTS_RegisterModule ("sckt", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(finish),
+ M2EXPORT(dep));
}
#include <config.h>
#include <m2rts.h>
+#define EXPORT(FUNC) m2pim ## _termios_ ## FUNC
+#define M2EXPORT(FUNC) m2pim ## _M2_termios_ ## FUNC
+#define M2LIBNAME "m2pim"
+
#if defined(HAVE_STDIO_H)
#include <stdio.h>
#endif
#if defined(HAVE_TERMIOS_H)
-#define EXPORT(X) termios##_##X
-
typedef enum {
vintr,
vquit,
#endif
extern "C" void
-_M2_termios_init (int, char *[], char *[])
+M2EXPORT(init) (int, char *argv[], char *env[])
{
}
extern "C" void
-_M2_termios_fini (int, char *[], char *[])
+M2EXPORT(fini) (int, char *argv[], char *env[])
{
}
extern "C" void
-_M2_termios_dep (void)
+M2EXPORT(dep) (void)
{
}
extern "C" void __attribute__((__constructor__))
-_M2_termios_ctor (void)
+M2EXPORT(ctor) (void)
{
- M2RTS_RegisterModule ("termios", _M2_termios_init, _M2_termios_fini,
- _M2_termios_dep);
+ m2pim_M2RTS_RegisterModule ("termios", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini), M2EXPORT(dep));
}
<http://www.gnu.org/licenses/>. */
#include <config.h>
+#include <m2rts.h>
+
+#define EXPORT(FUNC) m2pim ## _wrapc_ ## FUNC
+#define M2EXPORT(FUNC) m2pim ## _M2_wrapc_ ## FUNC
+#define M2LIBNAME "m2pim"
#if defined(HAVE_MATH_H)
#include <math.h>
/* strtime returns the address of a string which describes the
local time. */
-char *
-wrapc_strtime (void)
+extern "C" char *
+EXPORT(strtime) (void)
{
#if defined(HAVE_CTIME)
- time_t clock = time ((void *)0);
+ time_t clock = time (NULL);
char *string = ctime (&clock);
string[24] = (char)0;
#endif
}
-int
-wrapc_filesize (int f, unsigned int *low, unsigned int *high)
+extern "C" int
+EXPORT(filesize) (int f, unsigned int *low, unsigned int *high)
{
#if defined(HAVE_SYS_STAT_H) && defined(HAVE_STRUCT_STAT)
struct stat s;
/* filemtime returns the mtime of a file, f. */
-int
-wrapc_filemtime (int f)
+extern "C" int
+EXPORT(filemtime) (int f)
{
#if defined(HAVE_SYS_STAT_H) && defined(HAVE_STRUCT_STAT)
struct stat s;
/* fileinode returns the inode associated with a file, f. */
#if defined(HAVE_SYS_STAT_H) && defined(HAVE_STRUCT_STAT)
-ino_t
-wrapc_fileinode (int f, unsigned int *low, unsigned int *high)
+extern "C" ino_t
+EXPORT(fileinode) (int f, unsigned int *low, unsigned int *high)
{
struct stat s;
return -1;
}
#else
-int
-wrapc_fileinode (int f, unsigned int *low, unsigned int *high)
+extern "C" int
+EXPORT(fileinode) (int f, unsigned int *low, unsigned int *high)
{
*low = 0;
*high = 0;
/* getrand returns a random number between 0..n-1. */
-int
-wrapc_getrand (int n)
+extern "C" int
+EXPORT(getrand) (int n)
{
return rand () % n;
}
#if defined(HAVE_PWD_H)
#include <pwd.h>
-char *
-wrapc_getusername (void)
+extern "C" char *
+EXPORT(getusername) (void)
{
return getpwuid (getuid ())->pw_gecos;
}
/* getnameuidgid fills in the, uid, and, gid, which represents
user, name. */
-void
-wrapc_getnameuidgid (char *name, int *uid, int *gid)
+extern "C" void
+EXPORT(getnameuidgid) (char *name, int *uid, int *gid)
{
struct passwd *p = getpwnam (name);
}
}
#else
-char *
-wrapc_getusername (void)
+extern "C" char *
+EXPORT(getusername) (void)
{
return "unknown";
}
-void
-wrapc_getnameuidgid (char *name, int *uid, int *gid)
+extern "C" void
+EXPORT(getnameuidgid) (char *name, int *uid, int *gid)
{
*uid = -1;
*gid = -1;
}
#endif
-int
-wrapc_signbit (double r)
+extern "C" int
+EXPORT(signbit) (double r)
{
#if defined(HAVE_SIGNBIT)
#endif
}
-int
-wrapc_signbitl (long double r)
+extern "C" int
+EXPORT(signbitl) (long double r)
{
#if defined(HAVE_SIGNBITL)
#endif
}
-int
-wrapc_signbitf (float r)
+extern "C" int
+EXPORT(signbitf) (float r)
{
#if defined(HAVE_SIGNBITF)
/* isfinite provide non builtin alternative to the gcc builtin
isfinite. Returns 1 if x is finite and 0 if it is not. */
-int
-wrapc_isfinite (double x)
+extern "C" int
+EXPORT(isfinite) (double x)
{
#if defined(FP_NAN) && defined(FP_INFINITE)
return (fpclassify (x) != FP_NAN && fpclassify (x) != FP_INFINITE);
/* isfinitel provide non builtin alternative to the gcc builtin
isfinite. Returns 1 if x is finite and 0 if it is not. */
-int
-wrapc_isfinitel (long double x)
+extern "C" int
+EXPORT(isfinitel) (long double x)
{
#if defined(FP_NAN) && defined(FP_INFINITE)
return (fpclassify (x) != FP_NAN && fpclassify (x) != FP_INFINITE);
/* isfinitef provide non builtin alternative to the gcc builtin
isfinite. Returns 1 if x is finite and 0 if it is not. */
-int
-wrapc_isfinitef (float x)
+extern "C" int
+EXPORT(isfinitef) (float x)
{
#if defined(FP_NAN) && defined(FP_INFINITE)
return (fpclassify (x) != FP_NAN && fpclassify (x) != FP_INFINITE);
#endif
}
-/* init/finish are GNU Modula-2 linking fodder. */
+/* GNU Modula-2 linking hooks. */
-void
-_M2_wrapc_init ()
+extern "C" void
+M2EXPORT(init) (int, char **, char **)
{
}
-void
-_M2_wrapc_fini ()
+extern "C" void
+M2EXPORT(fini) (int, char **, char **)
{
}
-void
-_M2_wrapc_ctor ()
+extern "C" void
+M2EXPORT(dep) (void)
{
}
+extern "C" void __attribute__((__constructor__))
+M2EXPORT(ctor) (void)
+{
+ m2pim_M2RTS_RegisterModule ("wrapc", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini),
+ M2EXPORT(dep));
+}
projects / thirdparty / gcc.git / commitdiff
