2 % (c) The University of Glasgow, 2000
4 \section[CmLink]{Linker for GHCI}
7 module CmLink ( Linkable(..), Unlinked(..),
9 findModuleLinkable_maybe,
13 PersistentLinkerState{-abstractly!-}, emptyPLS,
23 import CmStaticInfo ( GhciMode(..) )
24 import Outputable ( SDoc )
25 import Digraph ( SCC(..), flattenSCC )
26 import Module ( ModuleName )
29 import ErrUtils ( showPass )
30 import CmdLineOpts ( DynFlags(..) )
31 import Panic ( panic, GhcException(..) )
38 #include "HsVersions.h"
42 data PersistentLinkerState
43 = PersistentLinkerState {
47 -- Current global mapping from RdrNames to closure addresses
48 closure_env :: ClosureEnv,
50 -- the current global mapping from RdrNames of DataCons to
51 -- info table addresses.
52 -- When a new Unlinked is linked into the running image, or an existing
53 -- module in the image is replaced, the itbl_env must be updated
57 -- list of objects we've loaded (we'll need to unload them again
58 -- before re-loading the same module), together with the ClockTime
59 -- of the linkable they were loaded from.
60 objects_loaded :: [Linkable]
62 -- notionally here, but really lives in the C part of the linker:
63 -- object_symtab :: FiniteMap String Addr
65 dummy :: () -- sigh, can't have an empty record
71 = LinkOK PersistentLinkerState
72 | LinkErrs PersistentLinkerState [SDoc]
74 findModuleLinkable_maybe :: [Linkable] -> ModuleName -> Maybe Linkable
75 findModuleLinkable_maybe lis mod
76 = case [LM time nm us | LM time nm us <- lis, nm == mod] of
79 many -> pprPanic "findModuleLinkable" (ppr mod)
82 emptyPLS :: IO PersistentLinkerState
84 emptyPLS = return (PersistentLinkerState { closure_env = emptyFM,
86 objects_loaded = [] })
88 emptyPLS = return (PersistentLinkerState {})
91 -----------------------------------------------------------------------------
92 -- Unloading old objects ready for a new compilation sweep.
94 -- The compilation manager provides us with a list of linkables that it
95 -- considers "stable", i.e. won't be recompiled this time around. For
96 -- each of the modules current linked in memory,
98 -- * if the linkable is stable (and it's the same one - the
99 -- user may have recompiled the module on the side), we keep it,
101 -- * otherwise, we unload it.
106 -> [Linkable] -- stable linkables
107 -> PersistentLinkerState
108 -> IO PersistentLinkerState
110 unload Batch dflags linkables pls = return pls
111 unload Interactive dflags linkables pls
112 = do new_loaded <- filterM maybeUnload (objects_loaded pls)
113 let mods_retained = map linkableModName new_loaded
114 itbl_env' = filterNameMap mods_retained (itbl_env pls)
115 closure_env' = filterNameMap mods_retained (closure_env pls)
117 let verb = verbosity dflags
118 when (verb >= 3) $ do
119 hPutStrLn stderr (showSDoc
120 (text "CmLink.unload: retaining" <+> ppr mods_retained))
122 return pls{ objects_loaded = new_loaded,
123 itbl_env = itbl_env',
124 closure_env = closure_env' }
126 maybeUnload :: Linkable -> IO Bool
127 maybeUnload (LM time mod objs) = do
128 case findModuleLinkable_maybe linkables mod of
129 Nothing -> do unloadObjs; return False
130 Just l | linkableTime l /= time -> do unloadObjs; return False
131 | otherwise -> return True
133 unloadObjs = mapM unloadObj [ f | DotO f <- objs ]
135 -----------------------------------------------------------------------------
138 link :: GhciMode -- interactive or batch
139 -> DynFlags -- dynamic flags
140 -> Bool -- attempt linking in batch mode?
142 -> PersistentLinkerState
145 -- For the moment, in the batch linker, we don't bother to tell doLink
146 -- which packages to link -- it just tries all that are available.
147 -- batch_attempt_linking should only be *looked at* in batch mode. It
148 -- should only be True if the upsweep was successful and someone
149 -- exports main, i.e., we have good reason to believe that linking
152 -- There will be (ToDo: are) two lists passed to link. These
155 -- 1. The list of all linkables in the current home package. This is
156 -- used by the batch linker to link the program, and by the interactive
157 -- linker to decide which modules from the previous link it can
159 -- 2. The list of modules on which we just called "compile". This list
160 -- is used by the interactive linker to decide which modules need
161 -- to be actually linked this time around (or unlinked and re-linked
162 -- if the module was recompiled).
164 link mode dflags batch_attempt_linking linkables pls1
165 = do let verb = verbosity dflags
166 when (verb >= 3) $ do
167 hPutStrLn stderr "CmLink.link: linkables are ..."
168 hPutStrLn stderr (showSDoc (vcat (map ppr linkables)))
169 res <- link' mode dflags batch_attempt_linking linkables pls1
171 hPutStrLn stderr "CmLink.link: done"
174 link' Batch dflags batch_attempt_linking linkables pls1
175 | batch_attempt_linking
176 = do let o_files = concatMap getOfiles linkables
178 hPutStrLn stderr "ghc: linking ..."
179 -- don't showPass in Batch mode; doLink will do that for us.
181 -- doLink only returns if it succeeds
184 = do when (verb >= 3) $ do
185 hPutStrLn stderr "CmLink.link(batch): upsweep (partially) failed OR"
186 hPutStrLn stderr " Main.main not exported; not linking."
189 verb = verbosity dflags
190 getOfiles (LM _ _ us) = map nameOfObject (filter isObject us)
192 link' Interactive dflags batch_attempt_linking linkables pls
193 = do showPass dflags "Linking"
194 let (objs, bcos) = partition (isObject.head.linkableUnlinked) linkables
195 linkObjs (objs ++ bcos) pls
196 -- get the objects first
198 ppLinkableSCC :: SCC Linkable -> SDoc
199 ppLinkableSCC = ppr . flattenSCC
201 filterModuleLinkables :: (ModuleName -> Bool) -> [Linkable] -> [Linkable]
202 filterModuleLinkables p [] = []
203 filterModuleLinkables p (li:lis)
205 LM _ modnm _ -> if p modnm then retain else dump
207 dump = filterModuleLinkables p lis
210 -----------------------------------------------------------------------------
211 -- Linker for interactive mode
214 linkObjs = panic "CmLink.linkObjs: no interpreter"
215 unload = panic "CmLink.unload: no interpreter"
216 lookupClosure = panic "CmLink.lookupClosure: no interpreter"
218 linkObjs [] pls = linkFinish pls []
219 linkObjs (l@(LM _ m uls) : ls) pls
220 | all isObject uls = do
221 if isLoaded l pls then linkObjs ls pls else do
222 let objs = [ file | DotO file <- uls ]
224 linkObjs ls pls{objects_loaded = l : objects_loaded pls}
225 | all isInterpretable uls = linkInterpretedCode (l:ls) [] pls
226 | otherwise = invalidLinkable
228 isLoaded :: Linkable -> PersistentLinkerState -> Bool
230 case findModuleLinkable_maybe (objects_loaded pls) (linkableModName l) of
232 Just m -> linkableTime l == linkableTime m
234 linkInterpretedCode [] ul_trees pls = linkFinish pls ul_trees
235 linkInterpretedCode (LM _ m uls : ls) ul_trees pls
236 | all isInterpretable uls =
237 linkInterpretedCode ls (uls++ul_trees) pls
239 = throwDyn (OtherError
240 "can't link object code that depends on interpreted code")
241 | otherwise = invalidLinkable
243 invalidLinkable = panic "CmLink: linkable doesn't contain entirely objects or interpreted code"
246 -- link all the interpreted code in one go.
247 linkFinish pls ul_bcos = do
250 let stuff = [ (bcos,itbls) | BCOs bcos itbls <- ul_bcos ]
252 (ibinds, new_itbl_env, new_closure_env) <-
253 linkIModules (itbl_env pls) (closure_env pls) stuff
255 let new_pls = pls { closure_env = new_closure_env,
256 itbl_env = new_itbl_env
258 return (LinkOK new_pls)
260 linkExpr :: PersistentLinkerState -> UnlinkedBCOExpr -> IO HValue
261 linkExpr PersistentLinkerState{ itbl_env = ie, closure_env = ce } bcos
262 = linkIExpr ie ce bcos