Commit 34488dfe authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Add basic support for rts package, #22.

parent 3872f968
......@@ -2,10 +2,11 @@
module GHC (
array, base, binary, bytestring, cabal, compiler, containers, compareSizes,
deepseq, deriveConstants, directory, dllSplit, filepath, genapply,
genprimopcode, ghc, ghcBoot, ghcCabal, ghci, ghcPkg, ghcPrim, ghcPwd, ghcTags,
haddock, haskeline, hsc2hs, hoopl, hp2ps, hpc, hpcBin, integerGmp,
integerSimple, iservBin, mkUserGuidePart, parallel, pretty, primitive, process,
runGhc, stm, templateHaskell, terminfo, time, transformers, unix, win32, xhtml,
genprimopcode, ghc, ghcBoot, ghcCabal, ghci, ghcPkg, ghcPrim, ghcPwd,
ghcTags, haddock, haskeline, hsc2hs, hoopl, hp2ps, hpc, hpcBin, integerGmp,
integerSimple, iservBin, mkUserGuidePart, parallel, pretty, primitive,
process, rts, runGhc, stm, templateHaskell, terminfo, time, transformers,
unix, win32, xhtml,
defaultKnownPackages, defaultTargetDirectory, defaultProgramPath
) where
......@@ -26,7 +27,7 @@ defaultKnownPackages =
, genprimopcode, ghc, ghcBoot, ghcCabal, ghci, ghcPkg, ghcPrim
, ghcPwd, ghcTags, haddock, haskeline, hsc2hs, hoopl, hp2ps, hpc, hpcBin
, integerGmp, integerSimple, iservBin, mkUserGuidePart, parallel, pretty
, primitive , process, runGhc, stm, templateHaskell, terminfo, time
, primitive, process, rts, runGhc, stm, templateHaskell, terminfo, time
, transformers, unix, win32, xhtml ]
-- Package definitions (see Package.hs)
......@@ -34,8 +35,9 @@ array, base, binary, bytestring, cabal, compiler, containers, compareSizes,
deepseq, deriveConstants, directory, dllSplit, filepath, genapply,
genprimopcode, ghc, ghcBoot, ghcCabal, ghci, ghcPkg, ghcPrim, ghcPwd,
ghcTags, haddock, haskeline, hsc2hs, hoopl, hp2ps, hpc, hpcBin, integerGmp,
integerSimple, iservBin, mkUserGuidePart, parallel, pretty, primitive, process,
runGhc, stm, templateHaskell, terminfo, time, transformers, unix, win32, xhtml :: Package
integerSimple, iservBin, mkUserGuidePart, parallel, pretty, primitive,
process, rts, runGhc, stm, templateHaskell, terminfo, time, transformers,
unix, win32, xhtml :: Package
array = library "array"
base = library "base"
......@@ -75,6 +77,7 @@ parallel = library "parallel"
pretty = library "pretty"
primitive = library "primitive"
process = library "process"
rts = topLevel "rts"
runGhc = utility "runGhc"
stm = library "stm"
templateHaskell = library "template-haskell"
......
-- | Convenient predicates
module Predicates (
stage, package, builder, stagedBuilder, builderGhc, file, way,
stage, package, builder, stagedBuilder, builderGcc, builderGhc, file, way,
stage0, stage1, stage2, notStage0, notPackage, registerPackage, splitObjects
) where
......@@ -24,6 +24,9 @@ builder b = fmap (b ==) getBuilder
stagedBuilder :: (Stage -> Builder) -> Predicate
stagedBuilder sb = (builder . sb) =<< getStage
builderGcc :: Predicate
builderGcc = stagedBuilder Gcc ||^ stagedBuilder GccM
builderGhc :: Predicate
builderGhc = stagedBuilder Ghc ||^ stagedBuilder GhcM
......@@ -55,7 +58,8 @@ registerPackage = return True
splitObjects :: Predicate
splitObjects = do
goodStage <- notStage0 -- We don't split bootstrap (stage 0) packages
goodPackage <- notM $ package compiler -- We don't split compiler
supported <- lift supportsSplitObjects
goodStage <- notStage0 -- We don't split bootstrap (stage 0) packages
pkg <- getPackage
supported <- lift supportsSplitObjects
let goodPackage = isLibrary pkg && pkg /= compiler && pkg /= rts
return $ goodStage && goodPackage && supported
......@@ -2,7 +2,8 @@ module Rules (generateTargets, packageRules) where
import Base
import Expression
import Rules.Install
import GHC
import Rules.Copy
import Rules.Package
import Rules.Resources
import Settings
......@@ -13,7 +14,7 @@ generateTargets :: Rules ()
generateTargets = action $ do
targets <- fmap concat . forM [Stage0 ..] $ \stage -> do
pkgs <- interpretWithStage stage getPackages
let libPkgs = filter isLibrary pkgs
let libPkgs = filter isLibrary pkgs \\ [rts]
libTargets <- fmap concat . forM libPkgs $ \pkg -> do
let target = PartialTarget stage pkg
needHaddock <- interpretPartial target buildHaddock
......@@ -21,7 +22,8 @@ generateTargets = action $ do
let programTargets = [ prog | Just prog <- programPath stage <$> pkgs ]
return $ libTargets ++ programTargets
need $ targets ++ installTargets
rtsLib <- pkgLibraryFile Stage1 rts "rts" vanilla
need $ targets ++ installTargets ++ [ rtsLib ]
packageRules :: Rules ()
packageRules = do
......
......@@ -29,7 +29,7 @@ cabalRules = do
-- Cache package dependencies
packageDependencies %> \out -> do
pkgs <- interpretWithStage Stage1 getPackages
pkgDeps <- forM (sort pkgs) $ \pkg -> do
pkgDeps <- forM (sort pkgs) $ \pkg -> if pkg == rts then return [] else do
need [pkgCabalFile pkg]
pd <- liftIO . readPackageDescription silent $ pkgCabalFile pkg
let depsLib = collectDeps $ condLibrary pd
......
......@@ -73,6 +73,24 @@ buildPackageData rs target @ (PartialTarget stage pkg) = do
writeFileChanged mk contents
putSuccess $ "| Successfully generated '" ++ mk ++ "'."
when (pkg == rts) $ dataFile %> \mk -> do
windows <- windowsHost
let prefix = "rts_" ++ stageString stage ++ "_"
dirs = [ ".", "hooks", "sm", "eventlog" ]
++ [ "posix" | not windows ]
++ [ "win32" | windows ]
-- TODO: rts/dist/build/sm/Evac_thr.c, rts/dist/build/sm/Scav_thr.c
-- TODO: adding cmm sources to C_SRCS is a hack; rethink after #18
cSrcs <- getDirectoryFiles (pkgPath pkg) (map (-/- "*.c") dirs)
cmmSrcs <- getDirectoryFiles (pkgPath pkg) ["*.cmm"]
let extraSrcs = [ targetDirectory Stage1 rts -/- "build/AutoApply.cmm" ]
includes <- interpretPartial target $ fromDiffExpr includesArgs
let contents = unlines $ map (prefix++)
[ "C_SRCS = " ++ unwords (cSrcs ++ cmmSrcs ++ extraSrcs)
, "CC_OPTS = " ++ unwords includes ]
writeFileChanged mk contents
putSuccess $ "| Successfully generated '" ++ mk ++ "'."
-- Prepare a given 'packaga-data.mk' file for parsing by readConfigFile:
-- 1) Drop lines containing '$'
-- For example, get rid of
......
......@@ -16,7 +16,7 @@ buildPackageDependencies _ target @ (PartialTarget stage pkg) =
dropBuild = (pkgPath pkg ++) . drop (length buildPath)
hDepFile = buildPath -/- ".hs-dependencies"
in do
(buildPath <//> "*.c.deps") %> \out -> do
[ buildPath ++ "//*.c.deps", buildPath ++ "//*.cmm.deps" ] |%> \out -> do
let srcFile = dropBuild . dropExtension $ out
orderOnly $ generatedDependencies stage pkg
need [srcFile]
......
......@@ -2,6 +2,7 @@ module Rules.Documentation (buildPackageDocumentation) where
import Base
import Expression
import GHC
import Oracles
import Rules.Actions
import Rules.Resources
......@@ -19,7 +20,8 @@ buildPackageDocumentation _ target @ (PartialTarget stage pkg) =
srcs <- interpretPartial target getPackageSources
deps <- map PackageName <$> interpretPartial target (getPkgDataList DepNames)
let haddocks = [ pkgHaddockFile depPkg
| Just depPkg <- map findKnownPackage deps ]
| Just depPkg <- map findKnownPackage deps
, depPkg /= rts ]
need $ srcs ++ haddocks
-- HsColour sources
......
......@@ -32,8 +32,6 @@ derivedConstantsPath = "includes/dist-derivedconstants/header"
-- TODO: can we drop COMPILER_INCLUDES_DEPS += $(includes_GHCCONSTANTS)?
generatedDependencies :: Stage -> Package -> [FilePath]
generatedDependencies stage pkg
| pkg == hp2ps = [ "includes/ghcautoconf.h"
, "includes/ghcplatform.h" ]
| pkg == compiler = let buildPath = targetPath stage compiler -/- "build"
in
[ "includes/ghcautoconf.h"
......@@ -60,14 +58,19 @@ generatedDependencies stage pkg
, "primop-vector-tys-exports.hs-incl"
, "primop-vector-tycons.hs-incl"
, "primop-vector-tys.hs-incl" ]
| pkg == hp2ps = [ "includes/ghcautoconf.h"
, "includes/ghcplatform.h" ]
| pkg == rts = let buildPath = targetPath stage rts -/- "build"
in
fmap (buildPath -/-) ["ffi.h", "ffitarget.h"]
| otherwise = []
-- The following generators and corresponding source extensions are supported:
knownGenerators :: [ (Builder, String) ]
knownGenerators = [ (Alex , ".x" )
, (Happy , ".y" )
, (Happy , ".ly" )
, (Hsc2Hs , ".hsc") ]
knownGenerators = [ (Alex , ".x" )
, (Happy , ".y" )
, (Happy , ".ly" )
, (Hsc2Hs, ".hsc") ]
determineBuilder :: FilePath -> Maybe Builder
determineBuilder file = fmap fst $ find (\(_, e) -> e == ext) knownGenerators
......@@ -115,6 +118,9 @@ generatePackageCode _ target @ (PartialTarget stage pkg) =
need [primopsTxt stage]
build $ fullTarget target GenPrimopCode [primopsTxt stage] [file]
when (pkg == rts) $ buildPath -/- "AutoApply.cmm" %> \file -> do
build $ fullTarget target GenApply [] [file]
priority 2.0 $ do
when (pkg == compiler && stage == Stage1) $
derivedConstantsPath ++ "//*" %> \file -> do
......
......@@ -17,7 +17,6 @@ ghcBuilderArgs :: Args
ghcBuilderArgs = stagedBuilder Ghc ? do
output <- getOutput
way <- getWay
pkg <- getPackage
let buildObj = ("//*." ++ osuf way) ?== output || ("//*." ++ obootsuf way) ?== output
libs <- getPkgDataList DepExtraLibs
libDirs <- getPkgDataList DepLibDirs
......@@ -27,7 +26,7 @@ ghcBuilderArgs = stagedBuilder Ghc ? do
, notStage0 ? arg "-O2"
, arg "-Wall"
, arg "-fwarn-tabs"
, isLibrary pkg ? splitObjects ? arg "-split-objs"
, splitObjects ? arg "-split-objs"
, not buildObj ? arg "-no-auto-link-packages"
, not buildObj ? append [ "-optl-l" ++ lib | lib <- libs ]
, not buildObj ? append [ "-optl-L" ++ dir | dir <- libDirs ]
......
......@@ -37,7 +37,8 @@ haddockBuilderArgs = builder Haddock ? do
++ ",../" ++ dep ++ "/src/%{MODULE/./-}.html\\#%{NAME},"
++ pkgHaddockFile depPkg
| (dep, depName) <- zip deps depNames
, Just depPkg <- [findKnownPackage $ PackageName depName] ]
, Just depPkg <- [findKnownPackage $ PackageName depName]
, depPkg /= rts ]
, append [ "--optghc=" ++ opt | opt <- ghcOpts ]
, specified HsColour ?
arg "--source-module=src/%{MODULE/./-}.html"
......
......@@ -32,7 +32,8 @@ packagesStage1 = mconcat
[ packagesStage0
, append [ array, base, bytestring, containers, compareSizes, deepseq
, directory, filepath, ghci, ghcPrim, ghcPwd, haskeline, hpcBin
, integerLibrary, mkUserGuidePart, pretty, process, runGhc, time ]
, integerLibrary, mkUserGuidePart, pretty, process, rts, runGhc
, time ]
, windowsHost ? append [win32]
, notM windowsHost ? append [unix]
, notM windowsHost ? append [iservBin]
......
module Settings.Packages.Rts (rtsPackageArgs) where
import Base
import Expression
import GHC (rts)
import Oracles.Config.Flag
import Oracles.Config.Setting
import Predicates (builderGcc, builderGhc, package, file)
import Settings
rtsPackageArgs :: Args
rtsPackageArgs = package rts ? do
let yesNo = lift . fmap (\x -> if x then "YES" else "NO")
projectVersion <- getSetting ProjectVersion
hostPlatform <- getSetting HostPlatform
hostArch <- getSetting HostArch
hostOs <- getSetting HostOs
hostVendor <- getSetting HostVendor
buildPlatform <- getSetting BuildPlatform
buildArch <- getSetting BuildArch
buildOs <- getSetting BuildOs
buildVendor <- getSetting BuildVendor
targetPlatform <- getSetting TargetPlatform
targetArch <- getSetting TargetArch
targetOs <- getSetting TargetOs
targetVendor <- getSetting TargetVendor
ghcUnreg <- yesNo $ flag GhcUnregisterised
ghcEnableTNC <- yesNo ghcEnableTablesNextToCode
way <- getWay
stage <- getStage
mconcat
[ builderGcc ? mconcat
[ arg "-Irts"
, arg $ "-I" ++ targetPath stage rts -/- "build"
, arg $ "-DRtsWay=\"rts_" ++ show way ++ "\""
, (file "//RtsMessages.*" ||^ file "//Trace.*") ?
arg ("-DProjectVersion=" ++ quote projectVersion)
, file "//RtsUtils.*" ? append
[ "-DProjectVersion=" ++ quote projectVersion
, "-DHostPlatform=" ++ quote hostPlatform
, "-DHostArch=" ++ quote hostArch
, "-DHostOS=" ++ quote hostOs
, "-DHostVendor=" ++ quote hostVendor
, "-DBuildPlatform=" ++ quote buildPlatform
, "-DBuildArch=" ++ quote buildArch
, "-DBuildOS=" ++ quote buildOs
, "-DBuildVendor=" ++ quote buildVendor
, "-DTargetPlatform=" ++ quote targetPlatform
, "-DTargetArch=" ++ quote targetArch
, "-DTargetOS=" ++ quote targetOs
, "-DTargetVendor=" ++ quote targetVendor
, "-DGhcUnregisterised=" ++ quote ghcUnreg
, "-DGhcEnableTablesNextToCode=" ++ quote ghcEnableTNC ] ]
, builderGhc ? arg "-Irts" ]
-- #-----------------------------------------------------------------------------
-- # Flags for compiling specific files
-- #
-- #
-- # Compile various performance-critical pieces *without* -fPIC -dynamic
-- # even when building a shared library. If we don't do this, then the
-- # GC runs about 50% slower on x86 due to the overheads of PIC. The
-- # cost of doing this is a little runtime linking and less sharing, but
-- # not much.
-- #
-- # On x86_64 this doesn't work, because all objects in a shared library
-- # must be compiled with -fPIC (since the 32-bit relocations generated
-- # by the default small memory can't be resolved at runtime). So we
-- # only do this on i386.
-- #
-- # This apparently doesn't work on OS X (Darwin) nor on Solaris.
-- # On Darwin we get errors of the form
-- #
-- # ld: absolute addressing (perhaps -mdynamic-no-pic) used in _stg_ap_0_fast from rts/dist/build/Apply.dyn_o not allowed in slidable image
-- #
-- # and lots of these warnings:
-- #
-- # ld: warning codegen in _stg_ap_pppv_fast (offset 0x0000005E) prevents image from loading in dyld shared cache
-- #
-- # On Solaris we get errors like:
-- #
-- # Text relocation remains referenced
-- # against symbol offset in file
-- # .rodata (section) 0x11 rts/dist/build/Apply.dyn_o
-- # ...
-- # ld: fatal: relocations remain against allocatable but non-writable sections
-- # collect2: ld returned 1 exit status
-- ifeq "$(TargetArch_CPP)" "i386"
-- i386_SPEED_HACK := "YES"
-- ifeq "$(TargetOS_CPP)" "darwin"
-- i386_SPEED_HACK := "NO"
-- endif
-- ifeq "$(TargetOS_CPP)" "solaris2"
-- i386_SPEED_HACK := "NO"
-- endif
-- endif
-- ifeq "$(TargetArch_CPP)" "i386"
-- ifeq "$(i386_SPEED_HACK)" "YES"
-- rts/sm/Evac_HC_OPTS += -fno-PIC
-- rts/sm/Evac_thr_HC_OPTS += -fno-PIC
-- rts/sm/Scav_HC_OPTS += -fno-PIC
-- rts/sm/Scav_thr_HC_OPTS += -fno-PIC
-- rts/sm/Compact_HC_OPTS += -fno-PIC
-- rts/sm/GC_HC_OPTS += -fno-PIC
-- # -static is also necessary for these bits, otherwise the NCG
-- # -generates dynamic references:
-- rts/Updates_HC_OPTS += -fno-PIC -static
-- rts/StgMiscClosures_HC_OPTS += -fno-PIC -static
-- rts/PrimOps_HC_OPTS += -fno-PIC -static
-- rts/Apply_HC_OPTS += -fno-PIC -static
-- rts/dist/build/AutoApply_HC_OPTS += -fno-PIC -static
-- endif
-- endif
-- # add CFLAGS for libffi
-- # ffi.h triggers prototype warnings, so disable them here:
-- ifeq "$(UseSystemLibFFI)" "YES"
-- LIBFFI_CFLAGS = $(addprefix -I,$(FFIIncludeDir))
-- else
-- LIBFFI_CFLAGS =
-- endif
-- rts/Interpreter_CC_OPTS += -Wno-strict-prototypes $(LIBFFI_CFLAGS)
-- rts/Adjustor_CC_OPTS += -Wno-strict-prototypes $(LIBFFI_CFLAGS)
-- rts/sm/Storage_CC_OPTS += -Wno-strict-prototypes $(LIBFFI_CFLAGS)
-- # inlining warnings happen in Compact
-- rts/sm/Compact_CC_OPTS += -Wno-inline
-- # emits warnings about call-clobbered registers on x86_64
-- rts/StgCRun_CC_OPTS += -w
-- rts/RetainerProfile_CC_OPTS += -w
-- rts/RetainerSet_CC_OPTS += -Wno-format
-- # On Windows:
-- rts/win32/ConsoleHandler_CC_OPTS += -w
-- rts/win32/ThrIOManager_CC_OPTS += -w
-- # The above warning suppression flags are a temporary kludge.
-- # While working on this module you are encouraged to remove it and fix
-- # any warnings in the module. See
-- # http://ghc.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
-- # for details
-- # Without this, thread_obj will not be inlined (at least on x86 with GCC 4.1.0)
-- ifneq "$(CC_CLANG_BACKEND)" "1"
-- rts/sm/Compact_CC_OPTS += -finline-limit=2500
-- endif
-- # -O3 helps unroll some loops (especially in copy() with a constant argument).
-- rts/sm/Evac_CC_OPTS += -funroll-loops
-- rts/dist/build/sm/Evac_thr_HC_OPTS += -optc-funroll-loops
-- # These files are just copies of sm/Evac.c and sm/Scav.c respectively,
-- # but compiled with -DPARALLEL_GC.
-- rts/dist/build/sm/Evac_thr_CC_OPTS += -DPARALLEL_GC -Irts/sm
-- rts/dist/build/sm/Scav_thr_CC_OPTS += -DPARALLEL_GC -Irts/sm
-- #-----------------------------------------------------------------------------
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