Commit 73faaba4 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Use new Program.Ld and Program.Ar in GHC module

parent 1bd7f95d
...@@ -93,11 +93,13 @@ import Distribution.Simple.Program ...@@ -93,11 +93,13 @@ import Distribution.Simple.Program
( Program(..), ConfiguredProgram(..), ProgramConfiguration, ProgArg ( Program(..), ConfiguredProgram(..), ProgramConfiguration, ProgArg
, ProgramLocation(..), rawSystemProgram, rawSystemProgramConf , ProgramLocation(..), rawSystemProgram, rawSystemProgramConf
, rawSystemProgramStdout, rawSystemProgramStdoutConf , rawSystemProgramStdout, rawSystemProgramStdoutConf
, requireProgramVersion , requireProgramVersion, requireProgram
, userMaybeSpecifyPath, programPath, lookupProgram, addKnownProgram , userMaybeSpecifyPath, programPath, lookupProgram, addKnownProgram
, ghcProgram, ghcPkgProgram, arProgram, ranlibProgram, ldProgram , ghcProgram, ghcPkgProgram, arProgram, ranlibProgram, ldProgram
, gccProgram, stripProgram ) , gccProgram, stripProgram )
import qualified Distribution.Simple.Program.HcPkg as HcPkg import qualified Distribution.Simple.Program.HcPkg as HcPkg
import qualified Distribution.Simple.Program.Ar as Ar
import qualified Distribution.Simple.Program.Ld as Ld
import Distribution.Simple.Compiler import Distribution.Simple.Compiler
( CompilerFlavor(..), CompilerId(..), Compiler(..), compilerVersion ( CompilerFlavor(..), CompilerId(..), Compiler(..), compilerVersion
, OptimisationLevel(..), PackageDB(..), PackageDBStack , OptimisationLevel(..), PackageDB(..), PackageDBStack
...@@ -115,9 +117,9 @@ import Control.Monad ( unless, when ) ...@@ -115,9 +117,9 @@ import Control.Monad ( unless, when )
import Data.Char import Data.Char
import Data.List import Data.List
import Data.Maybe ( catMaybes ) import Data.Maybe ( catMaybes )
import System.Directory ( removeFile, renameFile, import System.Directory
getDirectoryContents, doesFileExist, ( removeFile, getDirectoryContents, doesFileExist
getTemporaryDirectory ) , getTemporaryDirectory )
import System.FilePath ( (</>), (<.>), takeExtension, import System.FilePath ( (</>), (<.>), takeExtension,
takeDirectory, replaceExtension, splitExtension ) takeDirectory, replaceExtension, splitExtension )
import System.IO (hClose, hPutStrLn) import System.IO (hClose, hPutStrLn)
...@@ -530,28 +532,19 @@ buildLib verbosity pkg_descr lbi lib clbi = do ...@@ -530,28 +532,19 @@ buildLib verbosity pkg_descr lbi lib clbi = do
| libFilePath <- [vanillaLibFilePath, profileLibFilePath | libFilePath <- [vanillaLibFilePath, profileLibFilePath
,sharedLibFilePath, ghciLibFilePath] ] ,sharedLibFilePath, ghciLibFilePath] ]
let arVerbosity | verbosity >= deafening = "-v" let staticObjectFiles =
| otherwise = "-c"
arBasicArgs = [ "-r", "-s", arVerbosity ]
arArgs = arBasicArgs
++ [vanillaLibFilePath]
arObjArgs =
hObjs hObjs
++ map (pref </>) cObjs ++ map (pref </>) cObjs
++ stubObjs ++ stubObjs
arProfArgs = arBasicArgs profObjectFiles =
++ [profileLibFilePath]
arProfObjArgs =
hProfObjs hProfObjs
++ map (pref </>) cObjs ++ map (pref </>) cObjs
++ stubProfObjs ++ stubProfObjs
ldArgs = ["-r"] ghciObjFiles =
++ ["-o", ghciLibFilePath <.> "tmp"]
ldObjArgs =
hObjs hObjs
++ map (pref </>) cObjs ++ map (pref </>) cObjs
++ stubObjs ++ stubObjs
ghcSharedObjArgs = dynamicObjectFiles =
hSharedObjs hSharedObjs
++ map (pref </>) cSharedObjs ++ map (pref </>) cSharedObjs
++ stubSharedObjs ++ stubSharedObjs
...@@ -563,40 +556,29 @@ buildLib verbosity pkg_descr lbi lib clbi = do ...@@ -563,40 +556,29 @@ buildLib verbosity pkg_descr lbi lib clbi = do
"-shared", "-shared",
"-dynamic", "-dynamic",
"-o", sharedLibFilePath ] "-o", sharedLibFilePath ]
++ ghcSharedObjArgs ++ dynamicObjectFiles
++ ["-package-name", display pkgid ] ++ ["-package-name", display pkgid ]
++ (concat [ ["-package", display pkg] | pkg <- componentPackageDeps clbi ]) ++ (concat [ ["-package", display pkg] | pkg <- componentPackageDeps clbi ])
++ ["-l"++extraLib | extraLib <- extraLibs libBi] ++ ["-l"++extraLib | extraLib <- extraLibs libBi]
++ ["-L"++extraLibDir | extraLibDir <- extraLibDirs libBi] ++ ["-L"++extraLibDir | extraLibDir <- extraLibDirs libBi]
runLd ldLibName args = do ifVanillaLib False $ do
exists <- doesFileExist ldLibName (arProg, _) <- requireProgram verbosity arProgram (withPrograms lbi)
-- This method is called iteratively by xargs. The Ar.createArLibArchive verbosity arProg
-- output goes to <ldLibName>.tmp, and any existing file vanillaLibFilePath staticObjectFiles
-- named <ldLibName> is included when linking. The
-- output is renamed to <libName>.
rawSystemProgramConf verbosity ldProgram (withPrograms lbi)
(args ++ if exists then [ldLibName] else [])
renameFile (ldLibName <.> "tmp") ldLibName
runAr = rawSystemProgramConf verbosity arProgram (withPrograms lbi) ifProfLib $ do
(arProg, _) <- requireProgram verbosity arProgram (withPrograms lbi)
Ar.createArLibArchive verbosity arProg
profileLibFilePath profObjectFiles
--TODO: discover this at configure time or runtime on unix ifGHCiLib $ do
-- The value is 32k on Windows and posix specifies a minimum of 4k (ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi)
-- but all sensible unixes use more than 4k. Ld.combineObjectFiles verbosity ldProg
-- we could use getSysVar ArgumentLimit but that's in the unix lib ghciLibFilePath ghciObjFiles
maxCommandLineSize = 30 * 1024
ifVanillaLib False $ xargs maxCommandLineSize ifSharedLib $
runAr arArgs arObjArgs runGhcProg ghcSharedLinkArgs
ifProfLib $ xargs maxCommandLineSize
runAr arProfArgs arProfObjArgs
ifGHCiLib $ xargs maxCommandLineSize
(runLd ghciLibFilePath) ldArgs ldObjArgs
ifSharedLib $ runGhcProg ghcSharedLinkArgs
-- | Build an executable with GHC. -- | Build an executable with GHC.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment