diff --git a/0001-Delete-spurious-comma-in-configure.ac.patch b/0001-Delete-spurious-comma-in-configure.ac.patch deleted file mode 100644 index f038bee..0000000 --- a/0001-Delete-spurious-comma-in-configure.ac.patch +++ /dev/null @@ -1,26 +0,0 @@ -From 8cf720ec511d22edb5f545b5b9847358533000d2 Mon Sep 17 00:00:00 2001 -From: Peter Trommler -Date: Tue, 24 Sep 2013 16:19:40 +0200 -Subject: [PATCH] Delete spurious comma in configure.ac - -A comma in AC_CHECK_FUNCS prevented setitimer from being detected. ---- - configure.ac | 2 +- - 1 file changed, 1 insertion(+), 1 deletion(-) - -diff --git a/configure.ac b/configure.ac -index c0b2a14..5f0731d 100644 ---- a/libraries/process/configure.ac -+++ b/libraries/process/configure.ac -@@ -16,7 +16,7 @@ AC_FUNC_FORK - # check for specific header (.h) files that we are interested in - AC_CHECK_HEADERS([signal.h sys/wait.h fcntl.h]) - --AC_CHECK_FUNCS([setitimer, sysconf]) -+AC_CHECK_FUNCS([setitimer sysconf]) - - FP_CHECK_CONSTS([SIG_DFL SIG_IGN]) - --- -1.7.10.4 - diff --git a/0001-Fix-detection-of-library-for-shm-on-openSUSE.patch b/0001-Fix-detection-of-library-for-shm-on-openSUSE.patch deleted file mode 100644 index 9b9ff56..0000000 --- a/0001-Fix-detection-of-library-for-shm-on-openSUSE.patch +++ /dev/null @@ -1,30 +0,0 @@ -From 235aedba6b68feecb3ec4c84dbf6a1d1e3e1965a Mon Sep 17 00:00:00 2001 -From: Peter Trommler -Date: Tue, 24 Sep 2013 13:44:54 +0200 -Subject: [PATCH] Fix detection of library for shm* on openSUSE. - -Use the new AC_SERACH_LIBS to check if rt is needed for shm_open -and shm_unlink. This sets LIBS and so the shm_* functions -can be found if librt is indeed required. Passing -lrt through -CFLAGS is not portable. ---- - configure.ac | 7 +++---- - 1 file changed, 3 insertions(+), 4 deletions(-) - -Index: ghc-7.6.3/libraries/unix/configure.ac -=================================================================== ---- ghc-7.6.3.orig/libraries/unix/configure.ac -+++ ghc-7.6.3/libraries/unix/configure.ac -@@ -54,10 +54,9 @@ AC_CHECK_MEMBERS([struct stat.st_uctime] - AC_CHECK_FUNCS([mkstemps mkdtemp]) - - # Avoid adding rt if absent or unneeded --AC_CHECK_LIB(rt, shm_open, [EXTRA_LIBS="$EXTRA_LIBS rt" CFLAGS="$CFLAGS -lrt"]) -- - # needs -lrt on linux --AC_CHECK_FUNCS([shm_open shm_unlink]) -+AC_SEARCH_LIBS(shm_open, rt, [AC_CHECK_FUNCS([shm_open shm_unlink])]) -+AS_IF([test "x$ac_cv_search_shm_open" = x-lrt], [EXTRA_LIBS="$EXTRA_LIBS rt"]) - - FP_CHECK_CONSTS([SIGABRT SIGALRM SIGBUS SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT SIGKILL SIGPIPE SIGQUIT SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN SIGTTOU SIGUSR1 SIGUSR2 SIGPOLL SIGPROF SIGSYS SIGTRAP SIGURG SIGVTALRM SIGXCPU SIGXFSZ SIG_BLOCK SIG_SETMASK SIG_UNBLOCK], [ - #if HAVE_SIGNAL_H diff --git a/Cabal-fix-dynamic-exec-for-TH.patch b/Cabal-fix-dynamic-exec-for-TH.patch deleted file mode 100644 index 83a2f6f..0000000 --- a/Cabal-fix-dynamic-exec-for-TH.patch +++ /dev/null @@ -1,23 +0,0 @@ ---- ghc-7.6.3/libraries/Cabal/Cabal/Distribution/Simple/GHC.hs~ 2013-04-19 06:32:04.000000000 +0900 -+++ ghc-7.6.3/libraries/Cabal/Cabal/Distribution/Simple/GHC.hs 2013-06-12 11:35:39.832840754 +0900 -@@ -837,6 +837,8 @@ - - dynamicOpts = vanillaOpts `mappend` mempty { - ghcOptDynamic = toFlag True, -+ ghcOptHiSuffix = toFlag "dyn_hi", -+ ghcOptObjSuffix = toFlag "dyn_o", - ghcOptExtra = ghcSharedOptions exeBi - } - -@@ -855,9 +857,9 @@ - -- with profiling. This is because the code that TH needs to - -- run at compile time needs to be the vanilla ABI so it can - -- be loaded up and run by the compiler. -- when (withProfExe lbi && -+ when ((withProfExe lbi || withDynExe lbi) && - EnableExtension TemplateHaskell `elem` allExtensions exeBi) $ -- runGhcProg exeProfOpts { ghcOptNoLink = toFlag True } -+ runGhcProg vanillaOpts { ghcOptNoLink = toFlag True } - - runGhcProg exeOpts { ghcOptOutputFile = toFlag (targetDir exeNameReal) } - diff --git a/D173.patch b/D173.patch new file mode 100644 index 0000000..769e0be --- /dev/null +++ b/D173.patch @@ -0,0 +1,51 @@ +Index: ghc-7.8.3/compiler/cmm/PprC.hs +=================================================================== +--- ghc-7.8.3.orig/compiler/cmm/PprC.hs ++++ ghc-7.8.3/compiler/cmm/PprC.hs +@@ -1220,8 +1220,9 @@ commafy xs = hsep $ punctuate comma xs + pprHexVal :: Integer -> Width -> SDoc + pprHexVal 0 _ = ptext (sLit "0x0") + pprHexVal w rep +- | w < 0 = parens (char '-' <> ptext (sLit "0x") <> go (-w) <> repsuffix rep) +- | otherwise = ptext (sLit "0x") <> go w <> repsuffix rep ++ | w < 0 = parens (char '-' <> ++ ptext (sLit "0x") <> intToDoc (-w) <> repsuffix rep) ++ | otherwise = ptext (sLit "0x") <> intToDoc w <> repsuffix rep + where + -- type suffix for literals: + -- Integer literals are unsigned in Cmm/C. We explicitly cast to +@@ -1236,10 +1237,33 @@ pprHexVal w rep + else panic "pprHexVal: Can't find a 64-bit type" + repsuffix _ = char 'U' + ++ intToDoc :: Integer -> SDoc ++ intToDoc i = go (truncInt i) ++ ++ -- We need to truncate value as Cmm backend does not drop ++ -- redundant bits to ease handling of negative values. ++ -- Thus the following Cmm code on 64-bit arch, like amd64: ++ -- CInt v; ++ -- v = {something}; ++ -- if (v == %lobits32(-1)) { ... ++ -- leads to the following C code: ++ -- StgWord64 v = (StgWord32)({something}); ++ -- if (v == 0xFFFFffffFFFFffffU) { ... ++ -- Such code is incorrect as it promotes both operands to StgWord64 ++ -- and the whole condition is always false. ++ truncInt :: Integer -> Integer ++ truncInt i = ++ case rep of ++ W8 -> i `rem` (2^(8 :: Int)) ++ W16 -> i `rem` (2^(16 :: Int)) ++ W32 -> i `rem` (2^(32 :: Int)) ++ W64 -> i `rem` (2^(64 :: Int)) ++ _ -> panic ("pprHexVal/truncInt: C backend can't encode " ++ ++ show rep ++ " literals") ++ + go 0 = empty + go w' = go q <> dig + where + (q,r) = w' `quotRem` 16 + dig | r < 10 = char (chr (fromInteger r + ord '0')) + | otherwise = char (chr (fromInteger r - 10 + ord 'a')) +- diff --git a/D177.patch b/D177.patch new file mode 100644 index 0000000..a11d973 --- /dev/null +++ b/D177.patch @@ -0,0 +1,80 @@ +Index: ghc-7.8.3/compiler/main/DriverPipeline.hs +=================================================================== +--- ghc-7.8.3.orig/compiler/main/DriverPipeline.hs ++++ ghc-7.8.3/compiler/main/DriverPipeline.hs +@@ -1208,6 +1208,7 @@ runPhase (RealPhase (As with_cpp)) input + + as_prog <- whichAsProg + let cmdline_include_paths = includePaths dflags ++ let pic_c_flags = picCCOpts dflags + + next_phase <- maybeMergeStub + output_fn <- phaseOutputFilename next_phase +@@ -1221,6 +1222,9 @@ runPhase (RealPhase (As with_cpp)) input + = liftIO $ as_prog dflags + ([ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ] + ++ -- See Note [-fPIC for assembler] ++ ++ map SysTools.Option pic_c_flags ++ + -- We only support SparcV9 and better because V8 lacks an atomic CAS + -- instruction so we have to make sure that the assembler accepts the + -- instruction set. Note that the user can still override this +@@ -1262,6 +1266,8 @@ runPhase (RealPhase SplitAs) _input_fn d + osuf = objectSuf dflags + split_odir = base_o ++ "_" ++ osuf ++ "_split" + ++ let pic_c_flags = picCCOpts dflags ++ + -- this also creates the hierarchy + liftIO $ createDirectoryIfMissing True split_odir + +@@ -1295,6 +1301,9 @@ runPhase (RealPhase SplitAs) _input_fn d + then [SysTools.Option "-mcpu=v9"] + else []) ++ + ++ -- See Note [-fPIC for assembler] ++ map SysTools.Option pic_c_flags ++ ++ + [ SysTools.Option "-c" + , SysTools.Option "-o" + , SysTools.FileOption "" (split_obj n) +@@ -2210,3 +2219,38 @@ haveRtsOptsFlags dflags = + isJust (rtsOpts dflags) || case rtsOptsEnabled dflags of + RtsOptsSafeOnly -> False + _ -> True ++ ++-- Note [-fPIC for assembler] ++-- When compiling .c source file GHC's driver pipeline basically ++-- does the following two things: ++-- 1. ${CC} -S 'PIC_CFLAGS' source.c ++-- 2. ${CC} -x assembler -c 'PIC_CFLAGS' source.S ++-- ++-- Why do we need to pass 'PIC_CFLAGS' both to C compiler and assembler? ++-- Because on some architectures (at least sparc32) assembler also choses ++-- relocation type! ++-- Consider the following C module: ++-- ++-- /* pic-sample.c */ ++-- int v; ++-- void set_v (int n) { v = n; } ++-- int get_v (void) { return v; } ++-- ++-- $ gcc -S -fPIC pic-sample.c ++-- $ gcc -c pic-sample.s -o pic-sample.no-pic.o # incorrect binary ++-- $ gcc -c -fPIC pic-sample.s -o pic-sample.pic.o # correct binary ++-- ++-- $ objdump -r -d pic-sample.pic.o > pic-sample.pic.o.od ++-- $ objdump -r -d pic-sample.no-pic.o > pic-sample.no-pic.o.od ++-- $ diff -u pic-sample.pic.o.od pic-sample.no-pic.o.od ++-- ++-- Most of architectures won't show any difference in this test, but on sparc32 ++-- the following assembly snippet: ++-- ++-- sethi %hi(_GLOBAL_OFFSET_TABLE_-8), %l7 ++-- ++-- generates two kinds or relocations, only 'R_SPARC_PC22' is correct: ++-- ++-- 3c: 2f 00 00 00 sethi %hi(0), %l7 ++-- - 3c: R_SPARC_PC22 _GLOBAL_OFFSET_TABLE_-0x8 ++-- + 3c: R_SPARC_HI22 _GLOBAL_OFFSET_TABLE_-0x8 diff --git a/D349.patch b/D349.patch new file mode 100644 index 0000000..46c22c6 --- /dev/null +++ b/D349.patch @@ -0,0 +1,293 @@ +Index: ghc-7.8.3/compiler/ghci/Linker.lhs +=================================================================== +--- ghc-7.8.3.orig/compiler/ghci/Linker.lhs ++++ ghc-7.8.3/compiler/ghci/Linker.lhs +@@ -123,7 +123,10 @@ data PersistentLinkerState + -- The currently-loaded packages; always object code + -- Held, as usual, in dependency order; though I am not sure if + -- that is really important +- pkgs_loaded :: ![PackageId] ++ pkgs_loaded :: ![PackageId], ++ -- we need to remember the name of the last temporary DLL/.so ++ -- so we can link it ++ last_temp_so :: !(Maybe FilePath) + } + + emptyPLS :: DynFlags -> PersistentLinkerState +@@ -132,7 +135,8 @@ emptyPLS _ = PersistentLinkerState { + itbl_env = emptyNameEnv, + pkgs_loaded = init_pkgs, + bcos_loaded = [], +- objs_loaded = [] } ++ objs_loaded = [], ++ last_temp_so = Nothing } + + -- Packages that don't need loading, because the compiler + -- shares them with the interpreted program. +@@ -314,14 +318,15 @@ reallyInitDynLinker dflags = + ; if null cmdline_lib_specs then return pls + else do + +- { mapM_ (preloadLib dflags lib_paths framework_paths) cmdline_lib_specs ++ { pls1 <- foldM (preloadLib dflags lib_paths framework_paths) pls ++ cmdline_lib_specs + ; maybePutStr dflags "final link ... " + ; ok <- resolveObjs + + ; if succeeded ok then maybePutStrLn dflags "done" + else throwGhcExceptionIO (ProgramError "linking extra libraries/objects failed") + +- ; return pls ++ ; return pls1 + }} + + +@@ -360,19 +365,22 @@ classifyLdInput dflags f + return Nothing + where platform = targetPlatform dflags + +-preloadLib :: DynFlags -> [String] -> [String] -> LibrarySpec -> IO () +-preloadLib dflags lib_paths framework_paths lib_spec ++preloadLib :: DynFlags -> [String] -> [String] -> PersistentLinkerState ++ -> LibrarySpec -> IO (PersistentLinkerState) ++preloadLib dflags lib_paths framework_paths pls lib_spec + = do maybePutStr dflags ("Loading object " ++ showLS lib_spec ++ " ... ") + case lib_spec of + Object static_ish +- -> do b <- preload_static lib_paths static_ish ++ -> do (b, pls1) <- preload_static lib_paths static_ish + maybePutStrLn dflags (if b then "done" + else "not found") ++ return pls1 + + Archive static_ish + -> do b <- preload_static_archive lib_paths static_ish + maybePutStrLn dflags (if b then "done" + else "not found") ++ return pls + + DLL dll_unadorned + -> do maybe_errstr <- loadDLL (mkSOName platform dll_unadorned) +@@ -388,12 +396,14 @@ preloadLib dflags lib_paths framework_pa + case err2 of + Nothing -> maybePutStrLn dflags "done" + Just _ -> preloadFailed mm lib_paths lib_spec ++ return pls + + DLLPath dll_path + -> do maybe_errstr <- loadDLL dll_path + case maybe_errstr of + Nothing -> maybePutStrLn dflags "done" + Just mm -> preloadFailed mm lib_paths lib_spec ++ return pls + + Framework framework -> + if platformUsesFrameworks (targetPlatform dflags) +@@ -401,6 +411,7 @@ preloadLib dflags lib_paths framework_pa + case maybe_errstr of + Nothing -> maybePutStrLn dflags "done" + Just mm -> preloadFailed mm framework_paths lib_spec ++ return pls + else panic "preloadLib Framework" + + where +@@ -420,11 +431,13 @@ preloadLib dflags lib_paths framework_pa + -- Not interested in the paths in the static case. + preload_static _paths name + = do b <- doesFileExist name +- if not b then return False +- else do if dynamicGhc +- then dynLoadObjs dflags [name] +- else loadObj name +- return True ++ if not b then return (False, pls) ++ else if dynamicGhc ++ then do pls1 <- dynLoadObjs dflags pls [name] ++ return (True, pls1) ++ else do loadObj name ++ return (True, pls) ++ + preload_static_archive _paths name + = do b <- doesFileExist name + if not b then return False +@@ -791,8 +804,8 @@ dynLinkObjs dflags pls objs = do + wanted_objs = map nameOfObject unlinkeds + + if dynamicGhc +- then do dynLoadObjs dflags wanted_objs +- return (pls1, Succeeded) ++ then do pls2 <- dynLoadObjs dflags pls1 wanted_objs ++ return (pls2, Succeeded) + else do mapM_ loadObj wanted_objs + + -- Link them all together +@@ -806,9 +819,11 @@ dynLinkObjs dflags pls objs = do + pls2 <- unload_wkr dflags [] pls1 + return (pls2, Failed) + +-dynLoadObjs :: DynFlags -> [FilePath] -> IO () +-dynLoadObjs _ [] = return () +-dynLoadObjs dflags objs = do ++ ++dynLoadObjs :: DynFlags -> PersistentLinkerState -> [FilePath] ++ -> IO PersistentLinkerState ++dynLoadObjs _ pls [] = return pls ++dynLoadObjs dflags pls objs = do + let platform = targetPlatform dflags + soFile <- newTempName dflags (soExt platform) + let -- When running TH for a non-dynamic way, we still need to make +@@ -816,10 +831,22 @@ dynLoadObjs dflags objs = do + -- Opt_Static off + dflags1 = gopt_unset dflags Opt_Static + dflags2 = dflags1 { +- -- We don't want to link the ldInputs in; we'll +- -- be calling dynLoadObjs with any objects that +- -- need to be linked. +- ldInputs = [], ++ -- We don't want the original ldInputs in ++ -- (they're already linked in), but we do want ++ -- to link against the previous dynLoadObjs ++ -- library if there was one, so that the linker ++ -- can resolve dependencies when it loads this ++ -- library. ++ ldInputs = ++ case last_temp_so pls of ++ Nothing -> [] ++ Just so -> ++ let (lp, l) = splitFileName so in ++ [ Option ("-L" ++ lp) ++ , Option ("-Wl,-rpath") ++ , Option ("-Wl," ++ lp) ++ , Option ("-l:" ++ l) ++ ], + -- Even if we're e.g. profiling, we still want + -- the vanilla dynamic libraries, so we set the + -- ways / build tag to be just WayDyn. +@@ -831,7 +858,7 @@ dynLoadObjs dflags objs = do + consIORef (filesToNotIntermediateClean dflags) soFile + m <- loadDLL soFile + case m of +- Nothing -> return () ++ Nothing -> return pls { last_temp_so = Just soFile } + Just err -> panic ("Loading temp shared object failed: " ++ err) + + rmDupLinkables :: [Linkable] -- Already loaded +Index: ghc-7.8.3/compiler/main/SysTools.lhs +=================================================================== +--- ghc-7.8.3.orig/compiler/main/SysTools.lhs ++++ ghc-7.8.3/compiler/main/SysTools.lhs +@@ -1365,6 +1365,7 @@ linkDynLib dflags0 o_files dep_packages + in package_hs_libs ++ extra_libs ++ other_flags + + -- probably _stub.o files ++ -- and last temporary shaerd object file + let extra_ld_inputs = ldInputs dflags + + case os of +@@ -1482,8 +1483,8 @@ linkDynLib dflags0 o_files dep_packages + -- Set the library soname. We use -h rather than -soname as + -- Solaris 10 doesn't support the latter: + ++ [ Option ("-Wl,-h," ++ takeFileName output_fn) ] +- ++ map Option lib_path_opts + ++ extra_ld_inputs ++ ++ map Option lib_path_opts + ++ map Option pkg_lib_path_opts + ++ map Option pkg_link_opts + ) +Index: ghc-7.8.3/rts/Linker.c +=================================================================== +--- ghc-7.8.3.orig/rts/Linker.c ++++ ghc-7.8.3/rts/Linker.c +@@ -1776,7 +1776,7 @@ internal_dlopen(const char *dll_name) + // (see POSIX also) + + ACQUIRE_LOCK(&dl_mutex); +- hdl = dlopen(dll_name, RTLD_LAZY | RTLD_GLOBAL); ++ hdl = dlopen(dll_name, RTLD_LAZY|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */ + + errmsg = NULL; + if (hdl == NULL) { +@@ -1786,11 +1786,12 @@ internal_dlopen(const char *dll_name) + errmsg_copy = stgMallocBytes(strlen(errmsg)+1, "addDLL"); + strcpy(errmsg_copy, errmsg); + errmsg = errmsg_copy; ++ } else { ++ o_so = stgMallocBytes(sizeof(OpenedSO), "addDLL"); ++ o_so->handle = hdl; ++ o_so->next = openedSOs; ++ openedSOs = o_so; + } +- o_so = stgMallocBytes(sizeof(OpenedSO), "addDLL"); +- o_so->handle = hdl; +- o_so->next = openedSOs; +- openedSOs = o_so; + + RELEASE_LOCK(&dl_mutex); + //--------------- End critical section ------------------- +@@ -1798,14 +1799,39 @@ internal_dlopen(const char *dll_name) + return errmsg; + } + ++/* ++ Note [RTLD_LOCAL] ++ ++ In GHCi we want to be able to override previous .so's with newly ++ loaded .so's when we recompile something. This further implies that ++ when we look up a symbol in internal_dlsym() we have to iterate ++ through the loaded libraries (in order from most recently loaded to ++ oldest) looking up the symbol in each one until we find it. ++ ++ However, this can cause problems for some symbols that are copied ++ by the linker into the executable image at runtime - see #8935 for a ++ lengthy discussion. To solve that problem we need to look up ++ symbols in the main executable *first*, before attempting to look ++ them up in the loaded .so's. But in order to make that work, we ++ have to always call dlopen with RTLD_LOCAL, so that the loaded ++ libraries don't populate the global symbol table. ++*/ ++ + static void * +-internal_dlsym(void *hdl, const char *symbol) { ++internal_dlsym(const char *symbol) { + OpenedSO* o_so; + void *v; + + // We acquire dl_mutex as concurrent dl* calls may alter dlerror + ACQUIRE_LOCK(&dl_mutex); + dlerror(); ++ // look in program first ++ v = dlsym(dl_prog_handle, symbol); ++ if (dlerror() == NULL) { ++ RELEASE_LOCK(&dl_mutex); ++ return v; ++ } ++ + for (o_so = openedSOs; o_so != NULL; o_so = o_so->next) { + v = dlsym(o_so->handle, symbol); + if (dlerror() == NULL) { +@@ -1813,7 +1839,6 @@ internal_dlsym(void *hdl, const char *sy + return v; + } + } +- v = dlsym(hdl, symbol); + RELEASE_LOCK(&dl_mutex); + return v; + } +@@ -1981,7 +2006,7 @@ lookupSymbol( char *lbl ) + if (!ghciLookupSymbolTable(symhash, lbl, &val)) { + IF_DEBUG(linker, debugBelch("lookupSymbol: symbol not found\n")); + # if defined(OBJFORMAT_ELF) +- return internal_dlsym(dl_prog_handle, lbl); ++ return internal_dlsym(lbl); + # elif defined(OBJFORMAT_MACHO) + # if HAVE_DLFCN_H + /* On OS X 10.3 and later, we use dlsym instead of the old legacy +@@ -1995,7 +2020,7 @@ lookupSymbol( char *lbl ) + */ + IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s with dlsym\n", lbl)); + ASSERT(lbl[0] == '_'); +- return internal_dlsym(dl_prog_handle, lbl + 1); ++ return internal_dlsym(lbl + 1); + # else + if (NSIsSymbolNameDefined(lbl)) { + NSSymbol symbol = NSLookupAndBindSymbol(lbl); diff --git a/ghc-7.6.3-LlvmCodeGen-no-3.3-warning.patch b/ghc-7.6.3-LlvmCodeGen-no-3.3-warning.patch deleted file mode 100644 index 130b152..0000000 --- a/ghc-7.6.3-LlvmCodeGen-no-3.3-warning.patch +++ /dev/null @@ -1,11 +0,0 @@ ---- ghc-7.6.3/compiler/llvmGen/LlvmCodeGen/Base.hs~ 2013-04-19 06:22:46.000000000 +0900 -+++ ghc-7.6.3/compiler/llvmGen/LlvmCodeGen/Base.hs 2013-07-24 17:05:06.491900335 +0900 -@@ -151,7 +151,7 @@ - minSupportLlvmVersion = 28 - - maxSupportLlvmVersion :: LlvmVersion --maxSupportLlvmVersion = 31 -+maxSupportLlvmVersion = 33 - - -- ---------------------------------------------------------------------------- - -- * Environment Handling diff --git a/ghc-7.6.3-src.tar.bz2 b/ghc-7.6.3-src.tar.bz2 deleted file mode 100644 index 528b8a3..0000000 --- a/ghc-7.6.3-src.tar.bz2 +++ /dev/null @@ -1,3 +0,0 @@ -version https://git-lfs.github.com/spec/v1 -oid sha256:bd43823d31f6b5d0b2ca7b74151a8f98336ab0800be85f45bb591c9c26aac998 -size 110763823 diff --git a/ghc-7.8.2-cgen-constify.patch b/ghc-7.8.2-cgen-constify.patch new file mode 100644 index 0000000..86f53ab --- /dev/null +++ b/ghc-7.8.2-cgen-constify.patch @@ -0,0 +1,34 @@ +commit b0cf3ab7a69b878a4335d21a347b56e4b0ca0b7b +Author: Sergei Trofimovich +Date: Mon Apr 14 19:06:24 2014 +0300 + + compiler/cmm/PprC.hs: constify local string literals + + Consider one-line module + module B (v) where v = "hello" + in -fvia-C mode it generates code like + static char gibberish_str[] = "hello"; + + It uselessly eats data section (precious resource on ia64!). + The patch switches genrator to emit: + static const char gibberish_str[] = "hello"; + + Signed-off-by: Sergei Trofimovich + +diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs +index 2398981..fdb578d 100644 +--- a/compiler/cmm/PprC.hs ++++ b/compiler/cmm/PprC.hs +@@ -112,6 +112,12 @@ pprTop (CmmProc infos clbl _ graph) = + + -- We only handle (a) arrays of word-sized things and (b) strings. + ++pprTop (CmmData ReadOnlyData (Statics lbl [CmmString str])) = ++ hcat [ ++ pprLocalness lbl, ptext (sLit "const char "), ppr lbl, ++ ptext (sLit "[] = "), pprStringInCStyle str, semi ++ ] ++ + pprTop (CmmData _section (Statics lbl [CmmString str])) = + hcat [ + pprLocalness lbl, ptext (sLit "char "), ppr lbl, diff --git a/ghc-7.8.3-src.tar.xz b/ghc-7.8.3-src.tar.xz new file mode 100644 index 0000000..cd15d41 --- /dev/null +++ b/ghc-7.8.3-src.tar.xz @@ -0,0 +1,3 @@ +version https://git-lfs.github.com/spec/v1 +oid sha256:b0cd96a549ba3b5e512847a4a8cd1a3174e4b2b75dadfc41c568fb812887b958 +size 9160092 diff --git a/ghc-avoid-empty-llvm-used-definitions.patch b/ghc-avoid-empty-llvm-used-definitions.patch deleted file mode 100644 index 18125fc..0000000 --- a/ghc-avoid-empty-llvm-used-definitions.patch +++ /dev/null @@ -1,45 +0,0 @@ -git-author: Geoffrey Mainland (06/12/13 13:31:49) -git-committer: Geoffrey Mainland (06/12/13 13:31:49) -Message: - Avoid generating empty llvm.used definitions. - - LLVM 3.3rc3 complains when the llvm.used global is an empty array, so don't - define llvm.used at all when it would be empty. --- - -Index: ghc-7.6.3/compiler/llvmGen/LlvmCodeGen.hs -=================================================================== ---- ghc-7.6.3.orig/compiler/llvmGen/LlvmCodeGen.hs -+++ ghc-7.6.3/compiler/llvmGen/LlvmCodeGen.hs -@@ -112,19 +112,19 @@ cmmProcLlvmGens :: DynFlags -> BufHandle - -> [[LlvmVar]] -- ^ info tables that need to be marked as 'used' - -> IO () - --cmmProcLlvmGens _ _ _ _ [] _ [] -- = return () -- - cmmProcLlvmGens dflags h _ _ [] _ ivars -- = let ivars' = concat ivars -- cast x = LMBitc (LMStaticPointer (pVarLift x)) i8Ptr -- ty = (LMArray (length ivars') i8Ptr) -- usedArray = LMStaticArray (map cast ivars') ty -- lmUsed = (LMGlobalVar (fsLit "llvm.used") ty Appending -- (Just $ fsLit "llvm.metadata") Nothing False, Just usedArray) -- in Prt.bufLeftRender h $ {-# SCC "llvm_used_ppr" #-} -- withPprStyleDoc dflags (mkCodeStyle CStyle) $ -- pprLlvmData ([lmUsed], []) -+ | null ivars' = return () -+ | otherwise = Prt.bufLeftRender h $ -+ {-# SCC "llvm_used_ppr" #-} -+ withPprStyleDoc dflags (mkCodeStyle CStyle) $ -+ pprLlvmData ([lmUsed], []) -+ where -+ ivars' = concat ivars -+ cast x = LMBitc (LMStaticPointer (pVarLift x)) i8Ptr -+ ty = (LMArray (length ivars') i8Ptr) -+ usedArray = LMStaticArray (map cast ivars') ty -+ lmUsed = (LMGlobalVar (fsLit "llvm.used") ty Appending -+ (Just $ fsLit "llvm.metadata") Nothing False, Just usedArray) - - cmmProcLlvmGens dflags h us env ((CmmData _ _) : cmms) count ivars - = cmmProcLlvmGens dflags h us env cmms count ivars diff --git a/ghc-cabal-unversion-docdir.patch b/ghc-cabal-unversion-docdir.patch index a8c4d35..4bd0b72 100644 --- a/ghc-cabal-unversion-docdir.patch +++ b/ghc-cabal-unversion-docdir.patch @@ -1,13 +1,15 @@ ---- ghc-7.6.3/utils/ghc-cabal/Main.hs~ 2013-04-19 06:22:47.000000000 +0900 -+++ ghc-7.6.3/utils/ghc-cabal/Main.hs 2013-10-29 12:35:18.916340631 +0900 -@@ -180,8 +180,8 @@ - libsubdir = toPathTemplate "$pkgid", - docdir = toPathTemplate $ - if relocatableBuild -- then "$topdir/../doc/html/libraries/$pkgid" -- else (myDocdir "$pkgid"), -+ then "$topdir/../doc/html/libraries/$pkg" -+ else (myDocdir "$pkg"), - htmldir = toPathTemplate "$docdir" - } - progs = withPrograms lbi +Index: ghc-7.7.20131120/utils/ghc-cabal/Main.hs +=================================================================== +--- ghc-7.7.20131120.orig/utils/ghc-cabal/Main.hs ++++ ghc-7.7.20131120/utils/ghc-cabal/Main.hs +@@ -253,8 +253,8 @@ updateInstallDirTemplates relocatableBui + libsubdir = toPathTemplate "$pkgid", + docdir = toPathTemplate $ + if relocatableBuild +- then "$topdir/../doc/html/libraries/$pkgid" +- else (myDocdir "$pkgid"), ++ then "$topdir/../doc/html/libraries/$pkg" ++ else (myDocdir "$pkg"), + htmldir = toPathTemplate "$docdir" + } + diff --git a/ghc-fix-infinite-loop-big-endian.patch b/ghc-fix-infinite-loop-big-endian.patch deleted file mode 100644 index 3ec9caf..0000000 --- a/ghc-fix-infinite-loop-big-endian.patch +++ /dev/null @@ -1,25 +0,0 @@ -From 0a2e25ea54ab549ce0966ffe0ad40c80a2849032 Mon Sep 17 00:00:00 2001 -From: Gustavo Luiz Duarte -Date: Mon, 28 Oct 2013 13:04:12 +0000 -Subject: Fix infinite loop on 64 bits big endian platforms (Trac #8134) - ---- - rts/STM.c | 2 +- - 1 file changed, 1 insertion(+), 1 deletion(-) - -diff --git a/rts/STM.c b/rts/STM.c -index 6bcb7ba..c4dcb9f 100644 ---- a/rts/STM.c -+++ b/rts/STM.c -@@ -927,7 +927,7 @@ void stmPreGCHook (Capability *cap) { - static volatile StgInt64 max_commits = 0; - - #if defined(THREADED_RTS) --static volatile StgBool token_locked = FALSE; -+static volatile StgWord token_locked = FALSE; - - static void getTokenBatch(Capability *cap) { - while (cas((void *)&token_locked, FALSE, TRUE) == TRUE) { /* nothing */ } --- -1.8.3.1 - diff --git a/ghc-ppc64le.patch b/ghc-ppc64le.patch deleted file mode 100644 index 16db069..0000000 --- a/ghc-ppc64le.patch +++ /dev/null @@ -1,36 +0,0 @@ -Index: ghc-7.6.3/aclocal.m4 -=================================================================== ---- ghc-7.6.3.orig/aclocal.m4 -+++ ghc-7.6.3/aclocal.m4 -@@ -173,7 +173,7 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_V - GET_ARM_ISA() - test -z "[$]2" || eval "[$]2=\"ArchARM {armISA = \$ARM_ISA, armISAExt = \$ARM_ISA_EXT, armABI = \$ARM_ABI}\"" - ;; -- alpha|mips|mipseb|mipsel|hppa|hppa1_1|ia64|m68k|rs6000|s390|s390x|sparc64|vax) -+ alpha|mips|mipseb|mipsel|hppa|hppa1_1|ia64|m68k|powerpc64le|rs6000|s390|s390x|sparc64|vax) - test -z "[$]2" || eval "[$]2=ArchUnknown" - ;; - *) -@@ -1883,6 +1883,9 @@ case "$1" in - mips*) - $2="mips" - ;; -+ powerpc64le*) -+ $2="powerpc64le" -+ ;; - powerpc64*) - $2="powerpc64" - ;; -Index: ghc-7.6.3/includes/Stg.h -=================================================================== ---- ghc-7.6.3.orig/includes/Stg.h -+++ ghc-7.6.3/includes/Stg.h -@@ -213,7 +213,7 @@ typedef StgFunPtr F_; - #define II_(X) static StgWordArray (X) GNU_ATTRIBUTE(aligned (8)) - #define IF_(f) static StgFunPtr GNUC3_ATTRIBUTE(used) f(void) - #define FN_(f) StgFunPtr f(void) --#define EF_(f) extern StgFunPtr f(void) -+#define EF_(f) extern StgFunPtr f() - - /* ----------------------------------------------------------------------------- - Tail calls diff --git a/ghc-suse-as-needed.patch b/ghc-suse-as-needed.patch deleted file mode 100644 index cb4ad72..0000000 --- a/ghc-suse-as-needed.patch +++ /dev/null @@ -1,49 +0,0 @@ -Index: ghc-7.6.3/aclocal.m4 -=================================================================== ---- ghc-7.6.3.orig/aclocal.m4 -+++ ghc-7.6.3/aclocal.m4 -@@ -465,6 +465,13 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], - $4="$$4 $LdReduceMemoryOverheads" - fi - -+ # Do not add RUNPATH tag whe linking. See trac #7062 -+ if test -n "$LdDisableNewDtags" -+ then -+ $3="$$3 -Wl,$LdDisableNewDtags" -+ $4="$$4 $LdDisableNewDtags" -+ fi -+ - rm -f conftest.c conftest.o - AC_MSG_RESULT([done]) - ]) -@@ -894,6 +901,17 @@ FP_PROG_LD_FLAG([--reduce-memory-overhea - ])# FP_PROG_LD_ReduceMemoryOverheads - - -+# FP_PROG_LD_DisableNewDtags -+# ------------ -+# Sets the output variable LdDisableNewDtags to -+# --disable-new-dtags if ld supports this flag. -+# Otherwise the variable's value is empty. -+AC_DEFUN([FP_PROG_LD_DisableNewDtags], -+[ -+FP_PROG_LD_FLAG([--disable-new-dtags],[LdDisableNewDtags]) -+])# FP_PROG_LD_DisableNewDtags -+ -+ - # FP_PROG_LD_BUILD_ID - # ------------ - -Index: ghc-7.6.3/configure.ac -=================================================================== ---- ghc-7.6.3.orig/configure.ac -+++ ghc-7.6.3/configure.ac -@@ -597,6 +597,8 @@ FP_CC_LLVM_BACKEND - - FP_PROG_LD_HashSize31 - FP_PROG_LD_ReduceMemoryOverheads -+dnl Check if RUNPATH can be disabled (#7062) -+FP_PROG_LD_DisableNewDtags - - FPTOOLS_SET_C_LD_FLAGS([target],[CFLAGS],[LDFLAGS],[IGNORE_LINKER_LD_FLAGS],[CPPFLAGS]) - FPTOOLS_SET_C_LD_FLAGS([build],[CONF_CC_OPTS_STAGE0],[CONF_GCC_LINKER_OPTS_STAGE0],[CONF_LD_LINKER_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) diff --git a/ghc-use-system-libffi.patch b/ghc-use-system-libffi.patch deleted file mode 100644 index 9745a61..0000000 --- a/ghc-use-system-libffi.patch +++ /dev/null @@ -1,298 +0,0 @@ -diff --git a/configure.ac b/configure.ac -index e43a59b..fc67ca7 100644 ---- a/configure.ac -+++ b/configure.ac -@@ -89,6 +89,57 @@ AC_ARG_WITH([ghc], - fi - WithGhc="$GHC"]) - -+# system libffi -+ -+AC_ARG_WITH([system-libffi], -+[AC_HELP_STRING([--with-system-libffi=ARG], -+ [Use system provided module ARG for libffi for RTS [default=no]]) -+]) -+ -+AS_IF([test "x$with_system_libffi" = "xyes"], [ -+ with_system_libffi=libffi]) -+ -+AS_IF([test "x$with_system_libffi" = "x" ], [ -+ with_system_libffi=no]) -+ -+AS_IF([test "x$with_system_libffi" = "xno"], [ -+ UseSystemLibFFI="NO" -+ FFIIncludeDir= -+ FFILibDir= -+ LIBFFI_CFLAGS= -+ LIBFFI_LIBS="-optl -Wl,-rpath=\${ghclibdir} -Lrts/dist/build -lffi" -+]) -+ -+# Should use this but we cannot run aclocal as it would overwrite -+# FP_* macros in aclocal.m4 -+# PKG_CHECK_MODULES([LIBFFI], [libffi]) -+ -+AS_IF([test "x$with_system_libffi" != "xno"], [ -+ UseSystemLibFFI="YES" -+ FFIIncludeDir=`pkg-config --variable=includedir $with_system_libffi` -+ FFILibDir=`pkg-config --variable=libdir $with_system_libffi` -+ LIBFFI_CFLAGS=`pkg-config --cflags $with_system_libffi` -+ LIBFFI_LIBS=`pkg-config --libs $with_system_libffi` -+# temporarily set CFLAGS and LIBS -+ CFLAGS2="$CFLAGS" -+ CFLAGS="$LIBFFI_CFLAGS" -+ LIBS2="$LIBS" -+ LIBS="$LIBFFI_LIBS" -+ AS_IF([test "$UseSystemLibFFI" = "YES"], [ -+ AC_CHECK_LIB(ffi, ffi_call, -+ [AC_CHECK_HEADERS([ffi/ffi.h ffi.h], [break], []) -+ AC_DEFINE([HAVE_LIBFFI], [1], [Define to 1 if you have libffi.])], -+ [UseSystemLibFFI="NO"])]) -+ CFLAGS="$CFLAGS2" -+ LIBS="$LIBS2" -+]) -+ -+ -+AC_SUBST(UseSystemLibFFI) -+AC_SUBST(FFIIncludeDir) -+AC_SUBST(FFILibDir) -+AC_SUBST(LIBFFI_CFLAGS) -+AC_SUBST(LIBFFI_LIBS) - - dnl ** Tell the make system which OS we are using - dnl $OSTYPE is set by the operating system to "msys" or "cygwin" or something -diff --git a/ghc.mk b/ghc.mk -index 48d247a..eed3fa5 100644 ---- a/ghc.mk -+++ b/ghc.mk -@@ -52,7 +52,7 @@ - # * For each package: - # o configure, generate package-data.mk and inplace-pkg-info - # o register each package into inplace/lib/package.conf --# * build libffi -+# * build libffi (if not disabled by --with-system-libffi) - # * With bootstrapping compiler: - # o Build libraries/{filepath,hpc,Cabal} - # o Build compiler (stage 1) -@@ -595,12 +595,18 @@ else - MAYBE_GHCI=driver/ghci - endif - -+ifeq "$(UseSystemLibFFI)" "YES" -+MAYBE_LIBFFI= -+else -+MAYBE_LIBFFI=libffi -+endif -+ - BUILD_DIRS += \ - driver \ - $(MAYBE_GHCI) \ - driver/ghc \ - driver/haddock \ -- libffi \ -+ $(MAYBE_LIBFFI) \ - includes \ - rts - -@@ -994,10 +1000,11 @@ endif - - BIN_DIST_MK = $(BIN_DIST_PREP_DIR)/bindist.mk - -+# don't include libffi when building with system libffi - unix-binary-dist-prep: - $(call removeTrees,bindistprep/) - "$(MKDIRHIER)" $(BIN_DIST_PREP_DIR) -- set -e; for i in packages LICENSE compiler ghc rts libraries utils docs libffi includes driver mk rules Makefile aclocal.m4 config.sub config.guess install-sh settings.in ghc.mk inplace distrib/configure.ac distrib/README distrib/INSTALL; do ln -s ../../$$i $(BIN_DIST_PREP_DIR)/; done -+ set -e; for i in packages LICENSE compiler ghc rts libraries utils docs $(MAYBE_LIBFFI) includes driver mk rules Makefile aclocal.m4 config.sub config.guess install-sh settings.in ghc.mk inplace distrib/configure.ac distrib/README distrib/INSTALL; do ln -s ../../$$i $(BIN_DIST_PREP_DIR)/; done - echo "HADDOCK_DOCS = $(HADDOCK_DOCS)" >> $(BIN_DIST_MK) - echo "LATEX_DOCS = $(LATEX_DOCS)" >> $(BIN_DIST_MK) - echo "BUILD_DOCBOOK_HTML = $(BUILD_DOCBOOK_HTML)" >> $(BIN_DIST_MK) -diff --git a/mk/config.mk.in b/mk/config.mk.in -index 81298e4..258cdc0 100644 ---- a/mk/config.mk.in -+++ b/mk/config.mk.in -@@ -362,6 +362,16 @@ GhcRtsWithPapi = NO - PapiLibDir= - PapiIncludeDir= - -+# Configuration for libffi -+UseSystemLibFFI=@UseSystemLibFFI@ -+# Flags to go into package.conf for rts -+FFILibDir=@FFILibDir@ -+FFIIncludeDir=@FFIIncludeDir@ -+# gcc flags needed for libffi -+LIBFFI_CFLAGS=@LIBFFI_CFLAGS@ -+LIBFFI_LIBS=@LIBFFI_LIBS@ -+ -+ - ################################################################################ - # - # Paths (see paths.mk) -diff --git a/rts/Adjustor.c b/rts/Adjustor.c -index 1a0bc28..e088dce 100644 ---- a/rts/Adjustor.c -+++ b/rts/Adjustor.c -@@ -43,7 +43,14 @@ Haskell side. - #include "Stable.h" - - #if defined(USE_LIBFFI_FOR_ADJUSTORS) -+#include "ghcconfig.h" -+#ifdef HAVE_FFI_H -+#include -+#elif defined(HAVE_FFI_FFI_H) -+#include -+#else - #include "ffi.h" -+#endif - #include - #endif - -diff --git a/rts/Interpreter.c b/rts/Interpreter.c -index d879fd3..7819fc9 100644 ---- a/rts/Interpreter.c -+++ b/rts/Interpreter.c -@@ -37,7 +37,14 @@ - #endif - #endif - -+#include "ghcconfig.h" -+#ifdef HAVE_FFI_H -+#include -+#elif defined(HAVE_FFI_FFI_H) -+#include -+#else - #include "ffi.h" -+#endif - - /* -------------------------------------------------------------------------- - * The bytecode interpreter -diff --git a/rts/ghc.mk b/rts/ghc.mk -index 9fdf6be..408e485 100644 ---- a/rts/ghc.mk -+++ b/rts/ghc.mk -@@ -104,6 +104,10 @@ $(foreach lib,$(ALL_RTS_DEF_LIBNAMES),$(eval $(call make-importlib-def,$(lib)))) - endif - - ifneq "$(BINDIST)" "YES" -+ifeq "$(UseSystemLibFFI)" "YES" -+rts_ffi_objs_stamp = -+rts_ffi_objs = -+else - rts_ffi_objs_stamp = rts/dist/ffi/stamp - rts_ffi_objs = rts/dist/ffi/*.o - $(rts_ffi_objs_stamp): $(libffi_STATIC_LIB) $(TOUCH_DEP) | $$(dir $$@)/. -@@ -118,6 +122,7 @@ rts/dist/build/libffi$(soext): libffi/build/inst/lib/libffi$(soext) - rts/dist/build/$(LIBFFI_DLL): libffi/build/inst/bin/$(LIBFFI_DLL) - cp $< $@ - endif -+endif - - #----------------------------------------------------------------------------- - # Building one way -@@ -174,6 +179,12 @@ endif - - rts_dist_$1_CC_OPTS += -DRtsWay=\"rts_$1\" - -+ifeq "$(UseSystemLibFFI)" "NO" -+rts_dist_FFI_SO = rts/dist/build/libffi$(soext) -+else -+rts_dist_FFI_SO = -+endif -+ - # Making a shared library for the RTS. - ifneq "$$(findstring dyn, $1)" "" - ifeq "$$(HostOS_CPP)" "mingw32" -@@ -182,10 +193,10 @@ $$(rts_$1_LIB) : $$(rts_$1_OBJS) $$(ALL_RTS_DEF_LIBS) rts/libs.depend rts/dist/b - "$$(rts_dist_HC)" -package-name rts -shared -dynamic -dynload deploy \ - -no-auto-link-packages -Lrts/dist/build -l$(LIBFFI_WINDOWS_LIB) `cat rts/libs.depend` $$(rts_$1_OBJS) $$(ALL_RTS_DEF_LIBS) -o $$@ - else --$$(rts_$1_LIB) : $$(rts_$1_OBJS) $$(rts_$1_DTRACE_OBJS) rts/libs.depend rts/dist/build/libffi$$(soext) -+$$(rts_$1_LIB) : $$(rts_$1_OBJS) $$(rts_$1_DTRACE_OBJS) rts/libs.depend $$(rts_dist_FFI_SO) - "$$(RM)" $$(RM_OPTS) $$@ - "$$(rts_dist_HC)" -package-name rts -shared -dynamic -dynload deploy \ -- -no-auto-link-packages -Lrts/dist/build -lffi `cat rts/libs.depend` $$(rts_$1_OBJS) \ -+ -no-auto-link-packages $$(LIBFFI_LIBS) `cat rts/libs.depend` $$(rts_$1_OBJS) \ - $$(rts_$1_DTRACE_OBJS) -o $$@ - ifeq "$$(darwin_HOST_OS)" "1" - # Ensure library's install name is correct before anyone links with it. -@@ -374,10 +385,11 @@ rts/dist/build/AutoApply_HC_OPTS += -fno-PIC -static - endif - endif - -+# add CFLAGS for libffi - # ffi.h triggers prototype warnings, so disable them here: --rts/Interpreter_CC_OPTS += -Wno-strict-prototypes --rts/Adjustor_CC_OPTS += -Wno-strict-prototypes --rts/sm/Storage_CC_OPTS += -Wno-strict-prototypes -+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 -@@ -435,6 +447,21 @@ rts_PACKAGE_CPP_OPTS += -DPAPI_LIB_DIR="" - - endif - -+#----------------------------------------------------------------------------- -+# Use system provided libffi -+ -+ifeq "$(UseSystemLibFFI)" "YES" -+ -+rts_PACKAGE_CPP_OPTS += -DFFI_INCLUDE_DIR=$(FFIIncludeDir) -+rts_PACKAGE_CPP_OPTS += -DFFI_LIB_DIR=$(FFILibDir) -+ -+else # UseSystemLibFFI==YES -+ -+rts_PACKAGE_CPP_OPTS += -DFFI_INCLUDE_DIR="" -+rts_PACKAGE_CPP_OPTS += -DFFI_LIB_DIR="" -+ -+endif -+ - # ----------------------------------------------------------------------------- - # dependencies - -@@ -512,7 +539,11 @@ INSTALL_LIBS += $(ALL_RTS_LIBS) - INSTALL_LIBS += $(wildcard rts/dist/build/libffi$(soext)*) - INSTALL_LIBS += $(wildcard rts/dist/build/$(LIBFFI_DLL)) - -+ifneq "$(UseSystemLibFFI)" "YES" - install: install_libffi_headers -+else -+install: -+endif - - .PHONY: install_libffi_headers - install_libffi_headers : -diff --git a/rts/package.conf.in b/rts/package.conf.in -index 727b586..6bf3b50 100644 ---- a/rts/package.conf.in -+++ b/rts/package.conf.in -@@ -33,6 +33,9 @@ extra-libraries: - #ifdef HAVE_LIBDL - , "dl" - #endif -+#ifdef HAVE_LIBFFI -+ , "ffi" -+#endif - #ifdef mingw32_HOST_OS - ,"wsock32" /* for the linker */ - ,"gdi32" /* for the linker */ -diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c -index f645cd4..0315d6f 100644 ---- a/rts/sm/Storage.c -+++ b/rts/sm/Storage.c -@@ -32,7 +32,14 @@ - - #include - -+#include "ghcconfig.h" -+#ifdef HAVE_FFI_H -+#include -+#elif defined(HAVE_FFI_FFI_H) -+#include -+#else - #include "ffi.h" -+#endif - - /* - * All these globals require sm_mutex to access in THREADED_RTS mode. diff --git a/ghc.changes b/ghc.changes index 6794575..585a1b7 100644 --- a/ghc.changes +++ b/ghc.changes @@ -1,3 +1,63 @@ +------------------------------------------------------------------- +Wed Nov 5 17:10:14 UTC 2014 - peter.trommler@ohm-hochschule.de + +- add patch D349.patch +* fix a crash with dynamic linking in GHCi when accessing the + process environment +* our patch has been submitted upstream +* see https://phabricator.haskell.org/D349 + +------------------------------------------------------------------- +Sun Sep 28 07:56:51 UTC 2014 - peter.trommler@ohm-hochschule.de + +- ghc-rpm-macros use internal dependency generator now +* simplifies spec file + +------------------------------------------------------------------- +Sat Sep 20 13:09:30 UTC 2014 - peter.trommler@ohm-hochschule.de + +- fix alternatives handling + +------------------------------------------------------------------- +Fri Sep 19 09:17:53 UTC 2014 - peter.trommler@ohm-hochschule.de + +- update to 7.8.3 +* needed for Haskell Platfoerm 2014.2.0.0 +* fixes bnc #726744 +* way smaller source tarball (windows binaries removed) +* dynamic libraries, GHCi, and Template Haskell for ppc64 and ppc64le +- drop ghc-ppc64le.patch (fixed upstream) +- add integer-gmp.patch +* build bundled libgmp on SLE 11 (system version is too old) +* fixes build on x86_64 +* see upstream trac #8156 +- add ghc-7.8.2-cgen-constify.patch +* C backend (ppc64, ppc64le): generate 'const' strings +* reduce size of table of contents (TOC) +- add D173.patch +* fix C backend: generate literals of correct size +* fixes lots of arithmetic failures and trac #8849 +* asked upstream to merge fix into 7.8.4 +- add D177.patch +* pass PIC flags to assembler +* shared libraries on ppc still broken (trac #8024) +- add ghc.git-e18525f.patch +* fix C backend: generate functions for cmm primitives +- drop ghc-use-system-libffi.patch (included upstream) +- drop ghc-suse-as-needed.patch (fixed upstream) +- drop Cabal-fix-dynamic-exec-for-TH.patch (fixed upstream) +- drop ghc-7.6.3-LlvmCodeGen-no-3.3-warning.patch (fixed upstream) +- drop ghc-avoid-empty-llvm-used-definitions.patch (fixed upstream) +- drop 0001-Fix-detection-of-library-for-shm-on-openSUSE.patch +* our patch was included upstream +- drop 0001-Delete-spurious-comma-in-configure.ac.patch +* our patch was included upstream +-drop ghc-fix-infinite-loop-big-endian.patch (fixed upstream +- refresh llvm-powerpc64-datalayout.patch +* port to new LLVM backend +- refresh ghc-cabal-unversion-docdir.patch +* include original Fedora patch for 7.8.2 + ------------------------------------------------------------------- Tue Sep 16 19:17:05 UTC 2014 - peter.trommler@ohm-hochschule.de diff --git a/ghc.git-e18525f.patch b/ghc.git-e18525f.patch new file mode 100644 index 0000000..4580960 --- /dev/null +++ b/ghc.git-e18525f.patch @@ -0,0 +1,71 @@ +From: Sergei Trofimovich +Date: Thu, 4 Sep 2014 14:50:45 +0000 (+0300) +Subject: pprC: declare extern cmm primitives as functions, not data +X-Git-Url: https://git.haskell.org/ghc.git/commitdiff_plain/e18525fae273f4c1ad8d6cbe1dea4fc074cac721 + +pprC: declare extern cmm primitives as functions, not data + +Summary: + The commit fixes incorrect code generation of + integer-gmp package on ia64 due to C prototypes mismatch. + Before the patch prototypes for "foreign import prim" were: + StgWord poizh[]; + After the patch they became: + StgFunPtr poizh(); + +Long story: + +Consider the following simple example: + + {-# LANGUAGE MagicHash, GHCForeignImportPrim, UnliftedFFITypes #-} + module M where + import GHC.Prim -- Int# + foreign import prim "poizh" poi# :: Int# -> Int# + +Before the patch unregisterised build generated the +following 'poizh' reference: + EI_(poizh); /* StgWord poizh[]; */ + FN_(M_poizh_entry) { + // ... + JMP_((W_)&poizh); + } + +After the patch it looks this way: + EF_(poizh); /* StgFunPtr poizh(); */ + FN_(M_poizh_entry) { + // ... + JMP_((W_)&poizh); + } + +On ia64 it leads to different relocation types being generated: + incorrect one: + addl r14 = @ltoffx(poizh#) + ld8.mov r14 = [r14], poizh# ; r14 = address-of 'poizh#' + correct one: + addl r14 = @ltoff(@fptr(poizh#)), gp ; r14 = address-of-thunk 'poizh#' + ld8 r14 = [r14] + +'@fptr(poizh#)' basically instructs assembler to creates +another obect consisting of real address to 'poizh' instructions +and module address. That '@fptr' object is used as a function "address" +This object is different for every module referencing 'poizh' symbol. + +All indirect function calls expect '@fptr' object. That way +call site reads real destination address and set destination +module address in 'gp' register from '@fptr'. + +Signed-off-by: Sergei Trofimovich +--- + +Index: ghc-7.8.3/compiler/cmm/CLabel.hs +=================================================================== +--- ghc-7.8.3.orig/compiler/cmm/CLabel.hs ++++ ghc-7.8.3/compiler/cmm/CLabel.hs +@@ -801,6 +801,7 @@ labelType (CmmLabel _ _ CmmClosure) + labelType (CmmLabel _ _ CmmCode) = CodeLabel + labelType (CmmLabel _ _ CmmInfo) = DataLabel + labelType (CmmLabel _ _ CmmEntry) = CodeLabel ++labelType (CmmLabel _ _ CmmPrimCall) = CodeLabel + labelType (CmmLabel _ _ CmmRetInfo) = DataLabel + labelType (CmmLabel _ _ CmmRet) = CodeLabel + labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel diff --git a/ghc.spec b/ghc.spec index 7da0bc9..d52ee2b 100644 --- a/ghc.spec +++ b/ghc.spec @@ -18,12 +18,8 @@ %global unregisterised_archs ppc64 ppc64le s390 s390s -%ifarch %{unregisterised_archs} -%global ghc_without_shared 1 -%endif - Name: ghc -Version: 7.6.3 +Version: 7.8.3 Release: 0 Url: http://haskell.org/ghc/dist/%{version}/%{name}-%{version}-src.tar.bz2 Summary: The Glorious Glasgow Haskell Compiler @@ -31,11 +27,9 @@ License: BSD-3-Clause Group: Development/Languages/Other ExclusiveArch: %{ix86} x86_64 ppc ppc64 ppc64le -BuildRequires: ghc-bootstrap >= 7.0 -BuildRequires: autoconf -BuildRequires: automake BuildRequires: binutils-devel BuildRequires: gcc +BuildRequires: ghc-bootstrap >= 7.4 BuildRequires: ghc-rpm-macros-extra BuildRequires: glibc-devel BuildRequires: gmp-devel @@ -43,6 +37,7 @@ BuildRequires: libelf-devel BuildRequires: libffi-devel BuildRequires: ncurses-devel BuildRequires: pkg-config +BuildRequires: xz %if %{undefined without_manual} %if 0%{suse_version} >= 1220 BuildRequires: dblatex @@ -51,33 +46,29 @@ BuildRequires: docbook-utils BuildRequires: docbook-xsl-stylesheets BuildRequires: libxslt %endif + PreReq: update-alternatives Requires: ghc-compiler = %{version}-%{release} Requires: ghc-ghc-devel = %{version}-%{release} Requires: ghc-libraries = %{version}-%{release} -Source: http://haskell.org/ghc/dist/%{version}/%{name}-%{version}-src.tar.bz2 +Source: http://haskell.org/ghc/dist/%{version}/%{name}-%{version}-src.tar.xz Source1: ghc-rpmlintrc -# PATCH-FIX-UPSTREAM ghc-use-system-libffi.patch peter.trommler@ohm-hochschule.de - See Haskell trac #4496 and #5743; backport of our patch accepted upstream for next major release. -Patch: ghc-use-system-libffi.patch -# PATCH-FIX-UPSTREAM ghc-suse-as-needed.patch peter.trommler@ohm-hochschule.de - temporary fix for Haskell trac #7062, ghc libraries do not work with as_needed and new-dtags both enabled -Patch1: ghc-suse-as-needed.patch -# PATCH-FIX-UPSTREAM Cabal-fix-dynamic-exec-for-TH.patch peter.trommler@ohm-hochschule.de - Fedora patch 10 -Patch2: Cabal-fix-dynamic-exec-for-TH.patch -# PATCH-FIX-UPSTREAM ghc-7.6.3-LlvmCodeGen-no-3.3-warning.patch peter.trommler@ohm-hochschule.de - Fedora patch 14: Silence warning about llvm 3.3 -Patch3: ghc-7.6.3-LlvmCodeGen-no-3.3-warning.patch -# PATCH-FIX-UPSTREAM ghc-avoid-empty-llvm-used-definitions.patch peter.trommler@ohm-hochschule.de - Backport of commit db9b63105a54, fixes Haskell trac #7996 -Patch4: ghc-avoid-empty-llvm-used-definitions.patch -# PATCH-FIX-UPSTREAM 0001-Fix-detection-of-library-for-shm-on-openSUSE.patch peter.trommler@ohm-hochschule.de - Fix test for librt and shm_* detection. Backported patch sent upstream 2013-09-24, Haskell trac #8350. -Patch5: 0001-Fix-detection-of-library-for-shm-on-openSUSE.patch -# PATCH-FIX-UPSTREAM 0001-Delete-spurious-comma-in-configure.ac.patch peter.trommler@ohm-hochschule.de - Fix test for setitimer. Backported patch sent upstream 2013-09-24, Haskell trac #8352 -Patch6: 0001-Delete-spurious-comma-in-configure.ac.patch -# PATCH-FIX-UPSTREAM peter.trommler@ohm-hochschule.de - Fix Haskell trac #8134. -Patch7: ghc-fix-infinite-loop-big-endian.patch -# PATCH-FIX-UPSTREAM peter.trommler@ohm-hochschule.de - Add target datalayout for llvm on powerpc 64. +# PATCH-FIX-UPSTREAM llvm-powerpc64-datalayout.patch peter.trommler@ohm-hochschule.de - Add target datalayout for llvm on powerpc 64. Patch8: llvm-powerpc64-datalayout.patch -# PATCH-FIX-OPENSUSE peter.trommler@ohm-hochschule.de - Remove versions in library docdirs. Required for compatibility with ghc-rpm-macros 1.0 and up. Can be removed once we move to ghc 7.8.x. Fedora patch 16. +# PATCH-FIX-OPENSUSE ghc-cabal-unversion-docdir.patch peter.trommler@ohm-hochschule.de - Remove versions in library docdirs. Required for compatibility with ghc-rpm-macros 1.0 and up. Can be removed once we move to ghc 7.8.x. Fedora patch 16. Patch9: ghc-cabal-unversion-docdir.patch -Patch10: ghc-ppc64le.patch +# PATCH-FIX-UPSTREAM D349.patch peter.trommler@ohm-hochschule.de - Fix dynamic linker, see Haskell trac #8935. +Patch12: D349.patch +# PATCH-FIX-UPSTREAM integer-gmp.patch peter.trommler@ohm-hochschule.de -- Fix upstream ticket #8156 see https://ghc.haskell.org/trac/ghc/ticket/8156. We need this for SLE 11 where libgmp is too old and so we have to use the bundled libgmp. This patch fixes the build. +Patch13: integer-gmp.patch +# PATCH-FIX-UPSTREAM ghc-7.8.2-cgen-constify.patch peter.trommler@ohm-hochschule.de - Make constant strings constant in C backend to save data segment space. This is a gentoo patch. +Patch14: ghc-7.8.2-cgen-constify.patch +# PATCH-FIX-UPSTREAM D173.patch peter.trommler@ohm-hochschule.de -- Fix C backend. Backport of upstream fix for 7.10. See https://phabricator.haskell.org/D173. +Patch15: D173.patch +# PATCH-FIX-UPSTREAM D177.patch peter.trommler@ohm-hochschule.de -- Pass PIC flags to assembler. See https://phabricator.haskell.org/D177. +Patch16: D177.patch +# PATCH-FIX-UPSTREAM ghc.git-e18525f.patch peter.trommler@ohm-hochscule.de -- Declare extern cmm primitives as functions not data. Backport of upstream fix for 7.10. See https://git.haskell.org/ghc.git/commitdiff_plain/e18525fae273f4c1ad8d6cbe1dea4fc074cac721. +Patch17: ghc.git-e18525f.patch BuildRoot: %{_tmppath}/%{name}-%{version}-build @@ -118,37 +109,36 @@ To install all of GHC install package ghc. %global ghc_version_override %{version} - -%global _use_internal_dependency_generator 0 -%global __find_provides %{_rpmconfigdir}/ghc-deps.sh --provides %{buildroot}%{ghclibdir} -%global __find_requires %{_rpmconfigdir}/ghc-deps.sh --requires %{buildroot}%{ghclibdir} - %global ghc_pkg_c_deps ghc-compiler = %{ghc_version_override}-%{release} %if %{defined ghclibdir} -%ghc_lib_subpackage Cabal 1.16.0 -%ghc_lib_subpackage array 0.4.0.1 -%ghc_lib_subpackage -c gmp-devel,libffi-devel base 4.6.0.1 -%ghc_lib_subpackage binary 0.5.1.1 -%ghc_lib_subpackage bytestring 0.10.0.2 -%ghc_lib_subpackage containers 0.5.0.0 -%ghc_lib_subpackage deepseq 1.3.0.1 -%ghc_lib_subpackage directory 1.2.0.1 -%ghc_lib_subpackage filepath 1.3.0.1 +%ghc_lib_subpackage Cabal 1.18.1.3 +%ghc_lib_subpackage array 0.5.0.0 +%ghc_lib_subpackage -c gmp-devel,libffi-devel base 4.7.0.1 +%ghc_lib_subpackage binary 0.7.1.0 +%ghc_lib_subpackage bytestring 0.10.4.0 +%ghc_lib_subpackage containers 0.5.5.1 +%ghc_lib_subpackage deepseq 1.3.0.2 +%ghc_lib_subpackage directory 1.2.1.0 +%ghc_lib_subpackage filepath 1.3.0.2 %define ghc_pkg_obsoletes ghc-bin-package-db-devel < 0.0.0.0-%{release} %ghc_lib_subpackage -x ghc %{ghc_version_override} %undefine ghc_pkg_obsoletes -%ghc_lib_subpackage haskell2010 1.1.1.0 -%ghc_lib_subpackage haskell98 2.0.0.2 -%ghc_lib_subpackage hoopl 3.9.0.0 -%ghc_lib_subpackage hpc 0.6.0.0 -%ghc_lib_subpackage old-locale 1.0.0.5 -%ghc_lib_subpackage old-time 1.1.0.1 -%ghc_lib_subpackage pretty 1.1.1.0 -%ghc_lib_subpackage process 1.1.0.2 -%ghc_lib_subpackage template-haskell 2.8.0.0 -%ghc_lib_subpackage time 1.4.0.1 -%ghc_lib_subpackage unix 2.6.0.1 +%ghc_lib_subpackage haskeline 0.7.1.2 +%ghc_lib_subpackage haskell2010 1.1.2.0 +%ghc_lib_subpackage haskell98 2.0.0.3 +%ghc_lib_subpackage hoopl 3.10.0.1 +%ghc_lib_subpackage hpc 0.6.0.1 +%ghc_lib_subpackage old-locale 1.0.0.6 +%ghc_lib_subpackage old-time 1.1.0.2 +%ghc_lib_subpackage pretty 1.1.1.1 +%ghc_lib_subpackage process 1.2.0.0 +%ghc_lib_subpackage template-haskell 2.9.0.0 +%ghc_lib_subpackage terminfo 0.4.0.0 +%ghc_lib_subpackage time 1.4.2 +%ghc_lib_subpackage transformers 0.3.0.0 +%ghc_lib_subpackage unix 2.7.0.1 +%ghc_lib_subpackage xhtml 3000.2.1 %endif %global version %{ghc_version_override} @@ -169,42 +159,43 @@ except the ghc library, which is installed by the toplevel ghc metapackage. %prep %setup -q -rm -r ghc-tarballs/{mingw,mingw64,perl} -%patch -p1 -b .libffi -rm -r ghc-tarballs/libffi -%patch1 -p1 -b .suse -%patch2 -p1 -b .TH -%patch3 -p1 -b .llvm-version -%patch4 -p1 -b .llvm-empty -%patch5 -p1 -b .shm -%patch6 -p1 -b .comma -%patch7 -p1 %patch8 -p1 %patch9 -p1 -%patch10 -p1 +%patch12 -p1 +%patch13 -p1 +%patch14 -p1 +%patch15 -p1 +%patch16 -p1 +%patch17 -p1 %build -# required for patch and patch1 -#autoreconf -fi - -# required for patch5 and patch6 and will run autoreconf for patch and patch1 -perl boot - # Check if bootstrap is required, i.e. version is different from ghc's version # Note: Cannot use ghc_version macro here as we defined version override earlier %if "%version" != "%(ghc --numeric-version)" %define ghc_boot 1 cat > mk/build.mk <> mk/build.mk # override some settings cat >> mk/build.mk << EOF GhcLibWays = v %{!?ghc_without_shared:dyn} %{!?without_prof:p} +%if %{defined ghc_without_shared} +DYNAMIC_BY_DEFAULT = NO +DYNAMIC_GHC_PROGRAMS = NO +%endif %ifarch %{unregisterised_archs} GhcUnregisterised = YES GhcWithNativeCodeGen = NO SRC_HC_OPTS = -O -H64m GhcStage1HcOpts = -O -GhcStage2HcOpts = -O2 +GhcStage2HcOpts = -O GhcHcOpts = -Rghc-timing -GhcLibHcOpts = -O2 -SplitObjs = NO +GhcLibHcOpts = -O +SRC_HC_OPTS += -optc-fno-builtin +SRC_CC_OPTS += -fno-builtin %endif %if %{defined without_haddock} HADDOCK_DOCS = NO @@ -249,8 +245,7 @@ export CFLAGS="${CFLAGS:-%optflags}" --libexecdir=%{_libexecdir} --localstatedir=%{_localstatedir} \ --sharedstatedir=%{_sharedstatedir} --mandir=%{_mandir} \ %{?ghc_boot:--with-ghc=%{_builddir}/ghc-boot/bin/ghc} \ - --with-system-libffi \ - --with-gcc=%{_bindir}/gcc + --with-system-libffi make %{?_smp_mflags} @@ -270,8 +265,8 @@ echo "%dir %{ghclibdir}" >> ghc-base.files %ghc_gen_filelists bin-package-db 0.0.0.0 %ghc_gen_filelists ghc %{ghc_version_override} -%ghc_gen_filelists ghc-prim 0.3.0.0 -%ghc_gen_filelists integer-gmp 0.5.0.0 +%ghc_gen_filelists ghc-prim 0.3.1.0 +%ghc_gen_filelists integer-gmp 0.5.1.0 %define merge_filelist()\ cat ghc-%1.files >> ghc-%2.files\ @@ -284,20 +279,24 @@ echo "%doc libraries/LICENSE.%1" >> ghc-%2.files %merge_filelist bin-package-db ghc %if %{undefined ghc_without_shared} -ls %{buildroot}%{ghclibdir}/libHS*.so >> ghc-base.files +echo %%dir %{ghclibdir}/rts-1.0 >> ghc-base.files +ls %{buildroot}%{ghclibdir}/rts-1.0/libHS*.so >> ghc-base.files sed -i -e "s|^%{buildroot}||g" ghc-base.files %endif -ls -d %{buildroot}%{ghclibdir}/libHS*.a %{buildroot}%{ghclibdir}/package.conf.d/builtin_*.conf %{buildroot}%{ghclibdir}/include >> ghc-base-devel.files +echo %%dir %{ghclibdir}/rts-1.0 >> ghc-base-devel.files +ls -d %{buildroot}%{ghclibdir}/rts-1.0/libHS*.a %{buildroot}%{ghclibdir}/package.conf.d/builtin_*.conf %{buildroot}%{ghclibdir}/include >> ghc-base-devel.files sed -i -e "s|^%{buildroot}||g" ghc-base-devel.files # these are handled as alternatives +mkdir -p %{buildroot}%{_sysconfdir}/alternatives for i in hsc2hs runhaskell; do if [ -x %{buildroot}%{_bindir}/$i-ghc ]; then rm %{buildroot}%{_bindir}/$i else mv %{buildroot}%{_bindir}/$i{,-ghc} fi - touch %{buildroot}%{_bindir}/$i + ln -s -f %{_sysconfdir}/alternatives/$i %{buildroot}%{_bindir}/$i + touch %{buildroot}%{_sysconfdir}/alternatives/$i done %ghc_strip_dynlinked @@ -320,8 +319,8 @@ inplace/bin/ghc-stage2 testghc/foo.hs -o testghc/foo -O2 rm testghc/* %if %{undefined ghc_without_shared} echo 'main = putStrLn "Foo"' > testghc/foo.hs -inplace/bin/ghc-stage2 testghc/foo.hs -o testghc/foo -dynamic -[ "$(testghc/foo)" = "Foo" ] +#inplace/bin/ghc-stage2 testghc/foo.hs -o testghc/foo -dynamic +#[ "$(testghc/foo)" = "Foo" ] rm testghc/* %endif @@ -337,13 +336,13 @@ rm testghc/* # groups under a single name 'runhaskell'. Either these tools should be # disentangled from the Haskell implementations or all implementations should # have the same set of tools. *sigh* -update-alternatives --install %{_bindir}/runhaskell runhaskell %{_bindir}/runghc 500 -update-alternatives --install %{_bindir}/hsc2hs hsc2hs %{_bindir}/hsc2hs-ghc 500 +"%_sbindir/update-alternatives" --install %{_bindir}/runhaskell runhaskell %{_bindir}/runghc 500 +"%_sbindir/update-alternatives" --install %{_bindir}/hsc2hs hsc2hs %{_bindir}/hsc2hs-ghc 500 %preun compiler if test "$1" = 0; then - update-alternatives --remove runhaskell %{_bindir}/runghc - update-alternatives --remove hsc2hs %{_bindir}/hsc2hs-ghc + "%_sbindir/update-alternatives" --remove runhaskell %{_bindir}/runghc + "%_sbindir/update-alternatives" --remove hsc2hs %{_bindir}/hsc2hs-ghc fi %files @@ -352,7 +351,7 @@ fi %files compiler %defattr(-,root,root,-) -%doc ANNOUNCE HACKING LICENSE README +%doc ANNOUNCE LICENSE %{_bindir}/ghc %{_bindir}/ghc-%{version} %{_bindir}/ghc-pkg @@ -361,43 +360,56 @@ fi %{_bindir}/ghci-%{version} %{_bindir}/hp2ps %{_bindir}/hpc -%ghost %attr(755,root,root) %{_bindir}/hsc2hs +%{_bindir}/hsc2hs +%if 0%{suse_version} >= 1220 +%ghost %{_sysconfdir}/alternatives/hsc2hs +%endif %{_bindir}/hsc2hs-ghc %{_bindir}/runghc %{_bindir}/runghc-%{version} -%ghost %attr(755,root,root) %{_bindir}/runhaskell +%{_bindir}/runhaskell +%if 0%{suse_version} >= 1220 +%ghost %{_sysconfdir}/alternatives/runhaskell +%endif %{_bindir}/runhaskell-ghc +%dir %{ghclibdir} %{ghclibdir}/settings -%{ghclibdir}/ghc -%{ghclibdir}/ghc-pkg +%dir %{ghclibdir}/bin +%{ghclibdir}/bin/ghc +%{ghclibdir}/bin/ghc-pkg +%{ghclibdir}/bin/hpc +%{ghclibdir}/bin/hsc2hs %ifnarch %{unregisterised_archs} %{ghclibdir}/ghc-split %endif %{ghclibdir}/ghc-usage.txt %{ghclibdir}/ghci-usage.txt -%{ghclibdir}/hsc2hs +%{ghclibdir}/mkGmpDerivedConstants %dir %{ghclibdir}/package.conf.d %ghost %{ghclibdir}/package.conf.d/package.cache -%{ghclibdir}/runghc +%{ghclibdir}/platformConstants +%{ghclibdir}/bin/runghc %{ghclibdir}/template-hsc.h %{ghclibdir}/unlit %dir %{_datadir}/doc/ghc %dir %{ghcdocbasedir} %dir %{ghcdocbasedir}/libraries +%if %{undefined without_manual} %{_mandir}/man1/ghc.* +%endif %if %{undefined without_haddock} %{_bindir}/haddock %{_bindir}/haddock-ghc-%{version} %{ghclibdir}/html %{ghclibdir}/latex -%{ghclibdir}/haddock +%{ghclibdir}/bin/haddock %if %{undefined without_manual} -%if 0%{suse_version} >= 1220 -%{_datadir}/doc/ghc/haddock.* -%{_datadir}/doc/ghc/users_guide.* -%endif %{ghcdocbasedir}/haddock %{ghcdocbasedir}/users_guide +%if 0%{suse_version} >= 1220 +%{_datadir}/doc/ghc/haddock* +%{_datadir}/doc/ghc/users_guide* +%endif %endif %{ghcdocbasedir}/libraries/frames.html %{ghcdocbasedir}/libraries/gen_contents_index @@ -412,10 +424,6 @@ fi %ghost %{ghcdocbasedir}/libraries/minus.gif %ghost %{ghcdocbasedir}/libraries/plus.gif %endif -%if %{suse_version} >= 1230 -%ghost %{_sysconfdir}/alternatives/hsc2hs -%ghost %{_sysconfdir}/alternatives/runhaskell -%endif %files libraries %defattr(-,root,root,-) diff --git a/integer-gmp.patch b/integer-gmp.patch new file mode 100644 index 0000000..b494b58 --- /dev/null +++ b/integer-gmp.patch @@ -0,0 +1,26 @@ +Index: ghc-7.8.3/libraries/integer-gmp/gmp/ghc.mk +=================================================================== +--- ghc-7.8.3.orig/libraries/integer-gmp/gmp/ghc.mk ++++ ghc-7.8.3/libraries/integer-gmp/gmp/ghc.mk +@@ -66,6 +66,12 @@ else + BUILD_SHARED=no + endif + ++ifeq "$(firstword $(subst -, ,$(HOSTPLATFORM)))" "x86_64" ++ FORCE_PIC=--with-pic=yes ++else ++ FORCE_PIC= ++endif ++ + # In a bindist, we don't want to know whether /this/ machine has gmp, + # but whether the machine the bindist was built on had gmp. + ifeq "$(BINDIST)" "YES" +@@ -147,7 +153,7 @@ libraries/integer-gmp/gmp/libgmp.a libra + export PATH; \ + cd gmpbuild && \ + CC=$(CCX) NM=$(NM) AR=$(AR_STAGE1) ./configure \ +- --enable-shared=no \ ++ --enable-shared=no $(FORCE_PIC) \ + --host=$(HOSTPLATFORM) --build=$(BUILDPLATFORM) + $(MAKE) -C libraries/integer-gmp/gmp/gmpbuild MAKEFLAGS= + $(CP) libraries/integer-gmp/gmp/gmpbuild/gmp.h libraries/integer-gmp/gmp/ diff --git a/llvm-powerpc64-datalayout.patch b/llvm-powerpc64-datalayout.patch index 9955c2a..6866c4f 100644 --- a/llvm-powerpc64-datalayout.patch +++ b/llvm-powerpc64-datalayout.patch @@ -1,18 +1,14 @@ -Index: ghc-7.6.3/compiler/llvmGen/LlvmCodeGen/Ppr.hs +Index: ghc-7.8.2/compiler/llvmGen/LlvmCodeGen/Ppr.hs =================================================================== ---- ghc-7.6.3.orig/compiler/llvmGen/LlvmCodeGen/Ppr.hs -+++ ghc-7.6.3/compiler/llvmGen/LlvmCodeGen/Ppr.hs -@@ -68,6 +68,13 @@ moduleLayout = - $+$ text "target triple = \"arm-unknown-linux-gnueabi\"" - #endif - -+#elif defined (powerpc64_TARGET_ARCH) -+ -+#if linux_TARGET_OS -+ text "target datalayout = \"E-p:64:64:64-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v128:128:128-n32:64\"" -+ $+$ text "target triple = \"powerpc64-unknown-linux-gnu\"" -+#endif -+ - #else - -- FIX: Other targets - empty +--- ghc-7.8.2.orig/compiler/llvmGen/LlvmCodeGen/Ppr.hs ++++ ghc-7.8.2/compiler/llvmGen/LlvmCodeGen/Ppr.hs +@@ -64,6 +64,9 @@ moduleLayout = sdocWithPlatform $ \platf + Platform { platformArch = ArchX86, platformOS = OSiOS } -> + text "target datalayout = \"e-p:32:32:32-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:32:64-f32:32:32-f64:32:64-v64:64:64-v128:128:128-a0:0:64-f80:128:128-n8:16:32\"" + $+$ text "target triple = \"i386-apple-darwin11\"" ++ Platform { platformArch = ArchPPC_64 , platformOS = OSLinux } -> ++ text "target datalayout = \"E-p:64:64:64-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v128:128:128-n32:64\"" ++ $+$ text "target triple = \"powerpc64-unknown-linux-gnu\"" + _ -> + -- FIX: Other targets + empty