public inbox for gcc-cvs@sourceware.org help / color / mirror / Atom feed
From: Gaius Mulley <gaius@gcc.gnu.org> To: gcc-cvs@gcc.gnu.org Subject: [gcc/devel/m2link] New files implementing the scaffold at compile/runtime. Date: Mon, 20 Jun 2022 23:31:16 +0000 (GMT) [thread overview] Message-ID: <20220620233116.5603F385703E@sourceware.org> (raw) https://gcc.gnu.org/g:5ceb82c64ed01a53c34708d285643308305a06d7 commit 5ceb82c64ed01a53c34708d285643308305a06d7 Author: Gaius Mulley <gaius.mulley@southwales.ac.uk> Date: Tue Jun 21 00:26:46 2022 +0100 New files implementing the scaffold at compile/runtime. gcc/m2/ChangeLog: * gm2-compiler/M2Scaffold.def (New file). * gm2-compiler/M2Scaffold.mod (New file). * gm2-libs-ch/M2LINK.c (New file). * gm2-libs/M2Dependent.def (New file). * gm2-libs/M2Dependent.mod (New file). * gm2-libs/M2LINK.def (New file). * m2-link-support.h (Removed file). * mc-boot-ch/GM2LINK.c (New file). * mc-boot/GM2LINK.h (New file). Signed-off-by: Gaius Mulley <gaius.mulley@southwales.ac.uk> Diff: --- gcc/m2/gm2-compiler/M2Scaffold.def | 45 +++ gcc/m2/gm2-compiler/M2Scaffold.mod | 113 ++++++ gcc/m2/gm2-libs-ch/M2LINK.c | 44 +++ gcc/m2/gm2-libs/M2Dependent.def | 62 +++ gcc/m2/gm2-libs/M2Dependent.mod | 791 +++++++++++++++++++++++++++++++++++++ gcc/m2/gm2-libs/M2LINK.def | 41 ++ gcc/m2/m2-link-support.h | 197 --------- gcc/m2/mc-boot-ch/GM2LINK.c | 24 ++ gcc/m2/mc-boot/GM2LINK.h | 59 +++ 9 files changed, 1179 insertions(+), 197 deletions(-) diff --git a/gcc/m2/gm2-compiler/M2Scaffold.def b/gcc/m2/gm2-compiler/M2Scaffold.def new file mode 100644 index 00000000000..f16575f6eb3 --- /dev/null +++ b/gcc/m2/gm2-compiler/M2Scaffold.def @@ -0,0 +1,45 @@ +(* M2Scaffold.def declare and create scaffold entities. + +Copyright (C) 2022 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. + +You should have received a copy of the GNU General Public License +along with GNU Modula-2; see the file COPYING3. If not see +<http://www.gnu.org/licenses/>. *) + +DEFINITION MODULE M2Scaffold ; + + +VAR + finiFunction, + initFunction, + mainFunction: CARDINAL ; + + +(* + DeclareScaffold - declare scaffold related entities. +*) + +PROCEDURE DeclareScaffold (tokno: CARDINAL) ; + + +(* + DeclareArgEnvParams - declares (int argc, void *argv, void *envp) +*) + +PROCEDURE DeclareArgEnvParams (tokno: CARDINAL; proc: CARDINAL) ; + + +END M2Scaffold. diff --git a/gcc/m2/gm2-compiler/M2Scaffold.mod b/gcc/m2/gm2-compiler/M2Scaffold.mod new file mode 100644 index 00000000000..e27ccf26c36 --- /dev/null +++ b/gcc/m2/gm2-compiler/M2Scaffold.mod @@ -0,0 +1,113 @@ +(* M2Scaffold.mod declare and create scaffold entities. + +Copyright (C) 2022 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. + +You should have received a copy of the GNU General Public License +along with GNU Modula-2; see the file COPYING3. If not see +<http://www.gnu.org/licenses/>. *) + +IMPLEMENTATION MODULE M2Scaffold ; + +FROM SymbolTable IMPORT NulSym, MakeProcedure, PutFunction, + PutPublic, PutCtor, PutParam, IsProcedure, + StartScope, + EndScope ; + +FROM NameKey IMPORT MakeKey ; +FROM M2Base IMPORT Integer ; +FROM M2System IMPORT Address ; +FROM M2LexBuf IMPORT GetTokenNo ; +FROM Assertion IMPORT Assert ; + + +(* The dynamic scaffold takes the form: + +static void _M2_init (int argc, char *argv[], char *envp[]) +{ + M2RTS_ConstructModules (module_name, argc, argv, envp); +} + + +static void _M2_finish (int argc, char *argv[], char *envp[]) +{ + M2RTS_Terminate (); + M2RTS_DeconstructModules (module_name, argc, argv, envp); +} + + +int +main (int argc, char *argv[], char *envp[]) +{ + init (argc, argv, envp); + finish (); + return (0); +} *) + + +(* + DeclareScaffoldFunctions - declare main, _M2_init,_M2_finish + and _M2_DependencyGraph to the modula-2 + front end. +*) + +PROCEDURE DeclareScaffoldFunctions (tokenno: CARDINAL) ; +BEGIN + mainFunction := MakeProcedure (tokenno, MakeKey ("main")) ; + StartScope (mainFunction) ; + PutFunction (mainFunction, Integer) ; + DeclareArgEnvParams (tokenno, mainFunction) ; + PutPublic (mainFunction, TRUE) ; + EndScope ; + + initFunction := MakeProcedure (tokenno, MakeKey ("_M2_init")) ; + DeclareArgEnvParams (tokenno, initFunction) ; + + finiFunction := MakeProcedure (tokenno, MakeKey ("_M2_finish")) ; + DeclareArgEnvParams (tokenno, finiFunction) +END DeclareScaffoldFunctions ; + + +(* + DeclareArgEnvParams - declares (int argc, void *argv, void *envp) +*) + +PROCEDURE DeclareArgEnvParams (tokno: CARDINAL; proc: CARDINAL) ; +BEGIN + Assert (IsProcedure (proc)) ; + StartScope (proc) ; + Assert (PutParam (tokno, proc, 1, MakeKey ("argc"), Integer, FALSE)) ; + Assert (PutParam (tokno, proc, 2, MakeKey ("argv"), Address, FALSE)) ; + Assert (PutParam (tokno, proc, 3, MakeKey ("envp"), Address, FALSE)) ; + EndScope +END DeclareArgEnvParams ; + + + +(* + DeclareScaffold - declare scaffold related entities. +*) + +PROCEDURE DeclareScaffold (tokno: CARDINAL) ; +BEGIN + DeclareScaffoldFunctions (tokno) +END DeclareScaffold ; + + +BEGIN + finiFunction := NulSym ; + initFunction := NulSym ; + mainFunction := NulSym +END M2Scaffold. diff --git a/gcc/m2/gm2-libs-ch/M2LINK.c b/gcc/m2/gm2-libs-ch/M2LINK.c new file mode 100644 index 00000000000..70b4c3d889a --- /dev/null +++ b/gcc/m2/gm2-libs-ch/M2LINK.c @@ -0,0 +1,44 @@ +/* M2LINK.c provide a bootstrap minimal definitions. + +Copyright (C) 2022 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 "config.h" +#include "system.h" +#include "ansidecl.h" +#include "math.h" + +#include "gm2-libs-host.h" + +#ifdef __cplusplus +extern "C" { +#endif + + /* These definitions are only used during bootstrap to disable the dynamic + initialization features of M2RTS. */ + + char *M2LINK_ForcedModuleInitOrder = NULL; + int M2LINK_StaticInitialization = 1; + +} diff --git a/gcc/m2/gm2-libs/M2Dependent.def b/gcc/m2/gm2-libs/M2Dependent.def new file mode 100644 index 00000000000..a7c18159b12 --- /dev/null +++ b/gcc/m2/gm2-libs/M2Dependent.def @@ -0,0 +1,62 @@ +(* M2Dependent.def defines the run time module dependencies interface. + +Copyright (C) 2022 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/>. *) + +DEFINITION MODULE M2Dependent ; + +FROM SYSTEM IMPORT ADDRESS ; + + +TYPE + ArgCVEnvP = PROCEDURE (INTEGER, ADDRESS, ADDRESS) ; + + +PROCEDURE ConstructModules (applicationmodule: ADDRESS; + argc: INTEGER; argv, envp: ADDRESS) ; + +PROCEDURE DeconstructModules (applicationmodule: ADDRESS; + argc: INTEGER; argv, envp: ADDRESS) ; + + +(* + RegisterModule - adds module name to the list of outstanding + modules which need to have their dependencies + explored to determine initialization order. +*) + +PROCEDURE RegisterModule (name: ADDRESS; + init, fini: ArgCVEnvP; + dependencies: PROC) ; + + +(* + RequestDependant - used to specify that modulename is dependant upon + module dependantmodule. +*) + +PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ; + + +END M2Dependent. diff --git a/gcc/m2/gm2-libs/M2Dependent.mod b/gcc/m2/gm2-libs/M2Dependent.mod new file mode 100644 index 00000000000..3780cdb33bd --- /dev/null +++ b/gcc/m2/gm2-libs/M2Dependent.mod @@ -0,0 +1,791 @@ +(* M2Dependent.mod implements the run time module dependencies. + +Copyright (C) 2022 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 ; +(* 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 Storage IMPORT ALLOCATE ; +FROM StrLib IMPORT StrCopy, StrLen, StrEqual ; + +IMPORT M2RTS ; + + +TYPE + 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 : ADDRESS ; + init, + fini : ArgCVEnvP ; + dependency: DependencyList ; + prev, + next : ModuleChain ; + END ; + +VAR + Modules : ARRAY DependencyState OF ModuleChain ; + Initialized, + ModuleTrace, + DependencyTrace, + PreTrace, + PostTrace, + ForceTrace : BOOLEAN ; + + +(* + CreateModule - creates a new module entry and returns the + ModuleChain. +*) + +PROCEDURE CreateModule (name: ADDRESS; + init, fini: ArgCVEnvP; + dependencies: PROC) : ModuleChain ; +VAR + mptr: ModuleChain ; +BEGIN + NEW (mptr) ; + mptr^.name := name ; + mptr^.init := init ; + mptr^.fini := fini ; + mptr^.dependency.proc := dependencies ; + mptr^.dependency.state := unregistered ; + mptr^.prev := NIL ; + mptr^.next := NIL ; + 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 ; + + +(* + LookupModuleN - lookup module from the state list. The string is limited + to nchar. +*) + +PROCEDURE LookupModuleN (state: DependencyState; + name: ADDRESS; nchar: CARDINAL) : ModuleChain ; +VAR + ptr: ModuleChain ; +BEGIN + IF Modules[state] # NIL + THEN + ptr := Modules[state] ; + REPEAT + IF strncmp (ptr^.name, name, nchar) = 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: ADDRESS) : ModuleChain ; +BEGIN + RETURN LookupModuleN (state, name, strlen (name)) +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 (str[i] = "\") AND (i < high) + 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 (a # NIL) AND (b # NIL) AND (n > 0) + 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) ; +BEGIN + IF flag + THEN + toCString (str) ; + printf (str, arg) + END +END traceprintf2 ; + + +(* + 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: ADDRESS) ; +BEGIN + IF mptr = NIL + THEN + traceprintf (DependencyTrace, " module has not been registered via a global constructor\n"); + ELSE + IF onChain (started, mptr) + THEN + traceprintf (DependencyTrace, " processing...\n"); + ELSE + moveTo (started, mptr) ; + traceprintf2 (DependencyTrace, " starting: %s\n", + currentmodule); + mptr^.dependency.proc ; (* Invoke and process the dependency graph. *) + traceprintf2 (DependencyTrace, " finished: %s\n", + currentmodule); + 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 not using StaticInitialization. +*) + +PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ; +BEGIN + CheckInitialized ; + IF NOT StaticInitialization + THEN + PerformRequestDependant (modulename, dependantmodule) + END +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, dependantmodule: ADDRESS) ; +VAR + mptr: ModuleChain ; +BEGIN + traceprintf2 (DependencyTrace, " module %s", modulename) ; + IF dependantmodule = NIL + THEN + traceprintf2 (DependencyTrace, " has finished its import graph\n", modulename) ; + mptr := LookupModule (unordered, modulename) ; + IF mptr # NIL + THEN + traceprintf2 (DependencyTrace, " module %s is now ordered\n", modulename) ; + moveTo (ordered, mptr) + END + ELSE + traceprintf2 (DependencyTrace, " imports from %s\n", dependantmodule) ; + mptr := LookupModule (ordered, dependantmodule) ; + IF mptr = NIL + THEN + traceprintf2 (DependencyTrace, " module %s is not ordered\n", dependantmodule) ; + mptr := LookupModule (unordered, dependantmodule) ; + IF mptr = NIL + THEN + traceprintf2 (DependencyTrace, " module %s is not unordered\n", dependantmodule) ; + mptr := LookupModule (started, dependantmodule) ; + 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) + ELSE + traceprintf2 (DependencyTrace, " module %s has registered itself and has started\n", dependantmodule) + END + ELSE + traceprintf2 (DependencyTrace, " module %s resolving\n", dependantmodule) ; + ResolveDependant (mptr, dependantmodule) + END + ELSE + traceprintf2 (DependencyTrace, " module %s ", modulename) ; + traceprintf2 (DependencyTrace, " dependant %s is ordered\n", dependantmodule) + END + END +END PerformRequestDependant ; + + +(* + ResolveDependencies - resolve dependencies for currentmodule. +*) + +PROCEDURE ResolveDependencies (currentmodule: ADDRESS) ; +VAR + mptr: ModuleChain ; +BEGIN + mptr := LookupModule (unordered, currentmodule) ; + WHILE mptr # NIL DO + traceprintf2 (DependencyTrace, " attempting to resolve the dependants for %s\n", + currentmodule); + ResolveDependant (mptr, currentmodule) ; + mptr := Modules[unordered] + END +END ResolveDependencies ; + + +(* + DisplayModuleInfo - displays all module in the state. +*) + +PROCEDURE DisplayModuleInfo (state: DependencyState; name: ARRAY OF CHAR) ; +VAR + mptr: ModuleChain ; +BEGIN + IF Modules[state] # NIL + THEN + printf ("%s modules\n", ADR (name)) ; + mptr := Modules[state] ; + REPEAT + printf (" %s", mptr^.name) ; + 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) ; +VAR + mptr: ModuleChain ; +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 ; + + +(* + 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 ; + pc, start: PtrToChar ; +BEGIN + IF ForcedModuleInitOrder # NIL + THEN + userChain := NIL ; + pc := ForcedModuleInitOrder ; + start := pc ; + count := 0 ; + WHILE pc^ # nul DO + IF pc^ = ',' + THEN + mptr := LookupModuleN (ordered, start, count) ; + IF mptr # NIL + THEN + moveTo (user, mptr) + END ; + INC (pc) ; + start := pc ; + count := 0 + ELSE + INC (pc) ; + INC (count) + END + END ; + IF start # pc + THEN + mptr := LookupModuleN (ordered, start, count) ; + IF mptr # NIL + THEN + moveTo (user, mptr) + END + END ; + combine (user, ordered) + END +END ForceDependencies ; + + +(* + ConstructModules - resolve dependencies and then call each + module constructor in turn. +*) + +PROCEDURE ConstructModules (applicationmodule: ADDRESS; + argc: INTEGER; argv, envp: ADDRESS) ; +VAR + mptr: ModuleChain ; + nulp: ArgCVEnvP ; +BEGIN + CheckInitialized ; + traceprintf2 (ModuleTrace, "application module: %s\n", applicationmodule); + mptr := LookupModule (unordered, applicationmodule) ; + IF mptr # NIL + THEN + mptr^.dependency.appl := TRUE + END ; + traceprintf (PreTrace, "Pre resolving dependents\n"); + DumpModuleData (PreTrace) ; + ResolveDependencies (applicationmodule) ; + traceprintf (PreTrace, "Post resolving dependents\n"); + DumpModuleData (PostTrace) ; + ForceDependencies ; + traceprintf (ForceTrace, "After user forcing ordering\n"); + DumpModuleData (ForceTrace) ; + IF Modules[ordered] = NIL + THEN + traceprintf2 (ModuleTrace, " module: %s has not registered itself using a global constructor\n", applicationmodule); + 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 + traceprintf2 (ModuleTrace, "initializing module: %s for C\n", mptr^.name); + ELSE + traceprintf2 (ModuleTrace, "initializing module: %s\n", mptr^.name); + END ; + IF mptr^.dependency.appl + THEN + traceprintf2 (ModuleTrace, "application module: %s\n", mptr^.name); + 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: ADDRESS; + argc: INTEGER; argv, envp: ADDRESS) ; +VAR + mptr: ModuleChain ; +BEGIN + traceprintf2 (ModuleTrace, "application module finishing: %s\n", applicationmodule); + 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 + traceprintf2 (ModuleTrace, "finalizing module: %s for C\n", mptr^.name); + ELSE + traceprintf2 (ModuleTrace, "finalizing module: %s\n", mptr^.name); + END ; + mptr^.fini (argc, argv, envp) ; + mptr := mptr^.prev + UNTIL mptr = Modules[ordered]^.prev + END +END DeconstructModules ; + + +(* + RegisterModule - adds module name to the list of outstanding + modules which need to have their dependencies + explored to determine initialization order. +*) + +PROCEDURE RegisterModule (name: ADDRESS; + init, fini: ArgCVEnvP; + dependencies: PROC) ; +BEGIN + CheckInitialized ; + IF NOT StaticInitialization + THEN + traceprintf2 (ModuleTrace, "module: %s registering\n", + name); + moveTo (unordered, + CreateModule (name, init, fini, dependencies)) + 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,pre,post,dep,force". all turns them all on. + The flag meanings are as follows and flags the are in + execution order. + + module generate trace info as the modules are registered. + pre generate a list of all modules seen prior to having + their dependancies resolved. + dep display a trace as the modules are resolved. + post generate a list of all modules seen after having + their dependancies resolved 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 ; + 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 ; + INC (pc, 3) + ELSIF equal (pc, "module") + THEN + ModuleTrace := TRUE ; + INC (pc, 6) + 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 +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. diff --git a/gcc/m2/gm2-libs/M2LINK.def b/gcc/m2/gm2-libs/M2LINK.def new file mode 100644 index 00000000000..409142a2af5 --- /dev/null +++ b/gcc/m2/gm2-libs/M2LINK.def @@ -0,0 +1,41 @@ +(* M2LINK.def defines the linking mode used in Modula-2. + +Copyright (C) 2022 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/>. *) + +DEFINITION MODULE FOR "C" M2LINK ; + + +TYPE + PtrToChar = POINTER TO CHAR ; + +(* These variables are set by the compiler in the program module + according to linking command line options. *) + +VAR + ForcedModuleInitOrder: PtrToChar ; + StaticInitialization : BOOLEAN ; + + +END M2LINK. diff --git a/gcc/m2/m2-link-support.h b/gcc/m2/m2-link-support.h deleted file mode 100644 index a68b3c9cdc3..00000000000 --- a/gcc/m2/m2-link-support.h +++ /dev/null @@ -1,197 +0,0 @@ -/* Link support specs for GNU Modula-2. - Copyright (C) 2019-2022 Free Software Foundation, Inc. - Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>. - -This file is part of GCC. - -GCC 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. - -GCC 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/>. */ - -/* The subprograms used by Modula-2 to facilitate linking are: - gm2l - parses the top level module and all other dependent - modules. It creates a dependency tree and emits a list - of dependent modules. - gm2lcc - generates a link command for all dependent modules or - display module object filesystem location. - gm2m - parses the top level module and all other dependent - module and generates a Makefile from the import tree. - gm2lgen - generate a C or C++ scaffold from the list of modules. - gm2lorder - manipulate the dependent list of modules to force - critcal runtime modules to be initialized at the - beginning of the init sequence. */ - -/* AS run the assembler with default options. */ - -#define AS(INPUT,OUTPUT) "as %a %Y " INPUT " -o " OUTPUT - -/* GM2CC_OPTIONS a list of all CC options used by gm2 during the - link scaffold generation. */ - -#define GM2CC_OPTIONS "%{i*} %{v*} %{m*} %{g*} %{O*} %{fPIC} %{fpic} \ - %{+e*} %{I*} %{MD} %{MMD} %{M} %{MM} %{MA} \ - %{MT*} %{MF*} -quiet " - -/* SCAFFOLDNAME is the basename of the scaffold C or C++ program - which may be automatically generated by the linking process. */ - -#define SCAFFOLDNAME "%b_m2" - -/* RM_IF_NOSAVETEMP remove the next file if save-temps is absent. */ - -#define RM_IF_NOSAVETEMP "%{!save-temps*:%d}" - -/* GM2CC compile the link scaffold either with the C or C++ - compiler. */ - -#define GM2CC(INPUT,OUTPUT) \ - "%{!fno-exceptions:cc1plus;:cc1} %1" GM2CC_OPTIONS " " INPUT " \ - -o " RM_IF_NOSAVETEMP SCAFFOLDNAME ".s \n\ - " AS(SCAFFOLDNAME ".s",OUTPUT) " " - -/* GM2LCC invoke the sub program gm2lcc with the object path options - and user supplied objects. It will search for Modula-2 object - if they are not already present on the command line. The - current module is contained in OBJECT and LST is a list of all - the dependant modules. */ - -#define GM2LCC(OBJECT,LST) \ - "gm2lcc %{fshared} %{fpic} %{fPIC} %{B*} %{L*} %{ftarget-ar=*} \ - %{ftarget-ranlib=*} \ - %{fobject-path=*} %{v} --exec --startup \ - " SCAFFOLDNAME "%O \ - %{!fshared:--ar %:objects() %:noobjects() -o " \ - RM_IF_NOSAVETEMP "%w%g.a } \ - " OBJECT " \ - %{fshared:%w%{o:%{o*}}%:nolink() %:objects() %:noobjects() \ - %:linkargs() } " LST " " - -/* GM2LORDER run the gm2lorder sub program. It generates a module - list LST by parsing INPUT and all dependant modules. */ - -#define GM2LORDER(INPUT,LST) \ - "gm2lorder %{fruntime-modules=*} " INPUT " -o " LST " \n" - -/* GM2LGEN run the gm2lgen sub program which generates a C or C++ - scaffold (SCAFFOLDSRC). It then compiles SCAFFOLDSRC and links - it with all dependant modules in LST. MAINOBJECT is the main - module object name containing the scaffold. */ - -#define GM2LGEN(LST,SCAFFOLDSRC,MAINOBJECT) \ - "gm2lgen %{fshared} %{fshared:--terminate --exit} \ - %{!fno-exceptions:-fcpp} " LST " -o " SCAFFOLDSRC " \n\ - " GM2L_COMBINE(LST,SCAFFOLDSRC,MAINOBJECT) - -/* GM2L_COMBINE compiles the scaffold SCAFFOLDSRC and links all dependant - modules in LST. MAINOBJECT is the main module object containing - the scaffold. */ - -#define GM2L_COMBINE(LST,SCAFFOLDSRC,MAINOBJECT) \ - GM2CC(SCAFFOLDSRC,MAINOBJECT) " \n\ - rm -f %w%d%g.a \n\ - " GM2LCC("--mainobject " MAINOBJECT,LST) - -/* Pass the preprocessor options on the command line together with - the exec prefix. */ - -#define M2CPP "%{fcpp:-fcppbegin %:exec_prefix(cc1)" \ - " -E -lang-asm -traditional-cpp " \ - " %(cpp_unique_options) -fcppend}" - -/* Generate a list of topologically sorted dependent modules. */ - -#define GM2L(INPUT,OUTPUT) \ - "gm2l %{v} " M2CPP " %{I*} %{fdef=*} %{fmod=*} " OUTPUT " " INPUT " " - -/* General GNU options. */ - -#define GENERAL_OPTIONS "%{i*} %{f*} %{+e*} %{I*} %{MD} %{MMD} %{M} \ - %{MM} %{MA} %{MT*} %{MF*} %V" - -/* Run the compiler using standard GNU options. */ - -#define CC1GM2 "cc1gm2 " M2CPP " %(cc1_options) " GENERAL_OPTIONS - -/* Generate a swig interface file and exit. */ - -#define SWIG "%{fswig:" CC1GM2 "%i \n\ - %:exit()}" - -/* Generate a basename.lst containing a list of all dependent modules - for the project and exit. */ - -#define MAKELIST "%{fmakelist:" GM2L("%i","%{!pipe:-o %g.l}") " |\n\ - gm2lorder %{fruntime-modules=*} %{!pipe:%g.l} \ - -o %b.lst \n\ - %:exit()}" - -/* Generate a scaffold from basename.lst and store the output source - into SCAFFOLDNAME.cpp and exit. */ - -#define MAKEINIT "%{fmakeinit:gm2lgen %{fshared} \ - %{fshared:--terminate --exit} \ - %{!fno-exceptions:-fcpp} %b.lst -o " \ - SCAFFOLDNAME ".cpp \n\ - %:exit()}" - -/* Display the filesystem location of the all object files in the - project list. */ - -#define REPORT_OBJECTS "gm2lcc %{fshared} %{fpic} %{fPIC} %{B*} %{L*} \ - %{ftarget-ar=*} %{ftarget-ranlib=*} \ - %{fobject-path=*} %{v} -c " - -/* Generate a list of modules used within a project and report the - object file location and exit. */ - -#define MODULES \ - "%{fmodules:%{fuselist:" REPORT_OBJECTS " %b.lst}" \ - "%{!fuselist:" GM2L("%i","%{!pipe:-o %g.l}") " |\n\ - gm2lorder %{fruntime-modules=*} \ - %{!pipe:%g.l} -o %g.lst \n\ - " REPORT_OBJECTS " %g.lst} \n\ - %:exit()}" - -/* MODULA_PROJECT_SUPPORT contains a list of all project support - sub components. */ - -#define MODULA_PROJECT_SUPPORT SWIG MAKELIST MAKEINIT MODULES - -/* GM2 invoke cc1gm2 placing assembler output into OUTPUT given - source file, INPUT. */ - -#define GM2(INPUT,OUTPUT) CC1GM2 " -o " OUTPUT " " INPUT - -/* GEN_SCAFFOLD_SRC generates the string SCAFFOLDNAME ".cpp" - marking it for deletion if -fmakeinit is absent. */ - -#define GEN_SCAFFOLD_SRC \ - "%{fmakeinit:" SCAFFOLDNAME ".cpp;:" \ - RM_IF_NOSAVETEMP SCAFFOLDNAME ".cpp}" - -/* M2LINK compile main module (providing absense of -fonlylink) - and link all project dependent modules. */ - -#define M2LINK \ - "%{!S:%{!gm2gcc:%{!fonlylink:" GM2("%i",RM_IF_NOSAVETEMP "%g.s") " \n\ - " AS("%g.s","%w%b%O") " } \n\ - %{!fuselist:" GM2L("%i"," -o %g.l ") " \n\ - " GM2LORDER("%g.l","%g.lst") " \n\ - " GM2LGEN("%{fuselist:%b.lst;:%g.lst}",\ - GEN_SCAFFOLD_SRC,\ - RM_IF_NOSAVETEMP SCAFFOLDNAME "%O") "}}\n\ - }" - -/* MODULA_LINK_SUPPORT only invoke link subprocesses if no -c option. */ - -#define MODULA_LINK_SUPPORT "%{!c:" M2LINK "}" diff --git a/gcc/m2/mc-boot-ch/GM2LINK.c b/gcc/m2/mc-boot-ch/GM2LINK.c new file mode 100644 index 00000000000..2d293fd5a7d --- /dev/null +++ b/gcc/m2/mc-boot-ch/GM2LINK.c @@ -0,0 +1,24 @@ +/* GM2LINK.c a handwritten module for mc. + +Copyright (C) 2022 Free Software Foundation, Inc. +Contributed by Gaius Mulley <gaiusmod2@gmail.com>. + +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. + +You should have received a copy of the GNU General Public License +along with GNU Modula-2; see the file COPYING3. If not see +<http://www.gnu.org/licenses/>. */ + +/* mc currently is built using a static scaffold. */ + +int M2LINK_StaticInitialization = 1; diff --git a/gcc/m2/mc-boot/GM2LINK.h b/gcc/m2/mc-boot/GM2LINK.h new file mode 100644 index 00000000000..9807ab19d7e --- /dev/null +++ b/gcc/m2/mc-boot/GM2LINK.h @@ -0,0 +1,59 @@ +/* do not edit automatically generated by mc from M2LINK. */ +/* M2LINK.def defines the linking mode used in Modula-2. + +Copyright (C) 2022 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/>. */ + + +#if !defined (_M2LINK_H) +# define _M2LINK_H + +#include "config.h" +#include "system.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 + + +# if defined (_M2LINK_C) +# define EXTERN +# else +# define EXTERN extern +# endif + +typedef char *M2LINK_PtrToChar; + +EXTERN M2LINK_PtrToChar M2LINK_ForcedModuleInitOrder; +EXTERN unsigned int M2LINK_StaticInitialization; +# ifdef __cplusplus +} +# endif + +# undef EXTERN +#endif
reply other threads:[~2022-06-20 23:31 UTC|newest] Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions: You may reply publicly to this message via plain-text email using any one of the following methods: * Save the following mbox file, import it into your mail client, and reply-to-all from there: mbox Avoid top-posting and favor interleaved quoting: https://en.wikipedia.org/wiki/Posting_style#Interleaved_style * Reply using the --to, --cc, and --in-reply-to switches of git-send-email(1): git send-email \ --in-reply-to=20220620233116.5603F385703E@sourceware.org \ --to=gaius@gcc.gnu.org \ --cc=gcc-cvs@gcc.gnu.org \ /path/to/YOUR_REPLY https://kernel.org/pub/software/scm/git/docs/git-send-email.html * If your mail client supports setting the In-Reply-To header via mailto: links, try the mailto: linkBe sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).