summaryrefslogtreecommitdiff
path: root/utils
diff options
context:
space:
mode:
Diffstat (limited to 'utils')
-rw-r--r--utils/deriveConstants/DeriveConstants.hs15
-rw-r--r--utils/genprimopcode/Main.hs3
-rw-r--r--utils/genprimopcode/Syntax.hs2
-rw-r--r--utils/ghc-cabal/Main.hs49
-rw-r--r--utils/ghc-cabal/ghc.mk14
-rw-r--r--utils/ghc-pkg/Main.hs88
-rw-r--r--utils/hp2ps/Error.c2
-rw-r--r--utils/runghc/ghc.mk2
8 files changed, 95 insertions, 80 deletions
diff --git a/utils/deriveConstants/DeriveConstants.hs b/utils/deriveConstants/DeriveConstants.hs
index 78233a5b98..48990061cc 100644
--- a/utils/deriveConstants/DeriveConstants.hs
+++ b/utils/deriveConstants/DeriveConstants.hs
@@ -346,6 +346,7 @@ wanteds = concat
,structSize C "generation"
,structField C "generation" "n_new_large_words"
+ ,structField C "generation" "weak_ptr_list"
,structSize Both "CostCentreStack"
,structField C "CostCentreStack" "ccsID"
@@ -469,10 +470,14 @@ wanteds = concat
,closureField C "StgWeak" "key"
,closureField C "StgWeak" "value"
,closureField C "StgWeak" "finalizer"
- ,closureField C "StgWeak" "cfinalizer"
+ ,closureField C "StgWeak" "cfinalizers"
- ,closureSize C "StgDeadWeak"
- ,closureField C "StgDeadWeak" "link"
+ ,closureSize C "StgCFinalizerList"
+ ,closureField C "StgCFinalizerList" "link"
+ ,closureField C "StgCFinalizerList" "fptr"
+ ,closureField C "StgCFinalizerList" "ptr"
+ ,closureField C "StgCFinalizerList" "eptr"
+ ,closureField C "StgCFinalizerList" "flag"
,closureSize C "StgMVar"
,closureField C "StgMVar" "head"
@@ -571,11 +576,11 @@ wanteds = concat
,constantWord Haskell "MAX_Float_REG" "MAX_FLOAT_REG"
,constantWord Haskell "MAX_Double_REG" "MAX_DOUBLE_REG"
,constantWord Haskell "MAX_Long_REG" "MAX_LONG_REG"
- ,constantWord Haskell "MAX_SSE_REG" "MAX_SSE_REG"
+ ,constantWord Haskell "MAX_XMM_REG" "MAX_XMM_REG"
,constantWord Haskell "MAX_Real_Vanilla_REG" "MAX_REAL_VANILLA_REG"
,constantWord Haskell "MAX_Real_Float_REG" "MAX_REAL_FLOAT_REG"
,constantWord Haskell "MAX_Real_Double_REG" "MAX_REAL_DOUBLE_REG"
- ,constantWord Haskell "MAX_Real_SSE_REG" "MAX_REAL_SSE_REG"
+ ,constantWord Haskell "MAX_Real_XMM_REG" "MAX_REAL_XMM_REG"
,constantWord Haskell "MAX_Real_Long_REG" "MAX_REAL_LONG_REG"
-- This tells the native code generator the size of the spill
diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs
index 4230cd8696..8729d4c73c 100644
--- a/utils/genprimopcode/Main.hs
+++ b/utils/genprimopcode/Main.hs
@@ -138,8 +138,6 @@ gen_hs_source (Info defaults entries) =
++ unlines (map (("\t" ++) . hdr) entries)
++ ") where\n"
++ "\n"
- ++ "import GHC.Types\n"
- ++ "\n"
++ "{-\n"
++ unlines (map opt defaults)
++ "-}\n"
@@ -507,7 +505,6 @@ gen_wrappers (Info _ entries)
-- don't need the Prelude here so we add NoImplicitPrelude.
++ "module GHC.PrimopWrappers where\n"
++ "import qualified GHC.Prim\n"
- ++ "import GHC.Types (Bool)\n"
++ "import GHC.Tuple ()\n"
++ "import GHC.Prim (" ++ concat (intersperse ", " othertycons) ++ ")\n"
++ "#if defined (__GLASGOW_HASKELL_LLVM__)\n"
diff --git a/utils/genprimopcode/Syntax.hs b/utils/genprimopcode/Syntax.hs
index b2e983d48c..9d13f91e96 100644
--- a/utils/genprimopcode/Syntax.hs
+++ b/utils/genprimopcode/Syntax.hs
@@ -114,7 +114,7 @@ sanityPrimOp def_names p
sane_ty :: Category -> Ty -> Bool
sane_ty Compare (TyF t1 (TyF t2 td))
- | t1 == t2 && td == TyApp "Bool" [] = True
+ | t1 == t2 && td == TyApp "Int#" [] = True
sane_ty Monadic (TyF t1 td)
| t1 == td = True
sane_ty Dyadic (TyF t1 (TyF t2 td))
diff --git a/utils/ghc-cabal/Main.hs b/utils/ghc-cabal/Main.hs
index 991b2b80b6..9a76d6b93d 100644
--- a/utils/ghc-cabal/Main.hs
+++ b/utils/ghc-cabal/Main.hs
@@ -34,26 +34,24 @@ main :: IO ()
main = do hSetBuffering stdout LineBuffering
args <- getArgs
case args of
- "hscolour" : distDir : dir : args' ->
- runHsColour distDir dir args'
+ "hscolour" : dir : distDir : args' ->
+ runHsColour dir distDir args'
"check" : dir : [] ->
doCheck dir
- "copy" : strip : directory : distDir
- : myDestDir : myPrefix : myLibdir : myDocdir
+ "copy" : dir : distDir
+ : strip : myDestDir : myPrefix : myLibdir : myDocdir
: args' ->
- doCopy strip directory distDir
- myDestDir myPrefix myLibdir myDocdir
+ doCopy dir distDir
+ strip myDestDir myPrefix myLibdir myDocdir
args'
- "register" : ghc : ghcpkg : topdir : directory : distDir
+ "register" : dir : distDir : ghc : ghcpkg : topdir
: myDestDir : myPrefix : myLibdir : myDocdir
: relocatableBuild : args' ->
- doRegister ghc ghcpkg topdir directory distDir
+ doRegister dir distDir ghc ghcpkg topdir
myDestDir myPrefix myLibdir myDocdir
relocatableBuild args'
- "configure" : args' -> case break (== "--") args' of
- (config_args, "--" : distdir : directories) ->
- mapM_ (generate config_args distdir) directories
- _ -> die syntax_error
+ "configure" : dir : distDir : dll0Modules : config_args ->
+ generate dir distDir dll0Modules config_args
"sdist" : dir : distDir : [] ->
doSdist dir distDir
["--version"] ->
@@ -124,7 +122,7 @@ doCheck directory
isFailure _ = True
runHsColour :: FilePath -> FilePath -> [String] -> IO ()
-runHsColour distdir directory args
+runHsColour directory distdir args
= withCurrentDirectory directory
$ defaultMainArgs ("hscolour" : "--builddir" : distdir : args)
@@ -132,9 +130,9 @@ doCopy :: FilePath -> FilePath
-> FilePath -> FilePath -> FilePath -> FilePath -> FilePath
-> [String]
-> IO ()
-doCopy strip directory distDir
- myDestDir myPrefix myLibdir myDocdir
- args
+doCopy directory distDir
+ strip myDestDir myPrefix myLibdir myDocdir
+ args
= withCurrentDirectory directory $ do
let copyArgs = ["copy", "--builddir", distDir]
++ (if null myDestDir
@@ -182,7 +180,7 @@ doRegister :: FilePath -> FilePath -> FilePath -> FilePath
-> FilePath -> FilePath -> FilePath -> FilePath -> FilePath
-> String -> [String]
-> IO ()
-doRegister ghc ghcpkg topdir directory distDir
+doRegister directory distDir ghc ghcpkg topdir
myDestDir myPrefix myLibdir myDocdir
relocatableBuildStr args
= withCurrentDirectory directory $ do
@@ -300,8 +298,8 @@ mangleLbi "compiler" "stage2" lbi
_ -> False
mangleLbi _ _ lbi = lbi
-generate :: [String] -> FilePath -> FilePath -> IO ()
-generate config_args distdir directory
+generate :: FilePath -> FilePath -> String -> [String] -> IO ()
+generate directory distdir dll0Modules config_args
= withCurrentDirectory directory
$ do let verbosity = normal
-- XXX We shouldn't just configure with the default flags
@@ -405,9 +403,12 @@ generate config_args distdir directory
wrappedLibraryDirs <- wrap libraryDirs
let variablePrefix = directory ++ '_':distdir
+ mods = map display modules
+ otherMods = map display (otherModules bi)
+ allMods = mods ++ otherMods
let xs = [variablePrefix ++ "_VERSION = " ++ display (pkgVersion (package pd)),
- variablePrefix ++ "_MODULES = " ++ unwords (map display modules),
- variablePrefix ++ "_HIDDEN_MODULES = " ++ unwords (map display (otherModules bi)),
+ variablePrefix ++ "_MODULES = " ++ unwords mods,
+ variablePrefix ++ "_HIDDEN_MODULES = " ++ unwords otherMods,
variablePrefix ++ "_SYNOPSIS =" ++ synopsis pd,
variablePrefix ++ "_HS_SRC_DIRS = " ++ unwords (hsSourceDirs bi),
variablePrefix ++ "_DEPS = " ++ unwords deps,
@@ -437,6 +438,7 @@ generate config_args distdir directory
variablePrefix ++ "_DEP_CC_OPTS = " ++ unwords (forDeps Installed.ccOptions),
variablePrefix ++ "_DEP_LIB_DIRS_SINGLE_QUOTED = " ++ unwords wrappedLibraryDirs,
variablePrefix ++ "_DEP_LIB_DIRS_SEARCHPATH = " ++ mkSearchPath libraryDirs,
+ variablePrefix ++ "_DEP_LIB_REL_DIRS = " ++ unwords libraryRelDirs,
variablePrefix ++ "_DEP_LIB_REL_DIRS_SEARCHPATH = " ++ mkSearchPath libraryRelDirs,
variablePrefix ++ "_DEP_EXTRA_LIBS = " ++ unwords (forDeps Installed.extraLibraries),
variablePrefix ++ "_DEP_LD_OPTS = " ++ unwords (forDeps Installed.ldOptions),
@@ -450,6 +452,11 @@ generate config_args distdir directory
writeFile (distdir ++ "/haddock-prologue.txt") $
if null (description pd) then synopsis pd
else description pd
+ unless (null dll0Modules) $
+ do let dll0Mods = words dll0Modules
+ dllMods = allMods \\ dll0Mods
+ dllModSets = map unwords [dll0Mods, dllMods]
+ writeFile (distdir ++ "/dll-split") $ unlines dllModSets
where
escape = foldr (\c xs -> if c == '#' then '\\':'#':xs else c:xs) []
wrap = mapM wrap1
diff --git a/utils/ghc-cabal/ghc.mk b/utils/ghc-cabal/ghc.mk
index bb0a35ecd6..bafc47b261 100644
--- a/utils/ghc-cabal/ghc.mk
+++ b/utils/ghc-cabal/ghc.mk
@@ -18,17 +18,19 @@ CABAL_DOTTED_VERSION := $(shell grep "^version:" libraries/Cabal/Cabal/Cabal.cab
CABAL_VERSION := $(subst .,$(comma),$(CABAL_DOTTED_VERSION))
CABAL_CONSTRAINT := --constraint="Cabal == $(CABAL_DOTTED_VERSION)"
-ghc-cabal_INPLACE = inplace/bin/ghc-cabal$(exeext)
+ghc-cabal_DIST_BINARY_NAME = ghc-cabal$(exeext0)
+ghc-cabal_DIST_BINARY = utils/ghc-cabal/dist/build/tmp/$(ghc-cabal_DIST_BINARY_NAME)
+ghc-cabal_INPLACE = inplace/bin/$(ghc-cabal_DIST_BINARY_NAME)
ifneq "$(BINDIST)" "YES"
-$(ghc-cabal_INPLACE) : utils/ghc-cabal/dist/build/tmp/ghc-cabal$(exeext) | $$(dir $$@)/.
+$(ghc-cabal_INPLACE) : $(ghc-cabal_DIST_BINARY) | $$(dir $$@)/.
"$(CP)" $< $@
-utils/ghc-cabal/dist/build/tmp/ghc-cabal$(exeext): $(wildcard libraries/Cabal/Cabal/Distribution/*/*/*.hs)
-utils/ghc-cabal/dist/build/tmp/ghc-cabal$(exeext): $(wildcard libraries/Cabal/Cabal/Distribution/*/*.hs)
-utils/ghc-cabal/dist/build/tmp/ghc-cabal$(exeext): $(wildcard libraries/Cabal/Cabal/Distribution/*.hs)
+$(ghc-cabal_DIST_BINARY): $(wildcard libraries/Cabal/Cabal/Distribution/*/*/*.hs)
+$(ghc-cabal_DIST_BINARY): $(wildcard libraries/Cabal/Cabal/Distribution/*/*.hs)
+$(ghc-cabal_DIST_BINARY): $(wildcard libraries/Cabal/Cabal/Distribution/*.hs)
-utils/ghc-cabal/dist/build/tmp/ghc-cabal$(exeext): utils/ghc-cabal/Main.hs $(TOUCH_DEP) | $$(dir $$@)/. bootstrapping/.
+$(ghc-cabal_DIST_BINARY): utils/ghc-cabal/Main.hs $(TOUCH_DEP) | $$(dir $$@)/. bootstrapping/.
"$(GHC)" $(SRC_HC_OPTS) --make utils/ghc-cabal/Main.hs -o $@ \
-no-user-$(GHC_PACKAGE_DB_FLAG) \
-Wall -fno-warn-unused-imports -fno-warn-warnings-deprecations \
diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index 2e7bab6cc4..e2f497f36c 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -612,7 +612,7 @@ readParseDatabase verbosity mb_user_conf use_cache path
pkgs <- parseMultiPackageConf verbosity path
mkPackageDB pkgs
Right fs
- | not use_cache -> ignore_cache
+ | not use_cache -> ignore_cache (const $ return ())
| otherwise -> do
let cache = path </> cachefilename
tdir <- getModificationTime path
@@ -621,24 +621,42 @@ readParseDatabase verbosity mb_user_conf use_cache path
Left ex -> do
when (verbosity > Normal) $
warn ("warning: cannot read cache file " ++ cache ++ ": " ++ show ex)
- ignore_cache
- Right tcache
- | tcache >= tdir -> do
- when (verbosity > Normal) $
- infoLn ("using cache: " ++ cache)
- pkgs <- myReadBinPackageDB cache
- let pkgs' = map convertPackageInfoIn pkgs
- mkPackageDB pkgs'
- | otherwise -> do
- when (verbosity >= Normal) $ do
- warn ("WARNING: cache is out of date: " ++ cache)
- warn " use 'ghc-pkg recache' to fix."
- ignore_cache
+ ignore_cache (const $ return ())
+ Right tcache -> do
+ let compareTimestampToCache file =
+ when (verbosity >= Verbose) $ do
+ tFile <- getModificationTime file
+ compareTimestampToCache' file tFile
+ compareTimestampToCache' file tFile = do
+ let rel = case tcache `compare` tFile of
+ LT -> " (NEWER than cache)"
+ GT -> " (older than cache)"
+ EQ -> " (same as cache)"
+ warn ("Timestamp " ++ show tFile
+ ++ " for " ++ file ++ rel)
+ when (verbosity >= Verbose) $ do
+ warn ("Timestamp " ++ show tcache ++ " for " ++ cache)
+ compareTimestampToCache' path tdir
+ if tcache >= tdir
+ then do
+ when (verbosity > Normal) $
+ infoLn ("using cache: " ++ cache)
+ pkgs <- myReadBinPackageDB cache
+ let pkgs' = map convertPackageInfoIn pkgs
+ mkPackageDB pkgs'
+ else do
+ when (verbosity >= Normal) $ do
+ warn ("WARNING: cache is out of date: "
+ ++ cache)
+ warn "Use 'ghc-pkg recache' to fix."
+ ignore_cache compareTimestampToCache
where
- ignore_cache = do
+ ignore_cache :: (FilePath -> IO ()) -> IO PackageDB
+ ignore_cache checkTime = do
let confs = filter (".conf" `isSuffixOf`) fs
- pkgs <- mapM (parseSingletonPackageConf verbosity) $
- map (path </>) confs
+ doFile f = do checkTime f
+ parseSingletonPackageConf verbosity f
+ pkgs <- mapM doFile $ map (path </>) confs
mkPackageDB pkgs
where
mkPackageDB pkgs = do
@@ -883,6 +901,10 @@ updateDBCache verbosity db = do
if isPermissionError e
then die (filename ++ ": you don't have permission to modify this file")
else ioError e
+#ifndef mingw32_HOST_OS
+ status <- getFileStatus filename
+ setFileTimes (location db) (accessTime status) (modificationTime status)
+#endif
-- -----------------------------------------------------------------------------
-- Exposing, Hiding, Trusting, Distrusting, Unregistering are all similar
@@ -1153,35 +1175,17 @@ describeField :: Verbosity -> [Flag] -> PackageArg -> [String] -> Bool -> IO ()
describeField verbosity my_flags pkgarg fields expand_pkgroot = do
(_, _, flag_db_stack) <-
getPkgDatabases verbosity False True{-use cache-} expand_pkgroot my_flags
- fns <- toFields fields
+ fns <- mapM toField fields
ps <- findPackages flag_db_stack pkgarg
mapM_ (selectFields fns) ps
- where toFields [] = return []
- toFields (f:fs) = case toField f of
- Nothing -> die ("unknown field: " ++ f)
- Just fn -> do fns <- toFields fs
- return (fn:fns)
+ where showFun = if FlagSimpleOutput `elem` my_flags
+ then showSimpleInstalledPackageInfoField
+ else showInstalledPackageInfoField
+ toField f = case showFun f of
+ Nothing -> die ("unknown field: " ++ f)
+ Just fn -> return fn
selectFields fns pinfo = mapM_ (\fn->putStrLn (fn pinfo)) fns
-toField :: String -> Maybe (InstalledPackageInfo -> String)
--- backwards compatibility:
-toField "import_dirs" = Just $ strList . importDirs
-toField "source_dirs" = Just $ strList . importDirs
-toField "library_dirs" = Just $ strList . libraryDirs
-toField "hs_libraries" = Just $ strList . hsLibraries
-toField "extra_libraries" = Just $ strList . extraLibraries
-toField "include_dirs" = Just $ strList . includeDirs
-toField "c_includes" = Just $ strList . includes
-toField "package_deps" = Just $ strList . map display. depends
-toField "extra_cc_opts" = Just $ strList . ccOptions
-toField "extra_ld_opts" = Just $ strList . ldOptions
-toField "framework_dirs" = Just $ strList . frameworkDirs
-toField "extra_frameworks"= Just $ strList . frameworks
-toField s = showInstalledPackageInfoField s
-
-strList :: [String] -> String
-strList = show
-
-- -----------------------------------------------------------------------------
-- Check: Check consistency of installed packages
diff --git a/utils/hp2ps/Error.c b/utils/hp2ps/Error.c
index 346e267eb1..57325f34e5 100644
--- a/utils/hp2ps/Error.c
+++ b/utils/hp2ps/Error.c
@@ -53,7 +53,7 @@ Usage(const char *str)
printf(" -s use small title box\n");
printf(" -tf ignore trace bands which sum below f%% (default 1%%, max 5%%)\n");
printf(" -y traditional\n");
- printf(" -c colour ouput\n");
+ printf(" -c colour output\n");
exit(0);
}
diff --git a/utils/runghc/ghc.mk b/utils/runghc/ghc.mk
index cde8102312..5a56af5a49 100644
--- a/utils/runghc/ghc.mk
+++ b/utils/runghc/ghc.mk
@@ -32,7 +32,7 @@ install: install_runhaskell
.PHONY: install_runhaskell
ifeq "$(Windows_Host)" "YES"
install_runhaskell: install_bins
- "$(CP)" $(DESTDIR)$(bindir)/runghc$(exeext) $(DESTDIR)$(bindir)/runhaskell$(exeext)
+ "$(CP)" $(DESTDIR)$(bindir)/runghc$(exeext1) $(DESTDIR)$(bindir)/runhaskell$(exeext1)
else
install_runhaskell:
$(call removeFiles,"$(DESTDIR)$(bindir)/runhaskell")
View Lorry Controller Status