public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/modula-2] Shared library scaffold fixes.
@ 2022-08-02 22:57 Gaius Mulley
  0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2022-08-02 22:57 UTC (permalink / raw)
  To: gcc-cvs

https://gcc.gnu.org/g:a3192a7ec42b700ecd7bc37cb879713ef581afe2

commit a3192a7ec42b700ecd7bc37cb879713ef581afe2
Author: Gaius Mulley <gaius.mulley@southwales.ac.uk>
Date:   Tue Aug 2 20:27:11 2022 +0100

    Shared library scaffold fixes.
    
    These changes allow the module scaffold to be activated from within
    a shared library as a ctor.  The changes also correct the dtor names of
    wrapsock.c, wraptime.c, Selective.cc and wrapc.c.
    
    ChangeLog:
    
            * Makefile.tpl (BUILD_EXPORTS): GM2FLAGS added.
    
    gcc/m2/ChangeLog:
    
            * gm2-compiler/M2Graph.mod (Graph): Tidied up indent.
            (KillNode) Assign deps to result of KillIndex.
            * gm2-compiler/M2Options.def (GetUseList): Spelling corrected.
            (SharedFlag) exported.  (SetShared) New procedure.
            * gm2-compiler/M2Options.mod (SetShared): New procedure.
            (SharedFlag) Assigned to FALSE.
            * gm2-compiler/M2Scaffold.mod (SafeRequestSym): New procedure.
            (BuildM2MainFunction) Use SharedFlag to determine whether to
            generate main and if not produce ctors for the shared library.
            Use SafeRequest to access argc, argv, envp parameters.
            * gm2-compiler/M2Quads.mod (SymbolTable): Import list inserted
            identifiers IsCtor, IsExtern and IsPublic.
            (DisplayProcedureAttributes) New procedure.
            (BuildM2InitFunction): Use SafeRequest to access argc, argv,
            envp parameters.  (BuildM2FiniFunction): Use SafeRequest to
            access argc, argv, envp parameters.
            * gm2-gcc/m2options.h: (SetShared): New function.
            * gm2-lang.cc (gm2_langhook_handle_option): Call SetShared.
    
    libgm2/ChangeLog:
    
            * libm2iso/wrapsock.c: Replaced _finish with _fini.
            * libm2iso/wraptime.c: Replaced _finish with _fini.
            * libm2pim/Selective.cc: Replaced _finish with _fini.
            * libm2pim/wrapc.c: Replaced _finish with _fini.
    
    Signed-off-by: Gaius Mulley <gaius.mulley@southwales.ac.uk>

Diff:
---
 Makefile.tpl                       |  1 +
 gcc/m2/gm2-compiler/M2Graph.mod    |  4 +-
 gcc/m2/gm2-compiler/M2Options.def  | 15 ++++++-
 gcc/m2/gm2-compiler/M2Options.mod  | 13 +++++-
 gcc/m2/gm2-compiler/M2Quads.mod    | 83 +++++++++++++++++++++++++++++++-------
 gcc/m2/gm2-compiler/M2Scaffold.mod | 36 ++++++++++-------
 gcc/m2/gm2-gcc/m2options.h         |  1 +
 gcc/m2/gm2-lang.cc                 |  2 +-
 libgm2/libm2iso/wrapsock.c         |  2 +-
 libgm2/libm2iso/wraptime.c         |  2 +-
 libgm2/libm2pim/Selective.cc       |  4 +-
 libgm2/libm2pim/wrapc.c            |  2 +-
 12 files changed, 124 insertions(+), 41 deletions(-)

diff --git a/Makefile.tpl b/Makefile.tpl
index ae5e9c4c67f..0cbdb270e64 100644
--- a/Makefile.tpl
+++ b/Makefile.tpl
@@ -167,6 +167,7 @@ BUILD_EXPORTS = \
 	GDC="$(GDC_FOR_BUILD)"; export GDC; \
 	GDCFLAGS="$(GDCFLAGS_FOR_BUILD)"; export GDCFLAGS; \
 	GM2="$(GM2_FOR_BUILD)"; export GM2; \
+	GM2FLAGS="$(GM2FLAGS_FOR_BUILD)"; export GM2FLAGS; \
 	DLLTOOL="$(DLLTOOL_FOR_BUILD)"; export DLLTOOL; \
 	DSYMUTIL="$(DSYMUTIL_FOR_BUILD)"; export DSYMUTIL; \
 	LD="$(LD_FOR_BUILD)"; export LD; \
diff --git a/gcc/m2/gm2-compiler/M2Graph.mod b/gcc/m2/gm2-compiler/M2Graph.mod
index 3f8f299ea8f..489186a4b3b 100644
--- a/gcc/m2/gm2-compiler/M2Graph.mod
+++ b/gcc/m2/gm2-compiler/M2Graph.mod
@@ -46,7 +46,7 @@ TYPE
           END ;
 
    Graph = POINTER TO RECORD
-                         nodes : Index ;
+                         nodes: Index ;
                       END ;
 
 
@@ -70,7 +70,7 @@ END InitGraph ;
 
 PROCEDURE KillNode (nptr: node) ;
 BEGIN
-   KillIndex (nptr^.deps)
+   nptr^.deps := KillIndex (nptr^.deps)
 END KillNode ;
 
 
diff --git a/gcc/m2/gm2-compiler/M2Options.def b/gcc/m2/gm2-compiler/M2Options.def
index 0a60b7194a3..250e45fa386 100644
--- a/gcc/m2/gm2-compiler/M2Options.def
+++ b/gcc/m2/gm2-compiler/M2Options.def
@@ -52,7 +52,8 @@ EXPORT QUALIFIED SetReturnCheck, SetNilCheck, SetCaseCheck,
 		 SetWholeValueCheck, GetWholeValueCheck,
                  SetLowerCaseKeywords,
                  SetIndex, SetRange, SetWholeDiv, SetStrictTypeChecking,
-                 Setc, Getc, SetUselist, GetUselist, GetUselisrFilename,
+                 Setc, Getc, SetUselist, GetUselist, GetUselistFilename,
+                 SetShared,
 
                  Iso, Pim, Pim2, Pim3, Pim4,
                  cflag,
@@ -89,7 +90,7 @@ EXPORT QUALIFIED SetReturnCheck, SetNilCheck, SetCaseCheck,
                  SetScaffoldDynamic, SetScaffoldStatic,
                  SetScaffoldMain, ScaffoldMain,
                  SetRuntimeModuleOverride, GetRuntimeModuleOverride,
-                 SetGenModuleList, GetGenModuleFilename ;
+                 SetGenModuleList, GetGenModuleFilename, SharedFlag ;
 
 
 VAR
@@ -161,6 +162,9 @@ VAR
    ScaffoldMain,                 (* Should we generate a main function?      *)
    GenModuleList,                (* Should the compiler generate a list of   *)
                                  (* all modules used?                        *)
+   SharedFlag,                   (* -fshared indicating this module needs    *)
+                                 (* the shared library version of the        *)
+                                 (* scaffold.                                *)
    ForcedLocation,
    DebugFunctionLineNumbers,
    GenerateStatementNote,
@@ -787,6 +791,13 @@ PROCEDURE SetGenModuleList (value: BOOLEAN; filename: ADDRESS) ;
 PROCEDURE GetGenModuleFilename () : String ;
 
 
+(*
+   SetShared - sets the SharedFlag to value.
+*)
+
+PROCEDURE SetShared (value: BOOLEAN) ;
+
+
 (*
    FinaliseOptions - once all options have been parsed we set any inferred
                      values.
diff --git a/gcc/m2/gm2-compiler/M2Options.mod b/gcc/m2/gm2-compiler/M2Options.mod
index 5c0fb179c5e..a35412accd9 100644
--- a/gcc/m2/gm2-compiler/M2Options.mod
+++ b/gcc/m2/gm2-compiler/M2Options.mod
@@ -1184,6 +1184,16 @@ BEGIN
 END GetGenModuleFilename ;
 
 
+(*
+   SetShared - sets the SharedFlag to value.
+*)
+
+PROCEDURE SetShared (value: BOOLEAN) ;
+BEGIN
+   SharedFlag := value
+END SetShared ;
+
+
 BEGIN
    cflag                        := FALSE ;  (* -c.  *)
    RuntimeModuleOverride        := NIL ;
@@ -1247,5 +1257,6 @@ BEGIN
    ScaffoldMain                 := FALSE ;
    UselistFilename              := NIL ;
    GenModuleList                := FALSE ;
-   GenModuleListFilename        := NIL
+   GenModuleListFilename        := NIL ;
+   SharedFlag                   := FALSE
 END M2Options.
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 3cd9801fbee..73f6b93d483 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -115,6 +115,7 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown,
                         IsImportStatement, IsImport, GetImportModule, GetImportDeclared,
                         GetImportStatementList,
                         GetModuleDefImportStatementList, GetModuleModImportStatementList,
+                        IsCtor, IsPublic, IsExtern,
 
                         GetUnboundedRecordType,
                         GetUnboundedAddressOffset,
@@ -204,7 +205,7 @@ FROM M2Options IMPORT NilChecking,
                       Pedantic, CompilerDebugging, GenerateDebugging,
                       GenerateLineDebug, Exceptions,
                       Profiling, Coding, Optimizing,
-                      ScaffoldDynamic, ScaffoldStatic, cflag, ScaffoldMain ;
+                      ScaffoldDynamic, ScaffoldStatic, cflag, ScaffoldMain, SharedFlag ;
 
 FROM M2Pass IMPORT IsPassCodeGeneration, IsNoPass ;
 
@@ -2232,6 +2233,34 @@ BEGIN
 END BuildRetry ;
 
 
+(*
+   SafeRequestSym - only used during scaffold to get argc, argv, envp.
+                    It attempts to get symbol name from the current scope(s) and if
+                    it fails then it falls back onto default constants.
+*)
+
+PROCEDURE SafeRequestSym (procedure: CARDINAL; tok: CARDINAL; name: Name) : CARDINAL ;
+VAR
+   sym: CARDINAL ;
+BEGIN
+   sym := GetSym (name) ;
+   IF sym = NulSym
+   THEN
+      IF name = MakeKey ('argc')
+      THEN
+         RETURN MakeConstLit (tok, MakeKey ('0'), ZType)
+      ELSIF (name = MakeKey ('argv')) OR (name = MakeKey ('envp'))
+      THEN
+         RETURN Nil
+      ELSE
+         InternalError ('not expecting this parameter name') ;
+         RETURN Nil
+      END
+   END ;
+   RETURN sym
+END SafeRequestSym ;
+
+
 (*
    callRequestDependant - create a call:
                           RequestDependant (GetSymName (modulesym), GetSymName (depModuleSym));
@@ -2389,7 +2418,7 @@ END BuildM2LinkFunction ;
 
 PROCEDURE BuildM2MainFunction (tokno: CARDINAL; modulesym: CARDINAL) ;
 BEGIN
-   IF ScaffoldDynamic OR ScaffoldStatic
+   IF (ScaffoldDynamic OR ScaffoldStatic) AND (NOT SharedFlag)
    THEN
       (* Scaffold required and main should be produced.  *)
       (*
@@ -2475,18 +2504,18 @@ BEGIN
             PushT(1) ;
             BuildAdrFunction ;
 
-            PushTtok (RequestSym (tok, MakeKey ("argc")), tok) ;
-            PushTtok (RequestSym (tok, MakeKey ("argv")), tok) ;
-            PushTtok (RequestSym (tok, MakeKey ("envp")), tok) ;
+            PushTtok (SafeRequestSym (initFunction, tok, MakeKey ("argc")), tok) ;
+            PushTtok (SafeRequestSym (initFunction, tok, MakeKey ("argv")), tok) ;
+            PushTtok (SafeRequestSym (initFunction, tok, MakeKey ("envp")), tok) ;
             PushT (4) ;
             BuildProcedureCall (tok) ;
          END
       ELSIF ScaffoldStatic
       THEN
          ForeachModuleCallInit (tok,
-                                RequestSym (tok, MakeKey ("argc")),
-                                RequestSym (tok, MakeKey ("argv")),
-                                RequestSym (tok, MakeKey ("envp")))
+                                SafeRequestSym (initFunction, tok, MakeKey ("argc")),
+                                SafeRequestSym (initFunction, tok, MakeKey ("argv")),
+                                SafeRequestSym (initFunction, tok, MakeKey ("envp")))
       END ;
       EndScope ;
       BuildProcedureEnd ;
@@ -2530,18 +2559,18 @@ BEGIN
             PushT(1) ;
             BuildAdrFunction ;
 
-            PushTtok (RequestSym (tok, MakeKey ("argc")), tok) ;
-            PushTtok (RequestSym (tok, MakeKey ("argv")), tok) ;
-            PushTtok (RequestSym (tok, MakeKey ("envp")), tok) ;
+            PushTtok (SafeRequestSym (finiFunction, tok, MakeKey ("argc")), tok) ;
+            PushTtok (SafeRequestSym (finiFunction, tok, MakeKey ("argv")), tok) ;
+            PushTtok (SafeRequestSym (finiFunction, tok, MakeKey ("envp")), tok) ;
             PushT (4) ;
             BuildProcedureCall (tok)
          END
       ELSIF ScaffoldStatic
       THEN
          ForeachModuleCallFinish (tok,
-                                  RequestSym (tok, MakeKey ("argc")),
-                                  RequestSym (tok, MakeKey ("argv")),
-                                  RequestSym (tok, MakeKey ("envp")))
+                                  SafeRequestSym (finiFunction, tok, MakeKey ("argc")),
+                                  SafeRequestSym (finiFunction, tok, MakeKey ("argv")),
+                                  SafeRequestSym (finiFunction, tok, MakeKey ("envp")))
       END ;
       EndScope ;
       BuildProcedureEnd ;
@@ -13041,6 +13070,27 @@ BEGIN
 END DisplayQuad ;
 
 
+(*
+   DisplayProcedureAttributes -
+*)
+
+PROCEDURE DisplayProcedureAttributes (proc: CARDINAL) ;
+BEGIN
+   IF IsCtor (proc)
+   THEN
+      printf0 (" (ctor)")
+   END ;
+   IF IsPublic (proc)
+   THEN
+      printf0 (" (public)")
+   END ;
+   IF IsExtern (proc)
+   THEN
+      printf0 (" (extern)")
+   END
+END DisplayProcedureAttributes ;
+
+
 (*
    WriteQuad - Writes out the Quad BufferQuad.
 *)
@@ -13107,7 +13157,10 @@ BEGIN
       CallOp,
       KillLocalVarOp    : WriteOperand(Operand3) |
 
-      ProcedureScopeOp,
+      ProcedureScopeOp  : n1 := GetSymName(Operand2) ;
+                          n2 := GetSymName(Operand3) ;
+                          printf3('  %4d  %a  %a', Operand1, n1, n2) ;
+                          DisplayProcedureAttributes (Operand3) |
       NewLocalVarOp,
       FinallyStartOp,
       FinallyEndOp,
diff --git a/gcc/m2/gm2-compiler/M2Scaffold.mod b/gcc/m2/gm2-compiler/M2Scaffold.mod
index 4064c431541..dc228184d80 100644
--- a/gcc/m2/gm2-compiler/M2Scaffold.mod
+++ b/gcc/m2/gm2-compiler/M2Scaffold.mod
@@ -48,7 +48,8 @@ FROM SFIO IMPORT OpenToWrite, WriteS, ReadS, OpenToRead, Exists ;
 FROM FIO IMPORT File, EOF, IsNoError, Close ;
 
 FROM M2Options IMPORT GetUselist, ScaffoldStatic, ScaffoldDynamic, GenModuleList,
-                      GetGenModuleFilename, GetUselistFilename, GetUselist, cflag ;
+                      GetGenModuleFilename, GetUselistFilename, GetUselist, cflag,
+                      SharedFlag ;
 
 FROM M2Base IMPORT Proc ;
 
@@ -85,7 +86,7 @@ static void _M2_init (int argc, char *argv[], char *envp[])
 }
 
 
-static void _M2_finish (int argc, char *argv[], char *envp[])
+static void _M2_fini (int argc, char *argv[], char *envp[])
 {
   M2RTS_Terminate ();
   M2RTS_DeconstructModules (module_name, argc, argv, envp);
@@ -96,7 +97,7 @@ int
 main (int argc, char *argv[], char *envp[])
 {
   init (argc, argv, envp);
-  finish ();
+  fini (argc, argv, envp);
   return (0);
 }  *)
 
@@ -180,7 +181,7 @@ END ForeachModuleCallInit ;
 (*
    ForeachModuleCallFinish - precondition: the module list will be ordered.
                              postcondition: foreach module in the application universe
-                                               call _M2_module_finish (argc, argv, envp);
+                                               call _M2_module_fini (argc, argv, envp);
 *)
 
 PROCEDURE ForeachModuleCallFinish (tok: CARDINAL; argc, argv, envp: CARDINAL) ;
@@ -554,18 +555,23 @@ BEGIN
                    '{%O}dynamic linking enabled but no module ctor list has been created, hint use -fuse-list=filename or -fgen-module-list=-')
    END ;
 
-   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)
+   finiFunction := MakeProcedure (tokenno, MakeKey ("_M2_fini")) ;
+   IF SharedFlag
+   THEN
+      PutCtor (initFunction, TRUE) ;
+      PutCtor (finiFunction, TRUE)
+   ELSE
+      DeclareArgEnvParams (tokenno, initFunction) ;
+      DeclareArgEnvParams (tokenno, finiFunction) ;
+
+      mainFunction := MakeProcedure (tokenno, MakeKey ("main")) ;
+      StartScope (mainFunction) ;
+      PutFunction (mainFunction, Integer) ;
+      DeclareArgEnvParams (tokenno, mainFunction) ;
+      PutPublic (mainFunction, TRUE) ;
+      EndScope
+   END
 END DeclareScaffoldFunctions ;
 
 
diff --git a/gcc/m2/gm2-gcc/m2options.h b/gcc/m2/gm2-gcc/m2options.h
index 34f28976b8c..2962bb21eea 100644
--- a/gcc/m2/gm2-gcc/m2options.h
+++ b/gcc/m2/gm2-gcc/m2options.h
@@ -119,6 +119,7 @@ EXTERN void M2Options_SetScaffoldDynamic (int value);
 EXTERN void M2Options_SetScaffoldMain (int value);
 EXTERN void M2Options_SetRuntimeModuleOverride (const char *override);
 EXTERN void M2Options_SetGenModuleList (int value, const char *filename);
+EXTERN void M2Options_SetShared (int value);
 
 #undef EXTERN
 #endif /* m2options_h.  */
diff --git a/gcc/m2/gm2-lang.cc b/gcc/m2/gm2-lang.cc
index 07ae5ed5860..e17f7a513b6 100644
--- a/gcc/m2/gm2-lang.cc
+++ b/gcc/m2/gm2-lang.cc
@@ -377,7 +377,7 @@ gm2_langhook_handle_option (
       M2Options_SetSwig (value);
       return 1;
     case OPT_fshared:
-      /* handled by the linker.  */
+      M2Options_SetShared (value);
       return 1;
     case OPT_fm2_statistics:
       M2Options_SetStatistics (value);
diff --git a/libgm2/libm2iso/wrapsock.c b/libgm2/libm2iso/wrapsock.c
index d0948ac92bc..79c2d89ddd3 100644
--- a/libgm2/libm2iso/wrapsock.c
+++ b/libgm2/libm2iso/wrapsock.c
@@ -245,6 +245,6 @@ _M2_wrapsock_init (void)
 }
 
 void
-_M2_wrapsock_finish (void)
+_M2_wrapsock_fini (void)
 {
 }
diff --git a/libgm2/libm2iso/wraptime.c b/libgm2/libm2iso/wraptime.c
index bdaa7589a14..6d6929b3c89 100644
--- a/libgm2/libm2iso/wraptime.c
+++ b/libgm2/libm2iso/wraptime.c
@@ -403,6 +403,6 @@ _M2_wraptime_init ()
 {
 }
 void
-_M2_wraptime_finish ()
+_M2_wraptime_fini ()
 {
 }
diff --git a/libgm2/libm2pim/Selective.cc b/libgm2/libm2pim/Selective.cc
index e168e3181a5..a71c6577946 100644
--- a/libgm2/libm2pim/Selective.cc
+++ b/libgm2/libm2pim/Selective.cc
@@ -301,7 +301,7 @@ _M2_Selective_init (int argc, char *argv[], char *envp[])
 }
 
 extern "C" void
-_M2_Selective_finish (int argc, char *argv[], char *envp[])
+_M2_Selective_fini (int argc, char *argv[], char *envp[])
 {
 }
 
@@ -314,6 +314,6 @@ struct _M2_Selective_ctor { _M2_Selective_ctor (); } _M2_Selective_ctor;
 
 _M2_Selective_ctor::_M2_Selective_ctor (void)
 {
-  M2RTS_RegisterModule ("Selective", _M2_Selective_init, _M2_Selective_finish,
+  M2RTS_RegisterModule ("Selective", _M2_Selective_init, _M2_Selective_fini,
 			_M2_Selective_dep);
 }
diff --git a/libgm2/libm2pim/wrapc.c b/libgm2/libm2pim/wrapc.c
index e5e0357c565..6269155b62b 100644
--- a/libgm2/libm2pim/wrapc.c
+++ b/libgm2/libm2pim/wrapc.c
@@ -283,7 +283,7 @@ _M2_wrapc_init ()
 }
 
 void
-_M2_wrapc_finish ()
+_M2_wrapc_fini ()
 {
 }


^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2022-08-02 22:57 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-08-02 22:57 [gcc/devel/modula-2] Shared library scaffold fixes Gaius Mulley

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).