1 (* M2Dependent.mod implements the run time module dependencies.
3 Copyright (C) 2022-2024 Free Software Foundation, Inc.
4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
6 This file is part of GNU Modula-2.
8 GNU Modula-2 is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
13 GNU Modula-2 is distributed in the hope that it will be useful, but
14 WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 General Public License for more details.
18 Under Section 7 of GPL version 3, you are granted additional
19 permissions described in the GCC Runtime Library Exception, version
20 3.1, as published by the Free Software Foundation.
22 You should have received a copy of the GNU General Public License and
23 a copy of the GCC Runtime Library Exception along with this program;
24 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
25 <http://www.gnu.org/licenses/>. *)
27 IMPLEMENTATION MODULE M2Dependent
;
30 FROM libc
IMPORT abort
, exit
, write
, getenv
, printf
, snprintf
, strncpy
;
31 FROM ASCII
IMPORT nul
, nl
;
32 FROM SYSTEM
IMPORT ADR
;
33 FROM Storage
IMPORT ALLOCATE
;
34 FROM StrLib
IMPORT StrCopy
, StrLen
, StrEqual
;
40 PtrToChar
= POINTER TO CHAR ;
42 DependencyState
= (unregistered
, unordered
, started
, ordered
, user
) ;
44 DependencyList
= RECORD
46 (* Has this module order been forced by the user? *)
48 (* Is the module a definition module for C? *)
50 appl
: BOOLEAN ; (* The application module? *)
51 state
: DependencyState
;
54 ModuleChain
= POINTER TO RECORD
59 dependency
: DependencyList
;
65 Modules
: ARRAY DependencyState
OF ModuleChain
;
66 DynamicInitialization
,
74 ForceTrace
: BOOLEAN ;
78 InitDependencyList - initialize all fields of DependencyList.
81 PROCEDURE InitDependencyList (VAR depList
: DependencyList
;
82 proc
: PROC; state
: DependencyState
) ;
84 depList.proc
:= proc
;
85 depList.forced
:= FALSE ;
86 depList.forc
:= FALSE ;
87 depList.appl
:= FALSE ;
88 depList.state
:= state
89 END InitDependencyList
;
93 CreateModule - creates a new module entry and returns the
97 PROCEDURE CreateModule (name
, libname
: ADDRESS
;
98 init
, fini
: ArgCVEnvP
;
99 dependencies
: PROC) : ModuleChain
;
105 mptr^.libname
:= libname
;
108 InitDependencyList (mptr^.dependency
, dependencies
, unregistered
) ;
113 printf (" (init: %p fini: %p", init
, fini
) ;
114 printf (" dep: %p)", dependencies
)
121 AppendModule - append chain to end of the list.
124 PROCEDURE AppendModule (VAR head
: ModuleChain
; chain
: ModuleChain
) ;
129 chain^.prev
:= chain
;
132 chain^.next
:= head
; (* Add Item to the end of list. *)
133 chain^.prev
:= head^.prev
;
134 head^.prev^.next
:= chain
;
141 RemoveModule - remove chain from double linked list head.
144 PROCEDURE RemoveModule (VAR head
: ModuleChain
; chain
: ModuleChain
) ;
146 IF (chain^.next
=head
) AND (chain
=head
)
154 chain^.prev^.next
:= chain^.next
;
155 chain^.next^.prev
:= chain^.prev
161 onChain - returns TRUE if mptr is on the Modules[state] list.
164 PROCEDURE onChain (state
: DependencyState
; mptr
: ModuleChain
) : BOOLEAN ;
168 IF Modules
[state
] #
NIL
170 ptr
:= Modules
[state
] ;
177 UNTIL ptr
=Modules
[state
]
187 PROCEDURE max (a
, b
: CARDINAL) : CARDINAL ;
202 PROCEDURE min (a
, b
: CARDINAL) : CARDINAL ;
214 LookupModuleN - lookup module from the state list.
215 The strings lengths are known.
218 PROCEDURE LookupModuleN (state
: DependencyState
;
219 name
: ADDRESS
; namelen
: CARDINAL;
220 libname
: ADDRESS
; libnamelen
: CARDINAL) : ModuleChain
;
224 IF Modules
[state
] #
NIL
226 ptr
:= Modules
[state
] ;
228 IF (strncmp (ptr^.name
, name
,
229 max (namelen
, strlen (ptr^.name
))) = 0) AND
230 (strncmp (ptr^.libname
, libname
,
231 max (libnamelen
, strlen (ptr^.libname
))) = 0)
236 UNTIL ptr
= Modules
[state
]
243 LookupModule - lookup and return the ModuleChain pointer containing
244 module name from a particular list.
247 PROCEDURE LookupModule (state
: DependencyState
; name
, libname
: ADDRESS
) : ModuleChain
;
249 RETURN LookupModuleN (state
,
251 libname
, strlen (libname
))
256 toCString - replace any character sequence \n into a newline.
259 PROCEDURE toCString (VAR str
: ARRAY OF CHAR) ;
261 high
, i
, j
: CARDINAL ;
266 IF (i
< high
) AND (str
[i
] = "\")
284 strcmp - return 0 if both strings are equal.
285 We cannot use Builtins.def during bootstrap.
288 PROCEDURE strcmp (a, b: PtrToChar) : INTEGER ;
290 IF (a # NIL) AND (b # NIL)
311 strncmp - return 0 if both strings are equal.
312 We cannot use Builtins.def during bootstrap.
315 PROCEDURE strncmp (a, b: PtrToChar; n: CARDINAL) : INTEGER ;
320 ELSIF (a # NIL) AND (b # NIL)
326 WHILE (a^ = b^) AND (n > 0) DO
327 IF (a^ = nul) OR (n = 1)
342 strlen - returns the length of string.
345 PROCEDURE strlen (string: PtrToChar) : INTEGER ;
354 WHILE string^ # nul DO
364 traceprintf - wrap printf with a boolean flag.
367 PROCEDURE traceprintf (flag: BOOLEAN; str: ARRAY OF CHAR) ;
378 traceprintf2 - wrap printf with a boolean flag.
381 PROCEDURE traceprintf2 (flag: BOOLEAN; str: ARRAY OF CHAR; arg: ADDRESS) ;
399 traceprintf3 - wrap printf with a boolean flag.
402 PROCEDURE traceprintf3 (flag: BOOLEAN; str: ARRAY OF CHAR;
403 arg1, arg2: ADDRESS) ;
420 printf (str, arg1, arg2)
426 moveTo - moves mptr to the new list determined by newstate.
427 It updates the mptr state appropriately.
430 PROCEDURE moveTo (newstate: DependencyState; mptr: ModuleChain) ;
432 IF onChain (mptr^.dependency.state, mptr)
434 RemoveModule (Modules[mptr^.dependency.state], mptr)
436 mptr^.dependency.state := newstate ;
437 AppendModule (Modules[mptr^.dependency.state], mptr)
445 PROCEDURE ResolveDependant (mptr: ModuleChain; currentmodule, libname: ADDRESS) ;
449 traceprintf3 (DependencyTrace,
450 " module
%s
[%s
] has not been registered via a global constructor
\n",
451 currentmodule, libname);
453 IF onChain (started, mptr)
455 traceprintf (DependencyTrace, " processing...
\n");
457 moveTo (started, mptr) ;
458 traceprintf3 (DependencyTrace, " starting
: %s
[%s
]\n",
459 currentmodule, libname);
460 mptr^.dependency.proc ; (* Invoke and process the dependency graph. *)
461 traceprintf3 (DependencyTrace, " finished
: %s
[%s
]\n",
462 currentmodule, libname);
463 moveTo (ordered, mptr)
466 END ResolveDependant ;
470 RequestDependant - used to specify that modulename is dependant upon
471 module dependantmodule. It only takes effect
472 if we are using DynamicInitialization.
475 PROCEDURE RequestDependant (modulename, libname,
476 dependantmodule, dependantlibname: ADDRESS) ;
479 PerformRequestDependant (modulename, libname,
480 dependantmodule, dependantlibname)
481 END RequestDependant ;
485 PerformRequestDependant - the current modulename has a dependancy upon
486 dependantmodule. If dependantmodule is NIL then
487 modulename has no further dependants and it can be
491 PROCEDURE PerformRequestDependant (modulename, libname,
492 dependantmodule, dependantlibname: ADDRESS) ;
496 traceprintf3 (DependencyTrace, " module
%s
[%s
]", modulename, libname) ;
497 IF dependantmodule = NIL
499 traceprintf (DependencyTrace, " has finished its import graph
\n") ;
500 mptr := LookupModule (unordered, modulename, libname) ;
503 traceprintf3 (DependencyTrace, " module
%s
[%s
] is now ordered
\n",
504 modulename, libname) ;
505 moveTo (ordered, mptr)
508 traceprintf3 (DependencyTrace, " imports from
%s
[%s
]\n",
509 dependantmodule, dependantlibname) ;
510 mptr := LookupModule (ordered, dependantmodule, dependantlibname) ;
513 traceprintf3 (DependencyTrace, " module
%s
[%s
] is not ordered
\n",
514 dependantmodule, dependantlibname) ;
515 mptr := LookupModule (unordered, dependantmodule, dependantlibname) ;
518 traceprintf3 (DependencyTrace, " module
%s
[%s
] is not unordered
\n",
519 dependantmodule, dependantlibname) ;
520 mptr := LookupModule (started, dependantmodule, dependantlibname) ;
523 traceprintf3 (DependencyTrace, " module
%s
[%s
] has not started
\n",
524 dependantmodule, dependantlibname) ;
525 traceprintf3 (DependencyTrace, " module
%s
[%s
] attempting to import from
",
526 modulename, libname) ;
527 traceprintf3 (DependencyTrace, " %s
[%s
] which has not registered itself via a constructor
\n",
528 dependantmodule, dependantlibname)
530 traceprintf3 (DependencyTrace, " module
%s
[%s
] has registered itself and has started
\n",
531 dependantmodule, dependantlibname)
534 traceprintf3 (DependencyTrace, " module
%s
[%s
] resolving
\n", dependantmodule, dependantlibname) ;
535 ResolveDependant (mptr, dependantmodule, dependantlibname)
538 traceprintf3 (DependencyTrace, " module
%s
[%s
]", modulename, libname) ;
539 traceprintf3 (DependencyTrace, " dependant
%s
[%s
] is ordered
\n", dependantmodule, dependantlibname)
542 END PerformRequestDependant ;
546 ResolveDependencies - resolve dependencies for currentmodule, libname.
549 PROCEDURE ResolveDependencies (currentmodule, libname: ADDRESS) ;
553 mptr := LookupModule (unordered, currentmodule, libname) ;
555 traceprintf3 (DependencyTrace, " attempting to resolve the dependants for
%s
[%s
]\n",
556 currentmodule, libname);
557 ResolveDependant (mptr, currentmodule, libname) ;
558 mptr := Modules[unordered]
560 END ResolveDependencies ;
564 DisplayModuleInfo - displays all module in the state.
567 PROCEDURE DisplayModuleInfo (state: DependencyState; desc: ARRAY OF CHAR) ;
572 IF Modules[state] # NIL
574 printf ("%s modules
\n", ADR (desc)) ;
575 mptr := Modules[state] ;
580 printf (" %d
%s
[]", count, mptr^.name)
582 printf (" %d
%s
[%s
]", count, mptr^.name, mptr^.libname)
585 IF mptr^.dependency.appl
587 printf (" application
")
589 IF mptr^.dependency.forc
593 IF mptr^.dependency.forced
595 printf (" forced ordering
")
599 UNTIL mptr = Modules[state]
601 END DisplayModuleInfo ;
608 PROCEDURE DumpModuleData (flag: BOOLEAN) ;
612 DisplayModuleInfo (unregistered, "unregistered
") ;
613 DisplayModuleInfo (unordered, "unordered
") ;
614 DisplayModuleInfo (started, "started
") ;
615 DisplayModuleInfo (ordered, "ordered
") ;
621 combine - dest := src + dest. Places src at the front of list dest.
622 Pre condition: src, dest are lists.
623 Post condition : dest := src + dest
627 PROCEDURE combine (src, dest: DependencyState) ;
631 WHILE Modules[src] # NIL DO
632 last := Modules[src]^.prev ;
633 moveTo (ordered, last) ;
634 Modules[dest] := last (* New item is at the head. *)
643 PROCEDURE tracemodule (flag: BOOLEAN; modname: ADDRESS; modlen: CARDINAL; libname: ADDRESS; liblen: CARDINAL) ;
645 buffer: ARRAY [0..100] OF CHAR ;
650 len := min (modlen, SIZE (buffer)-1) ;
651 strncpy (ADR(buffer), modname, len) ;
653 printf ("%s
", ADR (buffer)) ;
654 len := min (liblen, SIZE (buffer)-1) ;
655 strncpy (ADR(buffer), libname, len) ;
657 printf (" [%s
]", ADR (buffer))
666 PROCEDURE ForceModule (modname: ADDRESS; modlen: CARDINAL;
667 libname: ADDRESS; liblen: CARDINAL) ;
671 traceprintf (ForceTrace, "forcing module
: ") ;
672 tracemodule (ForceTrace, modname, modlen, libname, liblen) ;
673 traceprintf (ForceTrace, "\n") ;
674 mptr := LookupModuleN (ordered, modname, modlen, libname, liblen) ;
677 mptr^.dependency.forced := TRUE ;
684 ForceDependencies - if the user has specified a forced order then we override
685 the dynamic ordering with the preference.
688 PROCEDURE ForceDependencies (overrideliborder: ADDRESS) ;
695 pc, start: PtrToChar ;
697 IF overrideliborder # NIL
699 traceprintf2 (ForceTrace, "user forcing order
: %s
\n", overrideliborder) ;
700 pc := overrideliborder ;
710 ':': libname := start ;
715 ',': modname := start ;
717 ForceModule (modname, modlen, libname, liblen) ;
731 ForceModule (start, len, libname, liblen)
733 combine (user, ordered)
735 END ForceDependencies ;
739 CheckApplication - check to see that the application is the last entry in the list.
740 This might happen if the application only imports FOR C modules.
743 PROCEDURE CheckApplication ;
748 mptr := Modules[ordered] ;
753 IF mptr^.dependency.appl
759 UNTIL (appl # NIL) OR (mptr=Modules[ordered]) ;
762 RemoveModule (Modules[ordered], appl) ;
763 AppendModule (Modules[ordered], appl)
766 END CheckApplication ;
770 ConstructModules - resolve dependencies and then call each
771 module constructor in turn.
774 PROCEDURE ConstructModules (applicationmodule, libname,
775 overrideliborder: ADDRESS;
776 argc: INTEGER; argv, envp: ADDRESS) ;
781 DynamicInitialization := TRUE ; (* This procedure is only called if we desire dynamic initialization. *)
782 traceprintf3 (ModuleTrace, "application module
: %s
[%s
]\n",
783 applicationmodule, libname);
784 mptr := LookupModule (unordered, applicationmodule, libname) ;
787 mptr^.dependency.appl := TRUE
789 traceprintf (PreTrace, "Pre resolving dependents
\n");
790 DumpModuleData (PreTrace) ;
791 ResolveDependencies (applicationmodule, libname) ;
792 traceprintf (PreTrace, "Post resolving dependents
\n");
793 DumpModuleData (PostTrace) ;
794 ForceDependencies (overrideliborder) ;
795 traceprintf (ForceTrace, "After user forcing ordering
\n");
796 DumpModuleData (ForceTrace) ;
798 traceprintf (ForceTrace, "After runtime forces application to the end
\n");
799 DumpModuleData (ForceTrace) ;
800 IF Modules[ordered] = NIL
802 traceprintf3 (ModuleTrace, " module
: %s
[%s
] has not registered itself using a global constructor
\n",
803 applicationmodule, libname);
804 traceprintf2 (ModuleTrace, " hint try compile and linking using
: gm2
%s.mod
\n", applicationmodule);
805 traceprintf2 (ModuleTrace, " or try using
: gm2
-fscaffold
-static
%s.mod
\n",
808 mptr := Modules[ordered] ;
810 IF mptr^.dependency.forc
812 traceprintf3 (ModuleTrace, "initializing module
: %s
[%s
] for C
\n", mptr^.name, mptr^.libname)
814 traceprintf3 (ModuleTrace, "initializing module
: %s
[%s
]\n", mptr^.name, mptr^.libname);
816 IF mptr^.dependency.appl
818 traceprintf3 (ModuleTrace, "application module
: %s
[%s
]\n", mptr^.name, mptr^.libname);
819 traceprintf (ModuleTrace, " calling M2RTS_ExecuteInitialProcedures
\n");
820 M2RTS.ExecuteInitialProcedures ;
821 traceprintf (ModuleTrace, " calling application module
\n");
823 mptr^.init (argc, argv, envp) ;
825 UNTIL mptr = Modules[ordered]
827 END ConstructModules ;
831 DeconstructModules - resolve dependencies and then call each
832 module constructor in turn.
835 PROCEDURE DeconstructModules (applicationmodule, libname: ADDRESS;
836 argc: INTEGER; argv, envp: ADDRESS) ;
840 traceprintf3 (ModuleTrace, "application module finishing
: %s
[%s
]\n",
841 applicationmodule, libname);
842 IF Modules[ordered] = NIL
844 traceprintf (ModuleTrace, " no ordered modules found during finishing
\n")
846 traceprintf (ModuleTrace, "ExecuteTerminationProcedures
\n") ;
847 M2RTS.ExecuteTerminationProcedures ;
848 traceprintf (ModuleTrace, "terminating modules in sequence
\n") ;
849 mptr := Modules[ordered]^.prev ;
851 IF mptr^.dependency.forc
853 traceprintf3 (ModuleTrace, "finalizing module
: %s
[%s
] for C
\n",
854 mptr^.name, mptr^.libname)
856 traceprintf3 (ModuleTrace, "finalizing module
: %s
[%s
]\n",
857 mptr^.name, mptr^.libname)
859 mptr^.fini (argc, argv, envp) ;
861 UNTIL mptr = Modules[ordered]^.prev
863 END DeconstructModules ;
867 warning3 - write format arg1 arg2 to stderr.
870 PROCEDURE warning3 (format: ARRAY OF CHAR; arg1, arg2: ADDRESS) ;
872 buffer: ARRAY [0..4096] OF CHAR ;
877 len := snprintf (ADR (buffer), SIZE (buffer), "warning
: ") ;
878 write (2, ADR (buffer), len) ;
879 len := snprintf (ADR (buffer), SIZE (buffer), format, arg1, arg2) ;
880 write (2, ADR (buffer), len)
886 RegisterModule - adds module name to the list of outstanding
887 modules which need to have their dependencies
888 explored to determine initialization order.
891 PROCEDURE RegisterModule (modulename, libname: ADDRESS;
892 init, fini: ArgCVEnvP;
893 dependencies: PROC) ;
898 mptr := LookupModule (unordered, modulename, libname) ;
901 traceprintf3 (ModuleTrace, "module
: %s
[%s
] registering
",
902 modulename, libname);
904 CreateModule (modulename, libname, init, fini, dependencies)) ;
905 traceprintf (ModuleTrace, "\n") ;
907 warning3 ("module
: %s
[%s
] (ignoring duplicate registration
)\n",
914 equal - return TRUE if C string cstr is equal to str.
917 PROCEDURE equal (cstr: ADDRESS; str: ARRAY OF CHAR) : BOOLEAN ;
919 RETURN strncmp (cstr, ADR (str), StrLen (str)) = 0
924 SetupDebugFlags - By default assigns ModuleTrace, DependencyTrace,
925 DumpPostInit to FALSE. It checks the environment
926 GCC_M2LINK_RTFLAG which can contain
927 "all
,module
,hex
,pre
,post
,dep
,force
". all turns them all on.
928 The flag meanings are as follows and flags the are in
931 module generate trace info as the modules are registered.
932 hex dump the modules ctor functions address in hex.
933 pre generate a list of all modules seen prior to having
934 their dependancies resolved.
935 dep display a trace as the modules are resolved.
936 post generate a list of all modules seen after having
937 their dependancies resolved dynamically.
938 force generate a list of all modules seen after having
939 their dependancies resolved and forced.
942 PROCEDURE SetupDebugFlags ;
944 pc: POINTER TO CHAR ;
946 ModuleTrace := FALSE ;
947 DependencyTrace := FALSE ;
950 ForceTrace := FALSE ;
952 WarningTrace := FALSE ;
953 pc := getenv (ADR ("GCC_M2LINK_RTFLAG
")) ;
954 WHILE (pc # NIL) AND (pc^ # nul) DO
957 ModuleTrace := TRUE ;
958 DependencyTrace := TRUE ;
963 WarningTrace := TRUE ;
965 ELSIF equal (pc, "module
")
967 ModuleTrace := TRUE ;
969 ELSIF equal (pc, "warning
")
971 WarningTrace := TRUE ;
973 ELSIF equal (pc, "hex
")
977 ELSIF equal (pc, "dep
")
979 DependencyTrace := TRUE ;
981 ELSIF equal (pc, "pre
")
985 ELSIF equal (pc, "post
")
989 ELSIF equal (pc, "force
")
997 END SetupDebugFlags ;
1001 Init - initialize the debug flags and set all lists to NIL.
1006 state: DependencyState ;
1009 FOR state := MIN (DependencyState) TO MAX (DependencyState) DO
1010 Modules[state] := NIL
1012 DynamicInitialization := FALSE
1017 CheckInitialized - checks to see if this module has been initialized
1018 and if it has not it calls Init. We need this
1019 approach as this module is called by module ctors
1020 before we reach main.
1023 PROCEDURE CheckInitialized ;
1027 Initialized := TRUE ;
1030 END CheckInitialized ;