(* M2Dependent.mod implements the run time module dependencies.
Copyright (C) 2022-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/>. *)
IMPLEMENTATION MODULE M2Dependent ;
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, SIZE ;
FROM Storage IMPORT ALLOCATE ;
FROM StrLib IMPORT StrCopy, StrLen, StrEqual ;
IMPORT M2RTS ;
TYPE
PtrToChar = POINTER TO CHAR ;
DependencyState = (unregistered, unordered, started, ordered, user) ;
DependencyList = RECORD
proc : PROC ;
(* Has this module order been forced by the user? *)
forced,
(* Is the module a definition module for C? *)
forc : BOOLEAN ;
appl : BOOLEAN ; (* The application module? *)
state : DependencyState ;
END ;
ModuleChain = POINTER TO RECORD
name,
libname : ADDRESS ;
init,
fini : ArgCVEnvP ;
dependency: DependencyList ;
prev,
next : ModuleChain ;
END ;
VAR
Modules : ARRAY DependencyState OF ModuleChain ;
DynamicInitialization,
Initialized,
WarningTrace,
ModuleTrace,
HexTrace,
DependencyTrace,
PreTrace,
PostTrace,
ForceTrace : BOOLEAN ;
(*
CreateModule - creates a new module entry and returns the
ModuleChain.
*)
PROCEDURE CreateModule (name, libname: ADDRESS;
init, fini: ArgCVEnvP;
dependencies: PROC) : ModuleChain ;
VAR
mptr: ModuleChain ;
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 ;
(*
AppendModule - append chain to end of the list.
*)
PROCEDURE AppendModule (VAR head: ModuleChain; chain: ModuleChain) ;
BEGIN
IF head = NIL
THEN
head := chain ;
chain^.prev := chain ;
chain^.next := chain
ELSE
chain^.next := head ; (* Add Item to the end of list. *)
chain^.prev := head^.prev ;
head^.prev^.next := chain ;
head^.prev := chain
END
END AppendModule ;
(*
RemoveModule - remove chain from double linked list head.
*)
PROCEDURE RemoveModule (VAR head: ModuleChain; chain: ModuleChain) ;
BEGIN
IF (chain^.next=head) AND (chain=head)
THEN
head := NIL
ELSE
IF head=chain
THEN
head := head^.next
END ;
chain^.prev^.next := chain^.next ;
chain^.next^.prev := chain^.prev
END
END RemoveModule ;
(*
onChain - returns TRUE if mptr is on the Modules[state] list.
*)
PROCEDURE onChain (state: DependencyState; mptr: ModuleChain) : BOOLEAN ;
VAR
ptr: ModuleChain ;
BEGIN
IF Modules[state] # NIL
THEN
ptr := Modules[state] ;
REPEAT
IF ptr = mptr
THEN
RETURN TRUE
END ;
ptr := ptr^.next
UNTIL ptr=Modules[state]
END ;
RETURN FALSE
END onChain ;
(*
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; namelen: CARDINAL;
libname: ADDRESS; libnamelen: CARDINAL) : ModuleChain ;
VAR
ptr: ModuleChain ;
BEGIN
IF Modules[state] # NIL
THEN
ptr := Modules[state] ;
REPEAT
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 ;
ptr := ptr^.next
UNTIL ptr = Modules[state]
END ;
RETURN NIL
END LookupModuleN ;
(*
LookupModule - lookup and return the ModuleChain pointer containing
module name from a particular list.
*)
PROCEDURE LookupModule (state: DependencyState; name, libname: ADDRESS) : ModuleChain ;
BEGIN
RETURN LookupModuleN (state,
name, strlen (name),
libname, strlen (libname))
END LookupModule ;
(*
toCString - replace any character sequence \n into a newline.
*)
PROCEDURE toCString (VAR str: ARRAY OF CHAR) ;
VAR
high, i, j: CARDINAL ;
BEGIN
i := 0 ;
high := HIGH (str) ;
WHILE i < high DO
IF (i < high) AND (str[i] = "\")
THEN
IF str[i+1] = "n"
THEN
str[i] := nl ;
j := i+1 ;
WHILE j < high DO
str[j] := str[j+1] ;
INC (j)
END
END
END ;
INC (i)
END
END toCString ;
(*
strcmp - return 0 if both strings are equal.
We cannot use Builtins.def during bootstrap.
*)
PROCEDURE strcmp (a, b: PtrToChar) : INTEGER ;
BEGIN
IF (a # NIL) AND (b # NIL)
THEN
IF a = b
THEN
RETURN 0
ELSE
WHILE a^ = b^ DO
IF a^ = nul
THEN
RETURN 0
END ;
INC (a) ;
INC (b)
END
END
END ;
RETURN 1
END strcmp ;
(*
strncmp - return 0 if both strings are equal.
We cannot use Builtins.def during bootstrap.
*)
PROCEDURE strncmp (a, b: PtrToChar; n: CARDINAL) : INTEGER ;
BEGIN
IF n = 0
THEN
RETURN 0
ELSIF (a # NIL) AND (b # NIL)
THEN
IF a = b
THEN
RETURN 0
ELSE
WHILE (a^ = b^) AND (n > 0) DO
IF (a^ = nul) OR (n = 1)
THEN
RETURN 0
END ;
INC (a) ;
INC (b) ;
DEC (n)
END
END
END ;
RETURN 1
END strncmp ;
(*
strlen - returns the length of string.
*)
PROCEDURE strlen (string: PtrToChar) : INTEGER ;
VAR
count: INTEGER ;
BEGIN
IF string = NIL
THEN
RETURN 0
ELSE
count := 0 ;
WHILE string^ # nul DO
INC (string) ;
INC (count)
END ;
RETURN count
END
END strlen ;
(*
traceprintf - wrap printf with a boolean flag.
*)
PROCEDURE traceprintf (flag: BOOLEAN; str: ARRAY OF CHAR) ;
BEGIN
IF flag
THEN
toCString (str) ;
printf (str)
END
END traceprintf ;
(*
traceprintf2 - wrap printf with a boolean flag.
*)
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.
*)
PROCEDURE moveTo (newstate: DependencyState; mptr: ModuleChain) ;
BEGIN
IF onChain (mptr^.dependency.state, mptr)
THEN
RemoveModule (Modules[mptr^.dependency.state], mptr)
END ;
mptr^.dependency.state := newstate ;
AppendModule (Modules[mptr^.dependency.state], mptr)
END moveTo ;
(*
ResolveDependant -
*)
PROCEDURE ResolveDependant (mptr: ModuleChain; currentmodule, libname: ADDRESS) ;
BEGIN
IF mptr = NIL
THEN
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) ;
traceprintf3 (DependencyTrace, " starting: %s [%s]\n",
currentmodule, libname);
mptr^.dependency.proc ; (* Invoke and process the dependency graph. *)
traceprintf3 (DependencyTrace, " finished: %s [%s]\n",
currentmodule, libname);
moveTo (ordered, mptr)
END
END
END ResolveDependant ;
(*
RequestDependant - used to specify that modulename is dependant upon
module dependantmodule. It only takes effect
if we are using DynamicInitialization.
*)
PROCEDURE RequestDependant (modulename, libname,
dependantmodule, dependantlibname: ADDRESS) ;
BEGIN
CheckInitialized ;
PerformRequestDependant (modulename, libname,
dependantmodule, dependantlibname)
END RequestDependant ;
(*
PerformRequestDependant - the current modulename has a dependancy upon
dependantmodule. If dependantmodule is NIL then
modulename has no further dependants and it can be
resolved.
*)
PROCEDURE PerformRequestDependant (modulename, libname,
dependantmodule, dependantlibname: ADDRESS) ;
VAR
mptr: ModuleChain ;
BEGIN
traceprintf3 (DependencyTrace, " module %s [%s]", modulename, libname) ;
IF dependantmodule = NIL
THEN
traceprintf (DependencyTrace, " has finished its import graph\n") ;
mptr := LookupModule (unordered, modulename, libname) ;
IF mptr # NIL
THEN
traceprintf3 (DependencyTrace, " module %s [%s] is now ordered\n",
modulename, libname) ;
moveTo (ordered, mptr)
END
ELSE
traceprintf3 (DependencyTrace, " imports from %s [%s]\n",
dependantmodule, dependantlibname) ;
mptr := LookupModule (ordered, dependantmodule, dependantlibname) ;
IF mptr = NIL
THEN
traceprintf3 (DependencyTrace, " module %s [%s] is not ordered\n",
dependantmodule, dependantlibname) ;
mptr := LookupModule (unordered, dependantmodule, dependantlibname) ;
IF mptr = NIL
THEN
traceprintf3 (DependencyTrace, " module %s [%s] is not unordered\n",
dependantmodule, dependantlibname) ;
mptr := LookupModule (started, dependantmodule, dependantlibname) ;
IF mptr = NIL
THEN
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
traceprintf3 (DependencyTrace, " module %s [%s] has registered itself and has started\n",
dependantmodule, dependantlibname)
END
ELSE
traceprintf3 (DependencyTrace, " module %s [%s] resolving\n", dependantmodule, dependantlibname) ;
ResolveDependant (mptr, dependantmodule, dependantlibname)
END
ELSE
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, libname.
*)
PROCEDURE ResolveDependencies (currentmodule, libname: ADDRESS) ;
VAR
mptr: ModuleChain ;
BEGIN
mptr := LookupModule (unordered, currentmodule, libname) ;
WHILE mptr # NIL DO
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; desc: ARRAY OF CHAR) ;
VAR
mptr : ModuleChain ;
count: CARDINAL ;
BEGIN
IF Modules[state] # NIL
THEN
printf ("%s modules\n", ADR (desc)) ;
mptr := Modules[state] ;
count := 0 ;
REPEAT
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
printf (" application")
END ;
IF mptr^.dependency.forc
THEN
printf (" for C")
END ;
IF mptr^.dependency.forced
THEN
printf (" forced ordering")
END ;
printf ("\n") ;
mptr := mptr^.next ;
UNTIL mptr = Modules[state]
END
END DisplayModuleInfo ;
(*
DumpModuleData -
*)
PROCEDURE DumpModuleData (flag: BOOLEAN) ;
BEGIN
IF flag
THEN
DisplayModuleInfo (unregistered, "unregistered") ;
DisplayModuleInfo (unordered, "unordered") ;
DisplayModuleInfo (started, "started") ;
DisplayModuleInfo (ordered, "ordered") ;
END
END DumpModuleData ;
(*
combine - dest := src + dest. Places src at the front of list dest.
Pre condition: src, dest are lists.
Post condition : dest := src + dest
src := NIL.
*)
PROCEDURE combine (src, dest: DependencyState) ;
VAR
last: ModuleChain ;
BEGIN
WHILE Modules[src] # NIL DO
last := Modules[src]^.prev ;
moveTo (ordered, last) ;
Modules[dest] := last (* New item is at the head. *)
END
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 (overrideliborder: ADDRESS) ;
VAR
len,
modlen,
liblen : CARDINAL ;
modname,
libname,
pc, start: PtrToChar ;
BEGIN
IF overrideliborder # NIL
THEN
traceprintf2 (ForceTrace, "user forcing order: %s\n", overrideliborder) ;
pc := overrideliborder ;
start := pc ;
len := 0 ;
modname := NIL ;
modlen := 0 ;
libname := NIL ;
liblen := 0 ;
WHILE pc^ # nul DO
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 (len)
END
END ;
IF start # pc
THEN
ForceModule (start, len, libname, liblen)
END ;
combine (user, ordered)
END
END ForceDependencies ;
(*
CheckApplication - check to see that the application is the last entry in the list.
This might happen if the application only imports FOR C modules.
*)
PROCEDURE CheckApplication ;
VAR
mptr,
appl: ModuleChain ;
BEGIN
mptr := Modules[ordered] ;
IF mptr # NIL
THEN
appl := NIL ;
REPEAT
IF mptr^.dependency.appl
THEN
appl := mptr
ELSE
mptr := mptr^.next
END
UNTIL (appl # NIL) OR (mptr=Modules[ordered]) ;
IF appl # NIL
THEN
RemoveModule (Modules[ordered], appl) ;
AppendModule (Modules[ordered], appl)
END
END
END CheckApplication ;
(*
ConstructModules - resolve dependencies and then call each
module constructor in turn.
*)
PROCEDURE ConstructModules (applicationmodule, libname,
overrideliborder: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
VAR
mptr: ModuleChain ;
BEGIN
CheckInitialized ;
DynamicInitialization := TRUE ; (* This procedure is only called if we desire dynamic initialization. *)
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, libname) ;
traceprintf (PreTrace, "Post resolving dependents\n");
DumpModuleData (PostTrace) ;
ForceDependencies (overrideliborder) ;
traceprintf (ForceTrace, "After user forcing ordering\n");
DumpModuleData (ForceTrace) ;
CheckApplication ;
traceprintf (ForceTrace, "After runtime forces application to the end\n");
DumpModuleData (ForceTrace) ;
IF Modules[ordered] = NIL
THEN
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);
ELSE
mptr := Modules[ordered] ;
REPEAT
IF mptr^.dependency.forc
THEN
traceprintf3 (ModuleTrace, "initializing module: %s [%s] for C\n", mptr^.name, mptr^.libname)
ELSE
traceprintf3 (ModuleTrace, "initializing module: %s [%s]\n", mptr^.name, mptr^.libname);
END ;
IF mptr^.dependency.appl
THEN
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");
END ;
mptr^.init (argc, argv, envp) ;
mptr := mptr^.next
UNTIL mptr = Modules[ordered]
END
END ConstructModules ;
(*
DeconstructModules - resolve dependencies and then call each
module constructor in turn.
*)
PROCEDURE DeconstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
VAR
mptr: ModuleChain ;
BEGIN
traceprintf3 (ModuleTrace, "application module finishing: %s [%s]\n",
applicationmodule, libname);
IF Modules[ordered] = NIL
THEN
traceprintf (ModuleTrace, " no ordered modules found during finishing\n")
ELSE
traceprintf (ModuleTrace, "ExecuteTerminationProcedures\n") ;
M2RTS.ExecuteTerminationProcedures ;
traceprintf (ModuleTrace, "terminating modules in sequence\n") ;
mptr := Modules[ordered]^.prev ;
REPEAT
IF mptr^.dependency.forc
THEN
traceprintf3 (ModuleTrace, "finalizing module: %s [%s] for C\n",
mptr^.name, mptr^.libname)
ELSE
traceprintf3 (ModuleTrace, "finalizing module: %s [%s]\n",
mptr^.name, mptr^.libname)
END ;
mptr^.fini (argc, argv, envp) ;
mptr := mptr^.prev
UNTIL mptr = Modules[ordered]^.prev
END
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 (modulename, libname: ADDRESS;
init, fini: ArgCVEnvP;
dependencies: PROC) ;
VAR
mptr: ModuleChain ;
BEGIN
CheckInitialized ;
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 RegisterModule ;
(*
equal - return TRUE if C string cstr is equal to str.
*)
PROCEDURE equal (cstr: ADDRESS; str: ARRAY OF CHAR) : BOOLEAN ;
BEGIN
RETURN strncmp (cstr, ADR (str), StrLen (str)) = 0
END equal ;
(*
SetupDebugFlags - By default assigns ModuleTrace, DependencyTrace,
DumpPostInit to FALSE. It checks the environment
GCC_M2LINK_RTFLAG which can contain
"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.
post generate a list of all modules seen after having
their dependancies resolved dynamically.
force generate a list of all modules seen after having
their dependancies resolved and forced.
*)
PROCEDURE SetupDebugFlags ;
VAR
pc: POINTER TO CHAR ;
BEGIN
ModuleTrace := FALSE ;
DependencyTrace := FALSE ;
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")
THEN
ModuleTrace := TRUE ;
DependencyTrace := TRUE ;
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 ;
INC (pc, 3)
ELSIF equal (pc, "pre")
THEN
PreTrace := TRUE ;
INC (pc, 3)
ELSIF equal (pc, "post")
THEN
PostTrace := TRUE ;
INC (pc, 4)
ELSIF equal (pc, "force")
THEN
ForceTrace := TRUE ;
INC (pc, 5)
ELSE
INC (pc)
END
END
END SetupDebugFlags ;
(*
Init - initialize the debug flags and set all lists to NIL.
*)
PROCEDURE Init ;
VAR
state: DependencyState ;
BEGIN
SetupDebugFlags ;
FOR state := MIN (DependencyState) TO MAX (DependencyState) DO
Modules[state] := NIL
END ;
DynamicInitialization := FALSE
END Init ;
(*
CheckInitialized - checks to see if this module has been initialized
and if it has not it calls Init. We need this
approach as this module is called by module ctors
before we reach main.
*)
PROCEDURE CheckInitialized ;
BEGIN
IF NOT Initialized
THEN
Initialized := TRUE ;
Init
END
END CheckInitialized ;
BEGIN
CheckInitialized
END M2Dependent.