From db67fa30db0161c72d35e8c5167e8113ab71500e Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Mon, 7 Apr 2025 14:22:18 +0200 Subject: [PATCH 01/28] Add zig cc support It requires zig 0.14 at least to compile xxhash.h which uses evex512. Wrappers are needed because zig needs its first argument (`cc` or `c++`) always. Trying to pass it as CFLAGS fails with: ghc-toolchain, GHC's response files used to call the linker (this arg isn't supported by zig in the response file), configure scripts that call the C compiler without passing the specified CFLAGS. Use the wrappers like this: CC=/path/to/zig-cc CXX=/path/to/zig-c++ make --- Build.hs | 2 +- compiler/GHC/Driver/Session.hs | 4 +++- zig-c++ | 3 +++ zig-cc | 2 ++ 4 files changed, 9 insertions(+), 2 deletions(-) create mode 100755 zig-c++ create mode 100755 zig-cc diff --git a/Build.hs b/Build.hs index 694f67abb01c..7ce66d8c3aa3 100755 --- a/Build.hs +++ b/Build.hs @@ -549,7 +549,7 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst ghcplatform_h <- readCreateProcess (shell ("find " ++ build_dir ++ " -name ghcplatform.h")) "" case ghcplatform_h of "" -> do - putStrLn "Couldn't find ghcplatform.h" + putStrLn $ "Couldn't find ghcplatform.h. Look into " ++ dst ++ "rts-conf.{stdout,stderr}" exitFailure d -> pure (takeDirectory d) diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index bf1db99c3b37..9a34afc9a891 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -3371,7 +3371,9 @@ picCCOpts dflags = else []) -- gcc may be configured to have PIC on by default, let's be -- explicit here, see #15847 - | otherwise -> ["-fno-PIC"] + -- FIXME: actually no, because -fPIC may be required for ASLR too! + -- Zig cc doesn't support `-fno-pic` in this case + | otherwise -> [] -- ["-fno-PIC"] pieCCLDOpts :: DynFlags -> [String] pieCCLDOpts dflags diff --git a/zig-c++ b/zig-c++ new file mode 100755 index 000000000000..66701c9b1837 --- /dev/null +++ b/zig-c++ @@ -0,0 +1,3 @@ +#!/bin/sh +zig c++ $@ + diff --git a/zig-cc b/zig-cc new file mode 100755 index 000000000000..c2b79d642979 --- /dev/null +++ b/zig-cc @@ -0,0 +1,2 @@ +#!/bin/sh +zig cc $@ From 1f9479d7634b45c4b80bec9c4d62df7b3665eed4 Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Thu, 10 Apr 2025 16:05:26 +0200 Subject: [PATCH 02/28] Fix build without polluting the global store --- Build.hs | 97 ++++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 63 insertions(+), 34 deletions(-) diff --git a/Build.hs b/Build.hs index 7ce66d8c3aa3..1013423d3c85 100755 --- a/Build.hs +++ b/Build.hs @@ -41,7 +41,7 @@ main = do ghc_path <- fromMaybe "ghc" <$> lookupEnv "GHC" findExecutable ghc_path >>= \case Nothing -> error ("Couldn't find GHC: " ++ show ghc_path) - Just x -> pure (Ghc x) + Just x -> pure (Ghc x []) cabal <- do cabal_path <- fromMaybe "cabal" <$> lookupEnv "CABAL" @@ -67,16 +67,15 @@ main = do cp "_build/stage0/lib/template-hsc.h" "_build/stage1/lib/template-hsc.h" cp "_build/stage0/pkgs/*" "_build/stage1/pkgs/" - ghc1 <- Ghc <$> makeAbsolute "_build/stage1/bin/ghc" + ghc1 <- Ghc <$> makeAbsolute "_build/stage1/bin/ghc" <*> pure [] ghcPkg1 <- GhcPkg <$> makeAbsolute "_build/stage1/bin/ghc-pkg" deriveConstants <- DeriveConstants <$> makeAbsolute "_build/stage1/bin/deriveConstants" genapply <- GenApply <$> makeAbsolute "_build/stage1/bin/genapply" genprimop <- GenPrimop <$> makeAbsolute "_build/stage1/bin/genprimopcode" ghcToolchain <- GhcToolchain <$> makeAbsolute "_build/stage1/bin/ghc-toolchain" - -- generate settings based on stage1 compiler settings: stage1 should never be - -- a cross-compiler! Hence we reuse the same target platform as the bootstrap - -- compiler. + -- generate settings for the stage1 compiler: we want a non cross-compiler so + -- we reuse the target from stage0 (bootstrap compiler). stage0_target_triple <- ghcTargetTriple ghc0 let stage1_settings = emptySettings { settingsTriple = Just stage0_target_triple @@ -88,19 +87,36 @@ main = do msg "Building stage2 GHC program" createDirectoryIfMissing True "_build/stage2" - ghc1' <- Ghc <$> makeAbsolute "_build/stage1/bin/ghc" + ghc1' <- Ghc <$> makeAbsolute "_build/stage1/bin/ghc" <*> pure [] buildGhcStage2 defaultGhcBuildOptions cabal ghc1' "_build/stage2/" - -- Reuse stage1 settings for stage2 and copy stage1's built boot package for - -- stage2 to use. + -- We keep the packages and the settings used to build the stage2 compiler. + -- They can be used to build plugins to use with fplugin-library and they can + -- also be used with the internal interpreter createDirectoryIfMissing True "_build/stage2/lib/" cp "_build/stage1/pkgs/*" "_build/stage2/pkgs" cp "_build/stage1/lib/settings" "_build/stage2/lib/settings" - -- TODO: in the future we want to generate different settings for cross - -- targets and build boot libraries with stage2 using these settings. In any - -- case, we need non-cross boot packages to build plugins for use with - -- -fplugin-library. + -- Now we build extra targets. Ideally those should be built on demand... + createDirectoryIfMissing True "_build/stage2/targets/" + let targets = + [-- (,) "aarch64-linux" emptySettings + -- { settingsTriple = Just "aarch64-linux" + -- , settingsCc = ProgOpt (Just "zig-cc") (Just ["-target", "aarch64-linux-gnu"]) + -- , settingsCxx = ProgOpt (Just "zig-c++") (Just ["-target", "aarch64-linux-gnu"]) + -- } +-- , (,) "javascript" emptySettings +-- { settingsTriple = Just "javascript-unknown-ghcjs" +-- , settingsCc = ProgOpt (Just "emcc") Nothing +-- } + ] + forM_ targets $ \(target,settings) -> do + msg $ "Bootstrapping target: " <> target + target_dir <- makeAbsolute ("_build/stage2/targets" target) + createDirectoryIfMissing True target_dir + generateSettings ghcToolchain settings target_dir + ghc2 <- Ghc <$> makeAbsolute "_build/stage2/bin/ghc" <*> pure ["-B"++ target_dir "lib"] + buildBootLibraries cabal ghc2 ghcPkg1 deriveConstants genapply genprimop defaultGhcBuildOptions target_dir -- Finally create bindist directory @@ -108,9 +124,11 @@ main = do createDirectoryIfMissing True "_build/bindist/lib/" createDirectoryIfMissing True "_build/bindist/bin/" createDirectoryIfMissing True "_build/bindist/pkgs/" + createDirectoryIfMissing True "_build/bindist/targets/" cp "_build/stage2/bin/*" "_build/bindist/bin/" cp "_build/stage2/lib/*" "_build/bindist/lib/" cp "_build/stage2/pkgs/*" "_build/bindist/pkgs/" + cp "_build/stage2/targets/*" "_build/bindist/targets/" cp "driver/ghc-usage.txt" "_build/bindist/lib/" cp "driver/ghci-usage.txt" "_build/bindist/lib/" @@ -448,9 +466,13 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst -- Build the RTS src_rts <- makeAbsolute (src "libraries/rts") - build_dir <- makeAbsolute (dst "cabal") + build_dir <- makeAbsolute (dst "cabal" "build") + store_dir <- makeAbsolute (dst "cabal" "store") ghcversionh <- makeAbsolute (src_rts "include/ghcversion.h") + createDirectoryIfMissing True build_dir + createDirectoryIfMissing True store_dir + -- FIXME: could we build a cross compiler, simply by not reading this from the boot compiler, but passing it in? target_triple <- ghcTargetTriple ghc let to_triple = \case @@ -503,7 +525,7 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst ] makeCabalProject cabal_project_rts_path $ - [ "package-dbs: clear, global" + [ "package-dbs: clear, store" , "" , "packages:" , " " ++ src "libraries/rts" @@ -523,7 +545,8 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst ] ++ rts_options let build_rts_cmd = runCabal cabal - [ "build" + [ "--store-dir=" ++ store_dir + , "build" , "--project-file=" ++ cabal_project_rts_path , "rts" , "--with-compiler=" ++ ghcPath ghc @@ -597,9 +620,8 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst -- build boot libraries: ghc-internal, base... let cabal_project_bootlibs_path = dst "cabal-project-boot-libs" makeCabalProject cabal_project_bootlibs_path $ - [ "package-dbs: clear, global" - , "" - , "packages:" + [-- "package-dbs: clear, store" -- this makes cabal fail because it can't find a dubious database in a temp directory + "packages:" , " " ++ src "libraries/rts" , " " ++ src "libraries/ghc-prim" , " " ++ src "libraries/ghc-internal" @@ -688,7 +710,8 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst let boot_libs_env = dst "boot-libs.env" let build_boot_cmd = runCabal cabal - [ "install" + [ "--store-dir=" ++ store_dir + , "install" , "--lib" , "--package-env=" ++ boot_libs_env , "--force-reinstalls" @@ -761,18 +784,26 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst -- The libraries have been installed globally. boot_libs_env_lines <- lines <$> readFile boot_libs_env - -- FIXME: Sometimes the package environment contains the path to the global db, - -- sometimes not... I don't know why yet. - (global_db,pkg_ids) <- case drop 2 boot_libs_env_lines of + (global_db,pkg_ids) <- case drop 2 boot_libs_env_lines of -- drop "clear-package-db\nglobal-package-db" [] -> error "Unexpected empty package environment" (x:xs) + -- FIXME: Sometimes the package environment contains the path to the global db, + -- sometimes not... I don't know why yet. | not ("package-db" `List.isPrefixOf` x) -> do putStrLn "For some reason cabal-install didn't generate a valid package environment (package-db is missing)." putStrLn "It happens sometimes for unknown reasons... Rerun 'make' to workaround this..." exitFailure - | otherwise -> pure (drop 11 x, map (drop 11) xs) - putStrLn $ "We've built boot libraries in " ++ global_db ++ ":" + | otherwise -> do + let !package_id_len = length ("package-id ":: String) + let !package_db_len = length ("package-db ":: String) + let pkgs_ids = map (drop package_id_len) xs + -- cabal always adds the `base` global package to the environment files + -- as first entry, so we remove it because it's wrong in our case. + -- See cabal-install/src/Distribution/Client/CmdInstall.hs:{globalPackages,installLibraries} + let pkgs_ids_without_wired_base = drop 1 pkgs_ids + pure (drop package_db_len x, pkgs_ids_without_wired_base) + -- putStrLn $ "We've built boot libraries in " ++ global_db ++ ":" mapM_ (putStrLn . (" - " ++)) pkg_ids -- copy the libs in another db @@ -842,7 +873,7 @@ msg x = do putStrLn (stp ++ replicate (6 - length stp) ' ' ++ x) -- Avoid FilePath blindness by using type aliases for programs. -newtype Ghc = Ghc FilePath +data Ghc = Ghc FilePath [String] newtype GhcPkg = GhcPkg FilePath newtype GhcToolchain = GhcToolchain FilePath newtype Cabal = Cabal FilePath @@ -851,10 +882,10 @@ newtype GenApply = GenApply FilePath newtype GenPrimop = GenPrimop FilePath runGhc :: Ghc -> [String] -> CreateProcess -runGhc (Ghc f) = proc f +runGhc (Ghc f args) xs = proc f (args ++ xs) ghcPath :: Ghc -> FilePath -ghcPath (Ghc x) = x +ghcPath (Ghc x _) = x runGhcPkg :: GhcPkg -> [String] -> CreateProcess runGhcPkg (GhcPkg f) = proc f @@ -1006,20 +1037,18 @@ generateSettings ghc_toolchain Settings{..} dst = do let gen_settings_path = dst "lib/settings.generated" - mbCC <- lookupEnv "CC" >>= \case - Just cc -> pure ["--cc", cc] - Nothing -> pure [] - mbCXX <- lookupEnv "CXX" >>= \case - Just cxx -> pure ["--cxx", cxx] - Nothing -> pure [] let common_args = [ "--output-settings" , "-o", gen_settings_path - ] ++ mbCC ++ mbCXX + ] let opt m f = fmap f m let args = mconcat (catMaybes [ opt settingsTriple $ \x -> ["--triple", x] + , opt (poPath settingsCc) $ \x -> ["--cc", x] + , opt (poFlags settingsCc) $ \xs -> concat [["--cc-opt", x] | x <- xs] + , opt (poPath settingsCxx) $ \x -> ["--cxx", x] + , opt (poFlags settingsCxx) $ \xs -> concat [["--cxx-opt", x] | x <- xs] -- FIXME: add other options for ghc-toolchain from Settings ]) ++ common_args From c088e3081c8c831156d2bcd0382c0766965edf93 Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Tue, 15 Apr 2025 15:27:45 +0200 Subject: [PATCH 03/28] Use zig to cross-compile to aarch64-linux We need to use wrappers, which is not pretty. We can use the resulting target with -Bpath/to/targets/aarch64_linux/lib but we can't link a program yet because we lack libffi for aarch64... In the past we built libffi with rts, we might do it again? --- Build.hs | 18 ++++++++++++------ aarch64-linux-zig-c++ | 3 +++ aarch64-linux-zig-cc | 2 ++ 3 files changed, 17 insertions(+), 6 deletions(-) create mode 100755 aarch64-linux-zig-c++ create mode 100755 aarch64-linux-zig-cc diff --git a/Build.hs b/Build.hs index 1013423d3c85..7174529bfd86 100755 --- a/Build.hs +++ b/Build.hs @@ -100,11 +100,13 @@ main = do -- Now we build extra targets. Ideally those should be built on demand... createDirectoryIfMissing True "_build/stage2/targets/" let targets = - [-- (,) "aarch64-linux" emptySettings - -- { settingsTriple = Just "aarch64-linux" - -- , settingsCc = ProgOpt (Just "zig-cc") (Just ["-target", "aarch64-linux-gnu"]) - -- , settingsCxx = ProgOpt (Just "zig-c++") (Just ["-target", "aarch64-linux-gnu"]) - -- } + [ (,) "aarch64-linux" emptySettings + { settingsTriple = Just "aarch64-linux" + , settingsCc = ProgOpt (Just "aarch64-linux-zig-cc") Nothing + , settingsCxx = ProgOpt (Just "aarch64-linux-zig-c++") Nothing + , settingsLd = ProgOpt (Just "aarch64-linux-zig-cc") Nothing + , settingsMergeObjs = ProgOpt (Just "aarch64-linux-zig-cc") Nothing + } -- , (,) "javascript" emptySettings -- { settingsTriple = Just "javascript-unknown-ghcjs" -- , settingsCc = ProgOpt (Just "emcc") Nothing @@ -801,7 +803,9 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst -- cabal always adds the `base` global package to the environment files -- as first entry, so we remove it because it's wrong in our case. -- See cabal-install/src/Distribution/Client/CmdInstall.hs:{globalPackages,installLibraries} - let pkgs_ids_without_wired_base = drop 1 pkgs_ids + -- + -- But apparently in Moritz' version of cabal, it's fixed. + let pkgs_ids_without_wired_base = drop 0 pkgs_ids pure (drop package_db_len x, pkgs_ids_without_wired_base) -- putStrLn $ "We've built boot libraries in " ++ global_db ++ ":" mapM_ (putStrLn . (" - " ++)) pkg_ids @@ -1049,6 +1053,8 @@ generateSettings ghc_toolchain Settings{..} dst = do , opt (poFlags settingsCc) $ \xs -> concat [["--cc-opt", x] | x <- xs] , opt (poPath settingsCxx) $ \x -> ["--cxx", x] , opt (poFlags settingsCxx) $ \xs -> concat [["--cxx-opt", x] | x <- xs] + , opt (poPath settingsLd) $ \x -> ["--ld", x] + , opt (poPath settingsMergeObjs) $ \x -> ["--merge-objs", x] -- FIXME: add other options for ghc-toolchain from Settings ]) ++ common_args diff --git a/aarch64-linux-zig-c++ b/aarch64-linux-zig-c++ new file mode 100755 index 000000000000..1ebc93d572f7 --- /dev/null +++ b/aarch64-linux-zig-c++ @@ -0,0 +1,3 @@ +#!/bin/sh +zig c++ --target=aarch64-linux $@ + diff --git a/aarch64-linux-zig-cc b/aarch64-linux-zig-cc new file mode 100755 index 000000000000..41722d3bbdde --- /dev/null +++ b/aarch64-linux-zig-cc @@ -0,0 +1,2 @@ +#!/bin/sh +zig cc --target=aarch64-linux $@ From cc44de7f39c8cd73818bf1cb5e18d845453acb78 Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Tue, 15 Apr 2025 15:37:00 +0200 Subject: [PATCH 04/28] Revert "Fix libffi linking" This reverts commit 420310e09a6d86b3c2a5c102736bb19213927399. --- rts/rts.cabal | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/rts/rts.cabal b/rts/rts.cabal index 193e8dd79440..249e814810ec 100644 --- a/rts/rts.cabal +++ b/rts/rts.cabal @@ -613,15 +613,11 @@ library Jumps_V32.cmm Jumps_V64.cmm - -- we always link against libffi, even without libffi-adjustors enabled. - -- libffi is used by the Interpreter and some of its symbols are declared - -- in RtsSymbols.c - extra-libraries: ffi - extra-libraries-static: ffi - -- Adjustor stuff if flag(libffi-adjustors) c-sources: adjustor/LibffiAdjustor.c + extra-libraries: ffi + extra-libraries-static: ffi else -- Use GHC's native adjustors if arch(i386) @@ -637,6 +633,8 @@ library -- fall back to the LibffiAdjustor if neither i386, or x86_64 if !arch(x86_64) && !arch(i386) c-sources: adjustor/LibffiAdjustor.c + extra-libraries: ffi + extra-libraries-static: ffi -- Use assembler STG entrypoint on architectures where it is used if arch(ppc) || arch(ppc64) || arch(s390x) || arch(riscv64) || arch(loongarch64) From 109e4b9c3b811c2fe01f6aa65494ede8a4d182ef Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Tue, 15 Apr 2025 15:37:08 +0200 Subject: [PATCH 05/28] Revert "[build] drop ffi" This reverts commit 1ec11989ce5d46f4fcaf5fea1f713e91e546f8b9. --- Build.hs | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/Build.hs b/Build.hs index 7174529bfd86..2b27e18b92de 100755 --- a/Build.hs +++ b/Build.hs @@ -619,6 +619,31 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst writeFile (src "libraries/ghc-internal/src/GHC/Internal/Prim.hs") =<< readCreateProcess (runGenPrimop genprimop ["--make-haskell-source"]) primops writeFile (src "libraries/ghc-internal/src/GHC/Internal/PrimopWrappers.hs") =<< readCreateProcess (runGenPrimop genprimop ["--make-haskell-wrappers"]) primops + -- build libffi + msg " - Building libffi..." + src_libffi <- makeAbsolute (src "libffi") + dst_libffi <- makeAbsolute (dst "libffi") + let libffi_version = "3.4.6" + createDirectoryIfMissing True src_libffi + createDirectoryIfMissing True dst_libffi + void $ readCreateProcess (shell ("tar -xvf libffi-tarballs/libffi-" ++ libffi_version ++ ".tar.gz -C " ++ src_libffi)) "" + let build_libffi = mconcat + [ "cd " ++ src_libffi "libffi-" ++ libffi_version ++ "; " + -- FIXME: pass the appropriate toolchain (CC, LD...) + , "./configure --disable-docs --with-pic=yes --disable-multi-os-directory --prefix=" ++ dst_libffi + , " && make install -j" + ] + (libffi_exit_code, libffi_stdout, libffi_stderr) <- readCreateProcessWithExitCode (shell build_libffi) "" + case libffi_exit_code of + ExitSuccess -> pure () + ExitFailure r -> do + putStrLn $ "Failed to build libffi with error code " ++ show r + putStrLn libffi_stdout + putStrLn libffi_stderr + exitFailure + cp (dst_libffi "include" "*") (src_rts "include") + cp (dst_libffi "lib" "libffi.a") (takeDirectory ghcplatform_dir "libCffi.a") + -- build boot libraries: ghc-internal, base... let cabal_project_bootlibs_path = dst "cabal-project-boot-libs" makeCabalProject cabal_project_bootlibs_path $ From 1fd397ec82db5239d138d0b09767117a8fc5c433 Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Tue, 15 Apr 2025 15:37:20 +0200 Subject: [PATCH 06/28] Revert "Drop libffi; Stop shipping a copy of libffi" This reverts commit 7996993375ccbf4823d60e2998647c2745145ed8. --- .gitmodules | 4 ++++ compiler/GHC/Driver/CodeOutput.hs | 7 ++++--- libffi-tarballs | 1 + packages | 1 + rts/rts.cabal | 25 ++++++++++++++++++------- 5 files changed, 28 insertions(+), 10 deletions(-) create mode 160000 libffi-tarballs diff --git a/.gitmodules b/.gitmodules index 9c72ac9d8846..fc634597fb31 100644 --- a/.gitmodules +++ b/.gitmodules @@ -100,6 +100,10 @@ path = utils/hsc2hs url = https://gitlab.haskell.org/ghc/hsc2hs.git ignore = untracked +[submodule "libffi-tarballs"] + path = libffi-tarballs + url = https://gitlab.haskell.org/ghc/libffi-tarballs.git + ignore = untracked [submodule "gmp-tarballs"] path = libraries/ghc-internal/gmp/gmp-tarballs url = https://gitlab.haskell.org/ghc/gmp-tarballs.git diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs index 023c4e1e365f..ff5a25c3bae0 100644 --- a/compiler/GHC/Driver/CodeOutput.hs +++ b/compiler/GHC/Driver/CodeOutput.hs @@ -255,11 +255,12 @@ outputJS _ _ _ _ _ = pgmError $ "codeOutput: Hit JavaScript case. We should neve -} {- -Note [libffi headers] +Note [Packaging libffi headers] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The C code emitted by GHC for libffi adjustors must depend upon the ffi_arg type, -defined in . On systems where GHC uses the libffi adjustors, the libffi -library, and headers must be installed. +defined in . For this reason, we must ensure that is available +in binary distributions. To do so, we install these headers as part of the +`rts` package. -} outputForeignStubs diff --git a/libffi-tarballs b/libffi-tarballs new file mode 160000 index 000000000000..89a9b01c5647 --- /dev/null +++ b/libffi-tarballs @@ -0,0 +1 @@ +Subproject commit 89a9b01c5647c8f0d3899435b99df690f582e9f1 diff --git a/packages b/packages index d6bb0cd77e13..4f02d0133c0b 100644 --- a/packages +++ b/packages @@ -37,6 +37,7 @@ # localpath tag remotepath upstreamurl # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ghc-tarballs windows ghc-tarballs.git - +libffi-tarballs - - - utils/hsc2hs - - ssh://git@github.com/haskell/hsc2hs.git libraries/array - - - libraries/binary - - https://github.com/kolmodin/binary.git diff --git a/rts/rts.cabal b/rts/rts.cabal index 249e814810ec..31ebdd4eb82a 100644 --- a/rts/rts.cabal +++ b/rts/rts.cabal @@ -276,6 +276,9 @@ flag librt flag libdl default: False manual: True +flag use-system-libffi + default: False + manual: True flag libffi-adjustors default: False manual: True @@ -399,6 +402,18 @@ library stg/Types.h else + -- If we are using an in-tree libffi then we must declare it as a bundled + -- library to ensure that Cabal installs it. + if !flag(use-system-libffi) + if os(windows) + extra-bundled-libraries: Cffi-6 + else + extra-bundled-libraries: Cffi + + install-includes: ffi.h ffitarget.h + -- ^ see Note [Packaging libffi headers] in + -- GHC.Driver.CodeOutput. + -- Here we declare several flavours to be available when passing the -- suitable (combination of) flag(s) when configuring the RTS from hadrian, -- using Cabal. @@ -450,6 +465,9 @@ library extra-libraries: rt if flag(libdl) extra-libraries: dl + if flag(use-system-libffi) + extra-libraries: ffi + extra-libraries-static: ffi if os(windows) extra-libraries: -- for the linker @@ -616,8 +634,6 @@ library -- Adjustor stuff if flag(libffi-adjustors) c-sources: adjustor/LibffiAdjustor.c - extra-libraries: ffi - extra-libraries-static: ffi else -- Use GHC's native adjustors if arch(i386) @@ -630,11 +646,6 @@ library else asm-sources: adjustor/NativeAmd64Asm.S c-sources: adjustor/NativeAmd64.c - -- fall back to the LibffiAdjustor if neither i386, or x86_64 - if !arch(x86_64) && !arch(i386) - c-sources: adjustor/LibffiAdjustor.c - extra-libraries: ffi - extra-libraries-static: ffi -- Use assembler STG entrypoint on architectures where it is used if arch(ppc) || arch(ppc64) || arch(s390x) || arch(riscv64) || arch(loongarch64) From 4eed2ea4f943a445c6bd5984d6a26ef1f304177b Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Tue, 29 Apr 2025 17:15:16 +0200 Subject: [PATCH 07/28] Cross build libffi with zig --- Build.hs | 66 ++++++++++++++++++++++++++++++++++++++------------------ Makefile | 1 + 2 files changed, 46 insertions(+), 21 deletions(-) diff --git a/Build.hs b/Build.hs index 2b27e18b92de..e0129410a0ad 100755 --- a/Build.hs +++ b/Build.hs @@ -481,6 +481,9 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst [arch,vendor,os] -> (arch,vendor,os) t -> error $ "Triple expected but got: " ++ show t let (arch,vendor,os) = to_triple $ words $ map (\c -> if c == '-' then ' ' else c) target_triple + let fixed_triple = case vendor of + "unknown" -> arch ++ "-" ++ os + _ -> target_triple let cabal_project_rts_path = dst "cabal.project-rts" -- cabal's code handling escaping is bonkers. We need to wrap the whole @@ -507,11 +510,8 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst -- This is stupid, I can't seem to figure out how to set this in cabal -- this needs to be fixed in cabal. , if os == "darwin" - then " flags: +tables-next-to-code +leading-underscore" - else " flags: +tables-next-to-code" - -- FIXME: we should - -- FIXME: deal with libffi (add package?) - -- + then " flags: +tables-next-to-code +leading-underscore +use-system-libffi" + else " flags: +tables-next-to-code +use-system-libffi" -- FIXME: we should make tables-next-to-code optional here and in the -- compiler settings. Ideally, GHC should even look into the rts's -- ghcautoconf.h to check whether TABLES_NEXT_TO_CODE is defined or @@ -578,6 +578,8 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst exitFailure d -> pure (takeDirectory d) + cc <- ghcSetting ghc "C compiler command" + -- deriving constants let derived_constants = src_rts "include/DerivedConstants.h" withSystemTempDirectory "derive-constants" $ \tmp_dir -> do @@ -587,7 +589,7 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst , "-o", derived_constants , "--target-os", target , "--tmpdir", tmp_dir - , "--gcc-program", "cc" -- FIXME + , "--gcc-program", cc , "--nm-program", "nm" -- FIXME , "--objdump-program", "objdump" -- FIXME -- pass `-fcommon` to force symbols into the common section. If they @@ -623,15 +625,18 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst msg " - Building libffi..." src_libffi <- makeAbsolute (src "libffi") dst_libffi <- makeAbsolute (dst "libffi") - let libffi_version = "3.4.6" - createDirectoryIfMissing True src_libffi createDirectoryIfMissing True dst_libffi - void $ readCreateProcess (shell ("tar -xvf libffi-tarballs/libffi-" ++ libffi_version ++ ".tar.gz -C " ++ src_libffi)) "" + + doesDirectoryExist src_libffi >>= \case + True -> pure () + False -> do + createDirectoryIfMissing True src_libffi + -- fetch libffi fork with zig build system + void $ readCreateProcess (shell ("git clone git@github.com:vezel-dev/libffi.git " ++ src_libffi)) "" + let build_libffi = mconcat - [ "cd " ++ src_libffi "libffi-" ++ libffi_version ++ "; " - -- FIXME: pass the appropriate toolchain (CC, LD...) - , "./configure --disable-docs --with-pic=yes --disable-multi-os-directory --prefix=" ++ dst_libffi - , " && make install -j" + [ "cd " ++ src_libffi ++ "; " + , "zig build install --prefix " ++ dst_libffi ++ " -Dtarget=" ++ fixed_triple ] (libffi_exit_code, libffi_stdout, libffi_stderr) <- readCreateProcessWithExitCode (shell build_libffi) "" case libffi_exit_code of @@ -828,9 +833,12 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst -- cabal always adds the `base` global package to the environment files -- as first entry, so we remove it because it's wrong in our case. -- See cabal-install/src/Distribution/Client/CmdInstall.hs:{globalPackages,installLibraries} - -- - -- But apparently in Moritz' version of cabal, it's fixed. - let pkgs_ids_without_wired_base = drop 0 pkgs_ids + let pkgs_ids_without_wired_base + | (fid:fids) <- pkgs_ids + , "base-" `List.isPrefixOf` fid = fids + -- apparently in Moritz' version of cabal, it's fixed. + | otherwise = pkgs_ids + pure (drop package_db_len x, pkgs_ids_without_wired_base) -- putStrLn $ "We've built boot libraries in " ++ global_db ++ ":" mapM_ (putStrLn . (" - " ++)) pkg_ids @@ -845,8 +853,19 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst -- NOTE: GHC assumes that pkgroot is just one directory above the directory -- containing the package db. In our case where everything is at the same -- level in "pkgs" we need to re-add "/pkgs" + let fix_pkgroot = Text.replace (Text.pack pkg_root) "${pkgroot}/pkgs" + -- Add libCffi library to the rts. We can't use RTS cabal flag -use-system-ffi + -- because the library needs to be installed during setup. + let fix_cffi_line l + | "hs-libraries:" `Text.isPrefixOf` l = l <> " Cffi" + | otherwise = l + let fix_cffi c + | not ("rts-" `List.isPrefixOf` pid) = c + | otherwise = Text.unlines (map fix_cffi_line (Text.lines c)) + + Text.writeFile (dst "pkgs" pid <.> "conf") - (Text.replace (Text.pack pkg_root) "${pkgroot}/pkgs" conf) + (fix_cffi (fix_pkgroot conf)) cp (pkg_root pid) (dst "pkgs") void $ readCreateProcess (runGhcPkg ghcpkg ["recache", "--package-db=" ++ (dst "pkgs")]) "" @@ -987,12 +1006,17 @@ getTarget ghc = ghcTargetArchOS ghc >>= \case (_,"OSLinux") -> pure "linux" _ -> error "Unsupported target" +ghcSettings :: Ghc -> IO [(String,String)] +ghcSettings ghc = read <$> readCreateProcess (runGhc ghc ["--info"]) "" + +ghcSetting :: Ghc -> String -> IO String +ghcSetting ghc s = do + is <- ghcSettings ghc + pure $ fromMaybe (error $ "Couldn't read '" ++ s ++ "' setting of " ++ ghcPath ghc) (lookup s is) + -- | Retrieve GHC's target triple ghcTargetTriple :: Ghc -> IO String -ghcTargetTriple ghc = do - is <- read <$> readCreateProcess (runGhc ghc ["--info"]) "" :: IO [(String,String)] - pure $ fromMaybe (error "Couldn't read 'Target platform setting") (lookup "Target platform" is) - +ghcTargetTriple ghc = ghcSetting ghc "Target platform" data Settings = Settings { settingsTriple :: Maybe String diff --git a/Makefile b/Makefile index d07edfae6fe9..6a9b4f688d0b 100644 --- a/Makefile +++ b/Makefile @@ -6,6 +6,7 @@ CPUS=$(shell mk/detect-cpu-count.sh) THREADS=${THREADS:-$((CPUS + 1))} all: $(CABAL) ./booted + PATH=`pwd`:${PATH} \ GHC=ghc-9.8.4 ./Build.hs cabal: $(CABAL) From 27abce3ca21dd779ed5748bbe380c3fa48b5e773 Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Wed, 30 Apr 2025 12:04:03 +0200 Subject: [PATCH 08/28] Disable ubsan and properly install libCffi --- Build.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/Build.hs b/Build.hs index e0129410a0ad..c68c17b00e56 100755 --- a/Build.hs +++ b/Build.hs @@ -106,6 +106,7 @@ main = do , settingsCxx = ProgOpt (Just "aarch64-linux-zig-c++") Nothing , settingsLd = ProgOpt (Just "aarch64-linux-zig-cc") Nothing , settingsMergeObjs = ProgOpt (Just "aarch64-linux-zig-cc") Nothing + , settingsCrossCompiling = True } -- , (,) "javascript" emptySettings -- { settingsTriple = Just "javascript-unknown-ghcjs" @@ -637,6 +638,7 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst let build_libffi = mconcat [ "cd " ++ src_libffi ++ "; " , "zig build install --prefix " ++ dst_libffi ++ " -Dtarget=" ++ fixed_triple + , " -Doptimize=ReleaseFast -Dlinkage=static" ] (libffi_exit_code, libffi_stdout, libffi_stderr) <- readCreateProcessWithExitCode (shell build_libffi) "" case libffi_exit_code of @@ -858,6 +860,7 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst -- because the library needs to be installed during setup. let fix_cffi_line l | "hs-libraries:" `Text.isPrefixOf` l = l <> " Cffi" + | "extra-libraries:" `Text.isPrefixOf` l = Text.replace "ffi" "" l | otherwise = l let fix_cffi c | not ("rts-" `List.isPrefixOf` pid) = c @@ -868,6 +871,10 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst (fix_cffi (fix_pkgroot conf)) cp (pkg_root pid) (dst "pkgs") + -- install libffi... + when ("rts-" `List.isPrefixOf` pid) $ do + cp (dst_libffi "lib" "libffi.a") (dst "pkgs" pid "lib" "libCffi.a") + void $ readCreateProcess (runGhcPkg ghcpkg ["recache", "--package-db=" ++ (dst "pkgs")]) "" @@ -1043,6 +1050,7 @@ data Settings = Settings , settingsTablesNextToCode :: Maybe Bool , settingsUseLibFFIForAdjustors :: Maybe Bool , settingsLdOverride :: Maybe Bool + , settingsCrossCompiling :: Bool } -- | Program specifier from the command-line. @@ -1080,6 +1088,7 @@ emptySettings = Settings , settingsTablesNextToCode = Nothing , settingsUseLibFFIForAdjustors = Nothing , settingsLdOverride = Nothing + , settingsCrossCompiling = False } where po0 = emptyProgOpt @@ -1126,5 +1135,6 @@ generateSettings ghc_toolchain Settings{..} dst = do $ Map.insert "RTS ways" "v" -- FIXME: this depends on the different ways used to build the RTS! $ Map.insert "otool command" "otool" -- FIXME: this should just arguably be a default in the settings in GHC, and not require the settings file? $ Map.insert "install_name_tool command" "install_name_tool" + $ Map.insert "cross compiling" (if settingsCrossCompiling then "YES" else "NO") $ kvs writeFile (dst "lib/settings") (show $ Map.toList kvs') From fae581915d5bd09d581346c16bb9e3589664c5f2 Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Wed, 30 Apr 2025 14:06:20 +0200 Subject: [PATCH 09/28] Progress towards fixing the build of cross libraries --- Build.hs | 42 ++++++++++++++++++++++++++++-------------- rts/rts.cabal | 8 +++++--- 2 files changed, 33 insertions(+), 17 deletions(-) diff --git a/Build.hs b/Build.hs index c68c17b00e56..da76aacd6667 100755 --- a/Build.hs +++ b/Build.hs @@ -113,12 +113,21 @@ main = do -- , settingsCc = ProgOpt (Just "emcc") Nothing -- } ] + + ghc_stage2_abs <- makeAbsolute "_build/stage2/bin/ghc" forM_ targets $ \(target,settings) -> do msg $ "Bootstrapping target: " <> target target_dir <- makeAbsolute ("_build/stage2/targets" target) createDirectoryIfMissing True target_dir generateSettings ghcToolchain settings target_dir - ghc2 <- Ghc <$> makeAbsolute "_build/stage2/bin/ghc" <*> pure ["-B"++ target_dir "lib"] + -- compiler flags aren't passed consistently to configure, etc. + -- So we need to create a wrapper. Yes this is garbage. Why are we + -- infliciting this (autotools, etc.) to ourselves? + let ghc_wrapper = target_dir "ghc" + writeFile ghc_wrapper ("#!/bin/sh\n" <> ghc_stage2_abs <> " -B" <> (target_dir "lib") <> " $@") + _ <- readCreateProcess (shell $ "chmod +x " ++ ghc_wrapper) "" + let ghc2 = Ghc ghc_wrapper [] + -- ghc2 <- Ghc <$> makeAbsolute "_build/stage2/bin/ghc" <*> pure ["-B"++ target_dir "lib"] buildBootLibraries cabal ghc2 ghcPkg1 deriveConstants genapply genprimop defaultGhcBuildOptions target_dir @@ -467,16 +476,7 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst src <- makeAbsolute (dst "src") prepareGhcSources opts src - -- Build the RTS - src_rts <- makeAbsolute (src "libraries/rts") - build_dir <- makeAbsolute (dst "cabal" "build") - store_dir <- makeAbsolute (dst "cabal" "store") - ghcversionh <- makeAbsolute (src_rts "include/ghcversion.h") - - createDirectoryIfMissing True build_dir - createDirectoryIfMissing True store_dir - - -- FIXME: could we build a cross compiler, simply by not reading this from the boot compiler, but passing it in? + -- detect target (inferred from the ghc we use) target_triple <- ghcTargetTriple ghc let to_triple = \case [arch,vendor,os] -> (arch,vendor,os) @@ -486,6 +486,15 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst "unknown" -> arch ++ "-" ++ os _ -> target_triple + -- Build the RTS + src_rts <- makeAbsolute (src "libraries/rts") + build_dir <- makeAbsolute (dst "cabal" "build") + store_dir <- makeAbsolute (dst "cabal" "store") + ghcversionh <- makeAbsolute (src_rts "include/ghcversion.h") + + createDirectoryIfMissing True build_dir + createDirectoryIfMissing True store_dir + let cabal_project_rts_path = dst "cabal.project-rts" -- cabal's code handling escaping is bonkers. We need to wrap the whole -- option into \" otherwise it does weird things (like keeping only the @@ -573,11 +582,16 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst writeFile (dst "rts-conf.stderr") rts_conf_stderr ghcplatform_dir <- do ghcplatform_h <- readCreateProcess (shell ("find " ++ build_dir ++ " -name ghcplatform.h")) "" - case ghcplatform_h of - "" -> do + case lines ghcplatform_h of + [] -> do putStrLn $ "Couldn't find ghcplatform.h. Look into " ++ dst ++ "rts-conf.{stdout,stderr}" exitFailure - d -> pure (takeDirectory d) + [d] -> pure (takeDirectory d) + ds -> do + putStrLn $ "ghcplatform.h found in several paths:" + forM_ ds $ \d -> putStrLn (" - " ++ d) + putStrLn $ "Check the log in " ++ (dst "rts-conf.{stdout,stderr}") + exitFailure cc <- ghcSetting ghc "C compiler command" diff --git a/rts/rts.cabal b/rts/rts.cabal index 31ebdd4eb82a..f3b80c7d1c0f 100644 --- a/rts/rts.cabal +++ b/rts/rts.cabal @@ -465,9 +465,11 @@ library extra-libraries: rt if flag(libdl) extra-libraries: dl - if flag(use-system-libffi) - extra-libraries: ffi - extra-libraries-static: ffi + -- we patch the package ourselves later to avoid cabal warning about + -- libffi not being available + -- if flag(use-system-libffi) + -- extra-libraries: ffi + -- extra-libraries-static: ffi if os(windows) extra-libraries: -- for the linker From bc31fb9962625656eb09375d86cfb7162950dda5 Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Wed, 30 Apr 2025 17:26:08 +0200 Subject: [PATCH 10/28] Finally build hackily install libffi --- Build.hs | 71 ++++++++++++++++++++++++++++----------------------- rts/rts.cabal | 8 +++--- 2 files changed, 42 insertions(+), 37 deletions(-) diff --git a/Build.hs b/Build.hs index da76aacd6667..91bded7828d2 100755 --- a/Build.hs +++ b/Build.hs @@ -475,6 +475,7 @@ buildBootLibraries :: Cabal -> Ghc -> GhcPkg -> DeriveConstants -> GenApply -> G buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst = do src <- makeAbsolute (dst "src") prepareGhcSources opts src + src_rts <- makeAbsolute (src "libraries/rts") -- detect target (inferred from the ghc we use) target_triple <- ghcTargetTriple ghc @@ -486,8 +487,36 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst "unknown" -> arch ++ "-" ++ os _ -> target_triple + -- build libffi + msg " - Building libffi..." + src_libffi <- makeAbsolute (src "libffi") + dst_libffi <- makeAbsolute (dst "libffi") + createDirectoryIfMissing True dst_libffi + + doesDirectoryExist src_libffi >>= \case + True -> pure () + False -> do + createDirectoryIfMissing True src_libffi + -- fetch libffi fork with zig build system + void $ readCreateProcess (shell ("git clone git@github.com:vezel-dev/libffi.git " ++ src_libffi)) "" + + let build_libffi = mconcat + [ "cd " ++ src_libffi ++ "; " + , "zig build install --prefix " ++ dst_libffi ++ " -Dtarget=" ++ fixed_triple + , " -Doptimize=ReleaseFast -Dlinkage=static" + ] + (libffi_exit_code, libffi_stdout, libffi_stderr) <- readCreateProcessWithExitCode (shell build_libffi) "" + case libffi_exit_code of + ExitSuccess -> pure () + ExitFailure r -> do + putStrLn $ "Failed to build libffi with error code " ++ show r + putStrLn libffi_stdout + putStrLn libffi_stderr + exitFailure + cp (dst_libffi "include" "*") (src_rts "include") + -- cp (dst_libffi "lib" "libffi.a") (takeDirectory ghcplatform_dir "libCffi.a") + -- Build the RTS - src_rts <- makeAbsolute (src "libraries/rts") build_dir <- makeAbsolute (dst "cabal" "build") store_dir <- makeAbsolute (dst "cabal" "store") ghcversionh <- makeAbsolute (src_rts "include/ghcversion.h") @@ -553,6 +582,8 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst , " executable-profiling: False" , " executable-dynamic: False" , " executable-static: False" + , " extra-lib-dirs: " ++ dst_libffi "lib" + , " extra-include-dirs: " ++ dst_libffi "include" , "" ] ++ rts_options @@ -584,7 +615,7 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst ghcplatform_h <- readCreateProcess (shell ("find " ++ build_dir ++ " -name ghcplatform.h")) "" case lines ghcplatform_h of [] -> do - putStrLn $ "Couldn't find ghcplatform.h. Look into " ++ dst ++ "rts-conf.{stdout,stderr}" + putStrLn $ "Couldn't find ghcplatform.h. Look into " ++ (dst "rts-conf.{stdout,stderr}") exitFailure [d] -> pure (takeDirectory d) ds -> do @@ -636,35 +667,6 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst writeFile (src "libraries/ghc-internal/src/GHC/Internal/Prim.hs") =<< readCreateProcess (runGenPrimop genprimop ["--make-haskell-source"]) primops writeFile (src "libraries/ghc-internal/src/GHC/Internal/PrimopWrappers.hs") =<< readCreateProcess (runGenPrimop genprimop ["--make-haskell-wrappers"]) primops - -- build libffi - msg " - Building libffi..." - src_libffi <- makeAbsolute (src "libffi") - dst_libffi <- makeAbsolute (dst "libffi") - createDirectoryIfMissing True dst_libffi - - doesDirectoryExist src_libffi >>= \case - True -> pure () - False -> do - createDirectoryIfMissing True src_libffi - -- fetch libffi fork with zig build system - void $ readCreateProcess (shell ("git clone git@github.com:vezel-dev/libffi.git " ++ src_libffi)) "" - - let build_libffi = mconcat - [ "cd " ++ src_libffi ++ "; " - , "zig build install --prefix " ++ dst_libffi ++ " -Dtarget=" ++ fixed_triple - , " -Doptimize=ReleaseFast -Dlinkage=static" - ] - (libffi_exit_code, libffi_stdout, libffi_stderr) <- readCreateProcessWithExitCode (shell build_libffi) "" - case libffi_exit_code of - ExitSuccess -> pure () - ExitFailure r -> do - putStrLn $ "Failed to build libffi with error code " ++ show r - putStrLn libffi_stdout - putStrLn libffi_stderr - exitFailure - cp (dst_libffi "include" "*") (src_rts "include") - cp (dst_libffi "lib" "libffi.a") (takeDirectory ghcplatform_dir "libCffi.a") - -- build boot libraries: ghc-internal, base... let cabal_project_bootlibs_path = dst "cabal-project-boot-libs" makeCabalProject cabal_project_bootlibs_path $ @@ -734,6 +736,8 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst , " executable-profiling: False" , " executable-dynamic: False" , " executable-static: True" + , " extra-lib-dirs: " ++ dst_libffi "lib" + , " extra-include-dirs: " ++ dst_libffi "include" , "" , "package ghc" -- build-tool-depends: require genprimopcode, etc. used by Setup.hs @@ -827,7 +831,7 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst putStrLn $ "Failed to build boot libraries with error code " ++ show r putStrLn boot_stdout putStrLn boot_stderr - putStrLn $ "Logs can be found in " ++ dst ++ "boot-libs.{stdout,stderr}" + putStrLn $ "Logs can be found in " ++ (dst "boot-libs.{stdout,stderr}") exitFailure -- The libraries have been installed globally. @@ -888,6 +892,8 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst -- install libffi... when ("rts-" `List.isPrefixOf` pid) $ do cp (dst_libffi "lib" "libffi.a") (dst "pkgs" pid "lib" "libCffi.a") + cp (dst_libffi "include" "ffi.h") (dst "pkgs" pid "lib" "include" "ffi.h") + cp (dst_libffi "include" "ffitarget.h") (dst "pkgs" pid "lib" "include" "ffitarget.h") void $ readCreateProcess (runGhcPkg ghcpkg ["recache", "--package-db=" ++ (dst "pkgs")]) "" @@ -1110,6 +1116,7 @@ emptySettings = Settings generateSettings :: GhcToolchain -> Settings -> FilePath -> IO () generateSettings ghc_toolchain Settings{..} dst = do createDirectoryIfMissing True (dst "lib") + createDirectoryIfMissing True (dst "pkgs") let gen_settings_path = dst "lib/settings.generated" diff --git a/rts/rts.cabal b/rts/rts.cabal index f3b80c7d1c0f..31ebdd4eb82a 100644 --- a/rts/rts.cabal +++ b/rts/rts.cabal @@ -465,11 +465,9 @@ library extra-libraries: rt if flag(libdl) extra-libraries: dl - -- we patch the package ourselves later to avoid cabal warning about - -- libffi not being available - -- if flag(use-system-libffi) - -- extra-libraries: ffi - -- extra-libraries-static: ffi + if flag(use-system-libffi) + extra-libraries: ffi + extra-libraries-static: ffi if os(windows) extra-libraries: -- for the linker From 8dfd49d260fe72171e2f2a43044ceca682cb4583 Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Wed, 30 Apr 2025 17:41:52 +0200 Subject: [PATCH 11/28] Deal with unlit path --- Build.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Build.hs b/Build.hs index 91bded7828d2..4920d220a2a7 100755 --- a/Build.hs +++ b/Build.hs @@ -107,6 +107,7 @@ main = do , settingsLd = ProgOpt (Just "aarch64-linux-zig-cc") Nothing , settingsMergeObjs = ProgOpt (Just "aarch64-linux-zig-cc") Nothing , settingsCrossCompiling = True + , settingsUnlit = "$topdir/../../../bin/unlit" } -- , (,) "javascript" emptySettings -- { settingsTriple = Just "javascript-unknown-ghcjs" @@ -1063,6 +1064,7 @@ data Settings = Settings , settingsReadelf :: ProgOpt , settingsMergeObjs :: ProgOpt , settingsWindres :: ProgOpt + , settingsUnlit :: String -- Note we don't actually configure LD into anything but -- see #23857 and #22550 for the very unfortunate story. , settingsLd :: ProgOpt @@ -1103,6 +1105,7 @@ emptySettings = Settings , settingsReadelf = po0 , settingsMergeObjs = po0 , settingsWindres = po0 + , settingsUnlit = "$topdir/../bin/unlit" , settingsLd = po0 , settingsUnregisterised = Nothing , settingsTablesNextToCode = Nothing @@ -1157,5 +1160,6 @@ generateSettings ghc_toolchain Settings{..} dst = do $ Map.insert "otool command" "otool" -- FIXME: this should just arguably be a default in the settings in GHC, and not require the settings file? $ Map.insert "install_name_tool command" "install_name_tool" $ Map.insert "cross compiling" (if settingsCrossCompiling then "YES" else "NO") + $ Map.insert "unlit command" settingsUnlit $ kvs writeFile (dst "lib/settings") (show $ Map.toList kvs') From 680b9c53a0e8ccf8bd105b0fd8cc263097d301f2 Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Wed, 30 Apr 2025 17:48:38 +0200 Subject: [PATCH 12/28] Use libffi adjustors on aarch64 --- rts/rts.cabal | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/rts/rts.cabal b/rts/rts.cabal index 31ebdd4eb82a..01d986df2cea 100644 --- a/rts/rts.cabal +++ b/rts/rts.cabal @@ -631,21 +631,24 @@ library Jumps_V32.cmm Jumps_V64.cmm - -- Adjustor stuff if flag(libffi-adjustors) + -- forced libffi adjustors c-sources: adjustor/LibffiAdjustor.c + elif arch(javascript) + -- no adjustors for javascript + elif arch(i386) + asm-sources: adjustor/Nativei386Asm.S + c-sources: adjustor/Nativei386.c + elif arch(x86_64) + if os(mingw32) + asm-sources: adjustor/NativeAmd64MingwAsm.S + c-sources: adjustor/NativeAmd64Mingw.c + else + asm-sources: adjustor/NativeAmd64Asm.S + c-sources: adjustor/NativeAmd64.c else - -- Use GHC's native adjustors - if arch(i386) - asm-sources: adjustor/Nativei386Asm.S - c-sources: adjustor/Nativei386.c - if arch(x86_64) - if os(mingw32) - asm-sources: adjustor/NativeAmd64MingwAsm.S - c-sources: adjustor/NativeAmd64Mingw.c - else - asm-sources: adjustor/NativeAmd64Asm.S - c-sources: adjustor/NativeAmd64.c + -- default to libffi adjustors + c-sources: adjustor/LibffiAdjustor.c -- Use assembler STG entrypoint on architectures where it is used if arch(ppc) || arch(ppc64) || arch(s390x) || arch(riscv64) || arch(loongarch64) From 1a56bf11c05a7074a69f8301ad6932b5f2d8e966 Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Mon, 5 May 2025 17:03:16 +0200 Subject: [PATCH 13/28] Add multi-target support Use --target=foo to select a target installed in $topdir/targets/foo/ --- ghc/Main.hs | 26 ++++++++++++++++++++++---- 1 file changed, 22 insertions(+), 4 deletions(-) diff --git a/ghc/Main.hs b/ghc/Main.hs index 87dbef1d89ef..dc8185212be4 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -86,6 +86,8 @@ import GHC.Iface.Errors.Ppr -- Standard Haskell libraries import System.IO +import System.FilePath +import System.Directory import System.Environment import System.Exit import System.FilePath @@ -123,11 +125,27 @@ main = do -- 1. extract the -B flag from the args argv0 <- getArgs - let (minusB_args, argv1) = partition ("-B" `isPrefixOf`) argv0 + let (target_args, argv1) = partition ("--target=" `isPrefixOf`) argv0 + mbTarget | null target_args = Nothing + | otherwise = Just (drop 9 (last target_args)) + + + let (minusB_args, argv1') = partition ("-B" `isPrefixOf`) argv1 mbMinusB | null minusB_args = Nothing | otherwise = Just (drop 2 (last minusB_args)) - let argv2 = map (mkGeneralLocated "on the commandline") argv1 + -- find top directory for the given target. Or default to usual topdir. + targettopdir <- Just <$> do + topdir <- findTopDir mbMinusB + case mbTarget of + Nothing -> pure topdir + Just target -> do + let r = topdir "targets" target "lib" + doesDirectoryExist r >>= \case + True -> pure r + False -> throwGhcException (UsageError $ "Couldn't find specific target `" ++ target ++ "' in `" ++ r ++ "'") + + let argv2 = map (mkGeneralLocated "on the commandline") argv1' -- 2. Parse the "mode" flags (--make, --interactive etc.) (mode, units, argv3, flagWarnings) <- parseModeFlags argv2 @@ -143,13 +161,13 @@ main = do case mode of Left preStartupMode -> do case preStartupMode of - ShowSupportedExtensions -> showSupportedExtensions mbMinusB + ShowSupportedExtensions -> showSupportedExtensions targettopdir ShowVersion -> showVersion ShowNumVersion -> putStrLn cProjectVersion ShowOptions isInteractive -> showOptions isInteractive Right postStartupMode -> -- start our GHC session - GHC.runGhc mbMinusB $ do + GHC.runGhc targettopdir $ do dflags <- GHC.getSessionDynFlags From bb87a13298134e2d86e0238c11452ef65a8f1194 Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Wed, 7 May 2025 10:53:42 +0200 Subject: [PATCH 14/28] Support listing targets --- ghc/Main.hs | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/ghc/Main.hs b/ghc/Main.hs index dc8185212be4..fcc469e4bd71 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -134,18 +134,32 @@ main = do mbMinusB | null minusB_args = Nothing | otherwise = Just (drop 2 (last minusB_args)) + let (list_targets_args, argv1'') = partition (== "--list-targets") argv1' + list_targets = not (null list_targets_args) + -- find top directory for the given target. Or default to usual topdir. targettopdir <- Just <$> do topdir <- findTopDir mbMinusB + let targets_dir = topdir "targets" + -- list targets when asked + when list_targets $ do + putStrLn "Installed extra targets:" + doesDirectoryExist targets_dir >>= \case + True -> do + ds <- listDirectory targets_dir + forM_ ds (\d -> putStrLn $ " - " ++ d) + False -> pure () + exitSuccess + -- otherwise select the appropriate target case mbTarget of Nothing -> pure topdir Just target -> do - let r = topdir "targets" target "lib" + let r = targets_dir target "lib" doesDirectoryExist r >>= \case True -> pure r False -> throwGhcException (UsageError $ "Couldn't find specific target `" ++ target ++ "' in `" ++ r ++ "'") - let argv2 = map (mkGeneralLocated "on the commandline") argv1' + let argv2 = map (mkGeneralLocated "on the commandline") argv1'' -- 2. Parse the "mode" flags (--make, --interactive etc.) (mode, units, argv3, flagWarnings) <- parseModeFlags argv2 From 17203d9b3577aee24d0bc3076f40962be83b8792 Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Tue, 13 May 2025 14:29:26 +0200 Subject: [PATCH 15/28] Don't forget to rebuild cabal when needed --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 6a9b4f688d0b..8ed3abf8fbf0 100644 --- a/Makefile +++ b/Makefile @@ -1,4 +1,4 @@ -export CABAL := $(shell cabal update 2>&1 >/dev/null && cabal list-bin -v0 --project-dir libraries/Cabal cabal-install:exe:cabal) +export CABAL := $(shell cabal update 2>&1 >/dev/null && cabal build cabal-install -v0 --disable-tests --project-dir libraries/Cabal && cabal list-bin -v0 --project-dir libraries/Cabal cabal-install:exe:cabal) CPUS=$(shell mk/detect-cpu-count.sh) From a5bfd6ab38c7a3ef35a27185e2877c10f5cfb45e Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Tue, 13 May 2025 14:30:07 +0200 Subject: [PATCH 16/28] Use newer Cabal with support for -W --- libraries/Cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/Cabal b/libraries/Cabal index 98242d4d81e3..7e50837ade18 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 98242d4d81e38dd591e212f3a9df7f04215ad1c7 +Subproject commit 7e50837ade188504d1401bad932a5b8b3769661e From b2dca9294bf5858370b05c23bc92c62edd0bfa37 Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Tue, 13 May 2025 14:30:28 +0200 Subject: [PATCH 17/28] Bump cabal-version to support extra-static-libraries --- rts/rts.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/rts.cabal b/rts/rts.cabal index 01d986df2cea..65fd926e3541 100644 --- a/rts/rts.cabal +++ b/rts/rts.cabal @@ -1,4 +1,4 @@ -cabal-version: 3.4 +cabal-version: 3.8 name: rts version: 1.0.3 synopsis: The GHC runtime system From 273aff977945d7cd810d097721015b3a5e8fbfad Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Tue, 13 May 2025 17:16:16 +0200 Subject: [PATCH 18/28] Use two GHCs with cabal --- Build.hs | 97 +++++++++++++++++++++++++++++--------------------------- 1 file changed, 50 insertions(+), 47 deletions(-) diff --git a/Build.hs b/Build.hs index 4920d220a2a7..094a16132f8b 100755 --- a/Build.hs +++ b/Build.hs @@ -83,7 +83,7 @@ main = do generateSettings ghcToolchain stage1_settings "_build/stage1/" msg "Building boot libraries with stage1 compiler..." - buildBootLibraries cabal ghc1 ghcPkg1 deriveConstants genapply genprimop defaultGhcBuildOptions "_build/stage1/" + buildBootLibraries cabal ghc1 ghc1 ghcPkg1 deriveConstants genapply genprimop defaultGhcBuildOptions "_build/stage1/" msg "Building stage2 GHC program" createDirectoryIfMissing True "_build/stage2" @@ -127,9 +127,10 @@ main = do let ghc_wrapper = target_dir "ghc" writeFile ghc_wrapper ("#!/bin/sh\n" <> ghc_stage2_abs <> " -B" <> (target_dir "lib") <> " $@") _ <- readCreateProcess (shell $ "chmod +x " ++ ghc_wrapper) "" + let ghc2_host = Ghc ghc_stage2_abs [] let ghc2 = Ghc ghc_wrapper [] -- ghc2 <- Ghc <$> makeAbsolute "_build/stage2/bin/ghc" <*> pure ["-B"++ target_dir "lib"] - buildBootLibraries cabal ghc2 ghcPkg1 deriveConstants genapply genprimop defaultGhcBuildOptions target_dir + buildBootLibraries cabal ghc2_host ghc2 ghcPkg1 deriveConstants genapply genprimop defaultGhcBuildOptions target_dir -- Finally create bindist directory @@ -472,8 +473,8 @@ prepareGhcSources opts dst = do subst_in (dst "libraries/rts/include/ghcversion.h") common_substs -buildBootLibraries :: Cabal -> Ghc -> GhcPkg -> DeriveConstants -> GenApply -> GenPrimop -> GhcBuildOptions -> FilePath -> IO () -buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst = do +buildBootLibraries :: Cabal -> Ghc -> Ghc -> GhcPkg -> DeriveConstants -> GenApply -> GenPrimop -> GhcBuildOptions -> FilePath -> IO () +buildBootLibraries cabal ghc_host ghc ghcpkg derive_constants genapply genprimop opts dst = do src <- makeAbsolute (dst "src") prepareGhcSources opts src src_rts <- makeAbsolute (src "libraries/rts") @@ -592,8 +593,9 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst [ "--store-dir=" ++ store_dir , "build" , "--project-file=" ++ cabal_project_rts_path - , "rts" - , "--with-compiler=" ++ ghcPath ghc + , "rts:rts" + , "-w", ghcPath ghc + , "-W", ghcPath ghc_host , "--with-hc-pkg=" ++ ghcPkgPath ghcpkg , "--ghc-options=\"-ghcversion-file=" ++ ghcversionh ++ "\"" , "--builddir=" ++ build_dir @@ -769,57 +771,58 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst , "--package-env=" ++ boot_libs_env , "--force-reinstalls" , "--project-file=" ++ cabal_project_bootlibs_path - , "--with-compiler=" ++ ghcPath ghc + , "-w", ghcPath ghc + , "-W", ghcPath ghc_host , "--with-hc-pkg=" ++ ghcPkgPath ghcpkg , "--ghc-options=\"-ghcversion-file=" ++ ghcversionh ++ "\"" , "--builddir=" ++ build_dir , "-j" -- targets - , "rts" - , "ghc-internal" - , "ghc-experimental" - , "ghc-compact" - , "base" - , "stm" - , "system-cxx-std-lib" + , "rts:rts" + , "ghc-internal:ghc-internal" + , "ghc-experimental:ghc-experimental" + , "ghc-compact:ghc-compact" + , "base:base" + , "stm:stm" + , "system-cxx-std-lib:system-cxx-std-lib" -- shallow compat packages over ghc-internal - , "ghc-prim" - , "ghc-bignum" - , "integer-gmp" - , "template-haskell" + , "ghc-prim:ghc-prim" + , "ghc-bignum:ghc-bignum" + , "integer-gmp:integer-gmp" + , "template-haskell:template-haskell" -- target dependencies - , "ghc-boot-th" -- dependency of template-haskell - , "pretty" -- dependency of ghc-boot-th + , "ghc-boot-th:ghc-boot-th" -- dependency of template-haskell + , "pretty:pretty" -- dependency of ghc-boot-th -- other boot libraries used by tests - , "array" - , "binary" - , "bytestring" - , "Cabal" - , "Cabal-syntax" - , "containers" - , "deepseq" - , "directory" - , "exceptions" - , "file-io" - , "filepath" - , "hpc" - , "mtl" - , "os-string" - , "parsec" - , "process" - , "semaphore-compat" - , "text" - , "time" - , "transformers" - , "unix" -- FIXME: we'd have to install Win32 for Windows target. Maybe --libs could install dependencies too.. + , "array:array" + , "binary:binary" + , "bytestring:bytestring" + , "Cabal:Cabal" + , "Cabal-syntax:Cabal-syntax" + , "containers:containers" + , "deepseq:deepseq" + , "directory:directory" + , "exceptions:exceptions" + , "file-io:file-io" + , "filepath:filepath" + , "hpc:hpc" + , "mtl:mtl" + , "os-string:os-string" + , "parsec:parsec" + , "process:process" + , "semaphore-compat:semaphore-compat" + , "text:text" + , "time:time" + , "transformers:transformers" + , "unix:unix" -- FIXME: we'd have to install Win32 for Windows target. Maybe --libs could install dependencies too.. -- ghc related - , "ghc-boot" - , "ghc-heap" - , "ghc-platform" - , "ghc-toolchain" -- some test requires this - , "ghci" - , "ghc" + , "ghc-boot:ghc-boot" + , "ghc-heap:ghc-heap" + , "ghc-platform:ghc-platform" + , "ghc-toolchain:ghc-toolchain" -- some test requires this + , "ghci:ghci" + , "ghc:ghc" ] msg " - Building boot libraries..." From 306d8dbcf17b421dcd3cd167cb7d84aa3b8d801c Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Wed, 14 May 2025 16:58:13 +0200 Subject: [PATCH 19/28] Fix installation path for targets --- Build.hs | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/Build.hs b/Build.hs index 094a16132f8b..aa2e1aba0b21 100755 --- a/Build.hs +++ b/Build.hs @@ -98,17 +98,18 @@ main = do cp "_build/stage1/lib/settings" "_build/stage2/lib/settings" -- Now we build extra targets. Ideally those should be built on demand... - createDirectoryIfMissing True "_build/stage2/targets/" - let targets = - [ (,) "aarch64-linux" emptySettings - { settingsTriple = Just "aarch64-linux" - , settingsCc = ProgOpt (Just "aarch64-linux-zig-cc") Nothing - , settingsCxx = ProgOpt (Just "aarch64-linux-zig-c++") Nothing - , settingsLd = ProgOpt (Just "aarch64-linux-zig-cc") Nothing - , settingsMergeObjs = ProgOpt (Just "aarch64-linux-zig-cc") Nothing - , settingsCrossCompiling = True - , settingsUnlit = "$topdir/../../../bin/unlit" - } + targets_dir <- makeAbsolute "_build/stage2/lib/targets/" + createDirectoryIfMissing True targets_dir + let targets = [ +-- [ (,) "aarch64-linux" emptySettings +-- { settingsTriple = Just "aarch64-linux" +-- , settingsCc = ProgOpt (Just "aarch64-linux-zig-cc") Nothing +-- , settingsCxx = ProgOpt (Just "aarch64-linux-zig-c++") Nothing +-- , settingsLd = ProgOpt (Just "aarch64-linux-zig-cc") Nothing +-- , settingsMergeObjs = ProgOpt (Just "aarch64-linux-zig-cc") Nothing +-- , settingsCrossCompiling = True +-- , settingsUnlit = "$topdir/../../../bin/unlit" +-- } -- , (,) "javascript" emptySettings -- { settingsTriple = Just "javascript-unknown-ghcjs" -- , settingsCc = ProgOpt (Just "emcc") Nothing @@ -118,7 +119,7 @@ main = do ghc_stage2_abs <- makeAbsolute "_build/stage2/bin/ghc" forM_ targets $ \(target,settings) -> do msg $ "Bootstrapping target: " <> target - target_dir <- makeAbsolute ("_build/stage2/targets" target) + target_dir <- makeAbsolute (targets_dir target) createDirectoryIfMissing True target_dir generateSettings ghcToolchain settings target_dir -- compiler flags aren't passed consistently to configure, etc. From 1b5a3b23fe55c430ad20d759140813f7473c7f76 Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Fri, 23 May 2025 10:16:45 +0200 Subject: [PATCH 20/28] Add cross compile for aarch64 with GCC --- Build.hs | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/Build.hs b/Build.hs index aa2e1aba0b21..08d946123fb9 100755 --- a/Build.hs +++ b/Build.hs @@ -100,8 +100,17 @@ main = do -- Now we build extra targets. Ideally those should be built on demand... targets_dir <- makeAbsolute "_build/stage2/lib/targets/" createDirectoryIfMissing True targets_dir - let targets = [ --- [ (,) "aarch64-linux" emptySettings + let targets = + [ (,) "aarch64-linux" emptySettings + { settingsTriple = Just "aarch64-linux" + , settingsCc = ProgOpt (Just "aarch64-linux-gnu-gcc") Nothing + , settingsCxx = ProgOpt (Just "aarch64-linux-gnu-g++") Nothing + , settingsLd = ProgOpt (Just "aarch64-linux-gnu-gcc") Nothing + , settingsMergeObjs = ProgOpt (Just "aarch64-linux-gnu-gcc") Nothing + , settingsCrossCompiling = True + , settingsUnlit = "$topdir/../../../bin/unlit" + } +-- , (,) "aarch64-linux" emptySettings -- { settingsTriple = Just "aarch64-linux" -- , settingsCc = ProgOpt (Just "aarch64-linux-zig-cc") Nothing -- , settingsCxx = ProgOpt (Just "aarch64-linux-zig-c++") Nothing From 89b802c62c31840f32d7c88d869b0a9240650fdb Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 9 May 2025 06:57:45 +0000 Subject: [PATCH 21/28] Add .envrc --- .envrc | 7 +++++++ 1 file changed, 7 insertions(+) create mode 100644 .envrc diff --git a/.envrc b/.envrc new file mode 100644 index 000000000000..665d43906d7c --- /dev/null +++ b/.envrc @@ -0,0 +1,7 @@ +# Check if nix-direnv is already loaded; if not, source it +if ! has nix_direnv_reload; then + source_url "https://raw.githubusercontent.com/nix-community/nix-direnv/2.2.0/direnvrc" "sha256-+IuxtJIDzJIlHDAxyzr7M2S3FD +zSd/BNfZe+ntXje0=" +fi + +# Use the specified flake to enter the Nix development environment +use flake github:input-output-hk/devx#ghc98-minimal-ghc \ No newline at end of file From 57b4a7b02c01a0be9c61268c8f87e915e1045502 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sat, 10 May 2025 03:22:27 +0000 Subject: [PATCH 22/28] [ci] used devx action We will use nix and the devx action for now. This is IOGs standard tooling. While we are not opposed to other options, this is for now the de-facto way how we build stuff at IOG by default. --- .github/workflows/ci.yml | 39 +++++++++++++++++++++------------------ 1 file changed, 21 insertions(+), 18 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 0c8875257dc8..4b5397af2e9c 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -9,48 +9,51 @@ on: push: branches: [master] + workflow_dispatch: + jobs: cabal: - name: ${{ matrix.os }} / ghc ${{ matrix.ghc }} - runs-on: ${{ matrix.os }} + name: ${{ matrix.plat }} / ghc ${{ matrix.ghc }} + runs-on: "${{ fromJSON('{\"x86_64-linux\": \"ubuntu-24.04\", \"aarch64-linux\": \"ubuntu-24.04-arm\", \"x86_64-darwin\": \"macos-latest\", \"aarch64-darwin\": \"macos-latest\"}')[matrix.plat] }}" + strategy: fail-fast: false matrix: - os: [ubuntu-latest] - ghc: ['9.8.4'] # bootstrapping compiler + plat: [x86_64-linux, aarch64-linux, x86_64-darwin, aarch64-darwin] + ghc: ['98'] # bootstrapping compiler steps: - uses: actions/checkout@v4 with: submodules: "recursive" - - uses: haskell-actions/setup@v2 - id: setup - name: Setup Haskell tools + - uses: input-output-hk/actions/devx@latest with: - ghc-version: ${{ matrix.ghc }} - cabal-version: "latest" - cabal-update: true + platform: ${{ matrix.plat }} + compiler-nix-name: 'ghc98' + minimal: true + ghc: true - - name: Configure the build - run: ./boot + - name: Update hackage + shell: devx {0} + run: cabal update - - name: Build patched cabal - run: make cabal + - name: Configure the build + shell: devx {0} + run: ./configure - name: Build the bindist - env: - CC: gcc - CXX: g++ + shell: devx {0} run: make - name: Upload artifacts uses: actions/upload-artifact@v4 with: - name: bindist + name: ${{ matrix.plat }}-bindist path: _build/bindist - name: Run the testsuite + shell: devx {0} run: make test - name: Upload test results From c4a5d1cb0f3b1697b4ffa221bd8bc2e2087d743e Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 26 May 2025 07:46:20 +0000 Subject: [PATCH 23/28] Disable forced static. --- Build.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Build.hs b/Build.hs index 08d946123fb9..517d641dc39e 100755 --- a/Build.hs +++ b/Build.hs @@ -237,7 +237,7 @@ buildGhcStage booting opts cabal ghc0 dst = do , " shared: False" , " executable-profiling: False" , " executable-dynamic: False" - , " executable-static: True" + , " executable-static: False" , "" , "package ghc-boot-th" , " flags: +bootstrap" @@ -283,7 +283,7 @@ buildGhcStage booting opts cabal ghc0 dst = do , " shared: False" , " executable-profiling: False" , " executable-dynamic: False" - , " executable-static: True" + , " executable-static: False" , "" , "package ghc-bin" -- FIXME: we don't support the threaded rts way yet @@ -748,7 +748,7 @@ buildBootLibraries cabal ghc_host ghc ghcpkg derive_constants genapply genprimop , " shared: False" , " executable-profiling: False" , " executable-dynamic: False" - , " executable-static: True" + , " executable-static: False" , " extra-lib-dirs: " ++ dst_libffi "lib" , " extra-include-dirs: " ++ dst_libffi "include" , "" From 5a9e4e4b51d1bdc8f89d559e23d1a834c262b774 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 26 May 2025 07:46:47 +0000 Subject: [PATCH 24/28] Print cabal command on failure --- Build.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Build.hs b/Build.hs index 517d641dc39e..bbc82d6100d6 100755 --- a/Build.hs +++ b/Build.hs @@ -341,6 +341,8 @@ buildGhcStage booting opts cabal ghc0 dst = do case exit_code of ExitSuccess -> pure () ExitFailure n -> do + let CreateProcess { cmdspec = RawCommand cmd args } = build_cmd in + putStrLn $ "Failed to run cabal-install: " ++ cmd ++ " " ++ unwords args putStrLn $ "cabal-install failed with error code: " ++ show n putStrLn cabal_stdout putStrLn cabal_stderr From c9f0f6c3dbbd9aa68b13956da184a20960b62aec Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 26 May 2025 07:46:58 +0000 Subject: [PATCH 25/28] clone via https --- Build.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Build.hs b/Build.hs index bbc82d6100d6..c62109091568 100755 --- a/Build.hs +++ b/Build.hs @@ -512,7 +512,7 @@ buildBootLibraries cabal ghc_host ghc ghcpkg derive_constants genapply genprimop False -> do createDirectoryIfMissing True src_libffi -- fetch libffi fork with zig build system - void $ readCreateProcess (shell ("git clone git@github.com:vezel-dev/libffi.git " ++ src_libffi)) "" + void $ readCreateProcess (shell ("git clone https://github.com/vezel-dev/libffi.git " ++ src_libffi)) "" let build_libffi = mconcat [ "cd " ++ src_libffi ++ "; " From 223929bb200b41038a35ff524809e4196c6f5c35 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 26 May 2025 07:47:24 +0000 Subject: [PATCH 26/28] Add ZIG_LIBFFI defines --- Build.hs | 24 +++++++++++++++++++----- 1 file changed, 19 insertions(+), 5 deletions(-) diff --git a/Build.hs b/Build.hs index c62109091568..ebdf3c4c866b 100755 --- a/Build.hs +++ b/Build.hs @@ -7,8 +7,11 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall #-} +#define ZIG_LIBFFI 1 + -- | GHC builder -- -- Importantly, it doesn't link with the cabal library but use cabal-install @@ -502,6 +505,7 @@ buildBootLibraries cabal ghc_host ghc ghcpkg derive_constants genapply genprimop _ -> target_triple -- build libffi +#if defined(ZIG_LIBFFI) msg " - Building libffi..." src_libffi <- makeAbsolute (src "libffi") dst_libffi <- makeAbsolute (dst "libffi") @@ -529,7 +533,7 @@ buildBootLibraries cabal ghc_host ghc ghcpkg derive_constants genapply genprimop exitFailure cp (dst_libffi "include" "*") (src_rts "include") -- cp (dst_libffi "lib" "libffi.a") (takeDirectory ghcplatform_dir "libCffi.a") - +#endif -- Build the RTS build_dir <- makeAbsolute (dst "cabal" "build") store_dir <- makeAbsolute (dst "cabal" "store") @@ -596,8 +600,10 @@ buildBootLibraries cabal ghc_host ghc ghcpkg derive_constants genapply genprimop , " executable-profiling: False" , " executable-dynamic: False" , " executable-static: False" +#if defined(ZIG_LIBFFI) , " extra-lib-dirs: " ++ dst_libffi "lib" , " extra-include-dirs: " ++ dst_libffi "include" +#endif , "" ] ++ rts_options @@ -751,8 +757,10 @@ buildBootLibraries cabal ghc_host ghc ghcpkg derive_constants genapply genprimop , " executable-profiling: False" , " executable-dynamic: False" , " executable-static: False" +#if defined(ZIG_LIBFFI) , " extra-lib-dirs: " ++ dst_libffi "lib" , " extra-include-dirs: " ++ dst_libffi "include" +#endif , "" , "package ghc" -- build-tool-depends: require genprimopcode, etc. used by Setup.hs @@ -889,7 +897,8 @@ buildBootLibraries cabal ghc_host ghc ghcpkg derive_constants genapply genprimop -- NOTE: GHC assumes that pkgroot is just one directory above the directory -- containing the package db. In our case where everything is at the same -- level in "pkgs" we need to re-add "/pkgs" - let fix_pkgroot = Text.replace (Text.pack pkg_root) "${pkgroot}/pkgs" + let fix_pkgroot = Text.replace (Text.pack pkg_root) "${pkgroot}/pkgs" +#if defined(ZIG_LIBFFI) -- Add libCffi library to the rts. We can't use RTS cabal flag -use-system-ffi -- because the library needs to be installed during setup. let fix_cffi_line l @@ -899,17 +908,22 @@ buildBootLibraries cabal ghc_host ghc ghcpkg derive_constants genapply genprimop let fix_cffi c | not ("rts-" `List.isPrefixOf` pid) = c | otherwise = Text.unlines (map fix_cffi_line (Text.lines c)) +#endif - - Text.writeFile (dst "pkgs" pid <.> "conf") - (fix_cffi (fix_pkgroot conf)) + Text.writeFile (dst "pkgs" pid <.> "conf") ( +#if defined(ZIG_LIBFFI) + fix_cffi +#endif + (fix_pkgroot conf)) cp (pkg_root pid) (dst "pkgs") +#if defined(ZIG_LIBFFI) -- install libffi... when ("rts-" `List.isPrefixOf` pid) $ do cp (dst_libffi "lib" "libffi.a") (dst "pkgs" pid "lib" "libCffi.a") cp (dst_libffi "include" "ffi.h") (dst "pkgs" pid "lib" "include" "ffi.h") cp (dst_libffi "include" "ffitarget.h") (dst "pkgs" pid "lib" "include" "ffitarget.h") +#endif void $ readCreateProcess (runGhcPkg ghcpkg ["recache", "--package-db=" ++ (dst "pkgs")]) "" From 5256df6ded36e917f77e70ecfbd5e3d96a8079eb Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 26 May 2025 08:18:23 +0000 Subject: [PATCH 27/28] Augmenting the .envrc shell with nix shell nixpkgs/nixos-unstable#zig nixpkgs/nixos-unstable#pkgsCross.aarch64-multiplatform.buildPackages.gcc this should now get fairly far. --- Build.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/Build.hs b/Build.hs index ebdf3c4c866b..d1763e37b896 100755 --- a/Build.hs +++ b/Build.hs @@ -105,11 +105,11 @@ main = do createDirectoryIfMissing True targets_dir let targets = [ (,) "aarch64-linux" emptySettings - { settingsTriple = Just "aarch64-linux" - , settingsCc = ProgOpt (Just "aarch64-linux-gnu-gcc") Nothing - , settingsCxx = ProgOpt (Just "aarch64-linux-gnu-g++") Nothing - , settingsLd = ProgOpt (Just "aarch64-linux-gnu-gcc") Nothing - , settingsMergeObjs = ProgOpt (Just "aarch64-linux-gnu-gcc") Nothing + { settingsTriple = Just "aarch64-unknown-linux" + , settingsCc = ProgOpt (Just "aarch64-unknown-linux-gnu-gcc") Nothing + , settingsCxx = ProgOpt (Just "aarch64-unknown-linux-gnu-g++") Nothing + , settingsLd = ProgOpt (Just "aarch64-unknown-linux-gnu-gcc") Nothing + , settingsMergeObjs = ProgOpt (Just "aarch64-unknown-linux-gnu-gcc") Nothing , settingsCrossCompiling = True , settingsUnlit = "$topdir/../../../bin/unlit" } From 6d13fd5531ab0580f766e649f12b795298e70cf9 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 26 May 2025 08:20:59 +0000 Subject: [PATCH 28/28] Add cabal-install debug info to boot libraries --- Build.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Build.hs b/Build.hs index d1763e37b896..bca310e165a1 100755 --- a/Build.hs +++ b/Build.hs @@ -852,6 +852,8 @@ buildBootLibraries cabal ghc_host ghc ghcpkg derive_constants genapply genprimop case boot_exit_code of ExitSuccess -> pure () ExitFailure r -> do + let CreateProcess { cmdspec = RawCommand cmd args } = build_boot_cmd in + putStrLn $ "Failed to run cabal-install: " ++ cmd ++ " " ++ unwords args putStrLn $ "Failed to build boot libraries with error code " ++ show r putStrLn boot_stdout putStrLn boot_stderr