2 % (c) The University of Glasgow, 2000
4 \section[CmLink]{Linker for GHCI}
7 module CmLink ( Linkable(..), Unlinked(..),
9 findModuleLinkable_maybe,
10 modname_of_linkable, is_package_linkable,
14 PersistentLinkerState{-abstractly!-}, emptyPLS,
24 import CmStaticInfo ( GhciMode(..) )
25 import Outputable ( SDoc )
26 import Digraph ( SCC(..), flattenSCC )
27 import Module ( ModuleName )
30 import ErrUtils ( showPass )
31 import CmdLineOpts ( DynFlags(..) )
32 import Panic ( panic, GhcException(..) )
38 #include "HsVersions.h"
42 data PersistentLinkerState
43 = PersistentLinkerState {
46 -- Current global mapping from RdrNames to closure addresses
47 closure_env :: ClosureEnv,
49 -- the current global mapping from RdrNames of DataCons to
50 -- info table addresses.
51 -- When a new Unlinked is linked into the running image, or an existing
52 -- module in the image is replaced, the itbl_env must be updated
56 -- notionally here, but really lives in the C part of the linker:
57 -- object_symtab :: FiniteMap String Addr
59 dummy :: () -- sigh, can't have an empty record
65 = LinkOK PersistentLinkerState
66 | LinkErrs PersistentLinkerState [SDoc]
68 findModuleLinkable_maybe :: [Linkable] -> ModuleName -> Maybe Linkable
69 findModuleLinkable_maybe lis mod
70 = case [LM time nm us | LM time nm us <- lis, nm == mod] of
73 many -> pprPanic "findModuleLinkable" (ppr mod)
76 emptyPLS :: IO PersistentLinkerState
78 emptyPLS = return (PersistentLinkerState { closure_env = emptyFM,
81 emptyPLS = return (PersistentLinkerState {})
86 link :: GhciMode -- interactive or batch
87 -> DynFlags -- dynamic flags
88 -> Bool -- attempt linking in batch mode?
89 -> [Linkable] -- only contains LMs, not LPs
90 -> PersistentLinkerState
93 -- For the moment, in the batch linker, we don't bother to tell doLink
94 -- which packages to link -- it just tries all that are available.
95 -- batch_attempt_linking should only be *looked at* in batch mode. It
96 -- should only be True if the upsweep was successful and someone
97 -- exports main, i.e., we have good reason to believe that linking
100 -- There will be (ToDo: are) two lists passed to link. These
103 -- 1. The list of all linkables in the current home package. This is
104 -- used by the batch linker to link the program, and by the interactive
105 -- linker to decide which modules from the previous link it can
107 -- 2. The list of modules on which we just called "compile". This list
108 -- is used by the interactive linker to decide which modules need
109 -- to be actually linked this time around (or unlinked and re-linked
110 -- if the module was recompiled).
112 link mode dflags batch_attempt_linking linkables pls1
113 = do let verb = verbosity dflags
114 when (verb >= 3) $ do
115 hPutStrLn stderr "CmLink.link: linkables are ..."
116 hPutStrLn stderr (showSDoc (vcat (map ppr linkables)))
117 res <- link' mode dflags batch_attempt_linking linkables pls1
119 hPutStrLn stderr "CmLink.link: done"
122 link' Batch dflags batch_attempt_linking linkables pls1
123 | batch_attempt_linking
124 = do let o_files = concatMap getOfiles linkables
126 hPutStrLn stderr "ghc: linking ..."
127 -- don't showPass in Batch mode; doLink will do that for us.
129 -- doLink only returns if it succeeds
132 = do when (verb >= 3) $ do
133 hPutStrLn stderr "CmLink.link(batch): upsweep (partially) failed OR"
134 hPutStrLn stderr " Main.main not exported; not linking."
137 verb = verbosity dflags
138 getOfiles (LP _) = panic "CmLink.link(getOfiles): shouldn't get package linkables"
139 getOfiles (LM _ _ us) = map nameOfObject (filter isObject us)
141 link' Interactive dflags batch_attempt_linking linkables pls1
142 = do showPass dflags "Linking"
144 linkObjs linkables pls2
147 ppLinkableSCC :: SCC Linkable -> SDoc
148 ppLinkableSCC = ppr . flattenSCC
151 modname_of_linkable (LM _ nm _) = nm
152 modname_of_linkable (LP _) = panic "modname_of_linkable: package"
154 is_package_linkable (LP _) = True
155 is_package_linkable (LM _ _ _) = False
157 filterModuleLinkables :: (ModuleName -> Bool)
160 filterModuleLinkables p [] = []
161 filterModuleLinkables p (li:lis)
164 LM _ modnm _ -> if p modnm then retain else dump
166 dump = filterModuleLinkables p lis
169 -----------------------------------------------------------------------------
170 -- Linker for interactive mode
173 linkObjs = panic "CmLink.linkObjs: no interpreter"
174 unload = panic "CmLink.unload: no interpreter"
175 lookupClosure = panic "CmLink.lookupClosure: no interpreter"
177 linkObjs [] pls = linkFinish pls [] []
178 linkObjs (l@(LM _ _ uls) : ls) pls
179 | all isObject uls = do
180 mapM_ loadObj [ file | DotO file <- uls ]
182 | all isInterpretable uls = linkInterpretedCode (l:ls) [] [] pls
183 | otherwise = invalidLinkable
185 throwDyn (OtherError "CmLink.linkObjs: found package linkable")
188 linkInterpretedCode [] mods ul_trees pls = linkFinish pls mods ul_trees
189 linkInterpretedCode (LM _ m uls : ls) mods ul_trees pls
190 | all isInterpretable uls =
191 linkInterpretedCode ls (m:mods) (uls++ul_trees) pls
194 = throwDyn (OtherError "can't link object code that depends on interpreted code")
195 | otherwise = invalidLinkable
196 linkInterpretedCode _ _ _ pls =
197 throwDyn (OtherError "CmLink.linkInterpretedCode: found package linkable")
199 invalidLinkable = throwDyn (OtherError "linkable doesn't contain entirely objects interpreted code")
202 -- link all the interpreted code in one go. We first remove from the
203 -- various environments any previous versions of these modules.
204 linkFinish pls mods ul_bcos = do
206 let itbl_env' = filterNameMap mods (itbl_env pls)
207 closure_env' = filterNameMap mods (closure_env pls)
208 stuff = [ (bcos,itbls) | BCOs bcos itbls <- ul_bcos ]
210 (ibinds, new_itbl_env, new_closure_env) <-
211 linkIModules itbl_env' closure_env' stuff
213 let new_pls = PersistentLinkerState {
214 closure_env = new_closure_env,
215 itbl_env = new_itbl_env
217 return (LinkOK new_pls)
219 -- purge the current "linked image"
220 unload :: PersistentLinkerState -> IO PersistentLinkerState
221 unload pls = return pls{ closure_env = emptyFM, itbl_env = emptyFM }
223 linkExpr :: PersistentLinkerState -> UnlinkedBCOExpr -> IO HValue
224 linkExpr PersistentLinkerState{ itbl_env = ie, closure_env = ce } bcos
225 = linkIExpr ie ce bcos