diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml new file mode 100644 index 000000000000..0c8875257dc8 --- /dev/null +++ b/.github/workflows/ci.yml @@ -0,0 +1,64 @@ +name: CI + +# Trigger the workflow on push or pull request, but only for the master branch +on: + pull_request: + types: + - opened + - synchronize + push: + branches: [master] + +jobs: + cabal: + name: ${{ matrix.os }} / ghc ${{ matrix.ghc }} + runs-on: ${{ matrix.os }} + strategy: + fail-fast: false + matrix: + os: [ubuntu-latest] + ghc: ['9.8.4'] # bootstrapping compiler + + steps: + - uses: actions/checkout@v4 + with: + submodules: "recursive" + + - uses: haskell-actions/setup@v2 + id: setup + name: Setup Haskell tools + with: + ghc-version: ${{ matrix.ghc }} + cabal-version: "latest" + cabal-update: true + + - name: Configure the build + run: ./boot + + - name: Build patched cabal + run: make cabal + + - name: Build the bindist + env: + CC: gcc + CXX: g++ + run: make + + - name: Upload artifacts + uses: actions/upload-artifact@v4 + with: + name: bindist + path: _build/bindist + + - name: Run the testsuite + run: make test + + - name: Upload test results + uses: actions/upload-artifact@v4 + if: ${{ !cancelled() }} # upload test results even if the testsuite failed to pass + with: + name: testsuite-results + path: | + _build/test-perf.csv + _build/test-summary.txt + _build/test-junit.xml diff --git a/.gitmodules b/.gitmodules index 46f1db3e7cc5..fc634597fb31 100644 --- a/.gitmodules +++ b/.gitmodules @@ -8,8 +8,9 @@ ignore = untracked [submodule "libraries/Cabal"] path = libraries/Cabal - url = https://gitlab.haskell.org/ghc/packages/Cabal.git + url = https://github.com/stable-haskell/cabal ignore = untracked + branch = wip/make-build [submodule "libraries/containers"] path = libraries/containers url = https://gitlab.haskell.org/ghc/packages/containers.git diff --git a/Build.hs b/Build.hs new file mode 100755 index 000000000000..08d946123fb9 --- /dev/null +++ b/Build.hs @@ -0,0 +1,1178 @@ +#!/usr/bin/env runhaskell + +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE RecordWildCards #-} +{-# OPTIONS_GHC -Wall #-} + +-- | GHC builder +-- +-- Importantly, it doesn't link with the cabal library but use cabal-install +-- program instead (compared to e.g. Hadrian). +module Main where + +import Data.Maybe +import Data.List qualified as List +import Data.Map qualified as Map +import Data.Map (Map) +import Data.Text (Text) +import Data.Text qualified as Text +import Data.Text.IO qualified as Text +import Control.Monad +import Control.Exception (bracket) +import System.Environment +import System.Directory +import System.Process +import System.FilePath +import System.Exit +import System.IO.Unsafe +import Data.Time.Clock +import Data.IORef +import Data.Fixed + +main :: IO () +main = do + -- detect GHC and cabal-install to use for bootstrapping + ghc0 <- 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 []) + + cabal <- do + cabal_path <- fromMaybe "cabal" <$> lookupEnv "CABAL" + findExecutable cabal_path >>= \case + Nothing -> error ("Couldn't find cabal-install: " ++ show cabal_path) + Just x -> pure (Cabal x) + + ghc0_version <- readCreateProcess (runGhc ghc0 ["--version"]) "" + msg $ "Bootstrapping GHC version: " ++ init ghc0_version + + msg "Building stage1 GHC program and utility programs" + buildGhcStage1 defaultGhcBuildOptions cabal ghc0 "_build/stage0/" + + -- now we copy the stage1 compiler and other tools into _build/stage1 and we + -- generate settings to use the newly installed packages. That's not what + -- Hadrian does but it's easier for us to nuke the stage1 directory to remove + -- only stage1's built libs without nuking the stage1 compiler which is slow + -- to build. + createDirectoryIfMissing True "_build/stage1/bin" + createDirectoryIfMissing True "_build/stage1/lib" + createDirectoryIfMissing True "_build/stage1/pkgs" + cp "_build/stage0/bin/*" "_build/stage1/bin/" + 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" <*> 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 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 + } + generateSettings ghcToolchain stage1_settings "_build/stage1/" + + msg "Building boot libraries with stage1 compiler..." + 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" <*> pure [] + buildGhcStage2 defaultGhcBuildOptions cabal ghc1' "_build/stage2/" + + -- 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" + + -- 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-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 +-- , 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 + msg "Creating bindist" + 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/" + + msg "Done" + + +-- | Build stage1 GHC program +buildGhcStage1 :: GhcBuildOptions -> Cabal -> Ghc -> FilePath -> IO () +buildGhcStage1 = buildGhcStage True + +-- | Build stage2 GHC program +buildGhcStage2 :: GhcBuildOptions -> Cabal -> Ghc -> FilePath -> IO () +buildGhcStage2 = buildGhcStage False + +-- | Build GHC program +buildGhcStage :: Bool -> GhcBuildOptions -> Cabal -> Ghc -> FilePath -> IO () +buildGhcStage booting opts cabal ghc0 dst = do + let src = dst "src" + prepareGhcSources opts src + + msg " - Building GHC and utility programs..." + + let builddir = dst "cabal" + createDirectoryIfMissing True builddir + + -- we need to augment the current environment to pass HADRIAN_SETTINGS + -- environment variable to ghc-boot's Setup.hs script. + (arch,os) <- ghcTargetArchOS ghc0 + stage1_ghc_boot_settings <- do + commit_id <- readCreateProcess (proc "git" ["rev-parse", "HEAD"]) "" + -- we infer stage1's host platform from stage0's settings + let settings = + [ ("hostPlatformArch", arch) + , ("hostPlatformOS", os) + , ("cProjectGitCommitId", commit_id) + , ("cProjectVersion", Text.unpack $ gboVersion opts) + , ("cProjectVersionInt", Text.unpack $ gboVersionInt opts) + , ("cProjectPatchLevel", Text.unpack $ gboVersionPatchLevel opts) + , ("cProjectPatchLevel1", Text.unpack $ gboVersionPatchLevel1 opts) + , ("cProjectPatchLevel2", Text.unpack $ gboVersionPatchLevel2 opts) + ] :: [(String,String)] + pure (show settings) + + current_env <- getEnvironment + let stage1_env = ("HADRIAN_SETTINGS", stage1_ghc_boot_settings) : current_env + + let cabal_project_path = dst "cabal.project-ghc" + + let stage1_project = + [ "packages:" + , " " ++ src "ghc-bin/" + , " " ++ src "libraries/ghc/" + , " " ++ src "libraries/directory/" + , " " ++ src "libraries/file-io/" + , " " ++ src "libraries/filepath/" + , " " ++ src "libraries/ghc-platform/" + , " " ++ src "libraries/ghc-boot/" + , " " ++ src "libraries/ghc-boot-th/" + , " " ++ src "libraries/ghc-heap" + , " " ++ src "libraries/ghci" + , " " ++ src "libraries/os-string/" + , " " ++ src "libraries/process/" + , " " ++ src "libraries/semaphore-compat" + , " " ++ src "libraries/time" + , " " ++ src "libraries/unix/" + , " " ++ src "libraries/Win32/" + , " " ++ src "utils/ghc-pkg" + , " " ++ src "utils/hsc2hs" + , " " ++ src "utils/unlit" + , " " ++ src "utils/genprimopcode/" + , " " ++ src "utils/genapply/" + , " " ++ src "utils/deriveConstants/" + , " " ++ src "utils/ghc-toolchain/" + , " " ++ src "utils/ghc-toolchain/exe" + , "" + , "benchmarks: False" + , "tests: False" + , "allow-boot-library-installs: True" + , "" + , "package *" + , " library-vanilla: True" + , " shared: False" + , " executable-profiling: False" + , " executable-dynamic: False" + , " executable-static: True" + , "" + , "package ghc-boot-th" + , " flags: +bootstrap" + , "" + , "package hsc2hs" + , " flags: +in-ghc-tree" -- allow finding template-hsc.h in GHC's /lib + , "" + -- allow template-haskell with newer ghc-boot-th + , "allow-newer: ghc-boot-th" + , "" + , "constraints:" + -- FIXME: template-haskell 2.23 is too recent when booting with 9.8.4 + , " template-haskell <= 2.22" + ] + + let stage2_project = + [ "packages:" + -- ghc *library* mustn't be listed here: otherwise its unit-id becomes + -- ghc-9.xx-inplace and it's wrong when we load plugins + -- (wired-in thisGhcUnitId is wrong) + -- + -- actually we don't need any of the boot packages we already + -- installed. + , " " ++ src "ghc-bin/" + , " " ++ src "libraries/haskeline/" + , " " ++ src "libraries/terminfo/" + , " " ++ src "utils/ghc-pkg" + , " " ++ src "utils/hsc2hs" + , " " ++ src "utils/hp2ps" + , " " ++ src "utils/hpc" + , " " ++ src "utils/unlit" + , " " ++ src "utils/iserv" + , " " ++ src "utils/genprimopcode/" + , " " ++ src "utils/genapply/" + , " " ++ src "utils/deriveConstants/" + , " " ++ src "utils/runghc/" + , "" + , "benchmarks: False" + , "tests: False" + , "" + , "package *" + , " library-vanilla: True" + , " shared: False" + , " executable-profiling: False" + , " executable-dynamic: False" + , " executable-static: True" + , "" + , "package ghc-bin" + -- FIXME: we don't support the threaded rts way yet + , " flags: +internal-interpreter -threaded" + , "" + , "package hsc2hs" + , " flags: +in-ghc-tree" -- allow finding template-hsc.h in GHC's /lib + , "" + , "package haskeline" + , " flags: -terminfo" -- FIXME: should be enabled but I don't have the static libs for terminfo on ArchLinux... + , "" + ] + + makeCabalProject cabal_project_path (if booting then stage1_project else stage2_project) + + -- the targets + let targets + | booting = + [ "ghc-bin:ghc" + , "ghc-pkg:ghc-pkg" + , "genprimopcode:genprimopcode" + , "deriveConstants:deriveConstants" + , "genapply:genapply" + , "ghc-toolchain-bin:ghc-toolchain-bin" + , "unlit:unlit" + , "hsc2hs:hsc2hs" + ] + | otherwise = + [ "ghc-bin:ghc" + , "ghc-pkg:ghc-pkg" + , "genprimopcode:genprimopcode" + , "deriveConstants:deriveConstants" + , "genapply:genapply" + , "unlit:unlit" + , "hsc2hs:hsc2hs" + , "hp2ps:hp2ps" + , "hpc-bin:hpc" + , "iserv:iserv" + , "runghc:runghc" + ] + + let build_cmd = (runCabal cabal $ + [ "build" + , "--project-file=" ++ cabal_project_path + , "--builddir=" ++ builddir + , "-j" + , "--with-compiler=" ++ ghcPath ghc0 + ] ++ targets) + { env = Just stage1_env + } + + (exit_code, cabal_stdout, cabal_stderr) <- readCreateProcessWithExitCode build_cmd "" + writeFile (dst "cabal.stdout") cabal_stdout + writeFile (dst "cabal.stderr") cabal_stderr + case exit_code of + ExitSuccess -> pure () + ExitFailure n -> do + putStrLn $ "cabal-install failed with error code: " ++ show n + putStrLn cabal_stdout + putStrLn cabal_stderr + putStrLn $ "Logs can be found in \"" ++ (dst "cabal.{stdout,stderr}\"") + exitFailure + + msg " - Copying programs and generating GHC settings..." + let listbin_cmd p = runCabal cabal + [ "list-bin" + , "--project-file=" ++ cabal_project_path + , "--with-compiler=" ++ ghcPath ghc0 + , "--builddir=" ++ builddir + , p + ] + let copy_bin target bin = do + (list_bin_exit_code, list_bin_stdout, list_bin_stderr) <- readCreateProcessWithExitCode (listbin_cmd target) "" + case list_bin_exit_code of + ExitSuccess + | (bin_src:_) <- lines list_bin_stdout + -> cp bin_src (dst "bin" bin) + _ -> do + putStrLn $ "Failed to run cabal list-bin for the target: " ++ show target + putStrLn list_bin_stderr + exitFailure + createDirectoryIfMissing True (dst "bin") + + copy_bin "ghc-bin:ghc" "ghc" + copy_bin "ghc-pkg:ghc-pkg" "ghc-pkg" + copy_bin "unlit:unlit" "unlit" + copy_bin "hsc2hs:hsc2hs" "hsc2hs" + -- always install these tools: they are needed to build the ghc library (e.g. + -- for a different target) + copy_bin "deriveConstants:deriveConstants" "deriveConstants" + copy_bin "genprimopcode:genprimopcode" "genprimopcode" + copy_bin "genapply:genapply" "genapply" + + createDirectoryIfMissing True (dst "lib") + cp (src "utils/hsc2hs/data/template-hsc.h") (dst "lib/template-hsc.h") + + unless booting $ do + copy_bin "hp2ps:hp2ps" "hp2ps" + copy_bin "hpc-bin:hpc" "hpc" + copy_bin "runghc:runghc" "runghc" + copy_bin "iserv:iserv" "ghc-iserv" -- vanilla iserv + + when booting $ do + copy_bin "ghc-toolchain-bin:ghc-toolchain-bin" "ghc-toolchain" + + -- initialize empty global package database + pkgdb <- makeAbsolute (dst "pkgs") + ghcpkg <- GhcPkg <$> makeAbsolute (dst "bin/ghc-pkg") + initEmptyDB ghcpkg pkgdb + + +-- | Prepare GHC sources in the given directory +prepareGhcSources :: GhcBuildOptions -> FilePath -> IO () +prepareGhcSources opts dst = do + msg $ " - Preparing sources in " ++ dst ++ "..." + createDirectoryIfMissing True dst + createDirectoryIfMissing True (dst "libraries/ghc/MachRegs") + + cp "./libraries" dst + cp "./compiler/*" (dst "libraries/ghc/") + cp "./rts" (dst "libraries/") + cp "./ghc" (dst "ghc-bin") + cp "./utils" dst + + cp "./config.sub" (dst "libraries/rts/") + cp "./config.guess" (dst "libraries/rts/") + + -- These needs to shared + cp "rts/include/rts/Bytecodes.h" (dst "libraries/ghc/") + cp "rts/include/rts/storage/ClosureTypes.h" (dst "libraries/ghc/") + cp "rts/include/rts/storage/FunTypes.h" (dst "libraries/ghc/") + cp "rts/include/stg/MachRegs.h" (dst "libraries/ghc/") + cp "rts/include/stg/MachRegs/*.h" (dst "libraries/ghc/MachRegs/") + + -- shared among ghc-internal rts and unlit + cp "utils/fs/fs.h" (dst "libraries/ghc-internal/include") + cp "utils/fs/fs.c" (dst "libraries/ghc-internal/cbits") + cp "utils/fs/fs.*" (dst "libraries/rts/") + cp "utils/fs/fs.*" (dst "utils/unlit/") + + python <- findExecutable "python" >>= \case + Nothing -> error "Couldn't find 'python'" + Just r -> pure r + + void $ readCreateProcess (proc python + [ "rts/gen_event_types.py" + , "--event-types-defines" + , dst "libraries/rts/include/rts/EventLogConstants.h" + ]) "" + + void $ readCreateProcess (proc python + [ "rts/gen_event_types.py" + , "--event-types-array" + , dst "libraries/rts/include/rts/EventTypes.h" + ]) "" + + -- substitute variables in files + let subst fin fout rs = do + t <- Text.readFile fin + Text.writeFile fout (List.foldl' (\v (needle,rep) -> Text.replace needle rep v) t rs) + let subst_in f = subst (f <.> "in") f + let common_substs = + [ (,) "@ProjectVersion@" (gboVersion opts) + , (,) "@ProjectVersionMunged@" (gboVersionMunged opts) + , (,) "@ProjectVersionForLib@" (gboVersionForLib opts) + , (,) "@ProjectPatchLevel1@" (gboVersionPatchLevel1 opts) + , (,) "@ProjectPatchLevel2@" (gboVersionPatchLevel2 opts) + , (,) "@ProjectVersionInt@" (gboVersionInt opts) + ] + llvm_substs = + [ (,) "@LlvmMinVersion@" (gboLlvmMinVersion opts) + , (,) "@LlvmMaxVersion@" (gboLlvmMaxVersion opts) + ] + boot_th_substs = + [ (,) "@Suffix@" "" + , (,) "@SourceRoot@" "." + ] + + subst_in (dst "ghc-bin/ghc-bin.cabal") common_substs + subst_in (dst "libraries/ghc/ghc.cabal") common_substs + subst_in (dst "libraries/ghc-boot/ghc-boot.cabal") common_substs + subst_in (dst "libraries/ghc-boot-th/ghc-boot-th.cabal") (common_substs ++ boot_th_substs) + subst_in (dst "libraries/ghc-heap/ghc-heap.cabal") common_substs + subst_in (dst "libraries/template-haskell/template-haskell.cabal") common_substs + subst_in (dst "libraries/ghci/ghci.cabal") common_substs + + -- This is only used for a warning message. Nuke the check! + subst_in (dst "libraries/ghc/GHC/CmmToLlvm/Version/Bounds.hs") llvm_substs + + subst_in (dst "utils/ghc-pkg/ghc-pkg.cabal") common_substs + subst_in (dst "utils/iserv/iserv.cabal") common_substs + subst_in (dst "utils/runghc/runghc.cabal") common_substs + + subst_in (dst "libraries/ghc-internal/ghc-internal.cabal") common_substs + subst_in (dst "libraries/ghc-experimental/ghc-experimental.cabal") common_substs + subst_in (dst "libraries/base/base.cabal") common_substs + subst_in (dst "libraries/rts/include/ghcversion.h") common_substs + + +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") + + -- 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 + 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 + 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 + -- last double-quote). + let def_string k v = " ghc-options: \"-optc-D" ++ k ++ "=\\\"" ++ v ++ "\\\"\"" + let def k v = " ghc-options: \"-optc-D" ++ k ++ "=" ++ v ++ "\"" + let rts_options = + [ "package rts" + , def_string "ProjectVersion" (Text.unpack (gboVersionInt opts)) + , def_string "RtsWay" "v" + , def_string "HostPlatform" target_triple + , def_string "HostArch" arch + , def_string "HostOS" os + , def_string "HostVendor" vendor + , def_string "BuildPlatform" "FIXME" + , def_string "BuildArch" "FIXME" + , def_string "BuildOS" "FIXME" + , def_string "BuildVendor" "FIXME" + , def_string "GhcUnregisterised" "FIXME" + , def_string "TablesNextToCode" "FIXME" + -- Set the namespace for the rts fs functions + , def "FS_NAMESPACE" "rts" + -- 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 +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 + -- not. It would be cleaner than duplicating this information into the + -- settings (similar to what we do with platform constants). + + -- FIXME: Cabal doesn't like when flags are on separate lines like + -- this: + -- flags: +use-system-libffi + -- flags: +tables-next-to-code + -- Apparently it makes it ignore the first set of flags... + -- See https://github.com/haskell/cabal/issues/10767 + ] + + makeCabalProject cabal_project_rts_path $ + [ "package-dbs: clear, store" + , "" + , "packages:" + , " " ++ src "libraries/rts" + , "" + , "benchmarks: False" + , "tests: False" + , "allow-boot-library-installs: True" + , "active-repositories: :none" + , "" + , "package *" + , " library-vanilla: True" + , " shared: False" + , " executable-profiling: False" + , " executable-dynamic: False" + , " executable-static: False" + , " extra-lib-dirs: " ++ dst_libffi "lib" + , " extra-include-dirs: " ++ dst_libffi "include" + , "" + ] ++ rts_options + + let build_rts_cmd = runCabal cabal + [ "--store-dir=" ++ store_dir + , "build" + , "--project-file=" ++ cabal_project_rts_path + , "rts:rts" + , "-w", ghcPath ghc + , "-W", ghcPath ghc_host + , "--with-hc-pkg=" ++ ghcPkgPath ghcpkg + , "--ghc-options=\"-ghcversion-file=" ++ ghcversionh ++ "\"" + , "--builddir=" ++ build_dir + ] + + -- FIXME: deriveConstants requires ghcautoconf.h and ghcplatform.h but these + -- files are generated by the configure script of the RTS... + -- We use the following hack: + -- 1. run cabal until it fails. This should generate the headers we need before failing. + -- 2. use deriveConstants to generate the other files + -- 3. rerun cabal to build the rts + + msg " - Generating headers and sources..." + + -- first run is expected to fail because of misssing headers + (_exit_code, rts_conf_stdout, rts_conf_stderr) <- readCreateProcessWithExitCode build_rts_cmd "" + writeFile (dst "rts-conf.stdout") rts_conf_stdout + writeFile (dst "rts-conf.stderr") rts_conf_stderr + ghcplatform_dir <- do + 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}") + exitFailure + [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" + withSystemTempDirectory "derive-constants" $ \tmp_dir -> do + target <- getTarget ghc + void $ readCreateProcess (runDeriveConstants derive_constants + [ "--gen-header" + , "-o", derived_constants + , "--target-os", target + , "--tmpdir", tmp_dir + , "--gcc-program", cc + , "--nm-program", "nm" -- FIXME + , "--objdump-program", "objdump" -- FIXME + -- pass `-fcommon` to force symbols into the common section. If they + -- end up in the ro data section `nm` won't list their size, and thus + -- derivedConstants will fail. Recent clang (e.g. 16) will by default + -- use `-fno-common`. + , "--gcc-flag", "-fcommon" + , "--gcc-flag", "-I" ++ src_rts "include" + , "--gcc-flag", "-I" ++ src_rts + , "--gcc-flag", "-I" ++ ghcplatform_dir + ]) "" + + -- Generate autoapply + let run_genapply args out = writeFile out =<< readCreateProcess (runGenApply genapply args) "" + run_genapply [derived_constants] (src_rts "AutoApply.cmm") + run_genapply [derived_constants, "-V16"] (src_rts "AutoApply_V16.cmm") + run_genapply [derived_constants, "-V32"] (src_rts "AutoApply_V32.cmm") + run_genapply [derived_constants, "-V64"] (src_rts "AutoApply_V64.cmm") + + -- Generate primop code for ghc-internal + -- + -- Note that this can't be done in a Setup.hs for ghc-internal because + -- cabal-install can't build Setup.hs because it depends on base, Cabal, etc. + -- libraries that aren't built yet. + let primops_txt = src "libraries/ghc/GHC/Builtin/primops.txt" + let primops_txt_pp = primops_txt <.> ".pp" + primops <- readCreateProcess (shell $ "cc -E -undef -traditional -P -x c " ++ primops_txt_pp) "" + writeFile primops_txt primops + 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 boot libraries: ghc-internal, base... + let cabal_project_bootlibs_path = dst "cabal-project-boot-libs" + makeCabalProject cabal_project_bootlibs_path $ + [-- "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" + , " " ++ src "libraries/ghc-experimental" + , " " ++ src "libraries/base" + , " " ++ src "libraries/ghc" + , " " ++ src "libraries/ghc-platform/" + , " " ++ src "libraries/ghc-compact/" + , " " ++ src "libraries/ghc-bignum/" + , " " ++ src "libraries/integer-gmp/" + , " " ++ src "libraries/ghc-boot/" + , " " ++ src "libraries/ghc-boot-th/" + , " " ++ src "libraries/ghc-heap" + , " " ++ src "libraries/ghci" + , " " ++ src "libraries/stm" + , " " ++ src "libraries/template-haskell" + , " " ++ src "libraries/hpc" + , " " ++ src "libraries/system-cxx-std-lib" + , " " ++ src "ghc-bin/" + , " " ++ src "utils/ghc-pkg" + , " " ++ src "utils/hsc2hs" + , " " ++ src "utils/unlit" + , " " ++ src "utils/genprimopcode" + , " " ++ src "utils/deriveConstants" + , " " ++ src "utils/ghc-toolchain/" + , " " ++ src "libraries/array" + , " " ++ src "libraries/binary" + , " " ++ src "libraries/bytestring" + , " " ++ src "libraries/containers/containers" + , " " ++ src "libraries/deepseq" + , " " ++ src "libraries/directory/" + , " " ++ src "libraries/exceptions" + , " " ++ src "libraries/file-io/" + , " " ++ src "libraries/filepath/" + , " " ++ src "libraries/mtl" + , " " ++ src "libraries/os-string/" + , " " ++ src "libraries/parsec" + , " " ++ src "libraries/pretty/" + , " " ++ src "libraries/process/" + , " " ++ src "libraries/semaphore-compat" + , " " ++ src "libraries/text" + , " " ++ src "libraries/time" + , " " ++ src "libraries/transformers" + , " " ++ src "libraries/unix/" + , " " ++ src "libraries/Win32/" + , " " ++ src "libraries/Cabal/Cabal-syntax" + , " " ++ src "libraries/Cabal/Cabal" + -- use alex from Hackage, not git, as it already has preprocessed + -- alex/happy files. + , " https://hackage.haskell.org/package/alex-3.5.2.0/alex-3.5.2.0.tar.gz" + , " https://hackage.haskell.org/package/happy-2.1.5/happy-2.1.5.tar.gz" + , " https://hackage.haskell.org/package/happy-lib-2.1.5/happy-lib-2.1.5.tar.gz" + , "" + , "benchmarks: False" + , "tests: False" + , "allow-boot-library-installs: True" + , "active-repositories: :none" + , "" + , "package *" + , " library-vanilla: True" + , " shared: False" + , " 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 + -- internal-interpreter: otherwise our compiler has the internal + -- interpreter but not the boot library we install + -- FIXME: we should really install the lib we used to build stage2 + , " flags: +build-tool-depends +internal-interpreter" + , "" + , "package ghci" + , " flags: +internal-interpreter" + , "" + , "package ghc-internal" + -- FIXME: make our life easier for now by using the native bignum backend + , " flags: +bignum-native" + , "" + , "package text" + -- FIXME: avoid having to deal with system-cxx-std-lib fake package for now + , " flags: -simdutf" + , "" + ] ++ rts_options + + + let boot_libs_env = dst "boot-libs.env" + let build_boot_cmd = runCabal cabal + [ "--store-dir=" ++ store_dir + , "install" + , "--lib" + , "--package-env=" ++ boot_libs_env + , "--force-reinstalls" + , "--project-file=" ++ cabal_project_bootlibs_path + , "-w", ghcPath ghc + , "-W", ghcPath ghc_host + , "--with-hc-pkg=" ++ ghcPkgPath ghcpkg + , "--ghc-options=\"-ghcversion-file=" ++ ghcversionh ++ "\"" + , "--builddir=" ++ build_dir + , "-j" + + -- targets + , "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-prim" + , "ghc-bignum:ghc-bignum" + , "integer-gmp:integer-gmp" + , "template-haskell:template-haskell" + -- target dependencies + , "ghc-boot-th:ghc-boot-th" -- dependency of template-haskell + , "pretty:pretty" -- dependency of ghc-boot-th + -- other boot libraries used by tests + , "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-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..." + (boot_exit_code, boot_stdout, boot_stderr) <- readCreateProcessWithExitCode build_boot_cmd "" + writeFile (dst "boot-libs.stdout") boot_stdout + writeFile (dst "boot-libs.stderr") boot_stderr + case boot_exit_code of + ExitSuccess -> pure () + ExitFailure r -> do + 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}") + exitFailure + + -- The libraries have been installed globally. + boot_libs_env_lines <- lines <$> readFile boot_libs_env + (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 -> 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 + createDirectoryIfMissing True (dst "pkgs") + initEmptyDB ghcpkg (dst "pkgs") + let pkg_root = takeDirectory global_db + forM_ pkg_ids $ \pid -> do + conf <- Text.readFile (global_db pid <.> "conf") + -- replace full path with ${pkgroot} + -- 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" + | "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)) + + + Text.writeFile (dst "pkgs" pid <.> "conf") + (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") + 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")]) "" + + + +--------------------------- +-- Options +--------------------------- + +data GhcBuildOptions = GhcBuildOptions + { gboVersion :: !Text -- ^ GHC version + , gboVersionInt :: !Text -- ^ GHC version as an Int + , gboVersionMunged :: !Text -- ^ GHC version "munged" + , gboVersionForLib :: !Text -- ^ GHC version for libraries? + , gboVersionPatchLevel :: !Text -- ^ GHC patchlevel version + , gboVersionPatchLevel1 :: !Text -- ^ GHC patchlevel1 version + , gboVersionPatchLevel2 :: !Text -- ^ GHC patchlevel2 version + , gboLlvmMinVersion :: !Text -- ^ Min LLVM version supported + , gboLlvmMaxVersion :: !Text -- ^ Max LLVM version supported + } + +defaultGhcBuildOptions :: GhcBuildOptions +defaultGhcBuildOptions = GhcBuildOptions + { gboVersion = "9.13" + , gboVersionInt = "913" + , gboVersionMunged = "9.13" + , gboVersionForLib = "9.1300" + , gboVersionPatchLevel = "0" + , gboVersionPatchLevel1 = "0" + , gboVersionPatchLevel2 = "0" + , gboLlvmMinVersion = "13" + , gboLlvmMaxVersion = "20" + } + + + +--------------------------- +-- Utilities +--------------------------- + +{-# NOINLINE init_time #-} +init_time :: IORef UTCTime +init_time = unsafePerformIO (newIORef =<< getCurrentTime) + +-- | Display a message to the user with some timestamp +msg :: String -> IO () +msg x = do + it <- readIORef init_time + t <- getCurrentTime + let d = realToFrac (nominalDiffTimeToSeconds (diffUTCTime t it)) :: Centi + let stp = "[" ++ show d ++ "s] " + putStrLn (stp ++ replicate (6 - length stp) ' ' ++ x) + +-- Avoid FilePath blindness by using type aliases for programs. +data Ghc = Ghc FilePath [String] +newtype GhcPkg = GhcPkg FilePath +newtype GhcToolchain = GhcToolchain FilePath +newtype Cabal = Cabal FilePath +newtype DeriveConstants = DeriveConstants FilePath +newtype GenApply = GenApply FilePath +newtype GenPrimop = GenPrimop FilePath + +runGhc :: Ghc -> [String] -> CreateProcess +runGhc (Ghc f args) xs = proc f (args ++ xs) + +ghcPath :: Ghc -> FilePath +ghcPath (Ghc x _) = x + +runGhcPkg :: GhcPkg -> [String] -> CreateProcess +runGhcPkg (GhcPkg f) = proc f + +runGhcToolchain :: GhcToolchain -> [String] -> CreateProcess +runGhcToolchain (GhcToolchain f) = proc f + +ghcPkgPath :: GhcPkg -> FilePath +ghcPkgPath (GhcPkg x) = x + +runCabal :: Cabal -> [String] -> CreateProcess +runCabal (Cabal f) = proc f + +runDeriveConstants :: DeriveConstants -> [String] -> CreateProcess +runDeriveConstants (DeriveConstants f) = proc f + +runGenApply :: GenApply -> [String] -> CreateProcess +runGenApply (GenApply f) = proc f + +runGenPrimop :: GenPrimop -> [String] -> CreateProcess +runGenPrimop (GenPrimop f) = proc f + +-- | Copy +-- +-- Recursively, force overwrite, and preserve timestamps (important for package +-- dbs) +cp :: String -> String -> IO () +cp src dst = void (readCreateProcess (shell $ "cp -rfp " ++ src ++ " " ++ dst) "") + + +makeCabalProject :: FilePath -> [String] -> IO () +makeCabalProject path xs = writeFile path $ unlines (xs ++ common) + where + common = + [ "" + , "program-options" + , " ghc-options: -fhide-source-paths -j" + ] + + +withSystemTempDirectory :: String -> (String -> IO a) -> IO a +withSystemTempDirectory prefix = do + bracket + (do + tmpdir <- getTemporaryDirectory + let dir = tmpdir prefix + createDirectory dir + return dir + ) + removeDirectoryRecursive + +initEmptyDB :: GhcPkg -> FilePath -> IO () +initEmptyDB ghcpkg pkgdb = do + -- don't try to recreate the DB if it already exist as it would fail + exists <- doesDirectoryExist pkgdb + unless exists $ void $ readCreateProcess (runGhcPkg ghcpkg ["init", pkgdb]) "" + +-- | Retrieve GHC's target arch/os from ghc --info +ghcTargetArchOS :: Ghc -> IO (String,String) +ghcTargetArchOS ghc = do + is <- read <$> readCreateProcess (runGhc ghc ["--info"]) "" :: IO [(String,String)] + let arch = fromMaybe (error "Couldn't read 'target arch' setting") (lookup "target arch" is) + let os = fromMaybe (error "Couldn't read 'target os' setting") (lookup "target os" is) + pure (arch,os) + +-- | Retrieve GHC's target as linux, or darwin +getTarget :: Ghc -> IO String +getTarget ghc = ghcTargetArchOS ghc >>= \case + (_,"OSDarwin") -> pure "darwin" + (_,"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 = ghcSetting ghc "Target platform" + +data Settings = Settings + { settingsTriple :: Maybe String + , settingsTargetPrefix :: Maybe String + , settingsLocallyExecutable :: Maybe Bool + , settingsLlvmTriple :: Maybe String + , settingsCc :: ProgOpt + , settingsCxx :: ProgOpt + , settingsCpp :: ProgOpt + , settingsHsCpp :: ProgOpt + , settingsJsCpp :: ProgOpt + , settingsCmmCpp :: ProgOpt + , settingsCcLink :: ProgOpt + , settingsAr :: ProgOpt + , settingsRanlib :: ProgOpt + , settingsNm :: ProgOpt + , 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 + , settingsUnregisterised :: Maybe Bool + , settingsTablesNextToCode :: Maybe Bool + , settingsUseLibFFIForAdjustors :: Maybe Bool + , settingsLdOverride :: Maybe Bool + , settingsCrossCompiling :: Bool + } + +-- | Program specifier from the command-line. +data ProgOpt = ProgOpt + { poPath :: Maybe String + -- ^ Refers to the path to an executable, or simply the + -- executable name. + , poFlags :: Maybe [String] + } + +emptyProgOpt :: ProgOpt +emptyProgOpt = ProgOpt Nothing Nothing + +emptySettings :: Settings +emptySettings = Settings + { settingsTriple = Nothing + , settingsTargetPrefix = Nothing + , settingsLocallyExecutable = Nothing + , settingsLlvmTriple = Nothing + , settingsCc = po0 + , settingsCxx = po0 + , settingsCpp = po0 + , settingsHsCpp = po0 + , settingsJsCpp = po0 + , settingsCmmCpp = po0 + , settingsCcLink = po0 + , settingsAr = po0 + , settingsRanlib = po0 + , settingsNm = po0 + , 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 + +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" + + let common_args = + [ "--output-settings" + , "-o", gen_settings_path + ] + + 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 + + (exit_code, toolchain_stdout, toolchain_stderr) <- readCreateProcessWithExitCode (runGhcToolchain ghc_toolchain args) "" + writeFile (dst "ghc-toolchain.stdout") toolchain_stdout + writeFile (dst "ghc-toolchain.stderr") toolchain_stderr + case exit_code of + ExitSuccess -> pure () + ExitFailure n -> do + putStrLn $ "ghc-toolchain failed with error code: " ++ show n + putStrLn toolchain_stdout + putStrLn toolchain_stderr + putStrLn $ "Logs can be found in \"" ++ (dst "ghc-toolchain.{stdout,stderr}\"") + exitFailure + + -- fixup settings generated by ghc-toolchain + kvs <- (Map.fromList . read) <$> readFile gen_settings_path :: IO (Map String String) + let kvs' = Map.insert "Relative Global Package DB" "../pkgs" + $ Map.insert "Support SMP" "NO" -- FIXME: this depends on the different ways used to build the RTS! + $ 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 new file mode 100644 index 000000000000..8ed3abf8fbf0 --- /dev/null +++ b/Makefile @@ -0,0 +1,31 @@ +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) + +# Use CPU cores + 1 if not already set +THREADS=${THREADS:-$((CPUS + 1))} + +all: $(CABAL) ./booted + PATH=`pwd`:${PATH} \ + GHC=ghc-9.8.4 ./Build.hs + +cabal: $(CABAL) + +$(CABAL): + cabal build --project-dir libraries/Cabal cabal-install:exe:cabal + +./booted: + ./boot + touch $@ + +clean: + rm -f ./booted + rm -rf _build + +test: all + echo "using THREADS=${THREADS}" >&2 + TEST_HC=`pwd`/_build/bindist/bin/ghc \ + METRICS_FILE=`pwd`/_build/test-perf.csv \ + SUMMARY_FILE=`pwd`/_build/test-summary.txt \ + JUNIT_FILE=`pwd`/_build/test-junit.xml \ + make -C testsuite/tests test THREADS=${THREADS} 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/Config/Linker.hs b/compiler/GHC/Driver/Config/Linker.hs index bf4cc95f2dbf..489f3ba5bdf7 100644 --- a/compiler/GHC/Driver/Config/Linker.hs +++ b/compiler/GHC/Driver/Config/Linker.hs @@ -20,8 +20,8 @@ initFrameworkOpts dflags = FrameworkOpts } -- | Initialize linker configuration from DynFlags -initLinkerConfig :: DynFlags -> LinkerConfig -initLinkerConfig dflags = +initLinkerConfig :: DynFlags -> Bool -> LinkerConfig +initLinkerConfig dflags require_cxx = let -- see Note [Solaris linker] ld_filter = case platformOS (targetPlatform dflags) of @@ -46,8 +46,13 @@ initLinkerConfig dflags = (p,pre_args) = pgm_l dflags post_args = map Option (getOpts dflags opt_l) + -- sneakily switch to C++ compiler when we need C++ standard lib + -- FIXME: ld flags may be totally inappropriate for the C++ compiler? + ld_prog = if require_cxx then pgm_cxx dflags else p + + in LinkerConfig - { linkerProgram = p + { linkerProgram = ld_prog , linkerOptionsPre = pre_args , linkerOptionsPost = post_args , linkerTempDir = tmpDir dflags diff --git a/compiler/GHC/Driver/Config/StgToJS.hs b/compiler/GHC/Driver/Config/StgToJS.hs index a737f9a242fd..c27c1378537f 100644 --- a/compiler/GHC/Driver/Config/StgToJS.hs +++ b/compiler/GHC/Driver/Config/StgToJS.hs @@ -34,7 +34,7 @@ initStgToJSConfig dflags = StgToJSConfig , csRuntimeAssert = False -- settings , csContext = initSDocContext dflags defaultDumpStyle - , csLinkerConfig = initLinkerConfig dflags + , csLinkerConfig = initLinkerConfig dflags False -- no C++ linking } -- | Default linker configuration diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs index 10a0a11d39e7..81517c4b9ff6 100644 --- a/compiler/GHC/Driver/Pipeline.hs +++ b/compiler/GHC/Driver/Pipeline.hs @@ -49,6 +49,8 @@ import GHC.Platform import GHC.Utils.Monad ( MonadIO(liftIO), mapMaybeM ) +import GHC.Builtin.Names + import GHC.Driver.Main import GHC.Driver.Env hiding ( Hsc ) import GHC.Driver.Errors @@ -91,6 +93,7 @@ import GHC.Data.StringBuffer ( hPutStringBuffer ) import GHC.Data.Maybe ( expectJust ) import GHC.Iface.Make ( mkFullIface ) +import GHC.Iface.Load ( getGhcPrimIface ) import GHC.Runtime.Loader ( initializePlugins ) @@ -817,7 +820,13 @@ hscGenBackendPipeline pipe_env hsc_env mod_sum result = do let !linkable = Linkable part_time (ms_mod mod_sum) (NE.singleton (DotO final_object ModuleObject)) -- Add the object linkable to the potential bytecode linkable which was generated in HscBackend. return (mlinkable { homeMod_object = Just linkable }) - return (miface, final_linkable) + + -- when building ghc-internal with cabal-install, we still want the virtual + -- interface for gHC_PRIM in the cache + let miface_final + | ms_mod mod_sum == gHC_PRIM = getGhcPrimIface hsc_env + | otherwise = miface + return (miface_final, final_linkable) asPipeline :: P m => Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe ObjFile) asPipeline use_cpp pipe_env hsc_env location input_fn = diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs index 5ba39e4bb234..4f72eff1b737 100644 --- a/compiler/GHC/Driver/Pipeline/Execute.hs +++ b/compiler/GHC/Driver/Pipeline/Execute.hs @@ -478,7 +478,7 @@ runCcPhase cc_phase pipe_env hsc_env location input_fn = do -- very weakly typed, being derived from C--. ["-fno-strict-aliasing"] - ghcVersionH <- getGhcVersionPathName dflags unit_env + include_ghcVersionH <- getGhcVersionIncludeFlags dflags unit_env withAtomicRename output_fn $ \temp_outputFilename -> GHC.SysTools.runCc (phaseForeignLanguage cc_phase) logger tmpfs dflags ( @@ -523,7 +523,7 @@ runCcPhase cc_phase pipe_env hsc_env location input_fn = do else []) ++ verbFlags ++ cc_opt - ++ [ "-include", ghcVersionH ] + ++ include_ghcVersionH ++ framework_paths ++ include_paths ++ pkg_extra_cc_opts 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/compiler/GHC/Iface/Errors/Ppr.hs b/compiler/GHC/Iface/Errors/Ppr.hs index d9f07343d245..c9d842fb1644 100644 --- a/compiler/GHC/Iface/Errors/Ppr.hs +++ b/compiler/GHC/Iface/Errors/Ppr.hs @@ -336,8 +336,8 @@ hiModuleNameMismatchWarn requested_mod read_mod ] ] | otherwise = - -- ToDo: This will fail to have enough qualification when the package IDs - -- are the same + -- Display fully qualified unit names by enabling ppr-debug + updSDocContext (\ctx -> ctx { sdocPprDebug = True}) $ withPprStyle (mkUserStyle alwaysQualify AllTheWay) $ -- we want the Modules below to be qualified with package names, -- so reset the NamePprCtx setting. @@ -345,7 +345,6 @@ hiModuleNameMismatchWarn requested_mod read_mod , ppr requested_mod , text "differs from name found in the interface file" , ppr read_mod - , parens (text "if these names look the same, try again with -dppr-debug") ] dynamicHashMismatchError :: Module -> ModLocation -> SDoc diff --git a/compiler/GHC/Linker/Dynamic.hs b/compiler/GHC/Linker/Dynamic.hs index b8aedd90acf5..28f814ca305a 100644 --- a/compiler/GHC/Linker/Dynamic.hs +++ b/compiler/GHC/Linker/Dynamic.hs @@ -24,6 +24,7 @@ import GHC.Linker.Unit import GHC.Linker.External import GHC.Utils.Logger import GHC.Utils.TmpFs +import GHC.Data.FastString import Control.Monad (when) import System.FilePath @@ -105,7 +106,8 @@ linkDynLib logger tmpfs dflags0 unit_env o_files dep_packages pkg_framework_opts <- getUnitFrameworkOpts unit_env (map unitId pkgs) let framework_opts = getFrameworkOpts (initFrameworkOpts dflags) platform - let linker_config = initLinkerConfig dflags + let require_cxx = any ((==) (PackageName (fsLit "system-cxx-std-lib")) . unitPackageName) pkgs + let linker_config = initLinkerConfig dflags require_cxx case os of OSMinGW32 -> do diff --git a/compiler/GHC/Linker/Static.hs b/compiler/GHC/Linker/Static.hs index ef356d724350..851e34db6a4a 100644 --- a/compiler/GHC/Linker/Static.hs +++ b/compiler/GHC/Linker/Static.hs @@ -33,6 +33,8 @@ import GHC.Linker.Static.Utils import GHC.Driver.Config.Linker import GHC.Driver.Session +import GHC.Data.FastString + import System.FilePath import System.Directory import Control.Monad @@ -192,7 +194,9 @@ linkBinary' staticLink logger tmpfs dflags unit_env o_files dep_units = do OSMinGW32 | gopt Opt_GenManifest dflags -> maybeCreateManifest logger tmpfs dflags output_fn _ -> return [] - let linker_config = initLinkerConfig dflags + let require_cxx = any ((==) (PackageName (fsLit "system-cxx-std-lib")) . unitPackageName) pkgs + + let linker_config = initLinkerConfig dflags require_cxx let link dflags args = do runLink logger tmpfs linker_config args -- Make sure to honour -fno-use-rpaths if set on darwin as well; see #20004 diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x index aa9d22fcb704..29d31565f989 100644 --- a/compiler/GHC/Parser/Lexer.x +++ b/compiler/GHC/Parser/Lexer.x @@ -3369,8 +3369,6 @@ topNoLayoutContainsCommas (ALRNoLayout b _ : _) = b -- If the generated alexScan/alexScanUser functions are called multiple times -- in this file, alexScanUser gets broken out into a separate function and -- increases memory usage. Make sure GHC inlines this function and optimizes it. --- https://github.com/haskell/alex/pull/262 -{-# INLINE alexScanUser #-} lexToken :: P (PsLocated Token) lexToken = do diff --git a/compiler/GHC/Runtime/Loader.hs b/compiler/GHC/Runtime/Loader.hs index 5368d01e34ed..06347d226d41 100644 --- a/compiler/GHC/Runtime/Loader.hs +++ b/compiler/GHC/Runtime/Loader.hs @@ -220,7 +220,7 @@ loadPlugin' occ_name plugin_name hsc_env mod_name [ text "The value", ppr name , text "with type", ppr actual_type , text "did not have the type" - , text "GHC.Plugins.Plugin" + , ppr (mkTyConTy plugin_tycon) , text "as required"]) Right (plugin, links, pkgs) -> return (plugin, mod_iface, links, pkgs) } } } } } diff --git a/compiler/GHC/SysTools/Cpp.hs b/compiler/GHC/SysTools/Cpp.hs index 4237c6c60360..2f7f60afb92e 100644 --- a/compiler/GHC/SysTools/Cpp.hs +++ b/compiler/GHC/SysTools/Cpp.hs @@ -7,6 +7,7 @@ module GHC.SysTools.Cpp ( doCpp , CppOpts(..) , getGhcVersionPathName + , getGhcVersionIncludeFlags , applyCDefs , offsetIncludePaths ) @@ -175,8 +176,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let asserts_def = [ "-D__GLASGOW_HASKELL_ASSERTS_IGNORED__" | gopt Opt_IgnoreAsserts dflags] -- Default CPP defines in Haskell source - ghcVersionH <- getGhcVersionPathName dflags unit_env - let hsSourceCppOpts = [ "-include", ghcVersionH ] + hsSourceCppOpts <- getGhcVersionIncludeFlags dflags unit_env -- MIN_VERSION macros let uids = explicitUnits unit_state @@ -262,28 +262,40 @@ generateMacros prefix name version = _ -> error "take3" (major1,major2,minor) = take3 $ map show (versionBranch version) ++ repeat "0" +getGhcVersionIncludeFlags :: DynFlags -> UnitEnv -> IO [String] +getGhcVersionIncludeFlags dflags unit_env = do + mghcversionh <- getGhcVersionPathName dflags unit_env + pure $ case mghcversionh of + Nothing -> [] + Just p -> ["-include", p] -- | Find out path to @ghcversion.h@ file -getGhcVersionPathName :: DynFlags -> UnitEnv -> IO FilePath +getGhcVersionPathName :: DynFlags -> UnitEnv -> IO (Maybe FilePath) getGhcVersionPathName dflags unit_env = do - let candidates = case ghcVersionFile dflags of - -- the user has provided an explicit `ghcversion.h` file to use. - Just path -> [path] - -- otherwise, try to find it in the rts' include-dirs. - -- Note: only in the RTS include-dirs! not all preload units less we may - -- use a wrong file. See #25106 where a globally installed - -- /usr/include/ghcversion.h file was used instead of the one provided - -- by the rts. - Nothing -> case lookupUnitId (ue_homeUnitState unit_env) rtsUnitId of - Nothing -> [] - Just info -> ( "ghcversion.h") <$> collectIncludeDirs [info] - - found <- filterM doesFileExist candidates - case found of - [] -> throwGhcExceptionIO (InstallationError - ("ghcversion.h missing; tried: " - ++ intercalate ", " candidates)) - (x:_) -> return x + case ghcVersionFile dflags of + -- the user has provided an explicit `ghcversion.h` file to use. + Just path -> doesFileExist path >>= \case + True -> pure (Just path) + False -> throwGhcExceptionIO (InstallationError + ("ghcversion.h missing; tried user-supplied path: " ++ path)) + -- otherwise, try to find it in the rts' include-dirs. + -- Note: only in the RTS include-dirs! not all preload units less we may + -- use a wrong file. See #25106 where a globally installed + -- /usr/include/ghcversion.h file was used instead of the one provided + -- by the rts. + Nothing -> case lookupUnitId (ue_homeUnitState unit_env) rtsUnitId of + Nothing -> do + -- print warning and return nothing + putStrLn "Couldn't find ghcversion.h file: no rts unit available and -ghcversion-file flag not passed" + pure Nothing + Just info -> do + let candidates = ( "ghcversion.h") <$> collectIncludeDirs [info] + found <- filterM doesFileExist candidates + case found of + [] -> throwGhcExceptionIO (InstallationError + ("ghcversion.h missing; tried: " + ++ intercalate ", " candidates)) + (x:_) -> return (Just x) applyCDefs :: DefunctionalizedCDefs -> Logger -> DynFlags -> IO [String] applyCDefs NoCDefs _ _ = return [] diff --git a/compiler/GHC/SysTools/Process.hs b/compiler/GHC/SysTools/Process.hs index bb4129cdd406..ab4c7d675f1b 100644 --- a/compiler/GHC/SysTools/Process.hs +++ b/compiler/GHC/SysTools/Process.hs @@ -228,7 +228,7 @@ handleProc pgm phase_name proc = do then does_not_exist else throwGhcExceptionIO (ProgramError $ show err) - does_not_exist = throwGhcExceptionIO (InstallationError ("could not execute: " ++ pgm)) + does_not_exist = throwGhcExceptionIO (InstallationError ("could not execute: `" ++ pgm ++ "'")) withPipe :: ((Handle, Handle) -> IO a) -> IO a withPipe = bracket createPipe $ \ (readEnd, writeEnd) -> do diff --git a/compiler/GHC/Unit/Info.hs b/compiler/GHC/Unit/Info.hs index 04ac54b5d310..ba653c2b0a50 100644 --- a/compiler/GHC/Unit/Info.hs +++ b/compiler/GHC/Unit/Info.hs @@ -235,9 +235,12 @@ unitHsLibs namever ways0 p = map (mkDynName . addSuffix . ST.unpack) (unitLibrar -- -- This change elevates the need to add custom hooks -- and handling specifically for the `rts` package. - addSuffix rts@"HSrts" = rts ++ (expandTag rts_tag) - addSuffix rts@"HSrts-1.0.3" = rts ++ (expandTag rts_tag) - addSuffix other_lib = other_lib ++ (expandTag tag) + is_rts x = (x == "HSrts" || "HSrts-" `isPrefixOf` x) + -- ensure we don't consider packages with names like "rts-foo" + && unitPackageName p == PackageName (fsLit "rts") + addSuffix x + | is_rts x = x ++ (expandTag rts_tag) + | otherwise = x ++ (expandTag tag) expandTag t | null t = "" | otherwise = '_':t diff --git a/compiler/Setup.hs b/compiler/Setup.hs index 42a58b5bb639..23d233877e88 100644 --- a/compiler/Setup.hs +++ b/compiler/Setup.hs @@ -1,4 +1,5 @@ {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE CPP #-} module Main where import Distribution.Simple @@ -11,6 +12,9 @@ import Distribution.Verbosity import Distribution.Simple.Program import Distribution.Simple.Utils import Distribution.Simple.Setup +#if MIN_VERSION_Cabal(3,14,0) +import Distribution.Simple.LocalBuildInfo (interpretSymbolicPathLBI) +#endif import System.IO import System.Process @@ -58,8 +62,15 @@ primopIncls = ghcAutogen :: Verbosity -> LocalBuildInfo -> IO () ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameMap} = do + +#if MIN_VERSION_Cabal(3,14,0) + let fromSymPath = interpretSymbolicPathLBI lbi +#else + let fromSymPath = id +#endif + -- Get compiler/ root directory from the cabal file - let Just compilerRoot = takeDirectory <$> pkgDescrFile + let Just compilerRoot = (takeDirectory . fromSymPath) <$> pkgDescrFile -- Require the necessary programs (gcc ,withPrograms) <- requireProgram normal gccProgram withPrograms @@ -79,25 +90,31 @@ ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameM -- Call genprimopcode to generate *.hs-incl forM_ primopIncls $ \(file,command) -> do contents <- readProcess "genprimopcode" [command] primopsStr - rewriteFileEx verbosity (buildDir lbi file) contents + rewriteFileEx verbosity (fromSymPath (buildDir lbi) file) contents -- Write GHC.Platform.Constants - let platformConstantsPath = autogenPackageModulesDir lbi "GHC/Platform/Constants.hs" + let platformConstantsPath = fromSymPath (autogenPackageModulesDir lbi) "GHC/Platform/Constants.hs" targetOS = case lookup "target os" settings of Nothing -> error "no target os in settings" Just os -> os createDirectoryIfMissingVerbose verbosity True (takeDirectory platformConstantsPath) +#if MIN_VERSION_Cabal(3,15,0) + -- temp files are now always created in system temp directory + -- (cf 8161f5f99dbe5d6c7564d9e163754935ddde205d) + withTempFile "Constants_tmp.hs" $ \tmp h -> do +#else withTempFile (takeDirectory platformConstantsPath) "Constants_tmp.hs" $ \tmp h -> do +#endif hClose h callProcess "deriveConstants" ["--gen-haskell-type","-o",tmp,"--target-os",targetOS] - renameFile tmp platformConstantsPath + copyFile tmp platformConstantsPath let cProjectUnitId = case Map.lookup (CLibName LMainLibName) componentNameMap of Just [LibComponentLocalBuildInfo{componentUnitId}] -> unUnitId componentUnitId _ -> error "Couldn't find unique cabal library when building ghc" -- Write GHC.Settings.Config - configHsPath = autogenPackageModulesDir lbi "GHC/Settings/Config.hs" + configHsPath = fromSymPath (autogenPackageModulesDir lbi) "GHC/Settings/Config.hs" configHs = generateConfigHs cProjectUnitId settings createDirectoryIfMissingVerbose verbosity True (takeDirectory configHsPath) rewriteFileEx verbosity configHsPath configHs diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 214f61cafc37..55083b5cdb39 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -50,7 +50,7 @@ extra-source-files: custom-setup - setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.14, directory, process, filepath, containers + setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.16, directory, process, filepath, containers Flag internal-interpreter Description: Build with internal interpreter support. @@ -67,6 +67,7 @@ Flag dynamic-system-linker Flag build-tool-depends Description: Use build-tool-depends Default: True + Manual: True Flag with-libzstd Default: False 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/hie.yaml b/hie.yaml index 34dde0452ad1..b666fd0f0517 100644 --- a/hie.yaml +++ b/hie.yaml @@ -5,4 +5,13 @@ # cradle: {bios: {program: "./hadrian/hie-bios.bat"}} # # The format is documented here - https://github.com/mpickering/hie-bios -cradle: {bios: {program: "./hadrian/hie-bios"}} +cradle: + multi: + - path: Build.hs + config: + cradle: + direct: + arguments: [] + - path: "*" + config: + cradle: {bios: {program: "./hadrian/hie-bios"}} diff --git a/libraries/Cabal b/libraries/Cabal index 269fd808e5d8..7e50837ade18 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 269fd808e5d80223a229b6b19edfe6f5b109007a +Subproject commit 7e50837ade188504d1401bad932a5b8b3769661e diff --git a/libraries/base/tests/IO/T12010/test.T b/libraries/base/tests/IO/T12010/test.T index e33e69036a8c..bb926dc72dd8 100644 --- a/libraries/base/tests/IO/T12010/test.T +++ b/libraries/base/tests/IO/T12010/test.T @@ -4,5 +4,6 @@ test('T12010', extra_ways(['threaded1']), when(wordsize(32), fragile(16572)), js_broken(22374), + req_target_debug_rts, cmd_prefix('WAY_FLAGS="' + ' '.join(config.way_flags['threaded1']) + '"')], makefile_test, []) diff --git a/libraries/base/tests/IO/all.T b/libraries/base/tests/IO/all.T index 5b28156c96bf..992b5dfbac42 100644 --- a/libraries/base/tests/IO/all.T +++ b/libraries/base/tests/IO/all.T @@ -114,7 +114,7 @@ test('countReaders001', js_broken(22261), compile_and_run, ['']) test('concio001', [normal, multi_cpu_race], makefile_test, ['test.concio001']) -test('concio001.thr', [extra_files(['concio001.hs']), multi_cpu_race], +test('concio001.thr', [extra_files(['concio001.hs']), multi_cpu_race, req_target_threaded_rts], makefile_test, ['test.concio001.thr']) test('T2122', [], compile_and_run, ['']) diff --git a/libraries/base/tests/perf/encodingAllocations.hs b/libraries/base/tests/perf/encodingAllocations.hs index cd136963cb94..e3a252655f1d 100755 --- a/libraries/base/tests/perf/encodingAllocations.hs +++ b/libraries/base/tests/perf/encodingAllocations.hs @@ -13,7 +13,11 @@ import Distribution.Simple.Utils main :: IO () -main = withTempFile "." "encodingAllocations.tmp" (const $ loop 1000000) +main = withTempFile +#if !MIN_VERSION_Cabal(3,15,0) + "." +#endif + "encodingAllocations.tmp" (const $ loop 1000000) loop :: Int -> Handle -> IO () loop 0 !_ = pure () diff --git a/libraries/ghc-boot/Setup.hs b/libraries/ghc-boot/Setup.hs index 0995ee3f8ff6..715b7e553596 100644 --- a/libraries/ghc-boot/Setup.hs +++ b/libraries/ghc-boot/Setup.hs @@ -1,6 +1,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE CPP #-} module Main where import Distribution.Simple @@ -10,6 +10,9 @@ import Distribution.Verbosity import Distribution.Simple.Program import Distribution.Simple.Utils import Distribution.Simple.Setup +#if MIN_VERSION_Cabal(3,14,0) +import Distribution.Simple.LocalBuildInfo (interpretSymbolicPathLBI) +#endif import System.IO import System.Directory @@ -31,13 +34,19 @@ main = defaultMainWithHooks ghcHooks ghcAutogen :: Verbosity -> LocalBuildInfo -> IO () ghcAutogen verbosity lbi@LocalBuildInfo{..} = do +#if MIN_VERSION_Cabal(3,14,0) + let fromSymPath = interpretSymbolicPathLBI lbi +#else + let fromSymPath = id +#endif + -- Get compiler/ root directory from the cabal file - let Just compilerRoot = takeDirectory <$> pkgDescrFile + let Just compilerRoot = (takeDirectory . fromSymPath) <$> pkgDescrFile let platformHostFile = "GHC/Platform/Host.hs" - platformHostPath = autogenPackageModulesDir lbi platformHostFile + platformHostPath = fromSymPath (autogenPackageModulesDir lbi) platformHostFile ghcVersionFile = "GHC/Version.hs" - ghcVersionPath = autogenPackageModulesDir lbi ghcVersionFile + ghcVersionPath = fromSymPath (autogenPackageModulesDir lbi) ghcVersionFile -- Get compiler settings settings <- lookupEnv "HADRIAN_SETTINGS" >>= \case diff --git a/libraries/ghc-boot/ghc-boot.cabal.in b/libraries/ghc-boot/ghc-boot.cabal.in index d61f6809fef4..992c7834739e 100644 --- a/libraries/ghc-boot/ghc-boot.cabal.in +++ b/libraries/ghc-boot/ghc-boot.cabal.in @@ -28,7 +28,7 @@ build-type: Custom extra-source-files: changelog.md custom-setup - setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.14, directory, filepath + setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.16, directory, filepath source-repository head type: git diff --git a/libraries/ghc-compact/tests/all.T b/libraries/ghc-compact/tests/all.T index 9a666161ff99..2bb90c4dbf1f 100644 --- a/libraries/ghc-compact/tests/all.T +++ b/libraries/ghc-compact/tests/all.T @@ -1,5 +1,5 @@ setTestOpts( - [extra_ways(['sanity', 'compacting_gc']), + [extra_ways(['compacting_gc'] + (['sanity'] if debug_rts() else [])), js_skip # compact API not supported by the JS backend ]) diff --git a/libraries/ghc-heap/tests/all.T b/libraries/ghc-heap/tests/all.T index 5722182d5f65..5b8b755ae812 100644 --- a/libraries/ghc-heap/tests/all.T +++ b/libraries/ghc-heap/tests/all.T @@ -94,7 +94,8 @@ test('stack_misc_closures', [ extra_files(['stack_misc_closures_c.c', 'stack_misc_closures_prim.cmm', 'TestUtils.hs']), ignore_stdout, - ignore_stderr + ignore_stderr, + req_target_debug_rts # Debug RTS to use checkSTACK() ], multi_compile_and_run, ['stack_misc_closures', diff --git a/libraries/ghc-internal/configure.ac b/libraries/ghc-internal/configure.ac index b87652f61d25..d92117246de1 100644 --- a/libraries/ghc-internal/configure.ac +++ b/libraries/ghc-internal/configure.ac @@ -6,6 +6,8 @@ AC_CONFIG_SRCDIR([include/HsBase.h]) AC_CONFIG_HEADERS([include/HsBaseConfig.h include/EventConfig.h]) +CPPFLAGS="-I$srcdir $CPPFLAGS" + AC_PROG_CC dnl make extensions visible to allow feature-tests to detect them later on AC_USE_SYSTEM_EXTENSIONS @@ -402,10 +404,10 @@ AS_IF([test "x$with_libcharset" != xno], fi -dnl Calling AC_CHECK_TYPE(T) makes AC_CHECK_SIZEOF(T) abort on failure -dnl instead of considering sizeof(T) as 0. -AC_CHECK_TYPE([struct MD5Context], [], [AC_MSG_ERROR([internal error])], [#include "include/md5.h"]) AC_CHECK_SIZEOF([struct MD5Context], [], [#include "include/md5.h"]) +AS_IF([test "$ac_cv_sizeof_struct_MD5Context" -eq 0],[ + AC_MSG_ERROR([cannot determine sizeof(struct MD5Context)]) +]) AC_SUBST(EXTRA_LIBS) AC_CONFIG_FILES([ghc-internal.buildinfo include/HsIntegerGmp.h]) diff --git a/libraries/ghc-internal/ghc-internal.cabal.in b/libraries/ghc-internal/ghc-internal.cabal.in index 76cdcb31be66..a35b5707853e 100644 --- a/libraries/ghc-internal/ghc-internal.cabal.in +++ b/libraries/ghc-internal/ghc-internal.cabal.in @@ -343,9 +343,11 @@ Library GHC.Internal.Tuple GHC.Internal.Types - autogen-modules: - GHC.Internal.Prim - GHC.Internal.PrimopWrappers + -- Cabal expects autogen modules to be some specific directories, not in the + -- source dirs... + -- autogen-modules: + -- GHC.Internal.Prim + -- GHC.Internal.PrimopWrappers other-modules: GHC.Internal.Data.Typeable.Internal diff --git a/libraries/ghc-prim/ghc-prim.cabal b/libraries/ghc-prim/ghc-prim.cabal index 8cb39c0b932d..add096d36d0b 100644 --- a/libraries/ghc-prim/ghc-prim.cabal +++ b/libraries/ghc-prim/ghc-prim.cabal @@ -8,6 +8,9 @@ category: GHC maintainer: libraries@haskell.org bug-reports: https://gitlab.haskell.org/ghc/ghc/issues/new synopsis: GHC primitives +-- We can't use Custom build-type with boot packages: building Setup.hs with +-- cabal-install requires that base, Cabal, directory, process, filepath, +-- containers, etc. libraries be available, but they aren't when we bootstrap. build-type: Simple description: This package used to contain the primitive types and operations supplied by diff --git a/libraries/system-cxx-std-lib/system-cxx-std-lib.cabal b/libraries/system-cxx-std-lib/system-cxx-std-lib.cabal new file mode 100644 index 000000000000..72f86a4d0b69 --- /dev/null +++ b/libraries/system-cxx-std-lib/system-cxx-std-lib.cabal @@ -0,0 +1,21 @@ +cabal-version: 2.0 +name: system-cxx-std-lib +version: 1.0 +license: BSD-3-Clause +synopsis: A placeholder for the system's C++ standard library implementation. +description: Building against C++ libraries requires that the C++ standard + library be included when linking. Typically when compiling a C++ + project this is done automatically by the C++ compiler. However, + as GHC uses the C compiler for linking, users needing the C++ + standard library must declare this dependency explicitly. + . + This "virtual" package can be used to depend upon the host system's + C++ standard library implementation in a platform agnostic manner. +category: System +build-type: Simple + +library + -- empty library: this is just a placeholder for GHC to use to inject C++ + -- standard libraries when linking with the C toolchain, or to directly use + -- the C++ toolchain to link. + diff --git a/rts/RtsUtils.c b/rts/RtsUtils.c index f842c1cc3c43..7640d7cca817 100644 --- a/rts/RtsUtils.c +++ b/rts/RtsUtils.c @@ -372,10 +372,6 @@ void printRtsInfo(const RtsConfig rts_config) { mkRtsInfoPair("Host architecture", HostArch); mkRtsInfoPair("Host OS", HostOS); mkRtsInfoPair("Host vendor", HostVendor); - mkRtsInfoPair("Target platform", TargetPlatform); - mkRtsInfoPair("Target architecture", TargetArch); - mkRtsInfoPair("Target OS", TargetOS); - mkRtsInfoPair("Target vendor", TargetVendor); mkRtsInfoPair("Word size", TOSTRING(WORD_SIZE_IN_BITS)); // TODO(@Ericson2314) This is a joint property of the RTS and generated // code. The compiler will soon be multi-target so it doesn't make sense to diff --git a/rts/rts.cabal b/rts/rts.cabal index f996cfa0e2b7..65fd926e3541 100644 --- a/rts/rts.cabal +++ b/rts/rts.cabal @@ -1,4 +1,4 @@ -cabal-version: 3.0 +cabal-version: 3.8 name: rts version: 1.0.3 synopsis: The GHC runtime system @@ -13,9 +13,248 @@ build-type: Configure extra-source-files: configure + config.guess + config.sub + ghcplatform.h.top.in + ghcplatform.h.bottom + ghcautoconf.h.autoconf.in configure.ac external-symbols.list.in rts.buildinfo.in + linker/ELFRelocs/AArch64.def + linker/ELFRelocs/ARM.def + linker/ELFRelocs/i386.def + linker/ELFRelocs/x86_64.def + win32/libHSffi.def + win32/libHSghc-internal.def + win32/libHSghc-prim.def + posix/ticker/Pthread.c + posix/ticker/Setitimer.c + posix/ticker/TimerCreate.c + posix/ticker/TimerFd.c + -- headers files that are not installed by the rts package but only used to + -- build the rts C code + xxhash.h + adjustor/AdjustorPool.h + Adjustor.h + Apply.h + Arena.h + ARMOutlineAtomicsSymbols.h + AutoApply.h + AutoApplyVecs.h + BeginPrivate.h + Capability.h + CheckUnload.h + CheckVectorSupport.h + CloneStack.h + Continuation.h + Disassembler.h + EndPrivate.h + eventlog/EventLog.h + Excn.h + FileLock.h + ForeignExports.h + fs_rts.h + fs.h + GetEnv.h + GetTime.h + Globals.h + Hash.h + hooks/Hooks.h + include/Cmm.h + include/ghcconfig.h + include/HsFFI.h + include/MachDeps.h + include/rts/Adjustor.h + include/RtsAPI.h + include/rts/BlockSignals.h + include/rts/Bytecodes.h + include/rts/Config.h + include/rts/Constants.h + include/rts/EventLogFormat.h + include/rts/EventLogWriter.h + include/rts/ExecPage.h + include/rts/FileLock.h + include/rts/Flags.h + include/rts/ForeignExports.h + include/rts/GetTime.h + include/rts/ghc_ffi.h + include/rts/Globals.h + include/Rts.h + include/rts/Hpc.h + include/rts/IOInterface.h + include/rts/IPE.h + include/rts/Libdw.h + include/rts/LibdwPool.h + include/rts/Linker.h + include/rts/Main.h + include/rts/Messages.h + include/rts/NonMoving.h + include/rts/OSThreads.h + include/rts/Parallel.h + include/rts/PosixSource.h + include/rts/PrimFloat.h + include/rts/prof/CCS.h + include/rts/prof/Heap.h + include/rts/Profiling.h + include/rts/prof/LDV.h + include/rts/Signals.h + include/rts/SpinLock.h + include/rts/StableName.h + include/rts/StablePtr.h + include/rts/StaticPtrTable.h + include/rts/storage/Block.h + include/rts/storage/ClosureMacros.h + include/rts/storage/Closures.h + include/rts/storage/ClosureTypes.h + include/rts/storage/FunTypes.h + include/rts/storage/GC.h + include/rts/storage/HeapAlloc.h + include/rts/storage/Heap.h + include/rts/storage/InfoTables.h + include/rts/storage/MBlock.h + include/rts/storage/TSO.h + include/rts/Threads.h + include/rts/Ticky.h + include/rts/Time.h + include/rts/Timer.h + include/rts/TSANUtils.h + include/rts/TTY.h + include/rts/Types.h + include/rts/Utils.h + include/stg/DLL.h + include/Stg.h + include/stg/MachRegs/arm32.h + include/stg/MachRegs/arm64.h + include/stg/MachRegsForHost.h + include/stg/MachRegs.h + include/stg/MachRegs/loongarch64.h + include/stg/MachRegs/ppc.h + include/stg/MachRegs/riscv64.h + include/stg/MachRegs/s390x.h + include/stg/MachRegs/wasm32.h + include/stg/MachRegs/x86.h + include/stg/MiscClosures.h + include/stg/Prim.h + include/stg/Regs.h + include/stg/SMP.h + include/stg/Ticky.h + include/stg/Types.h + Interpreter.h + IOManager.h + IOManagerInternals.h + IPE.h + Jumps.h + LdvProfile.h + Libdw.h + LibdwPool.h + linker/CacheFlush.h + linker/elf_compat.h + linker/elf_got.h + linker/Elf.h + linker/elf_plt_aarch64.h + linker/elf_plt_arm.h + linker/elf_plt.h + linker/elf_plt_riscv64.h + linker/elf_reloc_aarch64.h + linker/elf_reloc.h + linker/elf_reloc_riscv64.h + linker/ElfTypes.h + linker/elf_util.h + linker/InitFini.h + LinkerInternals.h + linker/LoadNativeObjPosix.h + linker/M32Alloc.h + linker/MachO.h + linker/macho/plt_aarch64.h + linker/macho/plt.h + linker/MachOTypes.h + linker/MMap.h + linker/PEi386.h + linker/PEi386Types.h + linker/SymbolExtras.h + linker/util.h + linker/Wasm32Types.h + Messages.h + PathUtils.h + Pool.h + posix/Clock.h + posix/Select.h + posix/Signals.h + posix/TTY.h + Prelude.h + Printer.h + ProfHeap.h + ProfHeapInternal.h + ProfilerReport.h + ProfilerReportJson.h + Profiling.h + Proftimer.h + RaiseAsync.h + ReportMemoryMap.h + RetainerProfile.h + RetainerSet.h + RtsDllMain.h + RtsFlags.h + RtsSignals.h + RtsSymbolInfo.h + RtsSymbols.h + RtsUtils.h + Schedule.h + sm/BlockAlloc.h + sm/CNF.h + sm/Compact.h + sm/Evac.h + sm/GC.h + sm/GCTDecl.h + sm/GCThread.h + sm/GCUtils.h + sm/HeapUtils.h + sm/MarkStack.h + sm/MarkWeak.h + sm/NonMovingAllocate.h + sm/NonMovingCensus.h + sm/NonMoving.h + sm/NonMovingMark.h + sm/NonMovingScav.h + sm/NonMovingShortcut.h + sm/NonMovingSweep.h + sm/OSMem.h + SMPClosureOps.h + sm/Sanity.h + sm/Scav.h + sm/ShouldCompact.h + sm/Storage.h + sm/Sweep.h + Sparks.h + StableName.h + StablePtr.h + StaticPtrTable.h + Stats.h + StgPrimFloat.h + StgRun.h + STM.h + Task.h + ThreadLabels.h + ThreadPaused.h + Threads.h + Ticker.h + Ticky.h + Timer.h + TopHandler.h + Trace.h + TraverseHeap.h + Updates.h + Weak.h + win32/AsyncMIO.h + win32/AsyncWinIO.h + win32/AwaitEvent.h + win32/ConsoleHandler.h + win32/MIOManager.h + win32/ThrIOManager.h + win32/veh_excn.h + win32/WorkQueue.h + WSDeque.h extra-tmp-files: autom4te.cache @@ -109,6 +348,7 @@ library -- expects the unit-id to be -- set without version ghc-options: -this-unit-id rts + cmm-options: -this-unit-id rts exposed: True exposed-modules: @@ -227,6 +467,7 @@ library extra-libraries: dl if flag(use-system-libffi) extra-libraries: ffi + extra-libraries-static: ffi if os(windows) extra-libraries: -- for the linker @@ -270,6 +511,8 @@ library cpp-options: -DNOSMP include-dirs: include + -- TODO: move internal headers into include/private? + include-dirs: . includes: Rts.h autogen-includes: ghcautoconf.h ghcplatform.h install-includes: Cmm.h HsFFI.h MachDeps.h Jumps.h Rts.h RtsAPI.h RtsSymbols.h Stg.h @@ -366,8 +609,6 @@ library HeapStackCheck.cmm Jumps_D.cmm Jumps_V16.cmm - Jumps_V32.cmm - Jumps_V64.cmm PrimOps.cmm StgMiscClosures.cmm StgStartup.cmm @@ -376,24 +617,38 @@ library -- AutoApply is generated AutoApply.cmm AutoApply_V16.cmm - AutoApply_V32.cmm - AutoApply_V64.cmm - -- Adjustor stuff + if arch(x86_64) + cmm-sources: + AutoApply_V32.cmm (-mavx2) + AutoApply_V64.cmm (-mavx512f) + Jumps_V32.cmm (-mavx2) + Jumps_V64.cmm (-mavx512f) + else + cmm-sources: + AutoApply_V32.cmm + AutoApply_V64.cmm + Jumps_V32.cmm + Jumps_V64.cmm + 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) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 5cc174403f4f..9fd18503df81 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -356,6 +356,20 @@ def req_ghc_smp( name, opts ): if not config.ghc_has_smp: opts.skip = True +def req_target_debug_rts( name, opts ): + """ + Mark a test as requiring the debug rts (e.g. compile with -debug or -ticky) + """ + if not config.debug_rts: + opts.skip = True + +def req_target_threaded_rts( name, opts ): + # FIXME: this is probably wrong: we should have a different flag for the + # compiler's rts and the target rts... + if not config.ghc_with_threaded_rts: + opts.skip = True + + def req_target_smp( name, opts ): """ Mark a test as requiring smp when run on the target. If the target does @@ -2876,6 +2890,11 @@ def normalise_callstacks(s: str) -> str: def repl(matches): location = matches.group(1) location = normalise_slashes_(location) + # backtrace paths contain the package path when building with Hadrian + location = re.sub(r'libraries/\w+(-\w+)*/', '', location) + location = re.sub(r'utils/\w+(-\w+)*/', '', location) + location = re.sub(r'compiler/', '', location) + location = re.sub(r'\./', '', location) return ', called at {0}:: in :'.format(location) # Ignore line number differences in call stacks (#10834). s = re.sub(callSite_re, repl, s) diff --git a/testsuite/ghc-config/ghc-config.hs b/testsuite/ghc-config/ghc-config.hs index 95f58d06789a..6dd442542e74 100644 --- a/testsuite/ghc-config/ghc-config.hs +++ b/testsuite/ghc-config/ghc-config.hs @@ -10,9 +10,9 @@ main = do let fields = read info :: [(String,String)] getGhcFieldOrFail fields "HostOS" "Host OS" getGhcFieldOrFail fields "WORDSIZE" "Word size" - getGhcFieldOrFail fields "TARGETPLATFORM" "Target platform" - getGhcFieldOrFail fields "TargetOS_CPP" "Target OS" - getGhcFieldOrFail fields "TargetARCH_CPP" "Target architecture" + getGhcFieldOrFail fields "TARGETPLATFORM" "Host platform" + getGhcFieldOrFail fields "TargetOS_CPP" "Host OS" + getGhcFieldOrFail fields "TargetARCH_CPP" "Host architecture" getGhcFieldOrFail fields "RTSWay" "RTS way" info <- readProcess ghc ["--info"] "" diff --git a/testsuite/mk/test.mk b/testsuite/mk/test.mk index 0d8899fe51b9..9fb28a05ad85 100644 --- a/testsuite/mk/test.mk +++ b/testsuite/mk/test.mk @@ -124,6 +124,13 @@ else RUNTEST_OPTS += -e ghc_with_dynamic_rts=False endif +ifeq "$(filter thr, $(GhcRTSWays))" "debug" +RUNTEST_OPTS += -e config.debug_rts=True +else +RUNTEST_OPTS += -e config.debug_rts=False +endif + + ifeq "$(GhcWithInterpreter)" "NO" RUNTEST_OPTS += -e config.have_interp=False else ifeq "$(GhcStage)" "1" diff --git a/testsuite/tests/codeGen/should_run/T25374/all.T b/testsuite/tests/codeGen/should_run/T25374/all.T index 1e4c3e9860b0..0e02dc0d263d 100644 --- a/testsuite/tests/codeGen/should_run/T25374/all.T +++ b/testsuite/tests/codeGen/should_run/T25374/all.T @@ -1,3 +1,3 @@ # This shouldn't crash the disassembler -test('T25374', [extra_hc_opts('+RTS -Di -RTS'), ignore_stderr, unless(debug_rts(), skip)], ghci_script, ['']) +test('T25374', [extra_hc_opts('+RTS -Di -RTS'), ignore_stderr, req_target_debug_rts], ghci_script, ['']) diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index 9f794b99e51e..1b361c3424de 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -330,4 +330,4 @@ test('T23944', [unless(have_dynamic(), skip), extra_files(['T23944A.hs'])], mult test('T24286', [cxx_src, unless(have_profiling(), skip), extra_files(['T24286.cpp'])], compile, ['-prof -no-hs-main']) test('T24839', [unless(arch('x86_64') or arch('aarch64'), skip), extra_files(["t24839_sub.S"])], compile_and_run, ['t24839_sub.S']) test('t25150', [extra_files(["t25150"])], multimod_compile, ['Main.hs', '-v0 -working-dir t25150/dir a.c']) -test('T25382', normal, makefile_test, []) +test('T25382', expect_broken(28), makefile_test, []) diff --git a/testsuite/tests/ffi/should_run/T1288_c.c b/testsuite/tests/ffi/should_run/T1288_c.c index 2fe90a989b53..ac5f41314b9e 100644 --- a/testsuite/tests/ffi/should_run/T1288_c.c +++ b/testsuite/tests/ffi/should_run/T1288_c.c @@ -3,4 +3,5 @@ void test(int arg) { printf("The argument passed was %i\n", arg ); + fflush(NULL); } diff --git a/testsuite/tests/ffi/should_run/T1288_ghci_c.c b/testsuite/tests/ffi/should_run/T1288_ghci_c.c index 2fe90a989b53..ac5f41314b9e 100644 --- a/testsuite/tests/ffi/should_run/T1288_ghci_c.c +++ b/testsuite/tests/ffi/should_run/T1288_ghci_c.c @@ -3,4 +3,5 @@ void test(int arg) { printf("The argument passed was %i\n", arg ); + fflush(NULL); } diff --git a/testsuite/tests/ffi/should_run/T2276_c.c b/testsuite/tests/ffi/should_run/T2276_c.c index 2fe90a989b53..ac5f41314b9e 100644 --- a/testsuite/tests/ffi/should_run/T2276_c.c +++ b/testsuite/tests/ffi/should_run/T2276_c.c @@ -3,4 +3,5 @@ void test(int arg) { printf("The argument passed was %i\n", arg ); + fflush(NULL); } diff --git a/testsuite/tests/ffi/should_run/T2276_ghci_c.c b/testsuite/tests/ffi/should_run/T2276_ghci_c.c index 2fe90a989b53..ac5f41314b9e 100644 --- a/testsuite/tests/ffi/should_run/T2276_ghci_c.c +++ b/testsuite/tests/ffi/should_run/T2276_ghci_c.c @@ -3,4 +3,5 @@ void test(int arg) { printf("The argument passed was %i\n", arg ); + fflush(NULL); } diff --git a/testsuite/tests/ghci/linking/all.T b/testsuite/tests/ghci/linking/all.T index a2b45e0e09f8..df46765d9afc 100644 --- a/testsuite/tests/ghci/linking/all.T +++ b/testsuite/tests/ghci/linking/all.T @@ -32,8 +32,7 @@ test('ghcilink005', when(unregisterised(), fragile(16085)), unless(doing_ghci, skip), req_dynamic_lib_support, - req_interp, - when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))], + req_interp], makefile_test, ['ghcilink005']) test('ghcilink006', diff --git a/testsuite/tests/ghci/linking/dyn/all.T b/testsuite/tests/ghci/linking/dyn/all.T index b215f6b7202b..5d834099deb1 100644 --- a/testsuite/tests/ghci/linking/dyn/all.T +++ b/testsuite/tests/ghci/linking/dyn/all.T @@ -3,7 +3,6 @@ setTestOpts(req_dynamic_lib_support) test('load_short_name', [ extra_files(['A.c']) , unless(doing_ghci, skip) , req_c - , when(opsys('linux') and not ghc_dynamic(), expect_broken(20706)) ], makefile_test, ['load_short_name']) @@ -12,8 +11,7 @@ test('T1407', unless(doing_ghci, skip), pre_cmd('$MAKE -s --no-print-directory compile_libT1407'), extra_hc_opts('-L"$PWD/T1407dir"'), - js_broken(22359), - when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))], + js_broken(22359)], makefile_test, []) test('T3242', diff --git a/testsuite/tests/ghci/prog001/prog001.T b/testsuite/tests/ghci/prog001/prog001.T index f00b0b6a9865..519ee2e38211 100644 --- a/testsuite/tests/ghci/prog001/prog001.T +++ b/testsuite/tests/ghci/prog001/prog001.T @@ -3,6 +3,5 @@ test('prog001', when(arch('arm'), fragile(17555)), cmd_prefix('ghciWayFlags=' + config.ghci_way_flags), req_interp, - unless(opsys('mingw32') or not config.have_RTS_linker, extra_ways(['ghci-ext'])), - when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))], + unless(opsys('mingw32') or not config.have_RTS_linker, extra_ways(['ghci-ext']))], ghci_script, ['prog001.script']) diff --git a/testsuite/tests/ghci/prog002/prog002.T b/testsuite/tests/ghci/prog002/prog002.T index 83f8d0d92e65..3e25bb455b00 100644 --- a/testsuite/tests/ghci/prog002/prog002.T +++ b/testsuite/tests/ghci/prog002/prog002.T @@ -1,4 +1,3 @@ test('prog002', [extra_files(['../shell.hs', 'A1.hs', 'A2.hs', 'B.hs', 'C.hs', 'D.hs']), - cmd_prefix('ghciWayFlags=' + config.ghci_way_flags), - when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))], + cmd_prefix('ghciWayFlags=' + config.ghci_way_flags)], ghci_script, ['prog002.script']) diff --git a/testsuite/tests/ghci/prog010/all.T b/testsuite/tests/ghci/prog010/all.T index 103ff8338196..d30de29400ae 100644 --- a/testsuite/tests/ghci/prog010/all.T +++ b/testsuite/tests/ghci/prog010/all.T @@ -1,5 +1,4 @@ test('ghci.prog010', [cmd_prefix('ghciWayFlags=' + config.ghci_way_flags), - extra_files(['../shell.hs', 'A.hs', 'B.hs']), - when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))], + extra_files(['../shell.hs', 'A.hs', 'B.hs'])], ghci_script, ['ghci.prog010.script']) diff --git a/testsuite/tests/ghci/scripts/T7388.hs b/testsuite/tests/ghci/scripts/T7388.hs index 91ca1c7268f3..348f2c446fc3 100644 --- a/testsuite/tests/ghci/scripts/T7388.hs +++ b/testsuite/tests/ghci/scripts/T7388.hs @@ -2,5 +2,7 @@ module T7388 where import Foreign.C +import Foreign.Ptr foreign import capi "stdio.h printf" printfb :: CString -> CInt -> IO () +foreign import capi "stdio.h fflush" fflushb :: Ptr () -> IO () diff --git a/testsuite/tests/ghci/scripts/T7388.script b/testsuite/tests/ghci/scripts/T7388.script index 7f02d864539d..c9477ab761de 100644 --- a/testsuite/tests/ghci/scripts/T7388.script +++ b/testsuite/tests/ghci/scripts/T7388.script @@ -1,2 +1,5 @@ :l T7388 withCString "I am a working CApi FFI call\n" $ \str -> printfb str 0 +-- don't forget to flush, otherwise when ghc is statically linked, the C stdout +-- buffer is never flushed. +fflushb nullPtr diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index da5685011d3d..b1f36e8d1b32 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -163,8 +163,7 @@ test('T6106', [extra_files(['../shell.hs']), test('T6105', normal, ghci_script, ['T6105.script']) test('T7117', normal, ghci_script, ['T7117.script']) test('ghci058', [extra_files(['../shell.hs']), - cmd_prefix('ghciWayFlags=' + config.ghci_way_flags), - when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))], + cmd_prefix('ghciWayFlags=' + config.ghci_way_flags)], ghci_script, ['ghci058.script']) test('T7587', normal, ghci_script, ['T7587.script']) test('T7688', normal, ghci_script, ['T7688.script']) diff --git a/testsuite/tests/plugins/all.T b/testsuite/tests/plugins/all.T index a7bad499350a..40d6439828d9 100644 --- a/testsuite/tests/plugins/all.T +++ b/testsuite/tests/plugins/all.T @@ -131,7 +131,7 @@ test('T10294a', pre_cmd('$MAKE -s --no-print-directory -C annotation-plugin package.T10294a TOP={top}')], makefile_test, []) -test('frontend01', [extra_files(['FrontendPlugin.hs']), when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))], +test('frontend01', [extra_files(['FrontendPlugin.hs'])], makefile_test, []) test('T11244', @@ -360,9 +360,7 @@ test('plugins-external', test('test-phase-hooks-plugin', [extra_files(['hooks-plugin/']), - pre_cmd('$MAKE -s --no-print-directory -C hooks-plugin package.test-phase-hooks-plugin TOP={top}'), - - when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))], + pre_cmd('$MAKE -s --no-print-directory -C hooks-plugin package.test-phase-hooks-plugin TOP={top}')], compile, ['-package-db hooks-plugin/pkg.test-phase-hooks-plugin/local.package.conf -fplugin Hooks.PhasePlugin -package hooks-plugin ' + config.plugin_way_flags]) diff --git a/testsuite/tests/plugins/plugins02.stderr b/testsuite/tests/plugins/plugins02.stderr index 2ea9331d3ec2..3d035ef35ee2 100644 --- a/testsuite/tests/plugins/plugins02.stderr +++ b/testsuite/tests/plugins/plugins02.stderr @@ -1 +1 @@ -: The value Simple.BadlyTypedPlugin.plugin with type GHC.Internal.Types.Int did not have the type GHC.Plugins.Plugin as required +: The value Simple.BadlyTypedPlugin.plugin with type GHC.Internal.Types.Int did not have the type GHC.Driver.Plugins.Plugin as required diff --git a/testsuite/tests/rts/T8308/all.T b/testsuite/tests/rts/T8308/all.T index 74eeec3ebcb1..080f09743f3c 100644 --- a/testsuite/tests/rts/T8308/all.T +++ b/testsuite/tests/rts/T8308/all.T @@ -1 +1 @@ -test('T8308', js_broken(22261), makefile_test, ['T8308']) +test('T8308', req_target_debug_rts, makefile_test, ['T8308']) diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index 96b93c72e3db..8579be3f9322 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -238,6 +238,7 @@ test('return_mem_to_os', normal, compile_and_run, ['']) test('T4850', [ when(opsys('mingw32'), expect_broken(4850)) , js_broken(22261) # FFI "dynamic" convention unsupported + , req_target_debug_rts ], makefile_test, ['T4850']) def config_T5250(name, opts): @@ -410,7 +411,7 @@ test('T10904', [ extra_run_opts('20000'), req_c ], test('T10728', [extra_run_opts('+RTS -maxN3 -RTS'), only_ways(['threaded2'])], compile_and_run, ['']) -test('T9405', [when(opsys('mingw32'), fragile(21361)), js_broken(22261)], makefile_test, ['T9405']) +test('T9405', [when(opsys('mingw32'), fragile(21361)), req_target_debug_rts], makefile_test, ['T9405']) test('T11788', [ when(ghc_dynamic(), skip) , req_interp @@ -466,9 +467,11 @@ test('T14900', test('InternalCounters', [ js_skip # JS backend doesn't support internal counters + # Require threaded RTS + , req_target_smp # The ways which build against the debug RTS are built with PROF_SPIN and # therefore differ in output - , omit_ways(['nonmoving_thr_sanity', 'threaded2_sanity', 'sanity']) + , when (debug_rts(), skip) ], makefile_test, ['InternalCounters']) test('alloccounter1', js_broken(22261), compile_and_run, [ @@ -498,6 +501,7 @@ test('keep-cafs-fail', filter_stdout_lines('Evaluated a CAF|exit.*'), ignore_stderr, # on OS X the shell emits an "Abort trap" message to stderr req_rts_linker, + req_target_debug_rts ], makefile_test, ['KeepCafsFail']) @@ -507,7 +511,8 @@ test('keep-cafs', 'KeepCafs2.hs', 'KeepCafsMain.hs']), when(opsys('mingw32'), expect_broken (5987)), when(opsys('freebsd') or opsys('openbsd'), expect_broken(16035)), - req_rts_linker + req_rts_linker, + req_target_debug_rts ], makefile_test, ['KeepCafs']) @@ -517,12 +522,11 @@ test('T11829', [ req_c, check_errmsg("This is a test"), when(arch('wasm32'), fra ['T11829_c.cpp -package system-cxx-std-lib']) test('T16514', [req_c, omit_ghci], compile_and_run, ['T16514_c.c']) -test('test-zeroongc', extra_run_opts('-DZ'), compile_and_run, ['-debug']) +test('test-zeroongc', [extra_run_opts('-DZ'), req_target_debug_rts], compile_and_run, ['-debug']) test('T13676', [when(opsys('mingw32'), expect_broken(17447)), - extra_files(['T13676.hs']), - when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))], + extra_files(['T13676.hs'])], ghci_script, ['T13676.script']) test('InitEventLogging', [ only_ways(['normal']) @@ -600,7 +604,7 @@ test('decodeMyStack_emptyListForMissingFlag', test('T20201a', [js_skip, exit_code(1)], compile_and_run, ['-with-rtsopts -AturtlesM']) test('T20201b', [js_skip, exit_code(1)], compile_and_run, ['-with-rtsopts -A64z']) -test('T22012', [js_skip, extra_ways(['ghci'])], compile_and_run, ['T22012_c.c']) +test('T22012', [js_skip, fragile(23043), extra_ways(['ghci'])], compile_and_run, ['T22012_c.c']) # Skip for JS platform as the JS RTS is always single threaded test('T22795a', [only_ways(['normal']), js_skip, req_ghc_with_threaded_rts], compile_and_run, ['-threaded']) @@ -620,7 +624,7 @@ test('T23221', compile_and_run, ['-O -with-rtsopts -T']) -test('T23142', [unless(debug_rts(), skip), req_interp], makefile_test, ['T23142']) +test('T23142', [req_target_debug_rts, req_interp], makefile_test, ['T23142']) test('T23400', [], compile_and_run, ['-with-rtsopts -A8k']) diff --git a/testsuite/tests/rts/linker/all.T b/testsuite/tests/rts/linker/all.T index e88594b1025c..a5e6e8ddac5c 100644 --- a/testsuite/tests/rts/linker/all.T +++ b/testsuite/tests/rts/linker/all.T @@ -123,14 +123,17 @@ test('linker_unload_native', ###################################### test('linker_error1', [extra_files(['linker_error.c']), js_skip, # dynamic linking not supported by the JS backend + req_target_debug_rts, ignore_stderr], makefile_test, ['linker_error1']) test('linker_error2', [extra_files(['linker_error.c']), js_skip, # dynamic linking not supported by the JS backend + req_target_debug_rts, ignore_stderr], makefile_test, ['linker_error2']) test('linker_error3', [extra_files(['linker_error.c']), js_skip, # dynamic linking not supported by the JS backend + req_target_debug_rts, ignore_stderr], makefile_test, ['linker_error3']) ###################################### @@ -149,7 +152,9 @@ test('rdynamic', [ unless(opsys('linux') or opsys('mingw32'), skip) test('T7072', [extra_files(['load-object.c', 'T7072.c']), unless(opsys('linux'), skip), - req_rts_linker], + req_rts_linker, + req_target_debug_rts + ], makefile_test, ['T7072']) test('T20494', [req_rts_linker, when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))], diff --git a/utils/deriveConstants/Main.hs b/utils/deriveConstants/Main.hs index 68acf8ec8150..044ba9339b41 100644 --- a/utils/deriveConstants/Main.hs +++ b/utils/deriveConstants/Main.hs @@ -841,6 +841,7 @@ getWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram = case words line of ('_' : n) : "C" : s : _ -> mkP n s n : "C" : s : _ -> mkP n s + n : "B" : _ : s : _ -> mkP n s [n, "D", _, s] -> mkP n s [s, "O", "*COM*", _, n] -> mkP n s _ -> Nothing diff --git a/utils/genprimopcode/genprimopcode.cabal b/utils/genprimopcode/genprimopcode.cabal index 8db8827e1594..946c5e576ae9 100644 --- a/utils/genprimopcode/genprimopcode.cabal +++ b/utils/genprimopcode/genprimopcode.cabal @@ -31,5 +31,7 @@ Executable genprimopcode AccessOps Build-Depends: base >= 4 && < 5, array + default-extensions: + UnboxedSums if flag(build-tool-depends) build-tool-depends: alex:alex >= 3.2.6, happy:happy >= 1.20.0 diff --git a/utils/ghc-toolchain/exe/Main.hs b/utils/ghc-toolchain/exe/Main.hs index 71faaf79a171..09f009f554a1 100644 --- a/utils/ghc-toolchain/exe/Main.hs +++ b/utils/ghc-toolchain/exe/Main.hs @@ -1,12 +1,14 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE RecordWildCards #-} module Main where import Control.Monad -import Data.Char (toUpper) +import Data.Char (toUpper,isSpace) import Data.Maybe (isNothing,fromMaybe) +import qualified Data.List as List import System.Exit import System.Console.GetOpt import System.Environment @@ -62,6 +64,7 @@ data Opts = Opts , optLdOverride :: Maybe Bool , optVerbosity :: Int , optKeepTemp :: Bool + , optOutputSettings :: Bool -- ^ Output settings file, not Target } data FormatOpts = FormatOpts @@ -107,6 +110,7 @@ emptyOpts = Opts , optLdOverride = Nothing , optVerbosity = 1 , optKeepTemp = False + , optOutputSettings = False } where po0 = emptyProgOpt @@ -148,6 +152,9 @@ _optTablesNextToCode = Lens optTablesNextToCode (\x o -> o {optTablesNextToCode= _optUseLibFFIForAdjustors = Lens optUseLibFFIForAdjustors (\x o -> o {optUseLibFFIForAdjustors=x}) _optLdOvveride = Lens optLdOverride (\x o -> o {optLdOverride=x}) +_optOutputSettings :: Lens Opts Bool +_optOutputSettings = Lens optOutputSettings (\x o -> o {optOutputSettings=x}) + _optVerbosity :: Lens Opts Int _optVerbosity = Lens optVerbosity (\x o -> o {optVerbosity=x}) @@ -161,6 +168,7 @@ options = , llvmTripleOpt , verbosityOpt , keepTempOpt + , outputSettingsOpt , outputOpt ] ++ concat @@ -233,6 +241,9 @@ options = keepTempOpt = Option [] ["keep-temp"] (NoArg (set _optKeepTemp True)) "do not remove temporary files" + outputSettingsOpt = Option [] ["output-settings"] (NoArg (set _optOutputSettings True)) + "output settings instead of Target" + outputOpt = Option ['o'] ["output"] (ReqArg (set _optOutput . Just) "OUTPUT") "The output path for the generated target toolchain configuration" @@ -309,7 +320,10 @@ run opts = do tgt <- mkTarget opts logDebug $ "Final Target: " ++ show tgt let file = fromMaybe (error "undefined --output") (optOutput opts) - writeFile file (show tgt) + let output = case optOutputSettings opts of + False -> show tgt + True -> show (targetToSettings tgt) + writeFile file output optional :: M a -> M (Maybe a) optional k = fmap Just k <|> pure Nothing @@ -493,3 +507,189 @@ mkTarget opts = do return t --- ROMES:TODO: fp_settings.m4 in general which I don't think was ported completely (e.g. the basenames and windows llvm-XX and such) + + +targetToSettings :: Target -> [(String,String)] +targetToSettings tgt@Target{..} = + [ ("C compiler command", ccPath) + , ("C compiler flags", ccFlags) + , ("C++ compiler command", cxxPath) + , ("C++ compiler flags", cxxFlags) + , ("C compiler link flags", clinkFlags) + , ("C compiler supports -no-pie", linkSupportsNoPie) + , ("CPP command", cppPath) + , ("CPP flags", cppFlags) + , ("Haskell CPP command", hsCppPath) + , ("Haskell CPP flags", hsCppFlags) + , ("JavaScript CPP command", jsCppPath) + , ("JavaScript CPP flags", jsCppFlags) + , ("C-- CPP command", cmmCppPath) + , ("C-- CPP flags", cmmCppFlags) + , ("C-- CPP supports -g0", cmmCppSupportsG0') + , ("ld supports compact unwind", linkSupportsCompactUnwind) + , ("ld supports filelist", linkSupportsFilelist) + , ("ld supports single module", linkSupportsSingleModule) + , ("ld is GNU ld", linkIsGnu) + , ("Merge objects command", mergeObjsPath) + , ("Merge objects flags", mergeObjsFlags) + , ("Merge objects supports response files", mergeObjsSupportsResponseFiles') + , ("ar command", arPath) + , ("ar flags", arFlags) + , ("ar supports at file", arSupportsAtFile') + , ("ar supports -L", arSupportsDashL') + , ("ranlib command", ranlibPath) + , ("otool command", otool_cmd) + , ("install_name_tool command", install_name_cmd) + , ("windres command", (maybe "/bin/false" prgPath tgtWindres)) -- TODO: /bin/false is not available on many distributions by default, but we keep it as it were before the ghc-toolchain patch. Fix-me. + , ("unlit command", "$topdir/../bin/unlit") -- FIXME + , ("cross compiling", yesNo False) -- FIXME: why do we need this settings at all? + , ("target platform string", targetPlatformTriple tgt) + , ("target os", (show $ archOS_OS tgtArchOs)) + , ("target arch", (show $ archOS_arch tgtArchOs)) + , ("target word size", wordSize) + , ("target word big endian", isBigEndian) + , ("target has GNU nonexec stack", (yesNo tgtSupportsGnuNonexecStack)) + , ("target has .ident directive", (yesNo tgtSupportsIdentDirective)) + , ("target has subsections via symbols", (yesNo tgtSupportsSubsectionsViaSymbols)) + , ("target has libm", has_libm) + , ("Unregisterised", (yesNo tgtUnregisterised)) + , ("LLVM target", tgtLlvmTarget) + , ("LLVM llc command", llc_cmd) + , ("LLVM opt command", llvm_opt_cmd) + , ("LLVM llvm-as command", llvm_as_cmd) + , ("Use inplace MinGW toolchain", use_inplace_mingw) + , ("target RTS linker only supports shared libraries", yesNo (targetRTSLinkerOnlySupportsSharedLibs tgt)) + , ("Use interpreter", yesNo (targetSupportsInterpreter tgt)) + , ("Support SMP", yesNo (targetSupportsSMP tgt)) + , ("RTS ways", "") -- FIXME: should be a property of the RTS, not of the target + , ("Tables next to code", (yesNo tgtTablesNextToCode)) + , ("Leading underscore", (yesNo tgtSymbolsHaveLeadingUnderscore)) + , ("Use LibFFI", yesNo tgtUseLibffiForAdjustors) + , ("RTS expects libdw", yesNo False) -- FIXME + , ("Relative Global Package DB", "") + , ("base unit-id", "") + ] + where + yesNo True = "YES" + yesNo False = "NO" + + wordSize = show (wordSize2Bytes tgtWordSize) + isBigEndian = yesNo $ (\case BigEndian -> True; LittleEndian -> False) tgtEndianness + + otool_cmd = "" -- FIXME + install_name_cmd = "" -- FIXME + has_libm = "NO" -- FIXME + llc_cmd = "llc" -- FIXME + llvm_opt_cmd = "opt" -- FIXME + llvm_as_cmd = "llvm-as" -- FIXME + use_inplace_mingw = "NO" -- FIXME + + ccPath = prgPath $ ccProgram tgtCCompiler + ccFlags = escapeArgs $ prgFlags $ ccProgram tgtCCompiler + cxxPath = prgPath $ cxxProgram tgtCxxCompiler + cxxFlags = escapeArgs $ prgFlags $ cxxProgram tgtCxxCompiler + clinkFlags = escapeArgs $ prgFlags $ ccLinkProgram tgtCCompilerLink + linkSupportsNoPie = yesNo $ ccLinkSupportsNoPie tgtCCompilerLink + cppPath = prgPath $ cppProgram tgtCPreprocessor + cppFlags = escapeArgs $ prgFlags $ cppProgram tgtCPreprocessor + hsCppPath = prgPath $ hsCppProgram tgtHsCPreprocessor + hsCppFlags = escapeArgs $ prgFlags $ hsCppProgram tgtHsCPreprocessor + jsCppPath = maybe "" (prgPath . jsCppProgram) tgtJsCPreprocessor + jsCppFlags = maybe "" (escapeArgs . prgFlags . jsCppProgram) tgtJsCPreprocessor + cmmCppPath = prgPath $ cmmCppProgram tgtCmmCPreprocessor + cmmCppFlags = escapeArgs $ prgFlags $ cmmCppProgram tgtCmmCPreprocessor + cmmCppSupportsG0' = yesNo $ cmmCppSupportsG0 tgtCmmCPreprocessor + mergeObjsPath = maybe "" (prgPath . mergeObjsProgram) tgtMergeObjs + mergeObjsFlags = maybe "" (escapeArgs . prgFlags . mergeObjsProgram) tgtMergeObjs + linkSupportsSingleModule = yesNo $ ccLinkSupportsSingleModule tgtCCompilerLink + linkSupportsFilelist = yesNo $ ccLinkSupportsFilelist tgtCCompilerLink + linkSupportsCompactUnwind = yesNo $ ccLinkSupportsCompactUnwind tgtCCompilerLink + linkIsGnu = yesNo $ ccLinkIsGnu tgtCCompilerLink + arPath = prgPath $ arMkArchive tgtAr + arFlags = escapeArgs $ prgFlags (arMkArchive tgtAr) + arSupportsAtFile' = yesNo (arSupportsAtFile tgtAr) + arSupportsDashL' = yesNo (arSupportsDashL tgtAr) + ranlibPath = maybe "" (prgPath . ranlibProgram) tgtRanlib + mergeObjsSupportsResponseFiles' = maybe "NO" (yesNo . mergeObjsSupportsResponseFiles) tgtMergeObjs + +-- | Just like 'GHC.ResponseFile.escapeArgs', but use spaces instead of newlines +-- for splitting elements. +escapeArgs :: [String] -> String +escapeArgs = unwords . map escapeArg + +escapeArg :: String -> String +escapeArg = reverse . List.foldl' escape [] + +escape :: String -> Char -> String +escape cs c + | isSpace c + || '\\' == c + || '\'' == c + || '"' == c = c:'\\':cs -- n.b., our caller must reverse the result + | otherwise = c:cs + +-- | Does the target support the -N RTS flag? +-- +-- Adapated from hadrian: Oracles.Flag.targetSupportsSMP +targetSupportsSMP :: Target -> Bool +targetSupportsSMP Target{..} = case archOS_arch tgtArchOs of + -- The THREADED_RTS requires `BaseReg` to be in a register and the + -- Unregisterised mode doesn't allow that. + _ | tgtUnregisterised -> False + ArchARM isa _ _ + -- We don't support load/store barriers pre-ARMv7. See #10433. + | isa < ARMv7 -> False + | otherwise -> True + ArchX86 -> True + ArchX86_64 -> True + ArchPPC -> True + ArchPPC_64 ELF_V1 -> True + ArchPPC_64 ELF_V2 -> True + ArchAArch64 -> True + ArchS390X -> True + ArchRISCV64 -> True + ArchLoongArch64 -> True + ArchAArch64 -> True + _ -> False + + + +-- | Check whether the target supports GHCi. +-- +-- Adapted from hadrian:Oracles.Settings.ghcWithInterpreter +targetSupportsInterpreter :: Target -> Bool +targetSupportsInterpreter Target{..} = goodOs && goodArch + where + goodOs = case archOS_OS tgtArchOs of + OSMinGW32 -> True + OSLinux -> True + OSSolaris2 -> True + OSFreeBSD -> True + OSDragonFly -> True + OSNetBSD -> True + OSOpenBSD -> True + OSDarwin -> True + OSKFreeBSD -> True + OSWasi -> True + _ -> False + -- TODO "cygwin32"? + + goodArch = case archOS_arch tgtArchOs of + ArchX86 -> True + ArchX86_64 -> True + ArchPPC -> True + ArchAArch64 -> True + ArchS390X -> True + ArchPPC_64 ELF_V1 -> True + ArchPPC_64 ELF_V2 -> True + ArchRISCV64 -> True + ArchWasm32 -> True + ArchAArch64 -> True + ArchARM {} -> True + _ -> False + + +targetRTSLinkerOnlySupportsSharedLibs :: Target -> Bool +targetRTSLinkerOnlySupportsSharedLibs tgt = case archOS_arch (tgtArchOs tgt) of + ArchWasm32 -> True + _ -> False 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 $@