diff options
| -rw-r--r-- | compiler/GHC/HsToCore/Foreign/Decl.hs | 31 | ||||
| -rw-r--r-- | includes/Rts.h | 3 | ||||
| -rw-r--r-- | includes/rts/ForeignExports.h | 36 | ||||
| -rw-r--r-- | rts/ForeignExports.c | 113 | ||||
| -rw-r--r-- | rts/ForeignExports.h | 21 | ||||
| -rw-r--r-- | rts/Linker.c | 37 | ||||
| -rw-r--r-- | rts/RtsStartup.c | 9 | ||||
| -rw-r--r-- | rts/RtsSymbols.c | 2 | ||||
| -rw-r--r-- | rts/rts.cabal.in | 2 |
9 files changed, 209 insertions, 45 deletions
diff --git a/compiler/GHC/HsToCore/Foreign/Decl.hs b/compiler/GHC/HsToCore/Foreign/Decl.hs index 08cfc7aee6..3c46ef5cf9 100644 --- a/compiler/GHC/HsToCore/Foreign/Decl.hs +++ b/compiler/GHC/HsToCore/Foreign/Decl.hs @@ -91,15 +91,16 @@ dsForeigns' :: [LForeignDecl GhcTc] dsForeigns' [] = return (NoStubs, nilOL) dsForeigns' fos = do + mod <- getModule fives <- mapM do_ldecl fos let (hs, cs, idss, bindss) = unzip4 fives fe_ids = concat idss - fe_init_code = map foreignExportInitialiser fe_ids + fe_init_code = foreignExportsInitialiser mod fe_ids -- return (ForeignStubs (vcat hs) - (vcat cs $$ vcat fe_init_code), + (vcat cs $$ fe_init_code), foldr (appOL . toOL) nilOL bindss) where do_ldecl (L loc decl) = putSrcSpanDs loc (do_decl decl) @@ -700,8 +701,8 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc ] -foreignExportInitialiser :: Id -> SDoc -foreignExportInitialiser hs_fn = +foreignExportsInitialiser :: Module -> [Id] -> SDoc +foreignExportsInitialiser mod hs_fns = -- Initialise foreign exports by registering a stable pointer from an -- __attribute__((constructor)) function. -- The alternative is to do this from stginit functions generated in @@ -710,14 +711,24 @@ foreignExportInitialiser hs_fn = -- all modules that are imported directly or indirectly are actually used by -- the program. -- (this is bad for big umbrella modules like Graphics.Rendering.OpenGL) + -- + -- See Note [Tracking foreign exports] in rts/ForeignExports.c vcat - [ text "static void stginit_export_" <> ppr hs_fn - <> text "() __attribute__((constructor));" - , text "static void stginit_export_" <> ppr hs_fn <> text "()" - , braces (text "foreignExportStablePtr" - <> parens (text "(StgPtr) &" <> ppr hs_fn <> text "_closure") - <> semi) + [ text "static struct ForeignExportsList" <+> list_symbol <+> equals + <+> braces (text ".exports = " <+> export_list) <> semi + , text "static void " <> ctor_symbol <> text "(void)" + <+> text " __attribute__((constructor));" + , text "static void " <> ctor_symbol <> text "()" + , braces (text "registerForeignExports" <> parens (char '&' <> list_symbol) <> semi) ] + where + mod_str = pprModuleName (moduleName mod) + ctor_symbol = text "stginit_export_" <> mod_str + list_symbol = text "stg_exports_" <> mod_str + export_list = braces $ pprWithCommas closure_ptr hs_fns + + closure_ptr :: Id -> SDoc + closure_ptr fn = text "(StgPtr) &" <> ppr fn <> text "_closure" mkHObj :: Type -> SDoc diff --git a/includes/Rts.h b/includes/Rts.h index 989394b590..589ef8b82c 100644 --- a/includes/Rts.h +++ b/includes/Rts.h @@ -212,6 +212,9 @@ void _assertFail(const char *filename, unsigned int linenum) #include "rts/storage/GC.h" #include "rts/NonMoving.h" +/* Foreign exports */ +#include "rts/ForeignExports.h" + /* Other RTS external APIs */ #include "rts/Parallel.h" #include "rts/Signals.h" diff --git a/includes/rts/ForeignExports.h b/includes/rts/ForeignExports.h new file mode 100644 index 0000000000..f8828e59d4 --- /dev/null +++ b/includes/rts/ForeignExports.h @@ -0,0 +1,36 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1995-2009 + * + * Interface to the RTS's foreign export tracking code. + * + * Do not #include this file directly: #include "Rts.h" instead. + * + * To understand the structure of the RTS headers, see the wiki: + * https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +struct _ObjectCode; + +/* N.B. See Note [Tracking foreign exports] in + * rts/ForeignExports.c. */ +struct ForeignExportsList { + /* a link field for linking these together into lists. + */ + struct ForeignExportsList *next; + /* the length of ->exports */ + int n_entries; + /* if the RTS linker loaded the module, + * to which ObjectCode these exports belong. */ + struct _ObjectCode *oc; + /* if the RTS linker loaded the module, + * this points to an array of length ->n_entries + * recording the StablePtr for each export. */ + StgPtr exports[]; +}; + +void registerForeignExports(struct ForeignExportsList *exports); + diff --git a/rts/ForeignExports.c b/rts/ForeignExports.c new file mode 100644 index 0000000000..3195b6e779 --- /dev/null +++ b/rts/ForeignExports.c @@ -0,0 +1,113 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#include "Rts.h" +#include "RtsUtils.h" +#include "ForeignExports.h" + +/* protected by linker_mutex after start-up */ +static struct ForeignExportsList *pending = NULL; +static ObjectCode *loading_obj = NULL; + +/* + * Note [Tracking foreign exports] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * + * Foreign exports are garbage collection roots. That is, things (e.g. CAFs) + * depended upon by a module's `foreign export`s need to be kept alive for as + * long an module is loaded. To ensure this we create a stable pointer to each + * `foreign export`'d closure. This works as follows: + * + * 1. The compiler (namely GHC.HsToCore.Foreign.Decl.foreignExports) + * inserts a C-stub into each module containing a `foreign export`. This + * stub contains two things: + * + * - A `ForeignExportsList` listing all of the exported closures, and + * + * - An initializer which calls `registerForeignExports` with a reference to + * the `ForeignExportsList`. + * + * 2. When the module's object code is loaded, its initializer is called by the + * linker (this might be the system's dynamic linker or GHC's own static + * linker). `registerForeignExports` then places the module's + * `ForeignExportsList` on `pending` list. + * + * 3. When loading has finished (e.g. during RTS initialization or at the end + * of `Linker.c:ocTryLoad`) `processForeignExports` is called. Here we + * traverse the `pending` list and create a `StablePtr` for each export + * therein. + * + * The reason for this two-step process is that we are very restricted in what + * we can do in an initializer function. For instance, we cannot necessarily + * call `malloc` since the `libc`'s own initializer may not have run yet. + * For instance, doing exactly this resulted in #18548. + * + * Another consideration here is that the linker needs to know which + * `StablePtr`s belong to each `ObjectCode` it loads for the sake of unloading. + * For this reason, the linker informs us when it is loading an object by calling + * `foreignExportsLoadingObject` and `foreignExportsFinishedLoadingObject`. We + * take note of the `ObjectCode*` we are loading in `loading_obj` such that we + * can associate the `StablePtr` with the `ObjectCode` in + * `processForeignExports`. + * + */ + +void registerForeignExports(struct ForeignExportsList *exports) +{ + ASSERT(exports->next == NULL); + ASSERT(exports->oc == NULL); + exports->next = pending; + exports->oc = loading_obj; + pending = exports; +} + +/* ----------------------------------------------------------------------------- + Create a StablePtr for a foreign export. This is normally called by + a C function with __attribute__((constructor)), which is generated + by GHC and linked into the module. + + If the object code is being loaded dynamically, then we remember + which StablePtrs were allocated by the constructors and free them + again in unloadObj(). + -------------------------------------------------------------------------- */ + +void foreignExportsLoadingObject(ObjectCode *oc) +{ + ASSERT(loading_obj == NULL); + loading_obj = oc; +} + +void foreignExportsFinishedLoadingObject() +{ + ASSERT(loading_obj != NULL); + loading_obj = NULL; + processForeignExports(); +} + +/* Caller must own linker_mutex so that we can safely modify + * oc->stable_ptrs. */ +void processForeignExports() +{ + while (pending) { + for (int i=0; i < pending->n_entries; i++) { + StgPtr p = pending->exports[i]; + StgStablePtr *sptr = getStablePtr(p); + + if (loading_obj != NULL) { + ForeignExportStablePtr *fe_sptr = (ForeignExportStablePtr *) + stgMallocBytes(sizeof(ForeignExportStablePtr), + "foreignExportStablePtr"); + fe_sptr->stable_ptr = sptr; + fe_sptr->next = loading_obj->stable_ptrs; + pending->oc->stable_ptrs = fe_sptr; + } + } + + pending = pending->next; + } +} diff --git a/rts/ForeignExports.h b/rts/ForeignExports.h new file mode 100644 index 0000000000..84bf3bc484 --- /dev/null +++ b/rts/ForeignExports.h @@ -0,0 +1,21 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +#include "Rts.h" +#include "LinkerInternals.h" + +#include "BeginPrivate.h" + +void foreignExportsLoadingObject(ObjectCode *oc); +void foreignExportsFinishedLoadingObject(void); +void processForeignExports(void); + +#include "EndPrivate.h" + diff --git a/rts/Linker.c b/rts/Linker.c index a8ab511719..fa38480fb6 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -26,6 +26,7 @@ #include "RtsSymbols.h" #include "RtsSymbolInfo.h" #include "Profiling.h" +#include "ForeignExports.h" #include "sm/OSMem.h" #include "linker/M32Alloc.h" #include "linker/CacheFlush.h" @@ -969,37 +970,6 @@ SymbolAddr* lookupSymbol( SymbolName* lbl ) } /* ----------------------------------------------------------------------------- - Create a StablePtr for a foreign export. This is normally called by - a C function with __attribute__((constructor)), which is generated - by GHC and linked into the module. - - If the object code is being loaded dynamically, then we remember - which StablePtrs were allocated by the constructors and free them - again in unloadObj(). - -------------------------------------------------------------------------- */ - -static ObjectCode *loading_obj = NULL; - -StgStablePtr foreignExportStablePtr (StgPtr p) -{ - ForeignExportStablePtr *fe_sptr; - StgStablePtr *sptr; - - sptr = getStablePtr(p); - - if (loading_obj != NULL) { - fe_sptr = stgMallocBytes(sizeof(ForeignExportStablePtr), - "foreignExportStablePtr"); - fe_sptr->stable_ptr = sptr; - fe_sptr->next = loading_obj->stable_ptrs; - loading_obj->stable_ptrs = fe_sptr; - } - - return sptr; -} - - -/* ----------------------------------------------------------------------------- * Debugging aid: look in GHCi's object symbol tables for symbols * within DELTA bytes of the specified address, and show their names. */ @@ -1793,7 +1763,8 @@ int ocTryLoad (ObjectCode* oc) { IF_DEBUG(linker, debugBelch("ocTryLoad: ocRunInit start\n")); - loading_obj = oc; // tells foreignExportStablePtr what to do + // See Note [Tracking foreign exports] in ForeignExports.c + foreignExportsLoadingObject(oc); #if defined(OBJFORMAT_ELF) r = ocRunInit_ELF ( oc ); #elif defined(OBJFORMAT_PEi386) @@ -1803,7 +1774,7 @@ int ocTryLoad (ObjectCode* oc) { #else barf("ocTryLoad: initializers not implemented on this platform"); #endif - loading_obj = NULL; + foreignExportsFinishedLoadingObject(); if (!r) { return r; } diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c index 497add5e92..b916010d34 100644 --- a/rts/RtsStartup.c +++ b/rts/RtsStartup.c @@ -20,6 +20,7 @@ #include "STM.h" /* initSTM */ #include "RtsSignals.h" #include "Weak.h" +#include "ForeignExports.h" /* processForeignExports */ #include "Ticky.h" #include "StgRun.h" #include "Prelude.h" /* fixupRTStoPreludeRefs */ @@ -339,7 +340,13 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) getStablePtr((StgPtr)processRemoteCompletion_closure); #endif - // Initialize the top-level handler system + /* + * process any foreign exports which were registered while loading the + * image + * */ + processForeignExports(); + + /* initialize the top-level handler system */ initTopHandler(); /* initialise the shared Typeable store */ diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c index 2895711089..d14bdbc662 100644 --- a/rts/RtsSymbols.c +++ b/rts/RtsSymbols.c @@ -652,7 +652,7 @@ SymI_HasProto(freeFullProgArgv) \ SymI_HasProto(getProcessElapsedTime) \ SymI_HasProto(getStablePtr) \ - SymI_HasProto(foreignExportStablePtr) \ + SymI_HasProto(registerForeignExports) \ SymI_HasProto(hs_init) \ SymI_HasProto(hs_init_with_rtsopts) \ SymI_HasProto(hs_init_ghc) \ diff --git a/rts/rts.cabal.in b/rts/rts.cabal.in index 1a1eb30611..89d160c9eb 100644 --- a/rts/rts.cabal.in +++ b/rts/rts.cabal.in @@ -140,6 +140,7 @@ library rts/EventLogWriter.h rts/FileLock.h rts/Flags.h + rts/ForeignExports.h rts/GetTime.h rts/Globals.h rts/Hpc.h @@ -412,6 +413,7 @@ library ClosureFlags.c Disassembler.c FileLock.c + ForeignExports.c Globals.c Hash.c Heap.c |