From 52dbfc65d363cf4bdad610c0c39299244452fca5 Mon Sep 17 00:00:00 2001 From: sewardj Date: Mon, 13 Nov 2000 17:08:36 +0000 Subject: [PATCH] [project @ 2000-11-13 17:08:36 by sewardj] First shot at batch linking. Does not attempt linking if upsweep was not completely successful. Always attempts linking if upsweep successful, even if there's no 'main' to be found anywhere. --- ghc/compiler/compMan/CmLink.lhs | 33 +++++++++++++++++++++++++++++---- ghc/compiler/compMan/CmSummarise.lhs | 3 ++- ghc/compiler/compMan/CompManager.lhs | 12 +++++++----- 3 files changed, 38 insertions(+), 10 deletions(-) diff --git a/ghc/compiler/compMan/CmLink.lhs b/ghc/compiler/compMan/CmLink.lhs index c645192..e072564 100644 --- a/ghc/compiler/compMan/CmLink.lhs +++ b/ghc/compiler/compMan/CmLink.lhs @@ -17,7 +17,7 @@ import Interpreter import CmStaticInfo ( PackageConfigInfo ) import Module ( ModuleName, PackageName ) import Outputable ( SDoc ) -import Digraph ( SCC(..), flattenSCC ) +import Digraph ( SCC(..), flattenSCC, flattenSCCs ) import Outputable import Panic ( panic ) @@ -70,6 +70,10 @@ isObject (DotA _) = True isObject (DotDLL _) = True isObject _ = False +nameOfObject (DotO fn) = fn +nameOfObject (DotA fn) = fn +nameOfObject (DotDLL fn) = fn + isInterpretable (Trees _ _) = True isInterpretable _ = False @@ -91,18 +95,39 @@ emptyPLS = return (PersistentLinkerState {}) \end{code} \begin{code} -link :: PackageConfigInfo +-- The first arg is supposed to be DriverPipeline.doLink. +-- Passed in here to avoid a hard-to-avoid circular dependency +-- between CmLink and DriverPipeline. Same deal as with +-- CmSummarise.summarise. +link :: ([String] -> IO ()) + -> Bool -- was the upsweep completely successful? + -> PackageConfigInfo -> [SCC Linkable] -> PersistentLinkerState -> IO LinkResult #ifndef GHCI_NOTYET --link = panic "CmLink.link: not implemented" -link pci groups pls1 + +-- For the moment, in the batch linker, we don't bother to +-- tell doLink which packages to link -- it just tries all that +-- are available. +link doLink upsweep_complete_success pci groups pls1 + | upsweep_complete_success = do putStrLn "Hello from the Linker!" putStrLn (showSDoc (vcat (map ppLinkableSCC groups))) - putStrLn "Bye-bye from the Linker!" + let o_files = concatMap getOfiles (flattenSCCs groups) + doLink o_files + putStrLn "Bye-bye from the Linker!" return (LinkOK pls1) + | otherwise + = do putStrLn "LINKER: upsweep (partially?) failed; not doing batch linking" + return (LinkOK pls1) + where + getOfiles (LP _) = [] + getOfiles (LM _ us) = map nameOfObject (filter isObject us) + + ppLinkableSCC :: SCC Linkable -> SDoc ppLinkableSCC = ppr . flattenSCC diff --git a/ghc/compiler/compMan/CmSummarise.lhs b/ghc/compiler/compMan/CmSummarise.lhs index 9971fdf..ede8046 100644 --- a/ghc/compiler/compMan/CmSummarise.lhs +++ b/ghc/compiler/compMan/CmSummarise.lhs @@ -72,7 +72,8 @@ type Fingerprint = Int -- The first arg is supposed to be DriverPipeline.preprocess. -- Passed in here to avoid a hard-to-avoid circular dependency --- between CmSummarise and DriverPipeline. +-- between CmSummarise and DriverPipeline. Same deal as with +-- CmLink.link. summarise :: (FilePath -> IO FilePath) -> Module -> ModuleLocation -> IO ModSummary summarise preprocess mod location diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs index 97622da..732e62a 100644 --- a/ghc/compiler/compMan/CompManager.lhs +++ b/ghc/compiler/compMan/CompManager.lhs @@ -30,7 +30,7 @@ import CmSummarise ( summarise, ModSummary(..), import Module ( ModuleName, moduleName, packageOfModule, isModuleInThisPackage, PackageName ) import CmStaticInfo ( Package(..), PackageConfigInfo ) -import DriverPipeline ( compile, preprocess, CompResult(..) ) +import DriverPipeline ( compile, preprocess, doLink, CompResult(..) ) import HscTypes ( HomeSymbolTable, HomeIfaceTable, PersistentCompilerState ) import HscMain ( initPersistentCompilerState ) @@ -167,7 +167,8 @@ cmLoadModule cmstate1 modname if upsweepOK then - do let mods_to_relink = upwards_closure mg2 + do putStrLn "UPSWEEP COMPLETELY SUCCESSFUL" + let mods_to_relink = upwards_closure mg2 (map modname_of_linkable newLis) pkg_linkables <- find_pkg_linkables_for pcii mg2 mods_to_relink @@ -176,7 +177,7 @@ cmLoadModule cmstate1 modname let sccs_to_relink = group_uis ui3 mg2 mods_to_relink let all_to_relink = map AcyclicSCC pkg_linkables ++ sccs_to_relink - linkresult <- link pcii all_to_relink pls1 + linkresult <- link doLink True pcii all_to_relink pls1 case linkresult of LinkErrs _ _ -> panic "cmLoadModule: link failed (1)" @@ -188,14 +189,15 @@ cmLoadModule cmstate1 modname return (cmstate3, Just modname) else - do let mods_to_relink = downwards_closure mg2 + do putStrLn "UPSWEEP PARTIALLY SUCCESSFUL" + let mods_to_relink = downwards_closure mg2 (map name_of_summary (flattenSCCs sccOKs)) pkg_linkables <- find_pkg_linkables_for pcii mg2 mods_to_relink let sccs_to_relink = group_uis ui3 mg2 mods_to_relink let all_to_relink = map AcyclicSCC pkg_linkables ++ sccs_to_relink - linkresult <- link pcii all_to_relink pls1 + linkresult <- link doLink False pcii all_to_relink pls1 let (hst4, hit4, ui4) = removeFromTopLevelEnvs mods_to_relink (hst3,hit3,ui3) case linkresult of -- 1.7.10.4