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 )
28 import Module ( ModuleName )
32 import ErrUtils ( showPass )
33 import CmdLineOpts ( DynFlags(..) )
34 import Panic ( panic )
40 #include "HsVersions.h"
44 data PersistentLinkerState
45 = PersistentLinkerState {
48 -- Current global mapping from RdrNames to closure addresses
49 closure_env :: ClosureEnv,
51 -- the current global mapping from RdrNames of DataCons to
52 -- info table addresses.
53 -- When a new Unlinked is linked into the running image, or an existing
54 -- module in the image is replaced, the itbl_env must be updated
58 -- notionally here, but really lives in the C part of the linker:
59 -- object_symtab :: FiniteMap String Addr
61 dummy :: () -- sigh, can't have an empty record
67 = LinkOK PersistentLinkerState
68 | LinkErrs PersistentLinkerState [SDoc]
70 findModuleLinkable_maybe :: [Linkable] -> ModuleName -> Maybe Linkable
71 findModuleLinkable_maybe lis mod
72 = case [LM time nm us | LM time nm us <- lis, nm == mod] of
75 many -> pprPanic "findModuleLinkable" (ppr mod)
78 emptyPLS :: IO PersistentLinkerState
80 emptyPLS = return (PersistentLinkerState { closure_env = emptyFM,
83 emptyPLS = return (PersistentLinkerState {})
88 link :: GhciMode -- interactive or batch
89 -> DynFlags -- dynamic flags
90 -> Bool -- attempt linking in batch mode?
91 -> [Linkable] -- only contains LMs, not LPs
92 -> PersistentLinkerState
95 -- For the moment, in the batch linker, we don't bother to tell doLink
96 -- which packages to link -- it just tries all that are available.
97 -- batch_attempt_linking should only be *looked at* in batch mode. It
98 -- should only be True if the upsweep was successful and someone
99 -- exports main, i.e., we have good reason to believe that linking
102 -- There will be (ToDo: are) two lists passed to link. These
105 -- 1. The list of all linkables in the current home package. This is
106 -- used by the batch linker to link the program, and by the interactive
107 -- linker to decide which modules from the previous link it can
109 -- 2. The list of modules on which we just called "compile". This list
110 -- is used by the interactive linker to decide which modules need
111 -- to be actually linked this time around (or unlinked and re-linked
112 -- if the module was recompiled).
114 link mode dflags batch_attempt_linking linkables pls1
115 = do let verb = verbosity dflags
116 when (verb >= 3) $ do
117 hPutStrLn stderr "CmLink.link: linkables are ..."
118 hPutStrLn stderr (showSDoc (vcat (map ppr linkables)))
119 res <- link' mode dflags batch_attempt_linking linkables pls1
121 hPutStrLn stderr "CmLink.link: done"
124 link' Batch dflags batch_attempt_linking linkables pls1
125 | batch_attempt_linking
126 = do let o_files = concatMap getOfiles linkables
128 hPutStrLn stderr "ghc: linking ..."
129 -- don't showPass in Batch mode; doLink will do that for us.
131 -- doLink only returns if it succeeds
134 = do when (verb >= 3) $ do
135 hPutStrLn stderr "CmLink.link(batch): upsweep (partially) failed OR"
136 hPutStrLn stderr " Main.main not exported; not linking."
139 verb = verbosity dflags
140 getOfiles (LP _) = panic "CmLink.link(getOfiles): shouldn't get package linkables"
141 getOfiles (LM _ _ us) = map nameOfObject (filter isObject us)
143 link' Interactive dflags batch_attempt_linking linkables pls1
144 = do showPass dflags "Linking"
146 linkObjs linkables pls2
149 ppLinkableSCC :: SCC Linkable -> SDoc
150 ppLinkableSCC = ppr . flattenSCC
153 modname_of_linkable (LM _ nm _) = nm
154 modname_of_linkable (LP _) = panic "modname_of_linkable: package"
156 is_package_linkable (LP _) = True
157 is_package_linkable (LM _ _ _) = False
159 filterModuleLinkables :: (ModuleName -> Bool)
162 filterModuleLinkables p [] = []
163 filterModuleLinkables p (li:lis)
166 LM _ modnm _ -> if p modnm then retain else dump
168 dump = filterModuleLinkables p lis
171 -----------------------------------------------------------------------------
172 -- Linker for interactive mode
175 linkObjs = panic "CmLink.linkObjs: no interpreter"
176 unload = panic "CmLink.unload: no interpreter"
177 lookupClosure = panic "CmLink.lookupClosure: no interpreter"
179 linkObjs [] pls = linkFinish pls [] []
180 linkObjs (l@(LM _ _ uls) : ls) pls
181 | all isObject uls = do
182 mapM_ loadObj [ file | DotO file <- uls ]
184 | all isInterpretable uls = linkInterpretedCode (l:ls) [] [] pls
185 | otherwise = invalidLinkable
187 throwDyn (OtherError "CmLink.linkObjs: found package linkable")
190 linkInterpretedCode [] mods ul_trees pls = linkFinish pls mods ul_trees
191 linkInterpretedCode (LM _ m uls : ls) mods ul_trees pls
192 | all isInterpretable uls =
193 linkInterpretedCode ls (m:mods) (uls++ul_trees) pls
196 = throwDyn (OtherError "can't link object code that depends on interpreted code")
197 | otherwise = invalidLinkable
198 linkInterpretedCode _ _ _ pls =
199 throwDyn (OtherError "CmLink.linkInterpretedCode: found package linkable")
201 invalidLinkable = throwDyn (OtherError "linkable doesn't contain entirely objects interpreted code")
204 -- link all the interpreted code in one go. We first remove from the
205 -- various environments any previous versions of these modules.
206 linkFinish pls mods ul_trees = do
208 let itbl_env' = filterNameMap mods (itbl_env pls)
209 closure_env' = filterNameMap mods (closure_env pls)
210 stuff = [ (trees,itbls) | Trees trees itbls <- ul_trees ]
212 (ibinds, new_itbl_env, new_closure_env) <-
213 linkIModules itbl_env' closure_env' stuff
215 let new_pls = PersistentLinkerState {
216 closure_env = new_closure_env,
217 itbl_env = new_itbl_env
219 return (LinkOK new_pls)
221 -- purge the current "linked image"
222 unload :: PersistentLinkerState -> IO PersistentLinkerState
223 unload pls = return pls{ closure_env = emptyFM, itbl_env = emptyFM }
225 linkExpr :: PersistentLinkerState -> UnlinkedIExpr -> IO HValue
226 linkExpr PersistentLinkerState{ itbl_env = ie, closure_env = ce } expr
227 = iExprToHValue ie ce expr