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 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 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/Build.hs b/Build.hs index 694f67abb01c..bca310e165a1 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 @@ -41,7 +44,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 +70,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 @@ -84,23 +86,64 @@ 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" - 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... + targets_dir <- makeAbsolute "_build/stage2/lib/targets/" + createDirectoryIfMissing True targets_dir + let targets = + [ (,) "aarch64-linux" emptySettings + { 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" + } +-- , (,) "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 +-- } + ] + + ghc_stage2_abs <- makeAbsolute "_build/stage2/bin/ghc" + forM_ targets $ \(target,settings) -> do + msg $ "Bootstrapping target: " <> 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. + -- 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_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_host ghc2 ghcPkg1 deriveConstants genapply genprimop defaultGhcBuildOptions target_dir -- Finally create bindist directory @@ -108,9 +151,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/" @@ -195,7 +240,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" @@ -241,7 +286,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 @@ -299,6 +344,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 @@ -441,22 +488,59 @@ 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 - - -- Build the RTS src_rts <- makeAbsolute (src "libraries/rts") - build_dir <- makeAbsolute (dst "cabal") - ghcversionh <- makeAbsolute (src_rts "include/ghcversion.h") - -- 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) 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 + + -- build libffi +#if defined(ZIG_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 https://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") +#endif + -- Build the 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 @@ -483,11 +567,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 @@ -503,7 +584,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" @@ -519,14 +600,20 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst , " 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 let build_rts_cmd = runCabal cabal - [ "build" + [ "--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 @@ -547,11 +634,18 @@ 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 - putStrLn "Couldn't find ghcplatform.h" + 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" -- deriving constants let derived_constants = src_rts "include/DerivedConstants.h" @@ -562,7 +656,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 @@ -597,9 +691,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" @@ -663,7 +756,11 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst , " shared: False" , " executable-profiling: False" , " executable-dynamic: False" - , " executable-static: True" + , " 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 @@ -688,62 +785,64 @@ 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" , "--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..." @@ -753,26 +852,41 @@ buildBootLibraries cabal ghc ghcpkg derive_constants genapply genprimop opts dst 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 - 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. 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 + | (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 -- copy the libs in another db @@ -785,10 +899,34 @@ 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" - Text.writeFile (dst "pkgs" pid <.> "conf") - (Text.replace (Text.pack pkg_root) "${pkgroot}/pkgs" conf) + 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 + | "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 + | otherwise = Text.unlines (map fix_cffi_line (Text.lines c)) +#endif + + 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")]) "" @@ -842,7 +980,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 +989,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 @@ -927,12 +1065,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 @@ -952,6 +1095,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 @@ -959,6 +1103,7 @@ data Settings = Settings , settingsTablesNextToCode :: Maybe Bool , settingsUseLibFFIForAdjustors :: Maybe Bool , settingsLdOverride :: Maybe Bool + , settingsCrossCompiling :: Bool } -- | Program specifier from the command-line. @@ -991,11 +1136,13 @@ emptySettings = Settings , settingsReadelf = po0 , settingsMergeObjs = po0 , settingsWindres = po0 + , settingsUnlit = "$topdir/../bin/unlit" , settingsLd = po0 , settingsUnregisterised = Nothing , settingsTablesNextToCode = Nothing , settingsUseLibFFIForAdjustors = Nothing , settingsLdOverride = Nothing + , settingsCrossCompiling = False } where po0 = emptyProgOpt @@ -1003,23 +1150,24 @@ 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" - 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] + , opt (poPath settingsLd) $ \x -> ["--ld", x] + , opt (poPath settingsMergeObjs) $ \x -> ["--merge-objs", x] -- FIXME: add other options for ghc-toolchain from Settings ]) ++ common_args @@ -1042,5 +1190,7 @@ 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") + $ Map.insert "unlit command" settingsUnlit $ kvs writeFile (dst "lib/settings") (show $ Map.toList kvs') diff --git a/Makefile b/Makefile index d07edfae6fe9..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) @@ -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) 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 $@ 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/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/ghc/Main.hs b/ghc/Main.hs index 87dbef1d89ef..fcc469e4bd71 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,41 @@ 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 + 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 = 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'' -- 2. Parse the "mode" flags (--make, --interactive etc.) (mode, units, argv3, flagWarnings) <- parseModeFlags argv2 @@ -143,13 +175,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 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/libraries/Cabal b/libraries/Cabal index 98242d4d81e3..7e50837ade18 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 98242d4d81e38dd591e212f3a9df7f04215ad1c7 +Subproject commit 7e50837ade188504d1401bad932a5b8b3769661e 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 193e8dd79440..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 @@ -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 @@ -613,30 +631,24 @@ 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) + -- 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 - -- fall back to the LibffiAdjustor if neither i386, or x86_64 - if !arch(x86_64) && !arch(i386) - c-sources: adjustor/LibffiAdjustor.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) 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 $@