diff --git a/.envrc b/.envrc
new file mode 100644
index 000000000000..637e3f13a491
--- /dev/null
+++ b/.envrc
@@ -0,0 +1,7 @@
+# Check if nix-direnv is already loaded; if not, source it
+if ! has nix_direnv_reload; then
+ source_url "https://raw.githubusercontent.com/nix-community/nix-direnv/3.0.7/direnvrc" "sha256-bn8WANE5a91RusFmRI7kS751ApelG02nMcwRekC/qzc="
+fi
+
+# Use the specified flake to enter the Nix development environment
+use flake github:input-output-hk/devx#ghc98-minimal-ghc
\ No newline at end of file
diff --git a/.github/actions/download/action.yml b/.github/actions/download/action.yml
new file mode 100644
index 000000000000..cfb4e283c80b
--- /dev/null
+++ b/.github/actions/download/action.yml
@@ -0,0 +1,25 @@
+name: 'Download artifact'
+description: 'Download artifacts with normalized names'
+inputs:
+ name:
+ required: true
+ type: string
+ path:
+ required: true
+ type: string
+
+runs:
+ using: "composite"
+ steps:
+ - name: Normalise name
+ run: |
+ name=${{ inputs.name }}
+ echo "NAME=${name//\//_}" >> "$GITHUB_ENV"
+ shell: bash
+
+ - name: Download artifact
+ uses: actions/download-artifact@v4
+ with:
+ name: ${{ env.NAME }}
+ path: ${{ inputs.path }}
+
diff --git a/.github/actions/upload/action.yml b/.github/actions/upload/action.yml
new file mode 100644
index 000000000000..927974ad581f
--- /dev/null
+++ b/.github/actions/upload/action.yml
@@ -0,0 +1,33 @@
+name: 'Upload artifact'
+description: 'Upload artifacts with normalized names'
+inputs:
+ if-no-files-found:
+ default: 'error'
+ type: string
+ name:
+ required: true
+ type: string
+ path:
+ required: true
+ type: string
+ retention-days:
+ default: 0
+ type: number
+
+runs:
+ using: "composite"
+ steps:
+ - name: Normalise name
+ run: |
+ name=${{ inputs.name }}
+ echo "NAME=${name//\//_}" >> "$GITHUB_ENV"
+ shell: bash
+
+ - name: Upload artifact
+ uses: actions/upload-artifact@v4
+ with:
+ if-no-files-found: ${{ inputs.if-no-files-found }}
+ retention-days: ${{ inputs.retention-days }}
+ name: ${{ env.NAME }}
+ path: ${{ inputs.path }}
+
diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
new file mode 100644
index 000000000000..97f19ed1039d
--- /dev/null
+++ b/.github/workflows/ci.yml
@@ -0,0 +1,233 @@
+name: CI
+
+on:
+ pull_request:
+ types: [opened, synchronize]
+ push:
+ branches: [stable-ghc-9.14, stable-master]
+ workflow_dispatch:
+
+env:
+ CABAL_CACHE_PATH: _build/cabal/bin
+
+jobs:
+ cabal:
+ strategy:
+ fail-fast: false
+ matrix:
+ include:
+ - plat: x86_64-linux
+ runner: ubuntu-24.04
+ ghc: '98'
+ dynamic: 0
+ - plat: x86_64-linux
+ runner: ubuntu-24.04
+ ghc: '98'
+ dynamic: 1
+ # - plat: aarch64-linux # disabled: waiting for devx images to be fixed
+ # runner: ubuntu-24.04-arm
+ # ghc: '98'
+ # dynamic: 0
+ # - plat: aarch64-linux
+ # runner: ubuntu-24.04-arm
+ # ghc: '98'
+ # dynamic: 1
+ - plat: aarch64-darwin
+ runner: macos-latest
+ ghc: '98'
+ dynamic: 0
+ - plat: aarch64-darwin
+ runner: macos-latest
+ ghc: '98'
+ dynamic: 1
+
+ name: "${{ matrix.plat }} / ghc ${{ matrix.ghc }} / dynamic=${{ matrix.dynamic }}"
+ runs-on: ${{ matrix.runner }}
+
+ steps:
+ - uses: actions/checkout@v4
+ with:
+ submodules: "recursive"
+
+ - uses: input-output-hk/actions/devx@latest
+ with:
+ platform: ${{ matrix.plat }}
+ compiler-nix-name: 'ghc98'
+ minimal: true
+ ghc: true
+
+ - name: Cache stage0 cabal binary
+ id: cabal-cache
+ uses: actions/cache@v5
+ with:
+ path: ${{ env.CABAL_CACHE_PATH }}
+ key: cabal-${{ vars.CACHE_VERSION || 'v1' }}-${{ matrix.plat }}-${{ hashFiles('cabal.project.stage0') }}
+
+ - name: Update hackage
+ shell: devx {0}
+ run: cabal update
+
+ # The Makefile will run configure (and boot), we also need to create a
+ # synthetic package before running configure. Once this nuisance is fixed
+ # we can do proper configure + make again. Until then... we have to live
+ # with the hack of running everything from the make target.
+ # - name: Configure the build
+ # shell: devx {0}
+ # run: ./configure
+
+ - name: Start metrics collection
+ shell: bash # bash (not devx): metrics tools use absolute paths to system binaries
+ run: ./mk/collect-metrics.sh start _build/metrics 0.5
+
+ - name: Build (dynamic=${{ matrix.dynamic }})
+ shell: devx {0}
+ run: make QUIET=1 DYNAMIC=${{ matrix.dynamic }} ${{ steps.cabal-cache.outputs.cache-hit == 'true' && 'USE_SYSTEM_CABAL=1' || '' }}
+
+ - name: Display build timings
+ if: ${{ !cancelled() }}
+ shell: devx {0}
+ run: make timing-summary
+
+ - name: Upload artifacts
+ uses: actions/upload-artifact@v4
+ with:
+ name: ${{ matrix.plat }}-dynamic${{ matrix.dynamic }}-dist
+ path: _build/dist
+
+ - name: Upload build logs and timing
+ uses: actions/upload-artifact@v4
+ if: ${{ !cancelled() }}
+ with:
+ name: ${{ matrix.plat }}-dynamic${{ matrix.dynamic }}-build-logs
+ path: |
+ _build/logs/
+ _build/timing/
+
+ - name: Run the testsuite (dynamic=${{ matrix.dynamic }})
+ shell: devx {0}
+ run: make test QUIET=1 DYNAMIC=${{ matrix.dynamic }} ${{ steps.cabal-cache.outputs.cache-hit == 'true' && 'USE_SYSTEM_CABAL=1' || '' }}
+
+ - name: Stop metrics collection
+ if: ${{ !cancelled() }}
+ shell: bash # bash (not devx): metrics tools use absolute paths to system binaries
+ run: ./mk/collect-metrics.sh stop _build/metrics
+
+ - name: Display test timings
+ if: ${{ !cancelled() }}
+ shell: devx {0}
+ run: make timing-summary
+
+ - name: Generate metrics plots
+ if: ${{ !cancelled() }}
+ continue-on-error: true
+ shell: bash
+ run: |
+ # Generate separate build and test SVG plots.
+ # Use bash (not devx) because nix is not available inside the devx shell.
+ PYTHON_MPL=$(nix build --impure --no-link --print-out-paths \
+ --expr 'let pkgs = (builtins.getFlake "nixpkgs").legacyPackages.${builtins.currentSystem}; in pkgs.python3.withPackages (ps: [ps.matplotlib])')
+ "$PYTHON_MPL/bin/python3" ./mk/plot-metrics.py _build/metrics _build/timing _build/metrics/metrics
+
+ - name: Upload metrics plots to R2
+ if: ${{ !cancelled() }}
+ continue-on-error: true
+ env:
+ AWS_ACCESS_KEY_ID: ${{ secrets.R2_METRICS_ACCESS_KEY_ID }}
+ AWS_SECRET_ACCESS_KEY: ${{ secrets.R2_METRICS_SECRET_ACCESS_KEY }}
+ R2_ENDPOINT: ${{ secrets.R2_METRICS_ENDPOINT }}
+ R2_PUBLIC_URL: ${{ vars.R2_METRICS_PUBLIC_URL }}
+ R2_BUCKET: ${{ vars.R2_METRICS_BUCKET_NAME }}
+ shell: bash
+ run: |
+ RUN_ID="${{ github.run_id }}"
+ PLAT="${{ matrix.plat }}"
+ DYN="${{ matrix.dynamic }}"
+
+ export AWS_ENDPOINT_URL="${R2_ENDPOINT}"
+ export AWS_DEFAULT_REGION=auto
+
+ # Use bash (not devx) because nix is not available inside the devx shell.
+ AWSCLI=$(nix build --no-link --print-out-paths nixpkgs#awscli2)
+ AWS="$AWSCLI/bin/aws"
+
+ # Upload build plot if it exists
+ if [[ -f "_build/metrics/metrics-build.svg" ]]; then
+ BUILD_PATH="runs/${RUN_ID}/${PLAT}-dynamic${DYN}-build.svg"
+ "$AWS" s3 cp _build/metrics/metrics-build.svg "s3://${R2_BUCKET}/${BUILD_PATH}" --content-type 'image/svg+xml' || echo "Failed to upload build plot (non-fatal)"
+ echo "BUILD_PLOT_URL=${R2_PUBLIC_URL}/${BUILD_PATH}" >> $GITHUB_ENV
+ fi
+
+ # Upload test plot if it exists
+ if [[ -f "_build/metrics/metrics-test.svg" ]]; then
+ TEST_PATH="runs/${RUN_ID}/${PLAT}-dynamic${DYN}-test.svg"
+ "$AWS" s3 cp _build/metrics/metrics-test.svg "s3://${R2_BUCKET}/${TEST_PATH}" --content-type 'image/svg+xml' || echo "Failed to upload test plot (non-fatal)"
+ echo "TEST_PLOT_URL=${R2_PUBLIC_URL}/${TEST_PATH}" >> $GITHUB_ENV
+ fi
+
+ - name: Write metrics summary
+ if: ${{ !cancelled() }}
+ shell: devx {0}
+ run: |
+ echo "## Build Metrics Summary" >> $GITHUB_STEP_SUMMARY
+ echo "" >> $GITHUB_STEP_SUMMARY
+
+ # Embed build plot if available
+ if [[ -n "${BUILD_PLOT_URL:-}" ]]; then
+ echo "### Build Phases (CPU & Memory)" >> $GITHUB_STEP_SUMMARY
+ echo "![\"Build](\"${BUILD_PLOT_URL}\")
" >> $GITHUB_STEP_SUMMARY
+ echo "" >> $GITHUB_STEP_SUMMARY
+ fi
+
+ # Embed test plot if available
+ if [[ -n "${TEST_PLOT_URL:-}" ]]; then
+ echo "### Test Phase (CPU & Memory)" >> $GITHUB_STEP_SUMMARY
+ echo "![\"Test](\"${TEST_PLOT_URL}\")
" >> $GITHUB_STEP_SUMMARY
+ echo "" >> $GITHUB_STEP_SUMMARY
+ fi
+
+ echo "### Phase Timings" >> $GITHUB_STEP_SUMMARY
+ echo "| Phase | Duration | Status |" >> $GITHUB_STEP_SUMMARY
+ echo "|-------|----------|--------|" >> $GITHUB_STEP_SUMMARY
+
+ # Auto-discover phases from timing files (summary.txt is generated
+ # by timing-summary.sh with ordered top-level + sub-phases)
+ make timing-summary 2>/dev/null || true
+ if [[ -f "_build/timing/summary.txt" ]]; then
+ while read -r phase dur status; do
+ mins=$((dur / 60))
+ secs=$((dur % 60))
+ status_str="OK"
+ [[ "$status" == "1" ]] && status_str="FAIL"
+ # Indent sub-phases (contain a dot) with leading spaces
+ if [[ "$phase" == *.* ]]; then
+ echo "| $phase | ${mins}m ${secs}s | $status_str |" >> $GITHUB_STEP_SUMMARY
+ else
+ echo "| **$phase** | **${mins}m ${secs}s** | $status_str |" >> $GITHUB_STEP_SUMMARY
+ fi
+ done < "_build/timing/summary.txt"
+ fi
+ echo "" >> $GITHUB_STEP_SUMMARY
+ # Add memory stats from metrics
+ if [[ -f "_build/metrics/metrics.csv" ]]; then
+ max_mem=$(awk -F',' 'NR>1 {if($3>max) max=$3} END {printf "%.1f", max/1024}' _build/metrics/metrics.csv)
+ echo "**Peak Memory:** ${max_mem} GB" >> $GITHUB_STEP_SUMMARY
+ fi
+
+ - name: Upload test results
+ uses: actions/upload-artifact@v4
+ if: ${{ !cancelled() }}
+ with:
+ name: ${{ matrix.plat }}-dynamic${{ matrix.dynamic }}-testsuite-results
+ path: |
+ _build/test-perf.csv
+ _build/test-summary.txt
+ _build/test-junit.xml
+ _build/timing/
+
+ - name: Upload metrics
+ uses: actions/upload-artifact@v4
+ if: ${{ !cancelled() }}
+ with:
+ name: ${{ matrix.plat }}-dynamic${{ matrix.dynamic }}-metrics
+ path: |
+ _build/metrics/
diff --git a/.github/workflows/release.yml b/.github/workflows/release.yml
new file mode 100644
index 000000000000..e6bf7718610f
--- /dev/null
+++ b/.github/workflows/release.yml
@@ -0,0 +1,46 @@
+name: Build and release
+
+on:
+ push:
+ tags: ['*']
+ pull_request:
+ types: [opened, synchronize, reopened, labeled]
+ branches:
+ - stable-ghc-9.14
+ schedule:
+ - cron: '0 0 * * *'
+ workflow_dispatch:
+
+permissions:
+ pull-requests: read
+ contents: write
+
+jobs:
+ release-workflow:
+ uses: ./.github/workflows/reusable-release.yml
+ with:
+ branches: '["${{ github.ref }}"]'
+
+ release:
+ name: release
+ needs: [ "release-workflow" ]
+ runs-on: ubuntu-latest
+ if: ${{ startsWith(github.ref, 'refs/tags/') || github.event_name == 'workflow_dispatch' }}
+ steps:
+ - name: Checkout code
+ uses: actions/checkout@v4
+
+ - name: Download artifacts
+ uses: actions/download-artifact@v4
+ with:
+ pattern: artifacts-*
+ merge-multiple: true
+ path: ./out
+
+ - name: Release
+ uses: softprops/action-gh-release@v2
+ with:
+ draft: true
+ files: |
+ ./out/*
+
diff --git a/.github/workflows/reusable-release.yml b/.github/workflows/reusable-release.yml
new file mode 100644
index 000000000000..fe56af77f3f3
--- /dev/null
+++ b/.github/workflows/reusable-release.yml
@@ -0,0 +1,855 @@
+name: Build and release
+
+on:
+ workflow_call:
+ inputs:
+ branches:
+ required: true
+ type: string
+ ghc:
+ type: string
+ default: 9.8.4
+ # speed up installation by skipping docs
+ # starting with GHC 9.10.x, we also need to pass the 'install_extra' target
+ ghc_targets:
+ type: string
+ default: "install_bin install_lib update_package_db"
+ cabal:
+ type: string
+ default: 3.14.2.0
+ dynamic:
+ type: string
+ default: 1
+ test:
+ type: boolean
+ default: true
+
+env:
+ GIT_COMMIT_ID: ${{ github.sha }}
+ # toolchain
+ GHC_VERSION: ${{ inputs.ghc }}
+ GHC_TARGETS: ${{ inputs.ghc_targets }}
+ CABAL_VERSION: ${{ inputs.cabal }}
+ # debian/ubuntu
+ DEBIAN_FRONTEND: noninteractive
+ TZ: Asia/Singapore
+ # cross
+ EMSDK_VERSION: 3.1.74
+ # make
+ MAKE_VERSION: 4.4
+ MAKE: make
+ # windows
+ GHCUP_MSYS2_ENV: CLANG64
+ MSYSTEM: CLANG64
+ CHERE_INVOKING: 1
+ # dynamic
+ DYNAMIC: ${{ inputs.dynamic }}
+ # stage0 cabal cache
+ CABAL_CACHE_PATH: _build/cabal/bin
+
+jobs:
+ tool-output:
+ runs-on: ubuntu-latest
+ outputs:
+ apt_tools_build: ${{ steps.gen_output.outputs.apt_tools_build }}
+ rpm_tools_build: ${{ steps.gen_output.outputs.rpm_tools_build }}
+ apk_tools_build: ${{ steps.gen_output.outputs.apk_tools_build }}
+ apt_tools_test: ${{ steps.gen_output.outputs.apt_tools_test }}
+ rpm_tools_test: ${{ steps.gen_output.outputs.rpm_tools_test }}
+ apk_tools_test: ${{ steps.gen_output.outputs.apk_tools_test }}
+ env:
+ APT_BUILD: "diffutils zlib1g-dev libtinfo-dev libsqlite3-0 libsqlite3-dev libgmp-dev libncurses-dev ca-certificates g++ git make automake autoconf gcc perl python3 texinfo xz-utils lbzip2 bzip2 patch openssh-client sudo time jq wget curl locales libdw1 libdw-dev valgrind systemtap-sdt-dev xutils-dev unzip pkg-config python3-sphinx texlive-xetex texlive-latex-extra texlive-binaries texlive-fonts-recommended lmodern tex-gyre texlive-plain-generic linux-perf linux-perf libnuma-dev patchelf"
+ RPM_BUILD: "diffutils binutils which git make automake autoconf gcc perl python3 texinfo xz bzip2 patch openssh-clients sudo zlib-devel sqlite ncurses-compat-libs gmp-devel ncurses-devel gcc-c++ findutils curl wget jq systemtap-sdt-devel python3-sphinx texlive texlive-latex texlive-xetex texlive-collection-latex texlive-collection-latexrecommended texlive-collection-xetex python-sphinx-latex dejavu-sans-fonts dejavu-serif-fonts dejavu-sans-mono-fonts patchelf"
+ APK_BUILD: "diffutils alpine-sdk autoconf automake bash binutils-gold build-base coreutils cpio curl gcc git gmp gmp-dev grep linux-headers gzip jq lld musl-dev musl-locales ncurses-dev ncurses-libs ncurses-static perl python3 sudo unzip wget xz zlib-dev zstd py3-sphinx texlive texlive-xetex texmf-dist-latexextra ttf-dejavu llvm17 clang17 texmf-dist-lang texmf-dist-fontsrecommended texinfo patchelf findutils"
+ APT_TEST: "diffutils locales libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl gzip libncurses-dev patchelf"
+ RPM_TEST: "diffutils autoconf automake binutils bzip2 coreutils curl elfutils-devel elfutils-libs findutils gcc gcc-c++ git gmp gmp-devel jq lbzip2 make ncurses ncurses-compat-libs ncurses-devel openssh-clients patch perl pxz python3 sqlite sudo wget which xz zlib-devel patchelf"
+ APK_TEST: "diffutils musl-locales curl gcc g++ gmp-dev libc-dev make musl-dev ncurses-dev perl tar xz autoconf automake bzip2 coreutils elfutils-dev findutils git jq bzip2-dev patch python3 sqlite sudo wget which zlib-dev patchelf zlib zlib-dev zlib-static"
+ steps:
+ - name: Generate output
+ id: gen_output
+ run: |
+ echo apt_tools_build="${{ env.APT_BUILD }}" >> "$GITHUB_OUTPUT"
+ echo rpm_tools_build="${{ env.RPM_BUILD }}" >> "$GITHUB_OUTPUT"
+ echo apk_tools_build="${{ env.APK_BUILD }}" >> "$GITHUB_OUTPUT"
+ echo apt_tools_test="${{ env.APT_TEST }}" >> "$GITHUB_OUTPUT"
+ echo rpm_tools_test="${{ env.RPM_TEST }}" >> "$GITHUB_OUTPUT"
+ echo apk_tools_test="${{ env.APK_TEST }}" >> "$GITHUB_OUTPUT"
+
+ build-linux:
+ name: Build linux binaries
+ runs-on: ubuntu-latest
+ needs: ["tool-output"]
+ strategy:
+ fail-fast: false
+ matrix:
+ branch: ${{ fromJSON(inputs.branches) }}
+ platform: [ { image: "rockylinux:8"
+ , installCmd: "dnf install -y 'dnf-command(config-manager)' && dnf config-manager --set-enabled powertools && yum install -y --allowerasing"
+ , toolRequirements: "${{ needs.tool-output.outputs.rpm_tools_build }}"
+ , ARTIFACT: "x86_64-linux-glibc"
+ },
+ { image: "alpine:3.20"
+ , installCmd: "apk update && apk add"
+ , toolRequirements: "${{ needs.tool-output.outputs.apk_tools_build }}"
+ , ARTIFACT: "x86_64-linux-musl"
+ }
+ ]
+ container:
+ image: ${{ matrix.platform.image }}
+ steps:
+ # needed for patchelf
+ - if: matrix.platform.image == 'rockylinux:8'
+ name: Install EPEL
+ run: |
+ dnf install -y epel-release
+
+ - name: Install requirements
+ shell: sh
+ run: |
+ ${{ matrix.platform.installCmd }} curl bash git ${{ matrix.platform.toolRequirements }}
+
+ - id: ghcup
+ name: Install GHCup
+ uses: haskell/ghcup-setup@v1
+ with:
+ cabal: ${{ env.CABAL_VERSION }}
+
+ - name: Install GHC
+ run: ghcup --no-verbose install ghc --set --install-targets "${{ env.GHC_TARGETS }}" "${{ env.GHC_VERSION }}"
+
+ - uses: actions/checkout@v4
+ with:
+ ref: ${{ matrix.branch }}
+ submodules: recursive
+
+ - uses: nick-fields/retry@v3
+ if: matrix.platform.image == 'rockylinux:8'
+ name: Install latest make
+ with:
+ timeout_minutes: 15
+ max_attempts: 3
+ retry_on: error
+ command: |
+ set -eux
+ curl -O -L https://ftp.gnu.org/gnu/make/make-${{ env.MAKE_VERSION }}.tar.gz
+ tar xf make-${{ env.MAKE_VERSION }}.tar.gz
+ cd make-${{ env.MAKE_VERSION }}
+ ./configure
+ make install
+ ln -s make /usr/local/bin/gmake
+ echo "/usr/local/bin" >> $GITHUB_PATH
+
+ - if: matrix.platform.image == 'rockylinux:8'
+ name: Install emscripten
+ run : &emscripten |
+ set -eux
+
+ git clone https://github.com/emscripten-core/emsdk.git
+ cd emsdk
+ git fetch --tags
+ git checkout ${{ env.EMSDK_VERSION }}
+ ./emsdk install ${{ env.EMSDK_VERSION }}
+ ./emsdk activate ${{ env.EMSDK_VERSION }}
+
+ - name: Cache stage0 cabal binary
+ uses: actions/cache@v5
+ with:
+ path: ${{ env.CABAL_CACHE_PATH }}
+ key: cabal-${{ vars.CACHE_VERSION || 'v1' }}-${{ matrix.platform.ARTIFACT }}-${{ hashFiles('cabal.project.stage0') }}
+
+ - name: Run build
+ run: &build |
+ set -eux
+
+ # Skip building cabal if a cached binary already exists
+ if [ -x "${{ env.CABAL_CACHE_PATH }}/cabal" ]; then
+ export USE_SYSTEM_CABAL=1
+ fi
+
+ # On windows, we use msys2 shell, which does not by default inherit the windows PATHs.
+ # So although the ghcup action sets the PATH, it's not visible. We don't want to use
+ # 'pathtype: inherit', because it pollutes the msys2 paths, possibly leading to linking
+ # or other issues. So we just hardcode it here.
+ if [ ${{ runner.os }} = "Windows" ] ; then
+ export PATH="/c/ghcup/bin:$PATH"
+ make --version
+ which make
+ fi
+
+ cabal update
+ if [ -e "emsdk" ] ; then
+ git config --system --add safe.directory $GITHUB_WORKSPACE
+ git config --system --add safe.directory '*'
+ cd emsdk
+ source ./emsdk_env.sh
+ cd ..
+ ${{ env.MAKE }} _build/dist/haskell-toolchain.tar.gz _build/dist/ghc.tar.gz _build/dist/cabal.tar.gz _build/dist/tests.tar.gz _build/dist/ghc-javascript-unknown-ghcjs.tar.gz
+ else
+ ${{ env.MAKE }} --debug _build/dist/ghc.tar.gz _build/dist/cabal.tar.gz _build/dist/tests.tar.gz
+ fi
+ cd _build/dist
+ mv ghc.tar.gz ghc-$(bin/ghc --numeric-version)-${ARTIFACT}.tar.gz
+ mv cabal.tar.gz cabal-$(bin/cabal --numeric-version)-${ARTIFACT}.tar.gz
+ if [ -e "haskell-toolchain.tar.gz" ] ; then
+ mv haskell-toolchain.tar.gz haskell-toolchain-${ARTIFACT}.tar.gz
+ mv ghc-javascript-unknown-ghcjs.tar.gz ghc-javascript-unknown-ghcjs-$(bin/ghc --numeric-version)-${ARTIFACT}.tar.gz
+ fi
+ mv tests.tar.gz tests-${ARTIFACT}.tar.gz
+ env:
+ ARTIFACT: ${{ matrix.platform.ARTIFACT }}
+
+ - if: always()
+ name: Upload artifact
+ uses: ./.github/actions/upload
+ with:
+ if-no-files-found: error
+ retention-days: 2
+ name: artifacts-${{ matrix.platform.ARTIFACT }}-${{ matrix.branch }}
+ path: |
+ ./_build/dist/*.tar.gz
+
+ build-arm:
+ name: Build ARM binary
+ needs: ["tool-output"]
+ runs-on: ubuntu-22.04-arm
+ strategy:
+ fail-fast: false
+ matrix:
+ branch: ${{ fromJSON(inputs.branches) }}
+ platform: [ { ARTIFACT: "aarch64-linux-deb11"
+ },
+ { ARTIFACT: "aarch64-linux-unknown"
+ }
+ ]
+ steps:
+ - uses: actions/checkout@v4
+ with:
+ ref: ${{ matrix.branch }}
+ submodules: recursive
+
+ - name: Cache stage0 cabal binary
+ uses: actions/cache@v5
+ with:
+ path: ${{ env.CABAL_CACHE_PATH }}
+ key: cabal-${{ vars.CACHE_VERSION || 'v1' }}-${{ matrix.platform.ARTIFACT }}-${{ hashFiles('cabal.project.stage0') }}
+
+ # debian 11 ships with make 4.3, but we need 4.4
+ - if: matrix.platform.ARTIFACT == 'aarch64-linux-deb11'
+ uses: docker://arm64v8/debian:11
+ name: Run build (aarch64 linux)
+ with:
+ args: |
+ sh -c "
+ apt-get update &&
+ apt-get install -y curl bash git ${{ needs.tool-output.outputs.apt_tools_build }} &&
+ curl -O -L https://ftp.gnu.org/gnu/make/make-${{ env.MAKE_VERSION }}.tar.gz &&
+ tar xf make-${{ env.MAKE_VERSION }}.tar.gz &&
+ cd make-${{ env.MAKE_VERSION }} &&
+ ./configure &&
+ make install &&
+ cd .. &&
+ ln -s make /usr/local/bin/gmake &&
+ export PATH=$HOME/.ghcup/bin:/usr/local/bin:$PATH &&
+ curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh &&
+ ghcup --no-verbose install ghc --set --install-targets '${{ env.GHC_TARGETS }}' ${{ env.GHC_VERSION }} &&
+ ghcup --no-verbose install cabal --set ${{ env.CABAL_VERSION }} &&
+ cabal update &&
+ if [ -x ${{ env.CABAL_CACHE_PATH }}/cabal ]; then export USE_SYSTEM_CABAL=1; fi &&
+ make _build/dist/ghc.tar.gz _build/dist/cabal.tar.gz _build/dist/tests.tar.gz &&
+ cd _build/dist &&
+ mv ghc.tar.gz ghc-$(bin/ghc --numeric-version)-${{ matrix.platform.ARTIFACT }}.tar.gz &&
+ mv cabal.tar.gz cabal-$(bin/cabal --numeric-version)-${{ matrix.platform.ARTIFACT }}.tar.gz &&
+ mv tests.tar.gz tests-${{ matrix.platform.ARTIFACT }}.tar.gz
+ "
+
+ - if: matrix.platform.ARTIFACT == 'aarch64-linux-unknown'
+ uses: docker://arm64v8/alpine:3.20
+ name: Run build (aarch64 linux alpine)
+ with:
+ args: |
+ sh -c "
+ apk update &&
+ apk add curl bash git ${{ needs.tool-output.outputs.apk_tools_build }} &&
+ export PATH=$HOME/.ghcup/bin:$PATH &&
+ curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh &&
+ ghcup --no-verbose install ghc --set --install-targets '${{ env.GHC_TARGETS }}' ${{ env.GHC_VERSION }} &&
+ ghcup --no-verbose install cabal --set ${{ env.CABAL_VERSION }} &&
+ cabal update &&
+ if [ -x ${{ env.CABAL_CACHE_PATH }}/cabal ]; then export USE_SYSTEM_CABAL=1; fi &&
+ make _build/dist/ghc.tar.gz _build/dist/cabal.tar.gz _build/dist/tests.tar.gz &&
+ cd _build/dist &&
+ mv ghc.tar.gz ghc-$(bin/ghc --numeric-version)-${{ matrix.platform.ARTIFACT }}.tar.gz &&
+ mv cabal.tar.gz cabal-$(bin/cabal --numeric-version)-${{ matrix.platform.ARTIFACT }}.tar.gz &&
+ mv tests.tar.gz tests-${{ matrix.platform.ARTIFACT }}.tar.gz
+ "
+
+ - if: always()
+ name: Upload artifact
+ uses: ./.github/actions/upload
+ with:
+ if-no-files-found: error
+ retention-days: 2
+ name: artifacts-${{ matrix.platform.ARTIFACT }}-${{ matrix.branch }}
+ path: |
+ ./_build/dist/*.tar.gz
+
+ build-mac-x86_64:
+ name: Build binary (Mac x86_64)
+ runs-on: macOS-15-intel
+ env:
+ ARTIFACT: "x86_64-apple-darwin"
+ MACOSX_DEPLOYMENT_TARGET: 10.13
+ strategy:
+ fail-fast: false
+ matrix:
+ branch: ${{ fromJSON(inputs.branches) }}
+ steps:
+ - uses: actions/checkout@v4
+ with:
+ ref: ${{ matrix.branch }}
+ submodules: recursive
+
+ - id: ghcup
+ name: Install GHCup
+ uses: haskell/ghcup-setup@v1
+ with:
+ cabal: ${{ env.CABAL_VERSION }}
+
+ - name: Install GHC
+ run: ghcup --no-verbose install ghc --set --install-targets "${{ env.GHC_TARGETS }}" "${{ env.GHC_VERSION }}"
+
+ - name: Install dependencies
+ run : |
+ brew install pkg-config gnu-sed automake autoconf make libtool
+ echo "/usr/local/opt/gnu-sed/libexec/gnubin" >> $GITHUB_PATH
+ echo "/usr/local/opt/make/libexec/gnubin" >> $GITHUB_PATH
+ echo "/usr/local/opt/libtool/libexec/gnubin" >> $GITHUB_PATH
+
+ - name: Cache stage0 cabal binary
+ uses: actions/cache@v5
+ with:
+ path: ${{ env.CABAL_CACHE_PATH }}
+ key: cabal-${{ vars.CACHE_VERSION || 'v1' }}-${{ env.ARTIFACT }}-${{ hashFiles('cabal.project.stage0') }}
+
+ - name: Install emscripten
+ run : *emscripten
+
+ - name: Run build
+ run: *build
+
+ - if: always()
+ name: Upload artifact
+ uses: ./.github/actions/upload
+ with:
+ if-no-files-found: error
+ retention-days: 2
+ name: artifacts-${{ env.ARTIFACT }}-${{ matrix.branch }}
+ path: |
+ ./_build/dist/*.tar.gz
+
+ build-mac-aarch64:
+ name: Build binary (Mac aarch64)
+ runs-on: macos-latest
+ env:
+ ARTIFACT: "aarch64-apple-darwin"
+ HOMEBREW_CHANGE_ARCH_TO_ARM: 1
+ GHCUP_INSTALL_BASE_PREFIX: ${{ github.workspace }}
+ strategy:
+ fail-fast: false
+ matrix:
+ branch: ${{ fromJSON(inputs.branches) }}
+ steps:
+ - uses: actions/checkout@v4
+ with:
+ ref: ${{ matrix.branch }}
+ submodules: recursive
+
+ - id: ghcup
+ name: Install GHCup
+ uses: haskell/ghcup-setup@v1
+ with:
+ cabal: ${{ env.CABAL_VERSION }}
+
+ - name: Install GHC
+ run: ghcup --no-verbose install ghc --set --install-targets "${{ env.GHC_TARGETS }}" "${{ env.GHC_VERSION }}"
+
+ - name: Install dependencies
+ run : |
+ brew install pkg-config gnu-sed automake autoconf make libtool
+ echo "/opt/homebrew/opt/gnu-sed/libexec/gnubin" >> $GITHUB_PATH
+ echo "/opt/homebrew/opt/make/libexec/gnubin" >> $GITHUB_PATH
+ echo "/opt/homebrew/opt/libtool/libexec/gnubin" >> $GITHUB_PATH
+
+ - name: Cache stage0 cabal binary
+ uses: actions/cache@v5
+ with:
+ path: ${{ env.CABAL_CACHE_PATH }}
+ key: cabal-${{ vars.CACHE_VERSION || 'v1' }}-${{ env.ARTIFACT }}-${{ hashFiles('cabal.project.stage0') }}
+
+ - name: Run build
+ run: *build
+
+ - if: always()
+ name: Upload artifact
+ uses: ./.github/actions/upload
+ with:
+ if-no-files-found: error
+ retention-days: 2
+ name: artifacts-${{ env.ARTIFACT }}-${{ matrix.branch }}
+ path: |
+ ./_build/dist/*.tar.gz
+
+ build-windows:
+ name: Build binary (Windows)
+ runs-on: windows-latest
+ env:
+ ARTIFACT: "x86_64-mingw64"
+ CABAL_DIR: "C:\\Users\\runneradmin\\AppData\\Roaming\\cabal"
+ GHCUP_INSTALL_BASE_PREFIX: "C:\\"
+ GHCUP_MSYS2: 'C:/msys64'
+ strategy:
+ fail-fast: false
+ matrix:
+ branch: ${{ fromJSON(inputs.branches) }}
+ defaults:
+ run:
+ shell: 'C:/msys64/usr/bin/bash.exe --login -e {0}'
+ steps:
+ - uses: actions/checkout@v4
+ with:
+ ref: ${{ matrix.branch }}
+ submodules: recursive
+
+ - name: Install msys2 dependencies
+ run: &msys2-install |
+ pacman --noconfirm -S --needed --overwrite '*' git vim winpty git tar bsdtar unzip binutils autoconf make xz curl libtool automake p7zip patch ca-certificates python3 zip mingw-w64-clang-x86_64-toolchain mingw-w64-clang-x86_64-python-sphinx mingw-w64-clang-x86_64-python-requests mingw-w64-clang-x86_64-tools-git mingw-w64-clang-x86_64-ghostscript tar gzip
+
+ - id: ghcup
+ name: Install GHCup
+ uses: haskell/ghcup-setup@v1
+ with:
+ cabal: ${{ env.CABAL_VERSION }}
+
+ - name: Install GHC
+ run: ghcup --no-verbose install ghc --set --install-targets "${{ env.GHC_TARGETS }}" "${{ env.GHC_VERSION }}"
+ shell: pwsh
+
+ - name: Cache stage0 cabal binary
+ uses: actions/cache@v5
+ with:
+ path: ${{ env.CABAL_CACHE_PATH }}
+ key: cabal-${{ vars.CACHE_VERSION || 'v1' }}-${{ env.ARTIFACT }}-${{ hashFiles('cabal.project.stage0') }}
+
+ - name: Run build
+ run: *build
+ env:
+ MAKE: make
+ DYNAMIC: 0
+
+ - if: always()
+ name: Upload artifact
+ uses: ./.github/actions/upload
+ with:
+ if-no-files-found: error
+ retention-days: 2
+ name: artifacts-${{ env.ARTIFACT }}-${{ matrix.branch }}
+ path: |
+ ./_build/dist/*.tar.gz
+
+ build-freebsd-x86_64:
+ name: Build FreeBSD x86_64
+ runs-on: [self-hosted, FreeBSD, X64]
+ env:
+ ARTIFACT: "x86_64-portbld-freebsd"
+ RUNNER_OS: FreeBSD
+ CABAL_DIR: ${{ github.workspace }}/.cabal
+ GHCUP_INSTALL_BASE_PREFIX: ${{ github.workspace }}
+ strategy:
+ fail-fast: false
+ matrix:
+ branch: ${{ fromJSON(inputs.branches) }}
+ steps:
+ - uses: actions/checkout@v4
+ with:
+ ref: ${{ matrix.branch }}
+ submodules: recursive
+
+ - id: ghcup
+ name: Install GHCup
+ uses: haskell/ghcup-setup@v1
+ with:
+ cabal: ${{ env.CABAL_VERSION }}
+
+ - name: Install GHC
+ run: ghcup --no-verbose install ghc --set --install-targets "${{ env.GHC_TARGETS }}" "${{ env.GHC_VERSION }}"
+ env:
+ LD: ld.lld
+ CC: cc
+ CXX: c++
+
+ - name: Install dependencies
+ run: |
+ sudo sed -i.bak -e 's/quarterly/latest/' /etc/pkg/FreeBSD.conf
+ sudo pkg install -y textproc/gsed gcc gmp ncurses perl5 pkgconf libiconv bash misc/compat10x misc/compat11x misc/compat12x \
+ terminfo-db \
+ devel/autoconf \
+ devel/automake \
+ devel/git \
+ devel/gmake \
+ gtar \
+ ftp/curl \
+ lang/python3 \
+ py311-sphinx \
+ math/gmp \
+ lang/ghc \
+ devel/hs-alex \
+ devel/hs-happy \
+ devel/hs-cabal-install
+ sudo tzsetup Etc/GMT
+ sudo adjkerntz -a
+
+ - name: Install emscripten
+ run : |
+ sudo pkg install -y emscripten
+
+ - name: Cache stage0 cabal binary
+ uses: actions/cache@v5
+ with:
+ path: ${{ env.CABAL_CACHE_PATH }}
+ key: cabal-${{ vars.CACHE_VERSION || 'v1' }}-${{ env.ARTIFACT }}-${{ hashFiles('cabal.project.stage0') }}
+
+ - name: Run build
+ run: |
+ set -eux
+ if [ -x "${{ env.CABAL_CACHE_PATH }}/cabal" ]; then
+ export USE_SYSTEM_CABAL=1
+ fi
+ which ghc
+ ghc --info
+ cabal update
+ gmake clean clean-cabal distclean
+ gmake _build/dist/haskell-toolchain.tar.gz _build/dist/ghc.tar.gz _build/dist/cabal.tar.gz _build/dist/tests.tar.gz _build/dist/ghc-javascript-unknown-ghcjs.tar.gz
+ cd _build/dist
+ mv ghc.tar.gz ghc-$(bin/ghc --numeric-version)-${{ env.ARTIFACT }}.tar.gz
+ mv cabal.tar.gz cabal-$(bin/cabal --numeric-version)-${{ env.ARTIFACT }}.tar.gz
+ mv haskell-toolchain.tar.gz haskell-toolchain-${{ env.ARTIFACT }}.tar.gz
+ mv ghc-javascript-unknown-ghcjs.tar.gz ghc-javascript-unknown-ghcjs-$(bin/ghc --numeric-version)-${{ env.ARTIFACT }}.tar.gz
+ mv tests.tar.gz tests-${{ env.ARTIFACT }}.tar.gz
+ env:
+ EXTRA_LIB_DIRS: /usr/local/lib
+ EXTRA_INCLUDE_DIRS: /usr/local/include
+ SED: gsed
+
+ - if: always()
+ name: Upload artifact
+ uses: ./.github/actions/upload
+ with:
+ if-no-files-found: error
+ retention-days: 2
+ name: artifacts-${{ env.ARTIFACT }}-${{ matrix.branch }}
+ path: |
+ ./_build/dist/*.tar.gz
+
+ test-linux:
+ name: Test linux binaries
+ runs-on: ubuntu-latest
+ needs: ["tool-output", "build-linux"]
+ if: ${{ inputs.test }}
+ strategy:
+ fail-fast: false
+ matrix:
+ branch: ${{ fromJSON(inputs.branches) }}
+ platform: [ { image: "debian:11"
+ , installCmd: "apt-get update && apt-get install -y"
+ , toolRequirements: "${{ needs.tool-output.outputs.apt_tools_test }}"
+ , ARTIFACT: "x86_64-linux-glibc"
+ },
+ { image: "debian:12"
+ , installCmd: "apt-get update && apt-get install -y"
+ , toolRequirements: "${{ needs.tool-output.outputs.apt_tools_test }}"
+ , ARTIFACT: "x86_64-linux-glibc"
+ },
+ { image: "ubuntu:20.04"
+ , installCmd: "apt-get update && apt-get install -y"
+ , toolRequirements: "${{ needs.tool-output.outputs.apt_tools_test }}"
+ , ARTIFACT: "x86_64-linux-glibc"
+ },
+ { image: "ubuntu:22.04"
+ , installCmd: "apt-get update && apt-get install -y"
+ , toolRequirements: "${{ needs.tool-output.outputs.apt_tools_test }}"
+ , ARTIFACT: "x86_64-linux-glibc"
+ },
+ { image: "ubuntu:24.04"
+ , installCmd: "apt-get update && apt-get install -y"
+ , toolRequirements: "${{ needs.tool-output.outputs.apt_tools_test }}"
+ , ARTIFACT: "x86_64-linux-glibc"
+ },
+ { image: "linuxmintd/mint20.3-amd64"
+ , installCmd: "apt-get update && apt-get install -y"
+ , toolRequirements: "${{ needs.tool-output.outputs.apt_tools_test }}"
+ , ARTIFACT: "x86_64-linux-glibc"
+ },
+ { image: "linuxmintd/mint21.3-amd64"
+ , installCmd: "apt-get update && apt-get install -y"
+ , toolRequirements: "${{ needs.tool-output.outputs.apt_tools_test }}"
+ , ARTIFACT: "x86_64-linux-glibc"
+ },
+ { image: "fedora:33"
+ , installCmd: "dnf install -y"
+ , toolRequirements: "${{ needs.tool-output.outputs.rpm_tools_test }}"
+ , ARTIFACT: "x86_64-linux-glibc"
+ },
+ { image: "fedora:37"
+ , installCmd: "dnf install -y"
+ , toolRequirements: "${{ needs.tool-output.outputs.rpm_tools_test }}"
+ , ARTIFACT: "x86_64-linux-glibc"
+ },
+ { image: "fedora:42"
+ , installCmd: "dnf install -y"
+ , toolRequirements: "${{ needs.tool-output.outputs.rpm_tools_test }}"
+ , ARTIFACT: "x86_64-linux-glibc"
+ },
+ { image: "rockylinux:8"
+ , installCmd: "yum -y install epel-release && yum install -y --allowerasing"
+ , toolRequirements: "${{ needs.tool-output.outputs.rpm_tools_test }}"
+ , ARTIFACT: "x86_64-linux-glibc"
+ },
+ { image: "rockylinux:9"
+ , installCmd: "yum -y install epel-release && yum install -y --allowerasing"
+ , toolRequirements: "${{ needs.tool-output.outputs.rpm_tools_test }}"
+ , ARTIFACT: "x86_64-linux-glibc"
+ },
+ { image: "alpine:3.20"
+ , installCmd: "apk update && apk add"
+ , toolRequirements: "${{ needs.tool-output.outputs.apk_tools_test }}"
+ , ARTIFACT: "x86_64-linux-musl"
+ }
+ ]
+ container:
+ image: ${{ matrix.platform.image }}
+ steps:
+ - name: Install requirements
+ shell: sh
+ run: |
+ ${{ matrix.platform.installCmd }} curl bash git ${{ matrix.platform.toolRequirements }}
+
+ # T14999 is broken: https://gitlab.haskell.org/ghc/ghc/-/issues/23685
+ - if: startsWith(matrix.platform.image, 'linuxmintd')
+ name: "Uninstall gdb"
+ run: |
+ apt-get remove -y gdb
+
+ - if: matrix.platform.image == 'rockylinux:8'
+ name: "Install newer python"
+ run: |
+ yum install -y --allowerasing python3.11
+ alternatives --set python3 /usr/bin/python3.11
+
+ # Test suite uses 'git' to find the test files. That appears
+ # to cause problems in CI. A similar hack is employed in the validate
+ # pipeline.
+ - name: git clone fix
+ run: git config --system --add safe.directory $GITHUB_WORKSPACE
+
+ - uses: actions/checkout@v4
+ with:
+ ref: ${{ matrix.branch }}
+
+ - uses: ./.github/actions/download
+ with:
+ name: artifacts-${{ matrix.platform.ARTIFACT }}-${{ matrix.branch }}
+ path: ./_build/dist
+
+ - id: pwd_output
+ run: |
+ echo pwd="$(pwd)" >> "$GITHUB_OUTPUT"
+
+ - name: Run test
+ run: &test |
+ # On windows, we use msys2 shell, which does not by default inherit the windows PATHs.
+ # So although the ghcup action sets the PATH, it's not visible. We don't want to use
+ # 'pathtype: inherit', because it pollutes the msys2 paths, possibly leading to linking
+ # or other issues. So we just hardcode it here.
+ if [ ${{ runner.os }} = "Windows" ] ; then
+ export PATH="/c/ghcup/bin:$PATH"
+ fi
+
+ rm -rf .git
+ (
+ cd _build/dist
+ for file in *.tar.gz; do tar xzf "$file"; done
+ )
+ PATH=$(pwd)/_build/dist/bin:$PATH ${{ env.MAKE }} -C _build/dist/testsuite
+ env:
+ THREADS: 4
+ TEST_HC: ${{ steps.pwd_output.outputs.pwd }}/_build/dist/bin/ghc
+ GHC_PKG: ${{ steps.pwd_output.outputs.pwd }}/_build/dist/bin/ghc-pkg
+ HP2PS_ABS: ${{ steps.pwd_output.outputs.pwd }}/_build/dist/bin/hp2ps
+ HPC: ${{ steps.pwd_output.outputs.pwd }}/_build/dist/bin/hpc
+ RUNGHC: ${{ steps.pwd_output.outputs.pwd }}/_build/dist/bin/runghc
+
+ test-arm:
+ name: Test ARM binary
+ runs-on: ubuntu-22.04-arm
+ needs: ["tool-output", "build-arm"]
+ if: ${{ inputs.test }}
+ strategy:
+ fail-fast: false
+ matrix:
+ branch: ${{ fromJSON(inputs.branches) }}
+ platform: [ { ARTIFACT: "aarch64-linux-deb11"
+ },
+ { ARTIFACT: "aarch64-linux-unknown"
+ }
+ ]
+ steps:
+ - uses: actions/checkout@v4
+ with:
+ ref: ${{ matrix.branch }}
+
+ - uses: ./.github/actions/download
+ with:
+ name: artifacts-${{ matrix.platform.ARTIFACT }}-${{ matrix.branch }}
+ path: ./_build/dist
+
+ - if: matrix.platform.ARTIFACT == 'aarch64-linux-deb11'
+ uses: docker://arm64v8/debian:11
+ name: Run build (aarch64 linux)
+ with:
+ args: sh -c "apt-get update && apt-get install -y curl bash git ${{ needs.tool-output.outputs.apt_tools_test }} && git config --system --add safe.directory $GITHUB_WORKSPACE && rm -rf .git && cd _build/dist && for file in *.tar.gz; do tar xzf $file; done && cd testsuite && PATH=$GITHUB_WORKSPACE/_build/dist/bin:$PATH make"
+
+ - if: matrix.platform.ARTIFACT == 'aarch64-linux-unknown'
+ uses: docker://arm64v8/alpine:3.20
+ name: Run build (aarch64 linux alpine)
+ with:
+ args: sh -c "apk update && apk add curl bash git ${{ needs.tool-output.outputs.apk_tools_test }} && git config --system --add safe.directory $GITHUB_WORKSPACE && rm -rf .git && cd _build/dist && for file in *.tar.gz; do tar xzf $file; done && cd testsuite && PATH=$GITHUB_WORKSPACE/_build/dist/bin:$PATH make"
+
+ test-mac-x86_64:
+ name: Test binary (Mac x86_64)
+ runs-on: macOS-15-intel
+ needs: ["build-mac-x86_64"]
+ if: ${{ inputs.test }}
+ env:
+ ARTIFACT: "x86_64-apple-darwin"
+ strategy:
+ fail-fast: false
+ matrix:
+ branch: ${{ fromJSON(inputs.branches) }}
+ steps:
+ - uses: actions/checkout@v4
+ with:
+ ref: ${{ matrix.branch }}
+
+ - uses: ./.github/actions/download
+ with:
+ name: artifacts-${{ env.ARTIFACT }}-${{ matrix.branch }}
+ path: ./_build/dist
+
+ - name: Run test
+ run: *test
+ env:
+ THREADS: 4
+
+ test-mac-aarch64:
+ name: Test binary (Mac aarch64)
+ runs-on: macos-latest
+ needs: ["build-mac-aarch64"]
+ if: ${{ inputs.test }}
+ env:
+ ARTIFACT: "aarch64-apple-darwin"
+ HOMEBREW_CHANGE_ARCH_TO_ARM: 1
+ strategy:
+ fail-fast: false
+ matrix:
+ branch: ${{ fromJSON(inputs.branches) }}
+ steps:
+ - uses: actions/checkout@v4
+ with:
+ ref: ${{ matrix.branch }}
+ submodules: recursive
+
+ - uses: ./.github/actions/download
+ with:
+ name: artifacts-${{ env.ARTIFACT }}-${{ matrix.branch }}
+ path: ./_build/dist
+
+ - name: Run test
+ run: *test
+ env:
+ THREADS: 4
+
+ test-windows:
+ name: Test binary (Windows)
+ runs-on: windows-latest
+ needs: ["build-windows"]
+ if: ${{ inputs.test }}
+ env:
+ ARTIFACT: "x86_64-mingw64"
+ strategy:
+ fail-fast: false
+ matrix:
+ branch: ${{ fromJSON(inputs.branches) }}
+ defaults:
+ run:
+ shell: 'C:/msys64/usr/bin/bash.exe --login -e {0}'
+ steps:
+ - uses: actions/checkout@v4
+ with:
+ ref: ${{ matrix.branch }}
+ submodules: recursive
+
+ - name: Install msys2 dependencies
+ run: *msys2-install
+
+ - uses: ./.github/actions/download
+ with:
+ name: artifacts-${{ env.ARTIFACT }}-${{ matrix.branch }}
+ path: ./_build/dist
+
+ - name: Run test
+ run: *test
+ env:
+ THREADS: 4
+ MAKE: make
+
+ test-freebsd-x86_64:
+ name: Test FreeBSD x86_64
+ runs-on: [self-hosted, FreeBSD, X64]
+ needs: ["build-freebsd-x86_64"]
+ if: ${{ inputs.test }}
+ env:
+ ARTIFACT: "x86_64-portbld-freebsd"
+ RUNNER_OS: FreeBSD
+ strategy:
+ fail-fast: false
+ matrix:
+ branch: ${{ fromJSON(inputs.branches) }}
+ steps:
+ - uses: actions/checkout@v4
+ with:
+ ref: ${{ matrix.branch }}
+
+ - uses: ./.github/actions/download
+ with:
+ name: artifacts-${{ env.ARTIFACT }}-${{ matrix.branch }}
+ path: ./_build/dist
+
+ - name: Install dependencies
+ run: |
+ sudo sed -i.bak -e 's/quarterly/latest/' /etc/pkg/FreeBSD.conf
+ sudo pkg install -y textproc/gsed curl gcc gmp gmake ncurses perl5 pkgconf libiconv git bash misc/compat10x misc/compat11x misc/compat12x groff autoconf automake lang/python3
+ sudo tzsetup Etc/GMT
+ sudo adjkerntz -a
+
+ - name: Run test
+ run: |
+ rm -rf .git
+ cd _build/dist
+ for file in *.tar.gz; do tar xzf "$file"; done
+ cd testsuite
+ export LD_LIBRARY_PATH=/usr/local/lib:$LD_LIBRARY_PATH
+ PATH=$GITHUB_WORKSPACE/_build/dist/bin:$PATH gmake
+ env:
+ MAKE: gmake
+ THREADS: 8
+
diff --git a/.gitignore b/.gitignore
index a96f6c05bb1b..752b78be40f1 100644
--- a/.gitignore
+++ b/.gitignore
@@ -95,7 +95,6 @@ _darcs/
/ghc/stage1/
/ghc/stage2/
/ghc/stage3/
-/utils/iserv/stage2*/
# -----------------------------------------------------------------------------
# specific generated files
@@ -202,7 +201,7 @@ _darcs/
/testsuite_summary*.txt
/testsuite*.xml
/testlog*
-/utils/iserv/iserv.cabal
+/utils/ghc-iserv/ghc-iserv.cabal
/utils/iserv-proxy/iserv-proxy.cabal
/utils/remote-iserv/remote-iserv.cabal
/utils/mkUserGuidePart/mkUserGuidePart.cabal
@@ -213,6 +212,7 @@ utils/unlit/fs.*
libraries/ghc-internal/include/fs.h
libraries/ghc-internal/cbits/fs.c
missing-win32-tarballs
+cabal.project.stage2.settings
/extra-gcc-opts
/sdistprep
@@ -221,6 +221,8 @@ missing-win32-tarballs
VERSION
GIT_COMMIT_ID
+/libraries/ghc-boot-th-next/*
+
# -------------------------------------------------------------------------------------
# when using a docker image, one can mount the source code directory as the home folder
# -------------------------------------------------------------------------------------
@@ -229,9 +231,6 @@ GIT_COMMIT_ID
.bash_history
.gitconfig
-# Should be equal to testdir_suffix from testsuite/driver/testlib.py.
-*.run
-
# -----------------------------------------------------------------------------
# ghc.nix
ghc.nix/
@@ -256,3 +255,39 @@ ghc.nix/
# clangd
.clangd
dist-newstyle/
+
+# -----------------------------------------------------------------------------
+# Local WASM toolchain symlinks (generated by flake.nix)
+.nix-wasm-bin/
+
+# Local remote build configuration
+.nixos-remote-build.conf
+
+# -----------------------------------------------------------------------------
+# AI Coding Assistants
+# See: https://agents.md/ for the AGENTS.md standard
+
+# Claude Code
+CLAUDE.md
+.claude
+
+# GitHub Copilot
+AGENTS.md
+AGENT.md
+.github/copilot-instructions.md
+.github/instructions/
+
+# Cursor
+.cursorrules
+.cursor/
+
+# Gemini CLI / Google Jules
+GEMINI.md
+JULES.md
+
+# OpenAI Codex
+CODEX.md
+
+# JetBrains Junie
+.aiignore
+testsuite/ghc-config/ghc-config
diff --git a/.gitmodules b/.gitmodules
index d3ea0f411de0..e69de29bb2d1 100644
--- a/.gitmodules
+++ b/.gitmodules
@@ -1,126 +0,0 @@
-[submodule "libraries/binary"]
- path = libraries/binary
- url = https://gitlab.haskell.org/ghc/packages/binary.git
- ignore = untracked
-[submodule "libraries/bytestring"]
- path = libraries/bytestring
- url = https://gitlab.haskell.org/ghc/packages/bytestring.git
- ignore = untracked
-[submodule "libraries/Cabal"]
- path = libraries/Cabal
- url = https://gitlab.haskell.org/ghc/packages/Cabal.git
- ignore = untracked
-[submodule "libraries/containers"]
- path = libraries/containers
- url = https://gitlab.haskell.org/ghc/packages/containers.git
- ignore = untracked
-[submodule "libraries/haskeline"]
- path = libraries/haskeline
- url = https://gitlab.haskell.org/ghc/packages/haskeline.git
- ignore = untracked
-[submodule "libraries/pretty"]
- path = libraries/pretty
- url = https://gitlab.haskell.org/ghc/packages/pretty.git
- ignore = untracked
-[submodule "libraries/terminfo"]
- path = libraries/terminfo
- url = https://gitlab.haskell.org/ghc/packages/terminfo.git
- ignore = untracked
-[submodule "libraries/transformers"]
- path = libraries/transformers
- url = https://gitlab.haskell.org/ghc/packages/transformers.git
- ignore = untracked
-[submodule "libraries/xhtml"]
- path = libraries/xhtml
- url = https://gitlab.haskell.org/ghc/packages/xhtml.git
- ignore = untracked
-[submodule "libraries/Win32"]
- path = libraries/Win32
- url = https://gitlab.haskell.org/ghc/packages/Win32.git
- ignore = untracked
-[submodule "libraries/time"]
- path = libraries/time
- url = https://gitlab.haskell.org/ghc/packages/time.git
- ignore = untracked
-[submodule "libraries/array"]
- path = libraries/array
- url = https://gitlab.haskell.org/ghc/packages/array.git
- ignore = untracked
-[submodule "libraries/deepseq"]
- path = libraries/deepseq
- url = https://gitlab.haskell.org/ghc/packages/deepseq.git
- ignore = untracked
-[submodule "libraries/directory"]
- path = libraries/directory
- url = https://gitlab.haskell.org/ghc/packages/directory.git
- ignore = untracked
-[submodule "libraries/filepath"]
- path = libraries/filepath
- url = https://gitlab.haskell.org/ghc/packages/filepath.git
- ignore = untracked
-[submodule "libraries/hpc"]
- path = libraries/hpc
- url = https://gitlab.haskell.org/ghc/packages/hpc.git
- ignore = untracked
-[submodule "libraries/parsec"]
- path = libraries/parsec
- url = https://gitlab.haskell.org/ghc/packages/parsec.git
- ignore = untracked
-[submodule "libraries/text"]
- path = libraries/text
- url = https://gitlab.haskell.org/ghc/packages/text.git
- ignore = untracked
-[submodule "libraries/mtl"]
- path = libraries/mtl
- url = https://gitlab.haskell.org/ghc/packages/mtl.git
- ignore = untracked
-[submodule "libraries/process"]
- path = libraries/process
- url = https://gitlab.haskell.org/ghc/packages/process.git
- ignore = untracked
-[submodule "libraries/unix"]
- path = libraries/unix
- url = https://gitlab.haskell.org/ghc/packages/unix.git
- ignore = untracked
- branch = 2.7
-[submodule "libraries/semaphore-compat"]
- path = libraries/semaphore-compat
- url = https://gitlab.haskell.org/ghc/semaphore-compat.git
- ignore = untracked
-[submodule "libraries/stm"]
- path = libraries/stm
- url = https://gitlab.haskell.org/ghc/packages/stm.git
- ignore = untracked
-[submodule "nofib"]
- path = nofib
- url = https://gitlab.haskell.org/ghc/nofib.git
- ignore = untracked
-[submodule "utils/hsc2hs"]
- path = utils/hsc2hs
- url = https://gitlab.haskell.org/ghc/hsc2hs.git
- ignore = untracked
-[submodule "libffi-tarballs"]
- path = libffi-tarballs
- url = https://gitlab.haskell.org/ghc/libffi-tarballs.git
- ignore = untracked
-[submodule "gmp-tarballs"]
- path = libraries/ghc-internal/gmp/gmp-tarballs
- url = https://gitlab.haskell.org/ghc/gmp-tarballs.git
-[submodule "libraries/exceptions"]
- path = libraries/exceptions
- url = https://gitlab.haskell.org/ghc/packages/exceptions.git
-[submodule "utils/hpc"]
- path = utils/hpc
- url = https://gitlab.haskell.org/hpc/hpc-bin.git
-[submodule "libraries/os-string"]
- path = libraries/os-string
- url = https://gitlab.haskell.org/ghc/packages/os-string
-[submodule "libraries/file-io"]
- path = libraries/file-io
- url = https://gitlab.haskell.org/ghc/packages/file-io.git
-[submodule "libraries/template-haskell-lift"]
- path = libraries/template-haskell-lift
- url = https://gitlab.haskell.org/ghc/template-haskell-lift.git
-[submodule "libraries/template-haskell-quasiquoter"]
- path = libraries/template-haskell-quasiquoter
- url = https://gitlab.haskell.org/ghc/template-haskell-quasiquoter.git
diff --git a/HACKING.md b/HACKING.md
deleted file mode 100644
index 1b47f75123a9..000000000000
--- a/HACKING.md
+++ /dev/null
@@ -1,111 +0,0 @@
-Contributing to the Glasgow Haskell Compiler
-============================================
-
-So you've decided to hack on GHC, congratulations! We hope you have a
-rewarding experience. This file will point you in the direction of
-information to help you get started right away.
-
-The GHC Developer's Wiki
-========================
-
-The home for GHC hackers is our GitLab instance, located here:
-
-
-
-From here, you can file bugs (or look them up), use the wiki, view the
-`git` history, among other things. Of particular note is the building
-page, which has the high level overview of the build process and how
-to get the source:
-
-
-
-Contributing patches to GHC in a hurry
-======================================
-
-Make sure your system has the necessary tools to compile GHC. You can
-find an overview of how to prepare your system for compiling GHC here:
-
-
-
-After you have prepared your system, you can build GHC following the instructions described here:
-
-
-
-Then start by making your commits however you want. When you're done, you can submit a merge request to [GitLab](https://gitlab.haskell.org/ghc/ghc/merge_requests) for code review.
-Changes to the `base` library require a proposal to the [core libraries committee](https://github.com/haskell/core-libraries-committee/issues).
-The GHC Wiki has a good summary for the [overall process](https://gitlab.haskell.org/ghc/ghc/wikis/working-conventions/fixing-bugs). One or several reviewers will review your PR, and when they are ok with your changes, they will assign the PR to [Marge Bot](https://gitlab.haskell.org/marge-bot) which will automatically rebase, batch and then merge your PR (assuming the build passes).
-
-
-Useful links:
-=============
-
-An overview of things like using Git, the release process, filing bugs
-and more can be located here:
-
-
-
-You can find our coding conventions for the compiler and RTS here:
-
-
-
-
-If you're going to contribute regularly, **learning how to use the
-build system is important** and will save you lots of time. You should
-read over this page carefully:
-
-
-
-A web based code explorer for the GHC source code with semantic analysis
-and type information of the GHC sources is available at:
-
-
-
-Look for `GHC` in `Package-name`. For example, here is the link to
-[GHC-8.6.5](https://haskell-code-explorer.mfix.io/package/ghc-8.6.5).
-
-If you want to watch issues and code review activities, the following page is a good start:
-
-
-
-
-How to communicate with us
-==========================
-
-GHC is a big project, so you'll surely need help. Luckily, we can
-provide plenty through a variety of means!
-
-## IRC
-
-If you're an IRC user, be sure to drop by the official `#ghc` channel
-on [Libera.Chat](https://libera.chat). Many (but not all) of the
-developers and committers are actively there during a variety of
-hours.
-
-## Mailing lists
-
-In the event IRC does not work or if you'd like a bigger audience, GHC
-has several mailing lists for this purpose. The most important one is
-[ghc-devs](http://www.haskell.org/pipermail/ghc-devs/), which is where
-the developers actively hang out and discuss incoming changes and
-problems.
-
-There is no strict standard about where you post patches - either in
-`ghc-devs` or in the bug tracker. Ideally, please put it in the bug
-tracker with test cases or relevant information in a ticket, and set
-the ticket status to `patch`. By doing this, we'll see the patch
-quickly and be able to review. This will also ensure it doesn't get
-lost. But if the change is small and self contained, feel free to
-attach it to your email, and send it to `ghc-devs`.
-
-Furthermore, if you're a developer (or want to become one!) you're
-undoubtedly also interested in the other mailing lists:
-
- * [glasgow-haskell-users](http://www.haskell.org/mailman/listinfo/glasgow-haskell-users)
- is where developers/users meet.
- * [ghc-commits](http://www.haskell.org/mailman/listinfo/ghc-commits)
- for commit messages when someone pushes to the repository.
-
-El fin
-======
-
-Happy Hacking! -- The GHC Team
diff --git a/INSTALL.md b/INSTALL.md
deleted file mode 100644
index 45fe5427b09e..000000000000
--- a/INSTALL.md
+++ /dev/null
@@ -1,47 +0,0 @@
-Building & Installing
-=====================
-
-For full information on building GHC, see the GHC Building Guide [1].
-Here follows a summary - if you get into trouble, the Building Guide
-has all the answers.
-
-Before building GHC you may need to install some other tools and
-libraries. See "Setting up your system for building GHC" [2].
-
-N.B. in particular you need GHC installed in order to build GHC,
-because the compiler is itself written in Haskell. For instructions
-on how to port GHC to a new platform, see the Building Guide [1].
-
-For building library documentation, you'll need Haddock [3]. To build
-the compiler documentation, you need [Sphinx](http://www.sphinx-doc.org/) and
-XeLaTex (only for PDF output).
-
-Quick start: the following gives you a default build:
-
- $ ./boot
- $ ./configure
- $ ./hadrian/build
-
- On Windows, you need an extra repository containing some build tools.
- These can be downloaded for you by configure. This only needs to be done once by running:
-
- $ ./configure --enable-tarballs-autodownload
-
-You can use `-jN` option to parallelize the build. It's generally best
-to set `N` somewhere around the core count of the build machine.
-
-The `./boot` step is only necessary if this is a tree checked out from
-git. For source distributions downloaded from GHC's web site, this step has
-already been performed.
-
-These steps give you the default build, which includes everything
-optimised and built in various ways (eg. profiling libs are built).
-It can take a long time. To customise the build, see the file
-`HACKING.md`.
-
-References
-==========
-
- - [1] http://www.haskell.org/ghc/
- - [2] https://gitlab.haskell.org/ghc/ghc/wikis/building/preparation
- - [3] http://www.haskell.org/haddock/
diff --git a/Makefile b/Makefile
new file mode 100644
index 000000000000..3c398ed9f539
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,1225 @@
+# Top-level Makefile
+#
+# This file is still _TOO_ large (should be < 100L). There are too many moving
+# _global_ parts, most of this should be relegated to the respective packages.
+# The whole version replacement therapy is utterly ridiculous. It should be done
+# in the respective packages.
+
+# ┌─────────────────────────────────────────────────────────────────────────┐
+# │ GHC Bootstrapping Stages │
+# ├─────────────────────────────────────────────────────────────────────────┤
+# │ │
+# │ Stage 0 (Bootstrap) │
+# │ ┌─────────┐ ┌─────────┐ │
+# │ │ ghc0 │ │ pkg0 │ (initial boot packages) │
+# │ │ (binary)│ │ │ │
+# │ └────┬────┘ └────┬────┘ │
+# │ │ │ │
+# │ └───────┬───────┘ │
+# │ ▼ │
+# │ ┌─────────┐ │
+# │ │ pkg0+ │ (augmented boot packages) │
+# │ └────┬────┘ │
+# │ │ │
+# │ ············│························································· │
+# │ ▼ │
+# │ Stage 1 │ │
+# │ ┌─────────┐ │ │
+# │ │ ghc1 │◄┘ (built with ghc0, linked with rts0) │
+# │ │ │ │
+# │ └────┬────┘ │
+# │ │ │
+# │ │ ┌─────────┐ │
+# │ └────►│ pkg1 │ (initially empty, then populated) │
+# │ ┌─────│ │ (built with ghc1) │
+# │ │ └─────────┘ │
+# │ │ ▲ │
+# │ │ │ (mutual dependency; ghc1 needs to sees pkg1) │
+# │ ▼ │ │
+# │ ┌─────────┐ │ │
+# │ │ ghc1 │──────┘ │
+# │ │ (uses) │ │
+# │ └────┬────┘ │
+# │ │ │
+# │ ·····│································································ │
+# │ ▼ │
+# │ Stage 2 │
+# │ ┌─────────┐ ┌──────────┐ ┌─────────┐ │
+# │ │ ghc2 │ │ ghc-pkg2 │ │ ... │ │
+# │ │ │ │ │ │ │ │
+# │ └─────────┘ └──────────┘ └─────────┘ │
+# │ (built with ghc1, linked with rts1) │
+# │ │
+# │ ┌─────────────────────────────────┐ │
+# │ │ SHIPPED RESULT │ │
+# │ │ ┌─────────┐ ┌─────────┐ │ │
+# │ │ │ pkg1 │ + │ ghc2 │ │ │
+# │ │ └─────────┘ └─────────┘ │ │
+# │ └─────────────────────────────────┘ │
+# │ │
+# │ Notes: │
+# │ • Binaries: one stage ahead (ghc1 builds pkg1, ghc2 ships with pkg1) │
+# │ • Libraries: one stage below (pkg1 ships with ghc2) │
+# │ • ghc1 and ghc2 are ABI compatible |
+# | • ghc0 and ghc1 are not guaranteed to be ABI compatible |
+# │ • ghc1 is linked against rts0, ghc2 against rts1 │
+# | • augmented packages are needed because ghc1 may require newer |
+# | versions or even new packages, not shipped with the boot compiler |
+# │ │
+# └─────────────────────────────────────────────────────────────────────────┘
+
+
+# ISSUES:
+# - [ ] Where do we get the version number from? The configure script _does_ contain
+# one and sets it, but should it come from the last release tag this branch is
+# contains?
+# - [ ] The hadrian folder needs to be removed.
+# - [ ] All sublibs should be SRPs in the relevant cabal.project files. No more
+# submodules.
+
+SHELL := bash
+.SHELLFLAGS := -eu -o pipefail -c
+.DEFAULT_GOAL := all
+
+VERBOSE ?= 0
+
+UNAME := $(shell uname)
+
+# Enable dynamic runtime/linking support when DYNAMIC=1 is passed on the make
+# command line. This selects the cabal.project.stage2.dynamic project file
+# (shared libraries, dynamic executables, dynamic RTS) instead of
+# cabal.project.stage2.static, and enables the dynamic-only dist steps below.
+# The default remains static to keep rebuild cost low.
+DYNAMIC ?= 0
+
+# Suffix selecting the static/dynamic stage2 project file (see CABAL_PROJECT_FILE).
+DYNAMIC_SUFFIX := $(if $(filter 1,$(DYNAMIC)),dynamic,static)
+
+# Quiet mode: suppress output unless error (QUIET=1)
+QUIET ?= 0
+
+# Metrics collection: start background CPU/memory sampling (METRICS=1)
+METRICS ?= 0
+METRICS_INTERVAL ?= 0.5
+
+#
+# System tools
+#
+# Note: ?= uses the environment variable if set
+#
+
+CABAL0 ?= cabal
+GHC0 ?= ghc-9.8.4
+
+AR ?= ar
+CC ?= cc
+LD ?= ld
+PYTHON ?= python3
+SED ?= sed
+LN ?= ln
+LN_S ?= $(LN) -s
+LN_SF ?= $(LN) -sf
+ifeq ($(UNAME), FreeBSD)
+TAR ?= gtar
+else
+TAR ?= tar
+endif
+
+ifeq ($(UNAME), Darwin)
+DLL := *.dylib
+else
+DLL := *.so
+endif
+
+# Notes
+#
+# - rts configure script is a bit evil.
+# λ rg AC_PATH rts/configure.ac
+# 489:AC_PATH_PROG([NM], nm)
+# 495:AC_PATH_PROG([OBJDUMP], objdump)
+# 501:AC_PATH_PROG([DERIVE_CONSTANTS], deriveConstants)
+# 505:AC_PATH_PROG([GENAPPLY], genapply)
+#
+
+#
+# Some compiler toolchain settings
+#
+
+CABAL_ARGS ?=
+CC_LINK_OPT =
+GHC_CONFIGURE_ARGS =
+
+GHC_TOOLCHAIN_ARGS = --disable-ld-override
+
+#
+# Build directories and paths
+#
+
+# NOTE: it's tricky to know when and where we need an absolute path or we can
+# get away with a relative path. We make BUILD_DIR absolute and all derived
+# paths will be absolute too.
+BUILD_DIR := _build
+STAGE_DIR = $(BUILD_DIR)/$(STAGE)
+STORE_DIR = $(STAGE_DIR)/store
+LOGS_DIR = $(STAGE_DIR)/logs
+
+DIST_DIR := $(BUILD_DIR)/dist
+
+# Timing directory for phase start/end timestamps
+TIMING_DIR := $(BUILD_DIR)/timing
+
+# Metrics directory for CPU/memory CSV data
+METRICS_DIR := $(BUILD_DIR)/metrics
+
+# Stamp files — Make uses these to know a stage is complete.
+# Phony targets like `stage2` always re-run their recipe, which causes `test`
+# (which depends on `stage2`) to re-execute the entire build even when nothing
+# changed. File-based stamps let Make skip already-completed stages.
+STAGE0_STAMP := $(BUILD_DIR)/.stamp-stage0
+STAGE1_STAMP := $(BUILD_DIR)/.stamp-stage1
+STAGE2_STAMP := $(BUILD_DIR)/.stamp-stage2
+
+# Stamp fallback rules: if a stamp doesn't exist, invoke the corresponding
+# stage via recursive make. The stage recipe touches the stamp on success.
+# Because there are no prerequisites, Make won't re-run these when the stamp
+# file already exists — which is the whole point: `test: $(STAGE2_STAMP)` will
+# skip the build if stage2 already completed.
+$(STAGE0_STAMP): ; @$(MAKE) stable-cabal
+$(STAGE1_STAMP): ; @$(MAKE) stage1
+$(STAGE2_STAMP): ; @$(MAKE) stage2
+
+# HOST_PLATFROM is always from the bootstrap compiler
+HOST_PLATFORM := $(shell $(GHC0) --print-host-platform)
+
+CABAL ?= $(BUILD_DIR)/cabal/bin/cabal$(EXE_EXT)
+
+STAGE1_PATH := $(let STAGE,stage1,$(STORE_DIR)/host/$(HOST_PLATFORM))
+STAGE2_PATH := $(let STAGE,stage2,$(STORE_DIR)/host/$(HOST_PLATFORM))
+
+GHC1 := $(STAGE1_PATH)/bin/ghc$(EXE_EXT)
+GHC2 := $(STAGE2_PATH)/bin/ghc$(EXE_EXT)
+
+#
+# Misc settings
+#
+
+# Handle CPUS and THREADS
+CPUS_DETECT_SCRIPT := ./mk/detect-cpu-count.sh
+CPUS := $(shell if [ -x $(CPUS_DETECT_SCRIPT) ]; then $(CPUS_DETECT_SCRIPT); else echo 2; fi)
+THREADS ?= $(shell echo $$(( $(CPUS) + 1 )))
+
+#
+# Build macros
+#
+
+ifeq ($(MAKE_HOST),x86_64-pc-msys)
+# Windows executables require .exe extension for native programs to find them
+EXE_EXT := .exe
+
+# FIXME Are we sure about this? Do we need to check if it exists?
+CC = x86_64-w64-mingw32-clang.exe
+CXX = x86_64-w64-mingw32-clang++.exe
+LD = ld.lld.exe
+
+# https://gitlab.haskell.org/ghc/ghc/-/issues/7289#note_646155
+CC_LINK_OPT = -Wl,CRT_fp8.o
+CYGPATH = cygpath --windows -f -
+CYGPATH_MIXED = cygpath --mixed -f -
+
+PATCHELF ?= echo
+else
+EXE_EXT :=
+CYGPATH = cat
+CYGPATH_MIXED = cat
+
+PATCHELF ?= patchelf
+INSTALL_NAME_TOOL ?= install_name_tool
+endif
+
+
+#
+# Logging utilities
+#
+
+# LOG_GROUP_START = @echo "::group::$1"
+# LOG_GROUP_END = @echo "::endgroup::"
+
+BOLD = $(shell tput bold)
+NORMAL = $(shell tput sgr0)
+
+LOG_GROUP_START = @echo "$(BOLD)>>>>> $1$(NORMAL)"
+LOG_GROUP_END = @echo ""
+
+LOG = @echo "$(BOLD)[$(STAGE)]$(NORMAL): $(1)"
+
+ifeq ($(QUIET),1)
+LOG = @:
+LOG_GROUP_START = @:
+LOG_GROUP_END = @:
+endif
+
+# Phase timing: records start/end timestamps and status.
+#
+# Guards prevent overwrites when PHONY targets re-run without doing real work.
+# For example, `test: stage2` triggers the PHONY stage2 recipe again; without
+# guards, the no-op re-check would overwrite the real stage2 build timings with
+# near-zero durations.
+#
+# Policy:
+# - If a phase already completed successfully (status=0), skip re-timing.
+# - If a phase failed (status=1) or never ran, (re)start timing.
+define PHASE_START
+ @mkdir -p $(TIMING_DIR)
+ @if [ ! -f $(TIMING_DIR)/$(1).end ] || [ "$$(cat $(TIMING_DIR)/$(1).status 2>/dev/null)" != "0" ]; then \
+ date +%s > $(TIMING_DIR)/$(1).start; \
+ rm -f $(TIMING_DIR)/$(1).end $(TIMING_DIR)/$(1).status; \
+ fi
+endef
+
+define PHASE_END_OK
+ @if [ ! -f $(TIMING_DIR)/$(1).end ]; then \
+ date +%s > $(TIMING_DIR)/$(1).end; \
+ echo "0" > $(TIMING_DIR)/$(1).status; \
+ fi
+endef
+
+define PHASE_END_FAIL
+ @if [ ! -f $(TIMING_DIR)/$(1).end ]; then \
+ date +%s > $(TIMING_DIR)/$(1).end; \
+ echo "1" > $(TIMING_DIR)/$(1).status; \
+ fi
+endef
+
+define NORMALIZE_FP
+$(shell echo $(1) | $(CYGPATH_MIXED))
+endef
+
+# CABAL_BUILD
+#
+# Generic "cabal build"
+#
+# $(1): the cabal binary to use
+#
+# NOTE: Do not pass --with-ar or --with-ld to cabal! it will screw up things
+#
+# Cabal project file for the current stage. stage2 has separate static/dynamic
+# variants selected by DYNAMIC (see DYNAMIC_SUFFIX); all other stages use a
+# single project file.
+CABAL_PROJECT_FILE = cabal.project.$(STAGE)$(if $(filter stage2,$(STAGE)),.$(DYNAMIC_SUFFIX))
+
+define CABAL_BUILD_WITH
+ $(1) \
+ --remote-repo-cache $(call NORMALIZE_FP,$(CURDIR)/$(BUILD_DIR)/packages) \
+ --store-dir $(call NORMALIZE_FP,$(CURDIR)/$(STORE_DIR)) \
+ --logs-dir $(call NORMALIZE_FP,$(CURDIR)/$(LOGS_DIR)) \
+ build \
+ --project-file $(CABAL_PROJECT_FILE) \
+ --builddir $(call NORMALIZE_FP,$(CURDIR)/$(STAGE_DIR)) \
+ $(CABAL_ARGS)
+endef
+
+define CABAL_BUILD
+ $(call CABAL_BUILD_WITH,$(CABAL))
+endef
+
+define CABAL_INSTALL_STAGE0
+ $(CABAL0) \
+ --store-dir $(call NORMALIZE_FP,$(CURDIR)/$(STORE_DIR)) \
+ --logs-dir $(call NORMALIZE_FP,$(CURDIR)/$(LOGS_DIR)) \
+ install \
+ --installdir $(dir $(CABAL)) \
+ --builddir $(call NORMALIZE_FP,$(CURDIR)/$(STAGE_DIR)) \
+ --project-file $(CABAL_PROJECT_FILE) \
+ --overwrite-policy=always --install-method=copy \
+ $(CABAL_ARGS)
+endef
+
+# LIB_NAME_GLOB
+#
+# $(1): library target, possibly with sublibrary after colon
+#
+# pkg -> pkg-*
+# pkg:lib -> pkg-*-lib
+LIB_NAME_GLOB = $(let pkg lib,$(subst :, ,$(1)),$(pkg)-*$(if $(lib),-$(lib)))
+
+# DIST_COPY_EXE
+#
+# Copies a executable named $(1) from the local store into the distribution
+# directory.
+#
+# $(1) name of the executable to copy
+#
+# NOTE: the ending empty line is important
+define DIST_COPY_EXE
+ $(call LOG,Copying executable $(1) into $(DIST_DIR)/bin)
+ @cp -a \
+ $(CURDIR)/$(STORE_DIR)/host/$(HOST_PLATFORM)/bin/$(1)$(EXE_EXT) \
+ $(CURDIR)/$(DIST_DIR)/bin/$(1)$(EXE_EXT)
+
+endef
+
+# $(1) name of the executable to link
+# $(2) platform
+define DIST_TARGET_EXE_LINK
+ @$(LN_S) \
+ $(1)$(EXE_EXT) \
+ $(CURDIR)/$(DIST_DIR)/bin/$(2)-$(1)$(EXE_EXT)
+
+endef
+
+# DIST_COPY_LIB
+#
+# Copies a library from the local store into the distribution directory.
+#
+# $(1) name of the library to copy
+#
+# NOTE: the ending empty line is important
+define DIST_COPY_LIB
+ $(call LOG,Copying library $(1) into $(DIST_DIR)/lib/$(TARGET_PLATFORM))
+ @cp -a \
+ $(CURDIR)/$(STORE_DIR)/host/$(TARGET_PLATFORM)/lib/$(call LIB_NAME_GLOB,$(1)) \
+ $(CURDIR)/$(DIST_DIR)/lib/$(TARGET_PLATFORM)
+
+endef
+
+# DIST_COPY_LIB_CROSS
+#
+# Copies a library from the local store into the distribution directory.
+#
+# $(1) name of the library to copy
+#
+# NOTE: the ending empty line is important
+define DIST_COPY_LIB_CROSS
+ $(call LOG,Copying library $(1) into $(DIST_DIR)/lib/targets/$(TARGET_PLATFORM)/lib/$(TARGET_PLATFORM))
+ @cp -a \
+ $(CURDIR)/$(STORE_DIR)/host/$(TARGET_PLATFORM)/lib/$(call LIB_NAME_GLOB,$(1)) \
+ $(CURDIR)/$(DIST_DIR)/lib/targets/$(TARGET_PLATFORM)/lib/$(TARGET_PLATFORM)
+
+endef
+
+# DIST_COPY_LIB_CONF
+#
+# Copies a library packagedb entry from the local store into the distribution
+# directory.
+#
+# $(1) library to copy
+#
+# NOTE: the ending empty line is important
+# NOTE: sed *has* to run in-place becase we do not know the exact filename of
+# the file. With -i we can get away with a glob.
+define DIST_COPY_LIB_CONF
+ $(call LOG,Copying $(1) packagedb entry into $(DIST_DIR)/lib/package.conf.d/)
+ @cp -a \
+ $(CURDIR)/$(STORE_DIR)/host/$(TARGET_PLATFORM)/package.conf.d/$(call LIB_NAME_GLOB,$(1)).conf \
+ $(CURDIR)/$(DIST_DIR)/lib/package.conf.d/
+ @$(SED) -i \
+ -e "s|$(call PATH_REGEX,$(CURDIR)/$(STORE_DIR)/host/$(TARGET_PLATFORM)/lib)|\$${pkgroot}/../lib/$(TARGET_PLATFORM)|g" \
+ $(CURDIR)/$(DIST_DIR)/lib/package.conf.d/$(call LIB_NAME_GLOB,$(1)).conf
+
+endef
+
+# PATH_REGEX
+#
+# Creates a path regex that, on windows, matches any path separator
+# and starts with a proper drive.
+#
+# On unix, this should do nothing.
+# $(1) path to create regex for
+define PATH_REGEX
+$(shell echo $(1) | $(CYGPATH_MIXED) | sed 's|/|[/\\]|g')
+endef
+
+# DIST_COPY_LIB_CONF_CROSS
+#
+# Copies a library packagedb entry from the local store into the distribution
+# directory.
+#
+# $(1) library to copy
+#
+# NOTE: the ending empty line is important
+# NOTE: sed *has* to run in-place becase we do not know the exact filename of
+# the file. With -i we can get away with a glob.
+define DIST_COPY_LIB_CONF_CROSS
+ $(call LOG,Copying $(1) packagedb entry into $(DIST_DIR)/lib/targets/$(TARGET_PLATFORM)/lib/package.conf.d/)
+ @cp -a \
+ $(CURDIR)/$(STORE_DIR)/host/$(TARGET_PLATFORM)/package.conf.d/$(call LIB_NAME_GLOB,$(1)).conf \
+ $(CURDIR)/$(DIST_DIR)/lib/targets/$(TARGET_PLATFORM)/lib/package.conf.d/
+ @$(SED) -i \
+ -e 's|$(CURDIR)/$(STORE_DIR)/host/$(TARGET_PLATFORM)/lib|\$${pkgroot}/../lib/$(TARGET_PLATFORM)|g' \
+ $(CURDIR)/$(DIST_DIR)/lib/targets/$(TARGET_PLATFORM)/lib/package.conf.d/$(call LIB_NAME_GLOB,$(1)).conf
+
+endef
+
+# SET_RPATH
+#
+# $(1) = rpath
+# $(2) = binary
+# set rpath relative to the current executable
+# TODO: on darwin, this doesn't overwrite rpath, but just adds to it,
+# so we'll have the old rpaths from the build host in there as well
+# set_rpath: Add rpath to binary. On Darwin, check if rpath already exists
+# before adding (install_name_tool fails if rpath is duplicate).
+define SET_RPATH
+ $(if $(filter Darwin,$(UNAME)), \
+ if ! otool -l "$(2)" 2>/dev/null | grep -A2 'LC_RPATH' | grep -q "@executable_path/$(1)"; then \
+ $(INSTALL_NAME_TOOL) -add_rpath "@executable_path/$(1)" "$(2)"; \
+ fi, \
+ $(PATCHELF) --force-rpath --set-rpath "\$$ORIGIN/$(1)" "$(2)")
+endef
+
+DIST_COPY_EXES = $(if $(1),$(foreach exe,$(1),$(call DIST_COPY_EXE,$(exe),$(2))))
+DIST_COPY_LIBS = $(if $(1),$(foreach lib,$(1),$(call DIST_COPY_LIB,$(lib))))
+DIST_COPY_LIBS_CROSS = $(if $(1),$(foreach lib,$(1),$(call DIST_COPY_LIB_CROSS,$(lib))))
+DIST_COPY_LIBS_CONF = $(if $(1),$(foreach lib,$(1),$(call DIST_COPY_LIB_CONF,$(lib))))
+DIST_COPY_LIBS_CONF_CROSS = $(if $(1),$(foreach lib,$(1),$(call DIST_COPY_LIB_CONF_CROSS,$(lib))))
+
+define DIST_COPY_LIBS_SO
+ @find $(CURDIR)/$(STORE_DIR)/host/$(TARGET_PLATFORM)/lib/ -mindepth 1 -type f -name "$(DLL)" -execdir cp '{}' $(CURDIR)/$(DIST_DIR)/lib/$(TARGET_PLATFORM)/'{}' \;
+endef
+
+define DIST_COPY_LIBS_SO_CROSS
+ @find $(CURDIR)/$(STORE_DIR)/host/$(TARGET_PLATFORM)/lib/ -mindepth 1 -type f -name "$(DLL)" -execdir cp '{}' $(CURDIR)/$(DIST_DIR)/lib/targets/$(TARGET_PLATFORM)/lib/$(TARGET_PLATFORM)/'{}' \;
+endef
+
+
+#
+# Files and targets
+#
+
+CONFIGURE_SCRIPTS = \
+ configure \
+ rts/configure \
+ libraries/ghc-internal/configure
+
+# Files that will be generated by config.status from their .in counterparts
+CONFIGURED_FILES := \
+ ghc/ghc-bin.cabal \
+ compiler/GHC/CmmToLlvm/Version/Bounds.hs \
+ compiler/ghc.cabal \
+ libraries/ghc-boot/ghc-boot.cabal \
+ libraries/ghc-boot-th/ghc-boot-th.cabal \
+ libraries/ghc-heap/ghc-heap.cabal \
+ libraries/template-haskell/template-haskell.cabal \
+ libraries/ghci/ghci.cabal \
+ utils/ghc-pkg/ghc-pkg.cabal \
+ utils/ghc-iserv/ghc-iserv.cabal \
+ utils/runghc/runghc.cabal \
+ libraries/ghc-internal/ghc-internal.cabal \
+ libraries/ghc-experimental/ghc-experimental.cabal \
+ libraries/base/base.cabal \
+ rts/include/ghcversion.h
+
+# __ __ _ _ _
+# | \/ | __ _(_)_ __ | |_ __ _ _ __ __ _ ___| |_
+# | |\/| |/ _` | | '_ \ | __/ _` | '__/ _` |/ _ \ __|
+# | | | | (_| | | | | | | || (_| | | | (_| | __/ |_
+# |_| |_|\__,_|_|_| |_| \__\__,_|_| \__, |\___|\__|
+# |___/
+
+.PHONY: timing-summary
+timing-summary:
+ @./mk/timing-summary.sh $(TIMING_DIR)
+
+.PHONY: metrics-start metrics-stop metrics-plot
+metrics-start:
+ @./mk/collect-metrics.sh start $(METRICS_DIR) $(METRICS_INTERVAL)
+
+metrics-stop:
+ @./mk/collect-metrics.sh stop $(METRICS_DIR)
+
+metrics-plot:
+ @if [ -f "$(METRICS_DIR)/metrics.csv" ]; then \
+ $(PYTHON) ./mk/plot-metrics.py $(METRICS_DIR) $(TIMING_DIR) $(METRICS_DIR)/metrics; \
+ else \
+ echo "No metrics data found. Run 'make METRICS=1 all' first."; \
+ fi
+
+.PHONY: all
+all: stage2
+
+# _ _ _ _ _ _
+# ___ __ _| |__ __ _| | (_)_ __ ___| |_ __ _| | |
+# / __/ _` | '_ \ / _` | |_____| | '_ \/ __| __/ _` | | |
+# | (_| (_| | |_) | (_| | |_____| | | | \__ \ || (_| | | |
+# \___\__,_|_.__/ \__,_|_| |_|_| |_|___/\__\__,_|_|_|
+
+# TODO: Building cabal-install from source as part of the Makefile is a
+# temporary workaround. We should eventually require cabal to be provided
+# externally (e.g. via ghcup) and drop this target entirely.
+.PHONY: stable-cabal
+stable-cabal: STAGE=stage0
+stable-cabal:
+ifeq (,$(USE_SYSTEM_CABAL))
+ $(call PHASE_START,cabal)
+ $(call LOG,Building $(CABAL))
+ $(CABAL_INSTALL_STAGE0) --with-compiler $(GHC0) cabal-install:exe:cabal
+ $(call PHASE_END_OK,cabal)
+ @touch $(STAGE0_STAMP)
+endif
+
+# ____ _ _
+# / ___|| |_ __ _ __ _ ___ / |
+# \___ \| __/ _` |/ _` |/ _ \ | |
+# ___) | || (_| | (_| | __/ | |
+# |____/ \__\__,_|\__, |\___| |_|
+# |___/
+
+# These are configuration variables for stage one
+
+# TODO we should not need genprimops code here, it is needed by compiler/Setup.hs
+# but it is also listed as a build-tool-depends in compiler/ghc.cabal so cabal-install
+# will build it automatically. The effect of listing genprimops here is that it
+# will be included as a host target rather as a build target. So we end up compiling it
+# twice for no reason.
+STAGE1_EXECUTABLES = \
+ deriveConstants \
+ genapply \
+ genprimopcode \
+ ghc \
+ ghc-pkg \
+ ghc-toolchain-bin \
+ hsc2hs \
+ unlit
+
+STAGE1_LIBRARIES =
+
+STAGE1_EXTRA_INCLUDE_DIRS ?=
+STAGE1_EXTRA_LIB_DIRS ?=
+
+STAGE1_CABAL_BUILD = \
+ $(CABAL_BUILD) \
+ --with-compiler=$(GHC0) \
+ --with-build-compiler=$(GHC0) \
+ --ghc-options "-ghcversion-file=$(call NORMALIZE_FP,$(CURDIR)/rts/include/ghcversion.h)"
+
+stage1: STAGE=stage1
+stage1: stable-cabal $(CONFIGURE_SCRIPTS) $(CONFIGURED_FILES) cabal.project.stage1 cabal.project.common libraries/ghc-boot-th-next | hackage
+ $(call PHASE_START,stage1)
+ $(call LOG,Starting build of $(STAGE))
+
+ $(call PHASE_START,stage1.executables)
+ $(call LOG,Building executables $(STAGE1_EXECUTABLES))
+ $(STAGE1_CABAL_BUILD) $(addprefix exe:,$(STAGE1_EXECUTABLES))
+ $(call PHASE_END_OK,stage1.executables)
+
+ $(call LOG,Creating $(STORE_DIR)/host/$(HOST_PLATFORM)/lib/settings)
+ @$(STORE_DIR)/host/$(HOST_PLATFORM)/bin/ghc-toolchain-bin $(GHC_TOOLCHAIN_ARGS) --triple $(HOST_PLATFORM) --cc $(CC) --cxx $(CXX) --cc-link-opt "$(CC_LINK_OPT)" --output-settings -o $(STORE_DIR)/host/$(HOST_PLATFORM)/lib/settings
+ifeq ($(DYNAMIC),1)
+ $(SED) -i -e 's/"RTS ways","/"RTS ways","dyn debug_dyn thr_dyn thr_debug_dyn /' $(STORE_DIR)/host/$(HOST_PLATFORM)/lib/settings
+endif
+
+ $(call LOG,Creating packagedb in $(STORE_DIR)/host/$(HOST_PLATFORM)/lib/package.conf.d)
+ @rm -rf $(STORE_DIR)/host/$(HOST_PLATFORM)/lib/package.conf.d
+ @$(STORE_DIR)/host/$(HOST_PLATFORM)/bin/ghc-pkg init $(STORE_DIR)/host/$(HOST_PLATFORM)/lib/package.conf.d
+
+ $(call LOG,Finished building $(STAGE))
+ $(call PHASE_END_OK,stage1)
+ @touch $(STAGE1_STAMP)
+
+$(addprefix $(STAGE1_PATH)/bin/,$(STAGE1_EXECUTABLES)) : stage1
+
+# ____ _ ____
+# / ___|| |_ __ _ __ _ ___ |___ \
+# \___ \| __/ _` |/ _` |/ _ \ __) |
+# ___) | || (_| | (_| | __/ / __/
+# |____/ \__\__,_|\__, |\___| |_____|
+# |___/
+
+# These are configuration variables for the second stage
+
+STAGE2_EXECUTABLES = \
+ ghc \
+ ghc-iserv \
+ ghc-pkg \
+ haddock \
+ hsc2hs \
+ hpc \
+ hp2ps \
+ runghc \
+ unlit
+
+STAGE2_LIBRARIES = \
+ array \
+ base \
+ binary \
+ bytestring \
+ Cabal \
+ Cabal-syntax \
+ containers \
+ deepseq \
+ directory \
+ exceptions \
+ file-io \
+ filepath \
+ ghc \
+ ghc-bignum \
+ ghc-boot \
+ ghc-boot-th \
+ ghc-compact \
+ ghc-experimental \
+ ghc-heap \
+ ghci \
+ ghc-internal \
+ ghc-platform \
+ ghc-prim \
+ ghc-toolchain \
+ haddock-api \
+ haddock-library \
+ haskeline \
+ hpc \
+ integer-gmp \
+ libffi-clib \
+ mtl \
+ os-string \
+ parsec \
+ pretty \
+ process \
+ rts \
+ rts:nonthreaded-debug \
+ rts:nonthreaded-nodebug \
+ rts:threaded-debug \
+ rts:threaded-nodebug \
+ rts-fs \
+ rts-headers \
+ semaphore-compat \
+ stm \
+ system-cxx-std-lib \
+ template-haskell \
+ template-haskell-lift \
+ template-haskell-quasiquoter \
+ text \
+ time \
+ transformers \
+ xhtml
+
+ifeq ($(MAKE_HOST),x86_64-pc-msys)
+STAGE2_LIBRARIES += Win32
+else
+STAGE2_LIBRARIES += terminfo unix
+endif
+
+STAGE2_EXTRA_INCLUDE_DIRS ?=
+STAGE2_EXTRA_LIB_DIRS ?=
+
+STAGE2_CABAL_BUILD = \
+ env \
+ DERIVE_CONSTANTS=$(call NORMALIZE_FP,$(CURDIR)/$(STAGE1_PATH)/bin/deriveConstants) \
+ GENAPPLY=$(call NORMALIZE_FP,$(CURDIR)/$(STAGE1_PATH)/bin/genapply) \
+ NM=$(NM) \
+ OBJDUMP=$(OBJDUMP) \
+ $(CABAL_BUILD) \
+ --with-compiler=$(call NORMALIZE_FP,$(CURDIR)/$(GHC1)) \
+ --with-build-compiler=$(GHC0) \
+ --ghc-options "-ghcversion-file=$(call NORMALIZE_FP,$(CURDIR)/rts/include/ghcversion.h)" \
+ $(foreach dir,$(STAGE2_EXTRA_LIB_DIRS),--extra-lib-dirs=$(dir)) \
+ $(foreach dir,$(STAGE2_EXTRA_INCLUDE_DIRS),--extra-include-dirs=$(dir))
+
+stage2: STAGE=stage2
+stage2: TARGET_PLATFORM:=$(HOST_PLATFORM)
+stage2: $(GHC1) stable-cabal $(CONFIGURE_SCRIPTS) $(CONFIGURED_FILES) cabal.project.stage2.common cabal.project.stage2.static cabal.project.stage2.dynamic cabal.project.common libraries/ghc-boot-th-next | stage1
+ $(call PHASE_START,stage2)
+ $(call LOG,Starting build of $(STAGE))
+
+ $(call PHASE_START,stage2.rts)
+ $(call LOG,Building rts)
+ $(STAGE2_CABAL_BUILD) rts
+ $(call PHASE_END_OK,stage2.rts)
+
+ $(call PHASE_START,stage2.executables)
+ $(call LOG,Building executables $(STAGE2_EXECUTABLES))
+ $(STAGE2_CABAL_BUILD) $(addprefix exe:,$(STAGE2_EXECUTABLES))
+ $(call PHASE_END_OK,stage2.executables)
+
+ $(call PHASE_START,stage2.libraries)
+ $(call LOG,Building libraries $(filter-out rts%,$(STAGE2_LIBRARIES)))
+ $(STAGE2_CABAL_BUILD) $(filter-out rts%,$(STAGE2_LIBRARIES))
+ $(call PHASE_END_OK,stage2.libraries)
+
+ $(call PHASE_START,stage2.dist)
+ $(call LOG,Building distribution in $(DIST_DIR))
+ @rm -rf $(DIST_DIR)
+
+ @mkdir -p $(DIST_DIR)/bin
+ $(call DIST_COPY_EXES,$(STAGE2_EXECUTABLES))
+
+ @mkdir -p $(DIST_DIR)/lib/$(TARGET_PLATFORM)
+ $(call DIST_COPY_LIBS,$(filter-out system-cxx-std-lib%,$(STAGE2_LIBRARIES)))
+ $(call DIST_COPY_LIBS_SO)
+
+ @mkdir -p $(DIST_DIR)/lib/package.conf.d
+ $(call DIST_COPY_LIBS_CONF,$(STAGE2_LIBRARIES))
+
+ $(call LOG,Creating $(DIST_DIR)/lib/settings)
+ @cp $(STAGE1_PATH)/lib/settings $(DIST_DIR)/lib/settings
+
+ $(call LOG,Creating $(DIST_DIR)/lib/template-hsc.h)
+ @cp $(STAGE2_PATH)/lib/hsc2hs-*-hsc2hs/share/template-hsc.h $(DIST_DIR)/lib/template-hsc.h
+
+ifeq ($(DYNAMIC),1)
+ # set rpath. Only needed for dynamic builds: statically-linked executables
+ # link only system libraries (libc/libm) and load nothing from ../lib, so
+ # they need no rpath. (patchelf also cannot rewrite the large static ghc,
+ # haddock and ghc-iserv binaries: it fails with "virtual address space
+ # underrun".)
+ @for binary in $(DIST_DIR)/bin/* ; do \
+ $(call SET_RPATH,../lib/$(HOST_PLATFORM),$${binary}) ; \
+ done
+ifneq ($(UNAME), Darwin)
+ $(PATCHELF) --force-rpath --set-rpath "\$$ORIGIN" $(CURDIR)/$(DIST_DIR)/lib/$(TARGET_PLATFORM)/$(DLL)
+endif
+ $(call LOG,Create -dyn iserv executable symlink so ghc can find ghc-iserv-dyn)
+ @$(LN_SF) ghc-iserv$(EXE_EXT) "$(DIST_DIR)/bin/ghc-iserv-dyn$(EXE_EXT)"
+endif
+ $(call LOG,Refreshing $(DIST_DIR)/lib/package.conf.d cache)
+ @$(DIST_DIR)/bin/ghc-pkg recache --package-db $(CURDIR)/$(DIST_DIR)/lib/package.conf.d
+
+ $(call LOG,Verifying $(DIST_DIR)/lib/package.conf.d)
+ @$(DIST_DIR)/bin/ghc-pkg check --package-db $(CURDIR)/$(DIST_DIR)/lib/package.conf.d
+
+ $(call LOG,Copying ghc-usage files)
+ @cp -rfp driver/ghc-usage.txt $(DIST_DIR)/lib/
+ @cp -rfp driver/ghci-usage.txt $(DIST_DIR)/lib/
+
+ $(call LOG,Finished building $(STAGE) in $(DIST_DIR))
+ $(call PHASE_END_OK,stage2.dist)
+ $(call PHASE_END_OK,stage2)
+ @touch $(STAGE2_STAMP)
+
+$(addprefix $(STAGE2_PATH)/bin/,$(STAGE2_EXECUTABLES)) : stage2
+
+# ____ _ _____
+# / ___|| |_ __ _ __ _ ___ |___ /
+# \___ \| __/ _` |/ _` |/ _ \ |_ \
+# ___) | || (_| | (_| | __/ ___) |
+# |____/ \__\__,_|\__, |\___| |____/
+# |___/
+
+# these are GHC names
+# TODO: x86_64-musl-linux -> x86_64-unknown-linux-musl
+STAGE3_PLATFORMS := \
+ x86_64-musl-linux \
+ javascript-unknown-ghcjs \
+ wasm32-unknown-wasi
+
+STAGE3_EXECUTABLES := \
+ ghc \
+ ghc-iserv \
+ ghc-pkg \
+ hp2ps \
+ hpc \
+ hsc2hs \
+ runghc \
+ unlit \
+ haddock
+
+# TODO: this won't work for musl stage3
+STAGE3_LIBRARIES = \
+ array \
+ base \
+ binary \
+ bytestring \
+ Cabal \
+ Cabal-syntax \
+ containers \
+ deepseq \
+ directory \
+ exceptions \
+ file-io \
+ filepath \
+ ghc \
+ ghc-bignum \
+ ghc-boot \
+ ghc-boot-th \
+ ghc-compact \
+ ghc-experimental \
+ ghc-heap \
+ ghci \
+ ghc-internal \
+ ghc-platform \
+ ghc-prim \
+ hpc \
+ integer-gmp \
+ mtl \
+ os-string \
+ parsec \
+ pretty \
+ process \
+ rts \
+ rts:nonthreaded-nodebug \
+ rts-fs \
+ rts-headers \
+ semaphore-compat \
+ stm \
+ template-haskell \
+ text \
+ time \
+ transformers \
+ unix \
+ xhtml
+
+STAGE3_x86_64-musl-linux_AR = x86_64-unknown-linux-musl-ar
+STAGE3_x86_64-musl-linux_CC = x86_64-unknown-linux-musl-gcc
+STAGE3_x86_64-musl-linux_CC_OPTS =
+STAGE3_x86_64-musl-linux_CXX = x86_64-unknown-linux-musl-g++
+STAGE3_x86_64-musl-linux_CXX_OPTS =
+STAGE3_x86_64-musl-linux_EXTRA_INCLUDE_DIRS =
+STAGE3_x86_64-musl-linux_EXTRA_LIB_DIRS =
+STAGE3_x86_64-musl-linux_LD = x86_64-unknown-linux-musl-ld
+STAGE3_x86_64-musl-linux_RANLIB = x86_64-unknown-linux-musl-ranlib
+STAGE3_x86_64-musl-linux_GHC_TOOLCHAIN_ARGS = $(GHC_TOOLCHAIN_ARGS)
+
+STAGE3_javascript-unknown-ghcjs_AR = emar
+STAGE3_javascript-unknown-ghcjs_CC = emcc
+STAGE3_javascript-unknown-ghcjs_CC_OPTS =
+STAGE3_javascript-unknown-ghcjs_CXX = em++
+STAGE3_javascript-unknown-ghcjs_CXX_OPTS =
+STAGE3_javascript-unknown-ghcjs_EXTRA_INCLUDE_DIRS =
+STAGE3_javascript-unknown-ghcjs_EXTRA_LIB_DIRS =
+STAGE3_javascript-unknown-ghcjs_LD = emcc
+STAGE3_javascript-unknown-ghcjs_NM = emnm
+STAGE3_javascript-unknown-ghcjs_RANLIB = emranlib
+STAGE3_javascript-unknown-ghcjs_STRIP = emstrip
+STAGE3_javascript-unknown-ghcjs_GHC_TOOLCHAIN_ARGS = $(GHC_TOOLCHAIN_ARGS) --disable-tables-next-to-code
+
+STAGE3_wasm32-unknown-wasi_CC = wasm32-wasi-clang
+STAGE3_wasm32-unknown-wasi_CC_OPTS = -fno-strict-aliasing -Wno-error=int-conversion -Oz -msimd128 -mnontrapping-fptoint -msign-ext -mbulk-memory -mmutable-globals -mmultivalue -mreference-types
+STAGE3_wasm32-unknown-wasi_CXX = wasm32-wasi-clang++
+STAGE3_wasm32-unknown-wasi_CXX_OPTS = $(STAGE3_wasm32-unknown-wasi_CC_OPTS) -fno-exceptions
+STAGE3_wasm32-unknown-wasi_AR = wasm32-wasi-ar
+STAGE3_wasm32-unknown-wasi_RANLIB = wasm32-wasi-ranlib
+STAGE3_wasm32-unknown-wasi_EXTRA_INCLUDE_DIRS =
+STAGE3_wasm32-unknown-wasi_EXTRA_LIB_DIRS =
+STAGE3_wasm32-unknown-wasi_GHC_TOOLCHAIN_ARGS = $(GHC_TOOLCHAIN_ARGS) --merge-objs wasm-ld --merge-objs-opt="-r" --disable-tables-next-to-code --disable-libffi-adjustors
+
+
+TARGET_DIR = $(DIST_DIR)/lib/targets/$(TARGET_PLATFORM)
+
+# NOTE: disable-library-for-ghci is repeated here but it should be sufficient
+# to put it in cabal.project.stage3
+
+define stage3
+
+STAGE3_$(1)_CABAL_BUILD = \
+ env \
+ DERIVE_CONSTANTS=$$(call NORMALIZE_FP,$$(CURDIR)/$$(STAGE1_PATH)/bin/deriveConstants) \
+ GENAPPLY=$$(call NORMALIZE_FP,$$(CURDIR)/$$(STAGE1_PATH)/bin/genapply) \
+ NM=$$(STAGE3_$(1)_NM) \
+ OBJDUMP=$$(STAGE3_$(1)_OBJDUMP) \
+ $$(CABAL_BUILD) \
+ --with-compiler=$$(call NORMALIZE_FP,$$(CURDIR)/$$(DIST_DIR)/bin/$(1)-ghc) \
+ --with-build-compiler=$$(call NORMALIZE_FP,$$(CURDIR)/$$(DIST_DIR)/bin/ghc) \
+ --ghc-options "-ghcversion-file=$$(call NORMALIZE_FP,$$(CURDIR)/rts/include/ghcversion.h)" \
+ --with-hsc2hs=$$(call NORMALIZE_FP,$$(CURDIR)/$$(DIST_DIR)/bin/$(1)-hsc2hs) \
+ --hsc2hs-options='-x' \
+ --with-gcc $$(STAGE3_$(1)_CC) \
+ $$(foreach dir,$$(STAGE3_$(1)_EXTRA_LIB_DIRS),--extra-lib-dirs=$$(dir)) \
+ $$(foreach dir,$$(STAGE3_$(1)_EXTRA_INCLUDE_DIRS),--extra-include-dirs=$$(dir))
+
+.PHONY: stage3-$(1)
+stage3-$(1): STAGE=stage3
+stage3-$(1): TARGET_PLATFORM=$(1)
+stage3-$(1): $(GHC2) $$(STAGE1_PATH)/bin/ghc-toolchain-bin $(CONFIGURE_SCRIPTS) $(CONFIGURED_FILES) libraries/ghc-boot-th-next cabal.project.common cabal.project.stage3 stage3-$(1)-additional-files
+ $$(call PHASE_START,stage3-$(1))
+ $$(call LOG,Linking executables)
+ $$(foreach exe,$$(STAGE3_EXECUTABLES),$(LN_SF) $$(exe) $(DIST_DIR)/bin/$(1)-$$(exe);)
+
+ @mkdir -p $$(TARGET_DIR)/lib
+ $$(STAGE1_PATH)/bin/ghc-toolchain-bin \
+ --output-settings \
+ --output $$(TARGET_DIR)/lib/settings \
+ --triple $(1) \
+ --cc $$(STAGE3_$(1)_CC) \
+ $$(foreach opt,$$(STAGE3_$(1)_CC_OPTS),--cc-opt=$$(opt)) \
+ --cxx $$(STAGE3_$(1)_CXX) \
+ $$(foreach opt,$$(STAGE3_$(1)_CXX_OPTS),--cxx-opt=$$(opt)) \
+ $(if $(STAGE3_$(1)_AR),--ar $$(STAGE3_$(1)_AR),) \
+ $(if $(STAGE3_$(1)_LD),--ld $$(STAGE3_$(1)_LD),) \
+ $(if $(STAGE3_$(1)_ND),--nm $$(STAGE3_$(1)_NM),) \
+ $(if $(STAGE3_$(1)_RANLIB),--ranlib $$(STAGE3_$(1)_RANLIB),) \
+ --disable-ld-override \
+ $$(STAGE3_$(1)_GHC_TOOLCHAIN_ARGS)
+
+ $$(DIST_DIR)/bin/$(1)-ghc --info
+
+ @rm -rf $$(TARGET_DIR)/lib/package.conf.d
+ $$(DIST_DIR)/bin/$(1)-ghc-pkg init $$(TARGET_DIR)/lib/package.conf.d
+
+ $$(call PHASE_START,stage3-$(1).rts)
+ $$(call LOG,Building library rts:nonthreaded-nodebug)
+ $$(STAGE3_$(1)_CABAL_BUILD) rts:nonthreaded-nodebug
+ $$(call PHASE_END_OK,stage3-$(1).rts)
+
+ $$(call PHASE_START,stage3-$(1).libraries)
+ $$(call LOG,Building libraries $(STAGE3_LIBRARIES))
+ $$(STAGE3_$(1)_CABAL_BUILD) $(filter-out rts%,$(STAGE3_LIBRARIES))
+ $$(call PHASE_END_OK,stage3-$(1).libraries)
+
+ $$(call PHASE_START,stage3-$(1).dist)
+ $$(call LOG,Copying libraries into distribution for target $(1))
+ @mkdir -p $$(TARGET_DIR)/lib/package.conf.d
+ @mkdir -p $$(TARGET_DIR)/lib/$(1)
+ $$(call DIST_COPY_LIBS_CROSS,$(STAGE3_LIBRARIES),$(1))
+ $$(call DIST_COPY_LIBS_SO_CROSS)
+ $$(call DIST_COPY_LIBS_CONF_CROSS,$(STAGE3_LIBRARIES),$(1))
+
+ $(call LOG,Refreshing $$(TARGET_DIR)/lib/package.conf.d cache)
+ @$(DIST_DIR)/bin/$(1)-ghc-pkg recache --package-db $$(CURDIR)/$$(TARGET_DIR)/lib/package.conf.d
+
+ $(call LOG,Verifying $$(TARGET_DIR)/lib/package.conf.d)
+ @$(DIST_DIR)/bin/$(1)-ghc-pkg check --package-db $$(CURDIR)/$$(TARGET_DIR)/lib/package.conf.d
+
+ $$(call LOG,Copying ghc-usage files)
+ @cp -rfp driver/ghc-usage.txt $$(TARGET_DIR)/lib/
+ @cp -rfp driver/ghci-usage.txt $$(TARGET_DIR)/lib/
+ $$(call PHASE_END_OK,stage3-$(1).dist)
+ $$(call PHASE_END_OK,stage3-$(1))
+
+$(DIST_DIR)/ghc-$(1).tar.gz: stage3-$(1)
+ @echo "::group::Creating ghc-$(1).tar.gz..."
+ tar czf $$@ \
+ --directory=$$(DIST_DIR) \
+ $(foreach exe,$(STAGE3_EXECUTABLES),bin/$(1)-$(exe)$(EXE_EXT)) \
+ lib/targets/$(1)
+ @echo "::endgroup::"
+
+endef
+
+stage3-javascript-unknown-ghcjs-additional-files: STAGE=stage3
+stage3-javascript-unknown-ghcjs-additional-files: TARGET_PLATFORM=javascript-unknown-ghcjs
+stage3-javascript-unknown-ghcjs-additional-files:
+ @mkdir -p $(TARGET_DIR)/lib/
+ $(call LOG,Copying dyld.mjs)
+ @cp -f utils/jsffi/dyld.mjs $(TARGET_DIR)/lib/dyld.mjs
+ $(call LOG,Copying ghc-interp.js)
+ @cp -f ghc-interp.js $(TARGET_DIR)/lib/ghc-interp.js
+ $(call LOG,Copying post-link.mjs)
+ @cp -f utils/jsffi/post-link.mjs $(TARGET_DIR)/lib/post-link.mjs
+ $(call LOG,Copying prelude.mjs)
+ @cp -f utils/jsffi/prelude.mjs $(TARGET_DIR)/lib/prelude.mjs
+
+stage3-wasm32-unknown-wasi-additional-files: STAGE=stage3
+stage3-wasm32-unknown-wasi-additional-files: TARGET_PLATFORM=wasm32-unknown-wasi
+stage3-wasm32-unknown-wasi-additional-files:
+ @mkdir -p $(TARGET_DIR)/lib/
+ $(call LOG,Copying dyld.mjs)
+ @cp -f utils/jsffi/dyld.mjs $(TARGET_DIR)/lib/dyld.mjs
+ $(call LOG,Copying ghc-interp.js)
+ @cp -f ghc-interp.js $(TARGET_DIR)/lib/ghc-interp.js
+ $(call LOG,Copying post-link.mjs)
+ @cp -f utils/jsffi/post-link.mjs $(TARGET_DIR)/lib/post-link.mjs
+ $(call LOG,Copying prelude.mjs)
+ @cp -f utils/jsffi/prelude.mjs $(TARGET_DIR)/lib/prelude.mjs
+
+stage3-x86_64-musl-linux-additional-files: STAGE=stage3
+stage3-x86_64-musl-linux-additional-files: TARGET_PLATFORM=x86_64-musl-linux
+stage3-x86_64-musl-linux-additional-files:
+ $(call LOG,No additional files to be copied)
+
+
+$(foreach platform,$(STAGE3_PLATFORMS),$(eval $(call stage3,$(platform))))
+
+stage3: $(foreach platform,$(STAGE3_PLATFORMS),stage3-$(platform))
+
+# ____ _ _ _ _
+# | __ )(_)_ __ __| (_)___| |_ ___
+# | _ \| | '_ \ / _` | / __| __/ __|
+# | |_) | | | | | (_| | \__ \ |_\__ \
+# |____/|_|_| |_|\__,_|_|___/\__|___/
+#
+
+$(DIST_DIR)/ghc.tar.gz: stage2
+ @echo "::group::Creating ghc.tar.gz..."
+ @$(TAR) czf $@ \
+ --directory=$(DIST_DIR) \
+ $(foreach exe,$(STAGE2_EXECUTABLES),bin/$(exe)$(EXE_EXT)) \
+ $(shell if [ "$(DYNAMIC)" = 1 ] ; then echo "bin/ghc-iserv-dyn$(EXE_EXT)" ; fi) \
+ lib/ghc-usage.txt \
+ lib/ghci-usage.txt \
+ lib/package.conf.d \
+ lib/settings \
+ lib/template-hsc.h \
+ lib/$(HOST_PLATFORM)
+ @echo "::endgroup::"
+
+$(DIST_DIR)/cabal.tar.gz: stable-cabal
+ @echo "::group::Creating cabal.tar.gz..."
+ @mkdir -p $(DIST_DIR)/bin
+ @cp $(CABAL) $(DIST_DIR)/bin/
+ @$(TAR) czf $@ \
+ --directory=$(DIST_DIR) \
+ bin/cabal
+ @echo "::endgroup::"
+
+$(DIST_DIR)/haskell-toolchain.tar.gz: stable-cabal stage2 stage3-javascript-unknown-ghcjs
+ @echo "::group::Creating haskell-toolchain.tar.gz..."
+ @mkdir -p $(DIST_DIR)/bin
+ @cp $(CABAL) $(DIST_DIR)/bin/
+ @$(TAR) czf $@ \
+ --directory=$(DIST_DIR) \
+ $(foreach exe,$(STAGE2_EXECUTABLES),bin/$(exe)$(EXE_EXT)) \
+ lib/ghc-usage.txt \
+ lib/ghci-usage.txt \
+ lib/package.conf.d \
+ lib/settings \
+ lib/template-hsc.h \
+ lib/$(HOST_PLATFORM) \
+ $(foreach exe,$(STAGE3_EXECUTABLES),bin/javascript-unknown-ghcjs-$(exe)$(EXE_EXT)) \
+ lib/targets/javascript-unknown-ghcjs \
+ bin/cabal
+ @echo "::endgroup::"
+
+$(DIST_DIR)/tests.tar.gz:
+ @echo "::group::Creating tests.tar.gz..."
+ @$(TAR) czf $@ \
+ testsuite
+ @echo "::endgroup::"
+
+# _ _ _
+# | | | | __ _ ___| | ____ _ __ _ ___
+# | |_| |/ _` |/ __| |/ / _` |/ _` |/ _ \
+# | _ | (_| | (__| < (_| | (_| | __/
+# |_| |_|\__,_|\___|_|\_\__,_|\__, |\___|
+# |___/
+
+# .PHONY: hackage
+hackage: $(BUILD_DIR)/packages/hackage.haskell.org/01-index.tar.gz
+
+$(BUILD_DIR)/packages/hackage.haskell.org/01-index.tar.gz:
+ $(CABAL) --remote-repo-cache $(call NORMALIZE_FP,$(CURDIR)/$(BUILD_DIR)/packages) update
+
+# ____ __ _
+# / ___|___ _ __ / _(_) __ _ _ _ _ __ ___
+# | | / _ \| '_ \| |_| |/ _` | | | | '__/ _ \
+# | |__| (_) | | | | _| | (_| | |_| | | | __/
+# \____\___/|_| |_|_| |_|\__, |\__,_|_| \___|
+# |___/
+
+$(CONFIGURE_SCRIPTS) : % : %.ac
+ @echo ">>> Running autoreconf $(@D)"
+ autoreconf $(@D)
+ @echo "::endgroup::"
+
+# Top level configure script.
+#
+# NOTE: configure scripts in packages with `Build-Type: Configure`
+# are run by Cabal not here.
+#
+# We use --no-create to avoid regenerating files if not needed.
+# Each configured file is tracked independently below.
+config.status: configure
+ @echo ">>> Running $(@D)/configure"
+ $(@D)/configure --no-create $(GHC_CONFIGURE_ARGS)
+ @echo "::endgroup::"
+
+# Configured files are obtained from their .in counterparts via config.status
+$(CONFIGURED_FILES) : % : ./config.status %.in
+ ./config.status $@
+
+libraries/ghc-boot-th-next/%: libraries/ghc-boot-th/%
+ @mkdir -p $(@D)
+ @cp -v $< $@
+
+libraries/ghc-boot-th-next/ghc-boot-th-next.cabal: libraries/ghc-boot-th/ghc-boot-th.cabal
+ @echo "::group::Synthesizing ghc-boot-th-next (copy & sed from ghc-boot-th)..."
+ @mkdir -p $(@D)
+ @$(SED) -e 's/^name:[[:space:]]*ghc-boot-th$$/name: ghc-boot-th-next/' $< > $@
+ @echo "::endgroup::"
+
+.PHONY: libraries/ghc-boot-th-next
+libraries/ghc-boot-th-next: \
+ libraries/ghc-boot-th-next/changelog.md \
+ libraries/ghc-boot-th-next/LICENSE \
+ libraries/ghc-boot-th-next/ghc-boot-th-next.cabal
+
+# --- Clean Targets ---
+clean-cabal: clean-stage0
+clean-stage0:
+ @echo "::group::Cleaning build artifacts..."
+ifeq (,$(USE_SYSTEM_CABAL))
+ rm -rf $(BUILD_DIR)/cabal
+endif
+ rm -rf $(BUILD_DIR)/stage0
+ rm -f $(STAGE0_STAMP)
+ @echo "::endgroup::"
+
+clean: clean-stage1 clean-stage2 clean-stage3
+ @echo "Not removing stage0 (cabal), use clean-stage0 to remove cabal too."
+
+clean-stage1:
+ @echo "::group::Cleaning stage1 build artifacts..."
+ rm -rf $(BUILD_DIR)/stage1
+ rm -f $(STAGE1_STAMP)
+ @echo "::endgroup::"
+
+clean-stage2:
+ @echo "::group::Cleaning stage2 build artifacts..."
+ rm -rf $(BUILD_DIR)/stage2
+ rm -f $(STAGE2_STAMP)
+ @echo "::endgroup::"
+
+clean-stage3:
+ @echo "::group::Cleaning stage3 build artifacts..."
+ rm -rf $(BUILD_DIR)/stage3
+ @echo "::endgroup::"
+
+distclean: clean
+ @echo "::group::Cleaning all generated files (distclean)..."
+ rm -rf autom4te.cache
+ rm -f config.status config.log config.h aclocal.m4
+ rm -f $(CONFIGURE_SCRIPTS) $(CONFIGURED_FILES)
+ rm -rf libraries/ghc-boot-th-next
+ @echo "::endgroup::"
+
+# Default: skip performance tests (can override with SKIP_PERF_TESTS=NO)
+SKIP_PERF_TESTS ?= YES
+export SKIP_PERF_TESTS
+
+# --- Test Suite Helper Tool Paths & Flags (Hadrian parity light) ---
+# We approximate Hadrian's test invocation without depending on Hadrian.
+# $(CURDIR) is needed because the test recipe runs $(MAKE) -C testsuite/tests,
+# so relative paths would resolve from the wrong directory. This matters both
+# for CI and local `make test` invocations.
+TEST_TOOLS_DIR := $(CURDIR)/$(DIST_DIR)/bin
+TEST_GHC := $(TEST_TOOLS_DIR)/ghc
+TEST_GHC_PKG := $(TEST_TOOLS_DIR)/ghc-pkg
+TEST_HP2PS := $(TEST_TOOLS_DIR)/hp2ps
+TEST_HPC := $(TEST_TOOLS_DIR)/hpc
+TEST_RUN_GHC := $(TEST_TOOLS_DIR)/runghc
+
+# Canonical GHC flags used by the testsuite (mirrors testsuite/mk/test.mk & Hadrian runTestGhcFlags)
+CANONICAL_TEST_HC_OPTS = \
+ -dcore-lint -dstg-lint -dcmm-lint -no-user-package-db -fno-dump-with-ways \
+ -fprint-error-index-links=never -rtsopts -fno-warn-missed-specialisations \
+ -fshow-warning-groups -fdiagnostics-color=never -fno-diagnostics-show-caret \
+ -Werror=compat -dno-debug-output
+
+# Build timeout utility (needed for some tests) if not already built.
+.PHONY: testsuite-timeout
+testsuite-timeout:
+ $(MAKE) -C testsuite/timeout
+
+# --- Test Target ---
+
+test: $(STAGE2_STAMP) testsuite-timeout
+ $(call PHASE_START,test)
+ @echo "::group::Running tests with THREADS=$(THREADS)" >&2
+ # If any required tool is missing, testsuite logic will skip related tests.
+ TEST_HC='$(TEST_GHC)' \
+ GHC_PKG='$(TEST_GHC_PKG)' \
+ HP2PS_ABS='$(TEST_HP2PS)' \
+ HPC='$(TEST_HPC)' \
+ RUNGHC='$(TEST_RUN_GHC)' \
+ TEST_CC='$(CC)' \
+ TEST_CXX='$(CXX)' \
+ TEST_HC_OPTS='$(CANONICAL_TEST_HC_OPTS)' \
+ METRICS_FILE='$(CURDIR)/$(BUILD_DIR)/test-perf.csv' \
+ SUMMARY_FILE='$(CURDIR)/$(BUILD_DIR)/test-summary.txt' \
+ JUNIT_FILE='$(CURDIR)/$(BUILD_DIR)/test-junit.xml' \
+ SKIP_PERF_TESTS='$(SKIP_PERF_TESTS)' \
+ THREADS='$(THREADS)' \
+ $(MAKE) -C testsuite/tests test
+ @echo "::endgroup::"
+ $(call PHASE_END_OK,test)
+
+# Inform Make that these are not actual files if they get deleted by other means
+.PHONY: clean clean-stage1 clean-stage2 clean-stage3 distclean test
diff --git a/README.md b/README.md
index a310c0a50fcc..ed6e5246305e 100644
--- a/README.md
+++ b/README.md
@@ -1,14 +1,19 @@
-The Glasgow Haskell Compiler
-============================
+The Glasgow Haskell Compiler - Stable Haskell Edition
+=====================================================
[](https://gitlab.haskell.org/ghc/ghc/commits/master)
+**This is the Stable Haskell Edition of GHC**, not the upstream GHC codebase.
+
This is the source tree for [GHC][1], a compiler and interactive
environment for the Haskell functional programming language.
-For more information, visit [GHC's web site][1].
+**Important**: All issues and bug reports for this fork should be reported at:
+
+
+For more information about upstream GHC, visit [GHC's web site][1].
-Information for developers of GHC can be found on the [GHC issue tracker][2], and you can also view [proposals for new GHC features][13].
+Information for developers of upstream GHC can be found on the [GHC issue tracker][2], and you can also view [proposals for new GHC features][13].
Getting the Source
@@ -26,10 +31,7 @@ There are two ways to get a source tree:
2. *Check out the source code from git*
- $ git clone --recurse-submodules git@gitlab.haskell.org:ghc/ghc.git
-
- Note: cloning GHC from Github requires a special setup. See [Getting a GHC
- repository from Github][7].
+ $ git clone --recurse-submodules https://github.com/stable-haskell/ghc.git
*See the GHC team's working conventions regarding [how to contribute a patch to GHC](https://gitlab.haskell.org/ghc/ghc/wikis/working-conventions/fixing-bugs).* First time contributors are encouraged to get started by just sending a Merge Request.
@@ -41,51 +43,55 @@ For full information on building GHC, see the [GHC Building Guide][3].
Here follows a summary - if you get into trouble, the Building Guide
has all the answers.
-Before building GHC you may need to install some other tools and
-libraries. See, [Setting up your system for building GHC][8].
+To build GHC, you need:
+- A working version of [GHC][1] (>= 9.8.4), as the compiler is written in Haskell
+- [cabal-install][9]
+
+Both the bootstrap compiler and cabal-install can be easily installed with
+[GHCup](https://www.haskell.org/ghcup/):
-*NB.* In particular, you need [GHC][1] installed in order to build GHC,
-because the compiler is itself written in Haskell. You also need
-[Happy][4], [Alex][5], and [Cabal][9]. For instructions on how
-to port GHC to a new platform, see the [GHC Building Guide][3].
+ $ ghcup install ghc --set 9.8.4
+ $ ghcup install cabal
+
+For additional system dependencies and libraries, see [Setting up your system for building GHC][8].
+For instructions on how to port GHC to a new platform, see the [GHC Building Guide][3].
For building library documentation, you'll need [Haddock][6]. To build
the compiler documentation, you need [Sphinx](http://www.sphinx-doc.org/)
and Xelatex (only for PDF output).
-**Quick start**: GHC is built using the [Hadrian build system](hadrian/README.md).
-The following gives you a default build:
+**Quick start**: The following gives you a default build:
+
+ $ make CABAL=$PWD/_build/stage0/bin/cabal
- $ ./boot
- $ ./configure
- $ hadrian/build # can also say '-jX' for X number of jobs
+On Windows, you should run the build command from an appropriate
+environment (e.g., MSYS2).
- On Windows, you need an extra repository containing some build tools.
- These can be downloaded for you by configure. This only needs to be done once by running:
+This gives you the default build, which includes everything
+optimised and built. It can take a long time.
- $ ./configure --enable-tarballs-autodownload
+To run the test suite:
- Additionally, on Windows, to run Hadrian you should run `hadrian/build.bat`
- instead of `hadrian/build`.
+ $ make test CABAL=$PWD/_build/stage0/bin/cabal
-(NB: **Do you have multiple cores? Be sure to tell that to `hadrian`!** This can
-save you hours of build time depending on your system configuration, and is
-almost always a win regardless of how many cores you have. As a simple rule,
-you should have about N+1 jobs, where `N` is the amount of cores you have.)
-The `./boot` step is only necessary if this is a tree checked out
-from git. For source distributions downloaded from [GHC's web site][1],
-this step has already been performed.
+Building cross-compilers
+================================
+
+To build *javascript-unknown-ghcjs*:
+
+ 1. Download the emscripten toolchain using the instructions at
+ https://emscripten.org/docs/getting_started/downloads.html
+ 2. Activate the environment using `source ./emsdk_env.sh`
+ 3. `make stage3-javascript-unknown-ghcjs`
-These steps give you the default build, which includes everything
-optimised and built in various ways (eg. profiling libs are built).
-It can take a long time. To customise the build, see the file `HACKING.md`.
Filing bugs and feature requests
================================
-If you've encountered what you believe is a bug in GHC, or you'd like
-to propose a feature request, please let us know! Submit an [issue][10] and we'll be sure to look into it. Remember:
+If you've encountered what you believe is a bug in this fork, or you'd like
+to propose a feature request, please let us know! Submit an issue at
+ and we'll be sure to look into it. Remember:
**Filing a bug is the best way to make sure your issue isn't lost over
time**, so please feel free.
@@ -93,13 +99,69 @@ If you're an active user of GHC, you may also be interested in joining
the [glasgow-haskell-users][11] mailing list, where developers and
GHC users discuss various topics and hang out.
-Hacking & Developing GHC
-========================
+Getting Started with Development
+---------------------------------
+
+Make sure your system has the necessary tools to compile GHC. You can
+find an overview of how to prepare your system here:
+
+
+
+After building GHC (see "Building & Installing" above), you can start
+making your commits. When you're done, you can submit a merge request
+to [GitLab](https://gitlab.haskell.org/ghc/ghc/merge_requests) for
+code review.
+
+Changes to the `base` library require a proposal to the
+[core libraries committee](https://github.com/haskell/core-libraries-committee/issues).
+
+The GHC Wiki has a good summary for the
+[overall process](https://gitlab.haskell.org/ghc/ghc/wikis/working-conventions/fixing-bugs).
+One or several reviewers will review your PR, and when they are ok with
+your changes, they will assign the PR to
+[Marge Bot](https://gitlab.haskell.org/marge-bot) which will automatically
+rebase, batch and then merge your PR (assuming the build passes).
+
+Useful Resources
+----------------
+
+The home for GHC hackers is our GitLab instance:
+
+
+
+From here, you can file bugs (or look them up), use the wiki, view the
+git history, among other things.
+
+An overview of things like using Git, the release process, filing bugs
+and more can be located here:
+
+
+
+You can find our coding conventions for the compiler and RTS here:
+
+
+
+
+If you're going to contribute regularly, **learning how to use the
+build system is important** and will save you lots of time. You should
+read over this page carefully:
+
+
+
+If you want to watch issues and code review activities, the following page
+is a good start:
+
+
+
+How to Communicate with Us
+--------------------------
+
+GHC is a big project, so you'll surely need help. Luckily, we can
+provide plenty through a variety of means!
+
+### Discord
-Once you've filed a bug, maybe you'd like to fix it yourself? That
-would be great, and we'd surely love your company! If you're looking
-to hack on GHC, check out the guidelines in the `HACKING.md` file in
-this directory - they'll get you up to speed quickly.
+If you're a Discord user, you can join [our server](https://discord.gg/aNN8XcQfA6).
Governance and Acknowledgements
===============================
@@ -118,19 +180,11 @@ as described in our [governance documentation](https://gitlab.haskell.org/ghc/gh
"gitlab.haskell.org/ghc/ghc/issues"
[3]: https://gitlab.haskell.org/ghc/ghc/wikis/building
"https://gitlab.haskell.org/ghc/ghc/wikis/building"
-[4]: http://www.haskell.org/happy/ "www.haskell.org/happy/"
-[5]: http://www.haskell.org/alex/ "www.haskell.org/alex/"
[6]: http://www.haskell.org/haddock/ "www.haskell.org/haddock/"
-[7]: https://gitlab.haskell.org/ghc/ghc/wikis/building/getting-the-sources#cloning-from-github
- "https://gitlab.haskell.org/ghc/ghc/wikis/building/getting-the-sources#cloning-from-github"
[8]: https://gitlab.haskell.org/ghc/ghc/wikis/building/preparation
"https://gitlab.haskell.org/ghc/ghc/wikis/building/preparation"
-[9]: http://www.haskell.org/cabal/ "http://www.haskell.org/cabal/"
-[10]: https://gitlab.haskell.org/ghc/ghc/issues
- "https://gitlab.haskell.org/ghc/ghc/issues"
+[9]: https://github.com/haskell/cabal "https://github.com/haskell/cabal"
[11]: http://www.haskell.org/pipermail/glasgow-haskell-users/
"http://www.haskell.org/pipermail/glasgow-haskell-users/"
-[12]: https://gitlab.haskell.org/ghc/ghc/wikis/team-ghc
- "https://gitlab.haskell.org/ghc/ghc/wikis/team-ghc"
[13]: https://github.com/ghc-proposals/ghc-proposals
"https://github.com/ghc-proposals/ghc-proposals"
diff --git a/boot b/boot
deleted file mode 100755
index c73ed3a430b0..000000000000
--- a/boot
+++ /dev/null
@@ -1,83 +0,0 @@
-#!/usr/bin/env python3
-
-import glob
-import os
-import os.path
-import sys
-from textwrap import dedent
-import subprocess
-import re
-import shutil
-
-# Packages whose libraries aren't in the submodule root
-EXCEPTIONS = {
- 'libraries/containers/': 'libraries/containers/containers/'
-}
-
-def print_err(s):
- print(dedent(s), file=sys.stderr)
-
-def die(mesg):
- print_err(mesg)
- sys.exit(1)
-
-def check_boot_packages():
- # Check that we have all boot packages.
- for l in open('packages', 'r'):
- if l.startswith('#'):
- continue
-
- parts = [part for part in l.split(' ') if part]
- if len(parts) != 4:
- die("Error: Bad line in packages file: " + l)
-
- dir_ = parts[0]
- tag = parts[1]
-
- # If tag is not "-" then it is an optional repository, so its
- # absence isn't an error.
- if tag == '-':
- # We would like to just check for a .git directory here,
- # but in an lndir tree we avoid making .git directories,
- # so it doesn't exist. We therefore require that every repo
- # has a LICENSE file instead.
- license_path = os.path.join(EXCEPTIONS.get(dir_+'/', dir_), 'LICENSE')
- if not os.path.isfile(license_path):
- die("""\
- Error: %s doesn't exist
- Maybe you haven't run 'git submodule update --init'?
- """ % license_path)
-
-def autoreconf():
- # Run autoreconf on everything that needs it.
- processes = {}
- if os.name == 'nt':
- # Get the normalized ACLOCAL_PATH for Windows
- # This is necessary since on Windows this will be a Windows
- # path, which autoreconf doesn't know doesn't know how to handle.
- ac_local = os.getenv('ACLOCAL_PATH', '')
- ac_local_arg = re.sub(r';', r':', ac_local)
- ac_local_arg = re.sub(r'\\', r'/', ac_local_arg)
- ac_local_arg = re.sub(r'(\w):/', r'/\1/', ac_local_arg)
- reconf_cmd = 'ACLOCAL_PATH=%s autoreconf' % ac_local_arg
- else:
- reconf_cmd = 'autoreconf'
-
- for dir_ in ['.', 'rts'] + glob.glob('libraries/*/'):
- if os.path.isfile(os.path.join(dir_, 'configure.ac')):
- print("Booting %s" % dir_)
- processes[dir_] = subprocess.Popen(['sh', '-c', reconf_cmd], cwd=dir_)
-
- # Wait for all child processes to finish.
- fail = False
- for k,v in processes.items():
- code = v.wait()
- if code != 0:
- print_err('autoreconf in %s failed with exit code %d' % (k, code))
- fail = True
-
- if fail:
- sys.exit(1)
-
-check_boot_packages()
-autoreconf()
diff --git a/cabal.project-reinstall b/cabal.project-reinstall
deleted file mode 100644
index 8f258c191330..000000000000
--- a/cabal.project-reinstall
+++ /dev/null
@@ -1,81 +0,0 @@
-packages: ./compiler
- ./utils/genprimopcode/
- ./utils/deriveConstants/
- ./ghc/
- -- ./libraries/array
- -- ./libraries/base
- ./libraries/binary
- ./libraries/bytestring
- ./libraries/Cabal/Cabal
- ./libraries/Cabal/Cabal-syntax
- ./libraries/containers/containers/
- -- ./libraries/deepseq/
- ./libraries/directory/
- ./libraries/exceptions/
- ./libraries/file-io/
- ./libraries/filepath/
- -- ./libraries/ghc-bignum/
- ./libraries/ghc-boot/
- -- ./libraries/ghc-boot-th/
- ./libraries/ghc-compact
- ./libraries/ghc-experimental
- ./libraries/ghc-heap
- ./libraries/ghci
- -- ./libraries/ghc-prim
- ./libraries/haskeline
- ./libraries/directory
- ./libraries/hpc
- -- ./libraries/integer-gmp
- ./libraries/mtl/
- ./libraries/os-string/
- ./libraries/parsec/
- -- ./libraries/pretty/
- ./libraries/process/
- ./libraries/semaphore-compat
- ./libraries/stm
- -- ./libraries/template-haskell/
- ./libraries/terminfo/
- ./libraries/text
- ./libraries/time
- ./libraries/transformers/
- ./libraries/unix/
- ./libraries/Win32/
- ./libraries/xhtml/
- ./utils/ghc-pkg
- ./utils/ghc-toolchain
- ./utils/ghc-toolchain/exe
- ./utils/haddock
- ./utils/haddock/haddock-api
- ./utils/haddock/haddock-library
- ./utils/hp2ps
- ./utils/hpc
- ./utils/hsc2hs
- ./utils/runghc
- ./utils/unlit
- ./utils/iserv
- ./linters/**/*.cabal
-
-constraints: ghc +internal-interpreter +dynamic-system-linke,
- ghc-bin +internal-interpreter +threaded,
- ghci +internal-interpreter,
- haddock +in-ghc-tree,
- any.array installed,
- any.base installed,
- any.deepseq installed,
- any.ghc-bignum installed,
- any.ghc-boot-th installed,
- any.integer-gmp installed,
- any.pretty installed,
- any.template-haskell installed
-
-
-benchmarks: False
-tests: False
-allow-boot-library-installs: True
-
--- Workaround for https://github.com/haskell/cabal/issues/7297
-package *
- library-vanilla: True
- shared: True
- executable-profiling: False
- executable-dynamic: True
diff --git a/cabal.project.common b/cabal.project.common
new file mode 100644
index 000000000000..ec303f209b53
--- /dev/null
+++ b/cabal.project.common
@@ -0,0 +1,95 @@
+index-state: 2025-10-26T19:17:08Z
+allow-boot-library-installs: True
+benchmarks: False
+tests: False
+
+
+--
+-- Package level configuration
+--
+
+package *
+ library-vanilla: True
+ executable-profiling: False
+ executable-static: False
+
+-- Cabal-syntax needs -O0 to avoid simplifier tick exhaustion in
+-- Distribution.PackageDescription.FieldGrammar. The backported simplifier
+-- fixes (#26323, #26903) cause a near-infinite simplifier loop in this module.
+package Cabal-syntax
+ ghc-options: -O0
+
+package haddock-api
+ flags: +in-ghc-tree
+
+package haskeline
+ flags: -terminfo
+
+-- TODO: What is this? Why do we need _in-ghc-tree_ here?
+package hsc2hs
+ flags: +in-ghc-tree
+
+-- NOTE: Yes. The strings have to be escaped like this.
+
+package rts
+ ghc-options: "-optc-DProjectVersion=\"914\""
+ ghc-options: "-optc-DBuildPlatform=\"FIXME\""
+ ghc-options: "-optc-DBuildArch=\"FIXME\""
+ ghc-options: "-optc-DBuildOS=\"FIXME\""
+ ghc-options: "-optc-DBuildVendor=\"FIXME\""
+ ghc-options: "-optc-DGhcUnregisterised=\"FIXME\""
+ ghc-options: "-optc-DTablesNextToCode=\"FIXME\""
+ ghc-options: "-optc-DFS_NAMESPACE=rts"
+
+if os(linux)
+ package rts
+ ghc-options: "-optc-DHostArch=\"x86_64\""
+ ghc-options: "-optc-DHostOS=\"linux\""
+ ghc-options: "-optc-DHostPlatform=\"x86_64-unknown-linux\""
+ ghc-options: "-optc-DHostVendor=\"unknown\""
+
+if os(darwin)
+ package rts
+ ghc-options: "-optc-DHostArch=\"aarch64\""
+ ghc-options: "-optc-DHostOS=\"darwin\""
+ ghc-options: "-optc-DHostPlatform=\"aarch64-apple-darwin\""
+ ghc-options: "-optc-DHostVendor=\"unknown\""
+ flags: +leading-underscore
+
+if os(windows)
+ package rts
+ ghc-options: "-optc-DHostArch=\"x86_64\""
+ ghc-options: "-optc-DHostOS=\"mingw32\""
+ ghc-options: "-optc-DHostPlatform=\"x86_64-unknown-mingw32\""
+ ghc-options: "-optc-DHostVendor=\"unknown\""
+
+if os(freebsd)
+ package rts
+ ghc-options: "-optc-DHostArch=\"x86_64\""
+ ghc-options: "-optc-DHostOS=\"freebsd\""
+ ghc-options: "-optc-DHostPlatform=\"x86_64-portbld-freebsd\""
+ ghc-options: "-optc-DHostVendor=\"unknown\""
+
+if os(wasi)
+ package rts
+ ghc-options: "-optc-DHostArch=\"wasm32\""
+ ghc-options: "-optc-DHostOS=\"unknown\""
+ ghc-options: "-optc-DHostPlatform=\"wasm32-wasi\""
+ ghc-options: "-optc-DHostVendor=\"unknown\""
+ ghc-options: -optl-Wl,--export-dynamic
+ ghc-options: -optc-fvisibility=default
+ ghc-options: -optc-fvisibility-inlines-hidden
+
+package text
+ flags: -simdutf
+
+program-options
+ ghc-options: -fhide-source-paths -j
+
+constraints:
+ -- because allow-newer doesn't play well with the automatic os-string flag
+ , any.unix +os-string
+ , any.directory +os-string
+ , any.file-io +os-string
+ , any.process +os-string
+ , any.Win32 +os-string
diff --git a/cabal.project.stage0 b/cabal.project.stage0
new file mode 100644
index 000000000000..10935f82914b
--- /dev/null
+++ b/cabal.project.stage0
@@ -0,0 +1,15 @@
+source-repository-package
+ type: git
+ location: https://github.com/stable-haskell/Cabal.git
+ tag: stable-haskell/master
+ subdir: Cabal
+ Cabal-syntax
+ cabal-install
+ cabal-install-solver
+ hooks-exe
+
+source-repository-package
+ type: git
+ location: https://github.com/stable-haskell/hackage-security.git
+ tag: baaad2e189a8203966f7d3f752a348f02eefd1b2
+ subdir: hackage-security
diff --git a/cabal.project.stage1 b/cabal.project.stage1
new file mode 100644
index 000000000000..d946e30e571b
--- /dev/null
+++ b/cabal.project.stage1
@@ -0,0 +1,98 @@
+-- Configuration common to all stages
+import: cabal.project.common
+
+packages:
+ -- NOTE: we need rts-headers, because the _newly_ built compiler depends
+ -- on these potentially _new_ headers, we must not rely on those from
+ -- the rts as shipped with the bootstrap compiler. For the stage2
+ -- compiler we have the `rts` available, which would have the correct
+ -- headers around, now it has them through the rts -> rts-headers
+ -- dependency.
+ rts-headers
+ rts-fs
+
+ -- Compiler
+ ghc
+ compiler
+
+ -- Internal libraries
+ libraries/ghc-boot
+ libraries/ghc-boot-th-next
+ libraries/ghci
+ libraries/ghc-platform
+ https://hackage.haskell.org/package/libffi-clib-3.5.2/libffi-clib-3.5.2.tar.gz
+
+ -- Internal tools
+ utils/deriveConstants
+ utils/genapply
+ utils/genprimopcode
+ utils/ghc-pkg
+ utils/ghc-toolchain
+ utils/ghc-toolchain/exe
+ utils/unlit
+
+ -- The following are packages available on Hackage but included as submodules
+ https://hackage.haskell.org/package/directory-1.3.10.0/directory-1.3.10.0.tar.gz
+ https://hackage.haskell.org/package/file-io-0.1.5/file-io-0.1.5.tar.gz
+ https://hackage.haskell.org/package/filepath-1.5.4.0/filepath-1.5.4.0.tar.gz
+ https://hackage.haskell.org/package/os-string-2.0.8/os-string-2.0.8.tar.gz
+ https://hackage.haskell.org/package/process-1.6.29.0/process-1.6.29.0.tar.gz
+ https://hackage.haskell.org/package/semaphore-compat-1.0.0/semaphore-compat-1.0.0.tar.gz
+ https://hackage.haskell.org/package/unix-2.8.8.0/unix-2.8.8.0.tar.gz
+ https://hackage.haskell.org/package/Win32-2.14.2.1/Win32-2.14.2.1.tar.gz
+ -- hsc2hs: see source-repository-package below
+
+source-repository-package
+ type: git
+ location: https://github.com/stable-haskell/Cabal.git
+ tag: stable-haskell/master
+ subdir: Cabal
+ Cabal-syntax
+
+
+allow-newer: directory:*
+ , file-io:*
+ , os-string:*
+ , process:*
+ , semaphore-compat:*
+ , unix:*
+ , Win32:*
+ , hsc2hs:*
+
+--
+-- Constraints
+--
+
+constraints:
+ template-haskell <= 2.22
+
+--
+-- Package level configuration
+--
+
+package *
+ shared: False
+ executable-dynamic: False
+
+if !os(windows)
+ package *
+ library-for-ghci: True
+
+package ghc
+ flags: +bootstrap
+
+package ghci
+ flags: +bootstrap
+
+package ghc-boot
+ flags: +bootstrap
+
+package ghc-boot-th-next
+ flags: +bootstrap
+
+-- hsc2hs with batch cross-compilation support
+-- https://github.com/stable-haskell/hsc2hs/tree/feat/batch-cross-compilation
+source-repository-package
+ type: git
+ location: https://github.com/stable-haskell/hsc2hs.git
+ tag: d07eea1260894ce5fe456f881fbc62366c9eb1b7
diff --git a/cabal.project.stage2.common b/cabal.project.stage2.common
new file mode 100644
index 000000000000..10ae9bef9aa1
--- /dev/null
+++ b/cabal.project.stage2.common
@@ -0,0 +1,212 @@
+-- Configuration common to all stages
+import: cabal.project.common
+
+-- Disable Hackage, we explicitly include the packages we need.
+active-repositories: :none
+
+packages:
+ -- RTS
+ rts-headers
+ rts-fs
+ rts
+
+ -- Compiler
+ compiler
+ ghc
+
+ -- Internal libraries
+ libraries/base
+ libraries/ghc-bignum
+ libraries/ghc-boot
+ libraries/ghc-boot-th
+ libraries/ghc-compact
+ libraries/ghc-experimental
+ libraries/ghc-heap
+ libraries/ghc-internal
+ libraries/ghc-platform
+ libraries/ghc-prim
+ libraries/ghci
+ libraries/integer-gmp
+ libraries/system-cxx-std-lib
+ libraries/template-haskell
+
+ -- Internal tools
+ utils/deriveConstants
+ utils/genapply
+ utils/genprimopcode
+ utils/ghc-iserv
+ utils/ghc-pkg
+ utils/ghc-toolchain
+ utils/haddock
+ utils/haddock/haddock-api
+ utils/haddock/haddock-library
+ utils/hp2ps
+ utils/runghc
+ utils/unlit
+
+ -- The following are packages available on Hackage but included as submodules
+ -- https://hackage.haskell.org/package/hsc2hs-0.68.10/hsc2hs-0.68.10.tar.gz
+
+ https://hackage.haskell.org/package/Win32-2.14.2.1/Win32-2.14.2.1.tar.gz
+ https://hackage.haskell.org/package/array-0.5.8.0/array-0.5.8.0.tar.gz
+ https://hackage.haskell.org/package/binary-0.8.9.3/binary-0.8.9.3.tar.gz
+ https://hackage.haskell.org/package/bytestring-0.12.2.0/bytestring-0.12.2.0.tar.gz
+ https://hackage.haskell.org/package/containers-0.8/containers-0.8.tar.gz
+ https://hackage.haskell.org/package/deepseq-1.5.1.0/deepseq-1.5.1.0.tar.gz
+ https://hackage.haskell.org/package/directory-1.3.10.0/directory-1.3.10.0.tar.gz
+ https://hackage.haskell.org/package/exceptions-0.10.11/exceptions-0.10.11.tar.gz
+ https://hackage.haskell.org/package/file-io-0.1.5/file-io-0.1.5.tar.gz
+ https://hackage.haskell.org/package/filepath-1.5.4.0/filepath-1.5.4.0.tar.gz
+ https://hackage.haskell.org/package/haskeline-0.8.3.0/haskeline-0.8.3.0.tar.gz
+ https://hackage.haskell.org/package/hpc-0.7.0.2/hpc-0.7.0.2.tar.gz
+ https://hackage.haskell.org/package/libffi-clib-3.5.2/libffi-clib-3.5.2.tar.gz
+ https://hackage.haskell.org/package/mtl-2.3.1/mtl-2.3.1.tar.gz
+ https://hackage.haskell.org/package/os-string-2.0.8/os-string-2.0.8.tar.gz
+ https://hackage.haskell.org/package/parsec-3.1.18.0/parsec-3.1.18.0.tar.gz
+ https://hackage.haskell.org/package/pretty-1.1.3.6/pretty-1.1.3.6.tar.gz
+ https://hackage.haskell.org/package/process-1.6.29.0/process-1.6.29.0.tar.gz
+ https://hackage.haskell.org/package/semaphore-compat-1.0.0/semaphore-compat-1.0.0.tar.gz
+ https://hackage.haskell.org/package/stm-2.5.3.1/stm-2.5.3.1.tar.gz
+ https://hackage.haskell.org/package/template-haskell-lift-0.1.0.0/template-haskell-lift-0.1.0.0.tar.gz
+ https://hackage.haskell.org/package/template-haskell-quasiquoter-0.1.0.0/template-haskell-quasiquoter-0.1.0.0.tar.gz
+ https://hackage.haskell.org/package/text-2.1.3/text-2.1.3.tar.gz
+ https://hackage.haskell.org/package/time-1.15/time-1.15.tar.gz
+ https://hackage.haskell.org/package/transformers-0.6.1.2/transformers-0.6.1.2.tar.gz
+ https://hackage.haskell.org/package/unix-2.8.8.0/unix-2.8.8.0.tar.gz
+ https://hackage.haskell.org/package/xhtml-3000.2.2.1/xhtml-3000.2.2.1.tar.gz
+
+ -- These would be on Hackage but we include them as direct URLs
+ -- (Hackage is disabled by `active-repositories: :none`)
+ 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
+
+source-repository-package
+ type: git
+ location: https://github.com/stable-haskell/Cabal.git
+ tag: stable-haskell/master
+ subdir: Cabal
+ Cabal-syntax
+
+source-repository-package
+ type: git
+ location: https://github.com/stable-haskell/hpc-bin.git
+ tag: 5923da3fe77993b7afc15b5163cffcaa7da6ecf5
+
+if !os(windows)
+ packages:
+ https://hackage.haskell.org/package/terminfo-0.4.1.7/terminfo-0.4.1.7.tar.gz
+
+allow-newer: hsc2hs:*
+ , Win32:*
+ , array:*
+ , binary:*
+ , bytestring:*
+ , containers:*
+ , deepseq:*
+ , directory:*
+ , exceptions:*
+ , file-io:*
+ , filepath:*
+ , haskeline:*
+ , hpc:*
+ , libffi-clib:*
+ , mtl:*
+ , os-string:*
+ , parsec:*
+ , pretty:*
+ , process:*
+ , semaphore-compat:*
+ , stm:*
+ , terminfo:*
+ , text:*
+ , time:*
+ , transformers:*
+ , template-haskell-lift:*
+ , template-haskell-quasiquoter:*
+ , unix:*
+ , xhtml:*
+
+if !os(windows)
+ package *
+ library-for-ghci: True
+
+--
+-- Constraints
+--
+
+constraints:
+ -- we do not want to use the rts-headers from stage1
+ rts-headers source, rts-fs source
+ -- All build dependencies should be installed, i.e. from stage1.
+ -- I cannot write build:* but ghc-internal is enough to do the job.
+ , build:any.ghc-internal installed
+
+--
+-- Package level configuration
+--
+
+package libffi-clib
+ ghc-options: -no-rts -optc-Wno-error
+
+-- We end up injecting the following depednency:
+--
+-- ghc-internal
+-- '- rts:
+-- '- rts
+--
+-- Because the ghc-internal package depends on the
+-- rts implementation (in the sublib), however GHC
+-- is responsible for dependency injecting the right
+-- implementation.
+--
+-- During the bootsrap phase of building GHC, there
+-- is a race condition where ghc-bin depends on
+-- the rts: and also on ghc-internal, hence
+-- we can occationally end up in the state where we
+-- try to build the ghc-internal library, while the
+-- rts: isn't yet built.
+--
+-- Modelling this in cabal properly is hard. Relying
+-- on chance to build it in the right sequence is
+-- also bad. Disabling this check outright in ghc
+-- is bad because under all circumstances (except
+-- bootstrapping) this is an essential dependency that
+-- must exist.
+--
+-- MAYBE: a better option is to push this check to
+-- the link time only. However we then don't
+-- have the ghc-internal available earlier
+-- throughout the session. See
+-- GHC.Unit.State:mkUnitState
+--
+
+package ghc
+ flags: +build-tool-depends +internal-interpreter
+
+package ghc-bin
+ flags: +internal-interpreter
+
+package ghci
+ flags: +internal-interpreter
+
+package ghc-internal
+ flags: +bignum-native
+ ghc-options: -no-rts
+
+package rts
+ ghc-options: -no-rts
+ flags: +tables-next-to-code
+
+package rts-headers
+ ghc-options: -no-rts
+
+package rts-fs
+ ghc-options: -no-rts
+
+-- hsc2hs with batch cross-compilation support
+-- https://github.com/stable-haskell/hsc2hs/tree/feat/batch-cross-compilation
+source-repository-package
+ type: git
+ location: https://github.com/stable-haskell/hsc2hs.git
+ tag: d07eea1260894ce5fe456f881fbc62366c9eb1b7
diff --git a/cabal.project.stage2.dynamic b/cabal.project.stage2.dynamic
new file mode 100644
index 000000000000..1a6ed5e16acb
--- /dev/null
+++ b/cabal.project.stage2.dynamic
@@ -0,0 +1,13 @@
+-- Dynamic stage2 build (DYNAMIC=1).
+--
+-- All shared stage2 configuration lives in cabal.project.stage2.common; this
+-- file only selects shared libraries, dynamic executables and the dynamic RTS.
+-- The Makefile uses this project file when DYNAMIC=1.
+import: cabal.project.stage2.common
+
+package *
+ shared: True
+ executable-dynamic: True
+
+constraints:
+ rts +dynamic
diff --git a/cabal.project.stage2.static b/cabal.project.stage2.static
new file mode 100644
index 000000000000..9a899dae9992
--- /dev/null
+++ b/cabal.project.stage2.static
@@ -0,0 +1,10 @@
+-- Static stage2 build (default).
+--
+-- All shared stage2 configuration lives in cabal.project.stage2.common; this
+-- file only selects static libraries. The Makefile uses this project file when
+-- DYNAMIC is not set to 1.
+import: cabal.project.stage2.common
+
+package *
+ shared: False
+ executable-dynamic: False
diff --git a/cabal.project.stage3 b/cabal.project.stage3
new file mode 100644
index 000000000000..183963cfe328
--- /dev/null
+++ b/cabal.project.stage3
@@ -0,0 +1,204 @@
+-- Configuration common to all stages
+import: cabal.project.common
+
+-- Disable Hackage, we explicitly include the packages we need.
+active-repositories: :none
+
+packages:
+ -- RTS
+ rts-headers
+ rts-fs
+ rts
+
+ -- Compiler
+ compiler
+
+ -- Internal libraries
+ libraries/base
+ libraries/ghc-bignum
+ libraries/ghc-boot
+ libraries/ghc-boot-th
+ libraries/ghc-compact
+ libraries/ghc-experimental
+ libraries/ghc-heap
+ libraries/ghc-internal
+ libraries/ghc-platform
+ libraries/ghc-prim
+ libraries/ghci
+ libraries/integer-gmp
+ libraries/system-cxx-std-lib
+ libraries/template-haskell
+
+ -- Internal tools
+ utils/genprimopcode
+ utils/deriveConstants
+
+ -- The following are packages available on Hackage but included as submodules
+ https://hackage.haskell.org/package/array-0.5.8.0/array-0.5.8.0.tar.gz
+ https://hackage.haskell.org/package/binary-0.8.9.3/binary-0.8.9.3.tar.gz
+ https://hackage.haskell.org/package/bytestring-0.12.2.0/bytestring-0.12.2.0.tar.gz
+ https://hackage.haskell.org/package/containers-0.8/containers-0.8.tar.gz
+ https://hackage.haskell.org/package/deepseq-1.5.1.0/deepseq-1.5.1.0.tar.gz
+ https://hackage.haskell.org/package/directory-1.3.10.0/directory-1.3.10.0.tar.gz
+ https://hackage.haskell.org/package/exceptions-0.10.11/exceptions-0.10.11.tar.gz
+ https://hackage.haskell.org/package/file-io-0.1.5/file-io-0.1.5.tar.gz
+ https://hackage.haskell.org/package/filepath-1.5.4.0/filepath-1.5.4.0.tar.gz
+ https://hackage.haskell.org/package/hpc-0.7.0.2/hpc-0.7.0.2.tar.gz
+ https://hackage.haskell.org/package/mtl-2.3.1/mtl-2.3.1.tar.gz
+ https://hackage.haskell.org/package/os-string-2.0.8/os-string-2.0.8.tar.gz
+ https://hackage.haskell.org/package/parsec-3.1.18.0/parsec-3.1.18.0.tar.gz
+ https://hackage.haskell.org/package/pretty-1.1.3.6/pretty-1.1.3.6.tar.gz
+ https://hackage.haskell.org/package/process-1.6.29.0/process-1.6.29.0.tar.gz
+ https://hackage.haskell.org/package/semaphore-compat-1.0.0/semaphore-compat-1.0.0.tar.gz
+ https://hackage.haskell.org/package/stm-2.5.3.1/stm-2.5.3.1.tar.gz
+ https://hackage.haskell.org/package/text-2.1.3/text-2.1.3.tar.gz
+ https://hackage.haskell.org/package/time-1.15/time-1.15.tar.gz
+ https://hackage.haskell.org/package/transformers-0.6.1.2/transformers-0.6.1.2.tar.gz
+ https://hackage.haskell.org/package/unix-2.8.8.0/unix-2.8.8.0.tar.gz
+ https://hackage.haskell.org/package/Win32-2.14.2.1/Win32-2.14.2.1.tar.gz
+ https://hackage.haskell.org/package/xhtml-3000.2.2.1/xhtml-3000.2.2.1.tar.gz
+
+ -- These would be on Hackage but we include them as direct URLs
+ -- (Hackage is disabled by `active-repositories: :none`)
+ 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
+
+source-repository-package
+ type: git
+ location: https://github.com/stable-haskell/Cabal.git
+ tag: stable-haskell/master
+ subdir: Cabal
+ Cabal-syntax
+
+allow-newer: array:*
+ , binary:*
+ , bytestring:*
+ , containers:*
+ , deepseq:*
+ , directory:*
+ , exceptions:*
+ , file-io:*
+ , filepath:*
+ , hpc:*
+ , mtl:*
+ , os-string:*
+ , parsec:*
+ , pretty:*
+ , process:*
+ , semaphore-compat:*
+ , stm:*
+ , text:*
+ , time:*
+ , transformers:*
+ , unix:*
+ , Win32:*
+ , xhtml:*
+
+
+--
+-- Constraints
+--
+
+constraints:
+ -- I cannot write build:* but ghc-internal is enough to do the job.
+ -- FIXME: it should be possible to write build:*
+ -- All build dependencies should be installed, i.e. from stage1.
+ build:any.ghc-internal installed,
+
+ -- for some reason cabal things these are already installed for the target,
+ -- although they only exist in the build compiler package db
+ Cabal source,
+ Cabal-syntax source,
+ array source,
+ base source,
+ binary source,
+ bytestring source,
+ containers source,
+ deepseq source,
+ directory source,
+ exceptions source,
+ file-io source,
+ filepath source,
+ ghc-bignum source,
+ hpc source,
+ integer-gmp source,
+ mtl source,
+ os-string source,
+ parsec source,
+ pretty source,
+ process source,
+ rts source,
+ rts-headers source,
+ rts-fs source,
+ stm source,
+ system-cxx-std-lib source,
+ template-haskell source,
+ text source,
+ time source,
+ transformers source,
+ unix source,
+ xhtml source,
+ Win32 source
+
+--
+-- Package level configuration
+--
+
+package *
+ shared: False
+ executable-dynamic: False
+
+ -- library-for-ghci will cause a `ld -r` call to create pre-linked objects.
+ -- This helps the internal linker when trying to link (.a) archives with massive
+ -- displacements. In that case the displacement can be in excess of what
+ -- is possible to relocate, and the linker fails. Pre-linking the objects helps with
+ -- this (and linking performance, as we need to process fewer relocations).
+ --
+ -- For some cross targets like JavaScript, this will fail as the $LD -r invocation
+ -- might not be properly supported.
+ --
+ -- fs.o: file not recognized: file format not recognized
+ --
+ -- Thus for cross compilers, we outright disable this here. The primary offending
+ -- library is libHSghc, which can easily be 150MB+
+ --
+ -- TODO: this is rather fragile, and should be fixed properly by making pre-linked
+ -- objects of have GHC pre-link excessively large archives on-demand.
+ library-for-ghci: False
+
+-- libffi-clib: only needed for native builds; WASM/WASI uses the system
+-- libffi stub from wasi-sdk instead (see +use-system-libffi on package rts).
+package libffi-clib
+ ghc-options: -no-rts
+
+-- WASM/WASI-specific overrides:
+-- - shared: True is required for GHCi/TH via dyld.mjs
+-- - +use-system-libffi is already set unconditionally on package rts above,
+-- but we keep this block for clarity and future conditional changes.
+if os(wasi)
+ package *
+ shared: True
+
+package ghc
+ flags: +build-tool-depends +internal-interpreter
+
+package ghc-bin
+ flags: +internal-interpreter
+
+package ghci
+ flags: +internal-interpreter +use-system-libffi
+
+package ghc-internal
+ flags: +bignum-native
+ ghc-options: -no-rts
+
+package rts
+ ghc-options: -no-rts
+ flags: +use-system-libffi -tables-next-to-code
+
+package rts-headers
+ ghc-options: -no-rts
+
+package rts-fs
+ ghc-options: -no-rts
diff --git a/compiler/CodeGen.Platform.h b/compiler/CodeGen.Platform.h
index fb0936264962..8e78dab34b62 100644
--- a/compiler/CodeGen.Platform.h
+++ b/compiler/CodeGen.Platform.h
@@ -7,7 +7,7 @@ import GHC.Utils.Panic.Plain
#endif
import GHC.Platform.Reg
-#include "MachRegs.h"
+#include "stg/MachRegs.h"
#if defined(MACHREGS_i386) || defined(MACHREGS_x86_64)
diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index 47079a4559ee..1569924f8921 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -337,7 +337,6 @@ module GHC (
import GHC.Prelude hiding (init)
import GHC.Platform
-import GHC.Platform.Ways
import GHC.Driver.Phases ( Phase(..), isHaskellSrcFilename
, isSourceFilename, startPhase )
@@ -351,7 +350,6 @@ import GHC.Driver.Backend
import GHC.Driver.Config.Finder (initFinderOpts)
import GHC.Driver.Config.Parser (initParserOpts)
import GHC.Driver.Config.Logger (initLogFlags)
-import GHC.Driver.Config.StgToJS (initStgToJSConfig)
import GHC.Driver.Config.Diagnostic
import GHC.Driver.Main
import GHC.Driver.Make
@@ -360,10 +358,11 @@ import GHC.Driver.Monad
import GHC.Driver.Ppr
import GHC.ByteCode.Types
-import qualified GHC.Linker.Loader as Loader
import GHC.Runtime.Loader
import GHC.Runtime.Eval
import GHC.Runtime.Interpreter
+import GHC.Runtime.Interpreter.Init
+import GHC.Driver.Config.Interpreter
import GHC.Runtime.Context
import GHCi.RemoteTypes
@@ -439,10 +438,8 @@ import GHC.Unit.Module.ModSummary
import GHC.Unit.Module.Graph
import GHC.Unit.Home.ModInfo
import qualified GHC.Unit.Home.Graph as HUG
-import GHC.Settings
import Control.Applicative ((<|>))
-import Control.Concurrent
import Control.Monad
import Control.Monad.Catch as MC
import Data.Foldable
@@ -712,100 +709,16 @@ setTopSessionDynFlags :: GhcMonad m => DynFlags -> m ()
setTopSessionDynFlags dflags = do
hsc_env <- getSession
logger <- getLogger
- lookup_cache <- liftIO $ mkInterpSymbolCache
-
- -- see Note [Target code interpreter]
- interp <- if
- -- Wasm dynamic linker
- | ArchWasm32 <- platformArch $ targetPlatform dflags
- -> do
- s <- liftIO $ newMVar InterpPending
- loader <- liftIO Loader.uninitializedLoader
- dyld <- liftIO $ makeAbsolute $ topDir dflags "dyld.mjs"
-#if defined(wasm32_HOST_ARCH)
- let libdir = sorry "cannot spawn child process on wasm"
-#else
- libdir <- liftIO $ last <$> Loader.getGccSearchDirectory logger dflags "libraries"
-#endif
- let profiled = ways dflags `hasWay` WayProf
- way_tag = if profiled then "_p" else ""
- let cfg =
- WasmInterpConfig
- { wasmInterpDyLD = dyld,
- wasmInterpLibDir = libdir,
- wasmInterpOpts = getOpts dflags opt_i,
- wasmInterpBrowser = gopt Opt_GhciBrowser dflags,
- wasmInterpBrowserHost = ghciBrowserHost dflags,
- wasmInterpBrowserPort = ghciBrowserPort dflags,
- wasmInterpBrowserRedirectWasiConsole = gopt Opt_GhciBrowserRedirectWasiConsole dflags,
- wasmInterpBrowserPuppeteerLaunchOpts = ghciBrowserPuppeteerLaunchOpts dflags,
- wasmInterpBrowserPlaywrightBrowserType = ghciBrowserPlaywrightBrowserType dflags,
- wasmInterpBrowserPlaywrightLaunchOpts = ghciBrowserPlaywrightLaunchOpts dflags,
- wasmInterpTargetPlatform = targetPlatform dflags,
- wasmInterpProfiled = profiled,
- wasmInterpHsSoSuffix = way_tag ++ dynLibSuffix (ghcNameVersion dflags),
- wasmInterpUnitState = ue_homeUnitState $ hsc_unit_env hsc_env
- }
- pure $ Just $ Interp (ExternalInterp $ ExtWasm $ ExtInterpState cfg s) loader lookup_cache
-
- -- JavaScript interpreter
- | ArchJavaScript <- platformArch (targetPlatform dflags)
- -> do
- s <- liftIO $ newMVar InterpPending
- loader <- liftIO Loader.uninitializedLoader
- let cfg = JSInterpConfig
- { jsInterpNodeConfig = defaultNodeJsSettings
- , jsInterpScript = topDir dflags "ghc-interp.js"
- , jsInterpTmpFs = hsc_tmpfs hsc_env
- , jsInterpTmpDir = tmpDir dflags
- , jsInterpLogger = hsc_logger hsc_env
- , jsInterpCodegenCfg = initStgToJSConfig dflags
- , jsInterpUnitEnv = hsc_unit_env hsc_env
- , jsInterpFinderOpts = initFinderOpts dflags
- , jsInterpFinderCache = hsc_FC hsc_env
- }
- return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader lookup_cache))
-
- -- external interpreter
- | gopt Opt_ExternalInterpreter dflags
- -> do
- let
- prog = pgm_i dflags ++ flavour
- profiled = ways dflags `hasWay` WayProf
- dynamic = ways dflags `hasWay` WayDyn
- flavour
- | profiled && dynamic = "-prof-dyn"
- | profiled = "-prof"
- | dynamic = "-dyn"
- | otherwise = ""
- msg = text "Starting " <> text prog
- tr <- if verbosity dflags >= 3
- then return (logInfo logger $ withPprStyle defaultDumpStyle msg)
- else return (pure ())
- let
- conf = IServConfig
- { iservConfProgram = prog
- , iservConfOpts = getOpts dflags opt_i
- , iservConfProfiled = profiled
- , iservConfDynamic = dynamic
- , iservConfHook = createIservProcessHook (hsc_hooks hsc_env)
- , iservConfTrace = tr
- }
- s <- liftIO $ newMVar InterpPending
- loader <- liftIO Loader.uninitializedLoader
- return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader lookup_cache))
-
- -- Internal interpreter
- | otherwise
- ->
-#if defined(HAVE_INTERNAL_INTERPRETER)
- do
- loader <- liftIO Loader.uninitializedLoader
- return (Just (Interp InternalInterp loader lookup_cache))
-#else
- return Nothing
-#endif
-
+ let platform = targetPlatform dflags
+ let unit_env = hsc_unit_env hsc_env
+ let tmpfs = hsc_tmpfs hsc_env
+ let finder_cache = hsc_FC hsc_env
+ interp_opts' <- liftIO $ initInterpOpts dflags
+ let interp_opts = interp_opts'
+ { interpCreateProcess = createIservProcessHook (hsc_hooks hsc_env)
+ }
+
+ interp <- liftIO $ initInterpreter tmpfs logger platform finder_cache unit_env interp_opts
modifySession $ \h -> hscSetFlags dflags
h{ hsc_IC = (hsc_IC h){ ic_dflags = dflags }
diff --git a/compiler/GHC/Builtin/PrimOps.hs b/compiler/GHC/Builtin/PrimOps.hs
index d4d982427597..2273d34f9c3d 100644
--- a/compiler/GHC/Builtin/PrimOps.hs
+++ b/compiler/GHC/Builtin/PrimOps.hs
@@ -25,7 +25,9 @@ module GHC.Builtin.PrimOps (
getPrimOpResultInfo, isComparisonPrimOp, PrimOpResultInfo(..),
- PrimCall(..)
+ PrimCall(..),
+
+ primOpPrimModule, primOpWrappersModule
) where
import GHC.Prelude
@@ -171,6 +173,12 @@ primOpDocs :: [(FastString, String)]
primOpDeprecations :: [(OccName, FastString)]
#include "primop-deprecations.hs-incl"
+primOpPrimModule :: String
+#include "primop-prim-module.hs-incl"
+
+primOpWrappersModule :: String
+#include "primop-wrappers-module.hs-incl"
+
{-
************************************************************************
* *
diff --git a/compiler/GHC/ByteCode/Asm.hs b/compiler/GHC/ByteCode/Asm.hs
index 9160d0531f0a..f47cbdcddf8e 100644
--- a/compiler/GHC/ByteCode/Asm.hs
+++ b/compiler/GHC/ByteCode/Asm.hs
@@ -532,7 +532,7 @@ countSmall big x = count big False x
-- Bring in all the bci_ bytecode constants.
-#include "Bytecodes.h"
+#include "rts/Bytecodes.h"
largeArgInstr :: Word16 -> Word16
largeArgInstr bci = bci_FLAG_LARGE_ARGS .|. bci
diff --git a/compiler/GHC/ByteCode/Linker.hs b/compiler/GHC/ByteCode/Linker.hs
index 60e0d7792d35..800da85ce58f 100644
--- a/compiler/GHC/ByteCode/Linker.hs
+++ b/compiler/GHC/ByteCode/Linker.hs
@@ -190,26 +190,57 @@ resolvePtr interp pkgs_loaded le lb bco_ix ptr = case ptr of
withForeignRef (expectJust (lookupModuleEnv (breakarray_env lb) tick_mod)) $
\ba -> pure $ ResolvedBCOPtrBreakArray ba
+{-
+Note [Symbol lookup order for boot libraries]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When looking up symbols for bytecode linking, we must check the main program's
+symbol table BEFORE looking in dynamically loaded libraries. This is critical
+for boot library symbols like 'stdout' from ghc-internal.
+
+The issue: When GHC compiles Template Haskell code, it loads boot libraries
+(like ghc-internal) as dynamic libraries for bytecode execution. These
+dynamically loaded libraries contain their OWN copies of CAFs (Constant
+Applicative Forms) like 'stdout'. If bytecode uses the DLL's stdout instead
+of GHC's native stdout, output buffering becomes inconsistent:
+
+ - GHC's native code flushes GHC's stdout
+ - Bytecode writes to DLL's stdout (a different buffer!)
+ - Output is lost because the wrong buffer is flushed
+
+The fix: Look up symbols in the main program first (via lookupSymbol, which
+uses dlsym(RTLD_DEFAULT) and checks the main executable before loaded
+libraries). Only if not found there do we search the loaded DLLs.
+
+This aligns with the RTS's internal_dlsym() which also checks the main
+program first. See Note [RTLD_LOCAL] in rts/Linker.c.
+-}
+
-- | Look up the address of a Haskell symbol in the currently
-- loaded units.
--
-- See Note [Looking up symbols in the relevant objects].
+-- See Note [Symbol lookup order for boot libraries].
lookupHsSymbol :: Interp -> PkgsLoaded -> InterpSymbol (Suffix s) -> IO (Maybe (Ptr ()))
lookupHsSymbol interp pkgs_loaded sym_to_find = do
massertPpr (isExternalName (interpSymbolName sym_to_find)) (ppr sym_to_find)
let pkg_id = moduleUnitId $ nameModule (interpSymbolName sym_to_find)
loaded_dlls = maybe [] loaded_pkg_hs_dlls $ lookupUDFM pkgs_loaded pkg_id
- go (dll:dlls) = do
- mb_ptr <- lookupSymbolInDLL interp dll sym_to_find
- case mb_ptr of
- Just ptr -> pure (Just ptr)
- Nothing -> go dlls
- go [] =
- -- See Note [Symbols may not be found in pkgs_loaded] in GHC.Linker.Types
- lookupSymbol interp sym_to_find
-
- go loaded_dlls
+ -- First try the main program / global symbol table.
+ -- This is important for boot library symbols (like stdout from ghc-internal)
+ -- to ensure bytecode uses the same CAFs as GHC's native code.
+ -- See Note [Symbol lookup order for boot libraries].
+ mb_main <- lookupSymbol interp sym_to_find
+ case mb_main of
+ Just ptr -> pure (Just ptr)
+ Nothing -> go loaded_dlls
+ where
+ go (dll:dlls) = do
+ mb_ptr <- lookupSymbolInDLL interp dll sym_to_find
+ case mb_ptr of
+ Just ptr -> pure (Just ptr)
+ Nothing -> go dlls
+ go [] = pure Nothing
linkFail :: String -> SDoc -> IO a
linkFail who what
@@ -223,7 +254,7 @@ linkFail who what
, "flags, or simply by naming the relevant files on the GHCi command line."
, "Alternatively, this link failure might indicate a bug in GHCi."
, "If you suspect the latter, please report this as a GHC bug:"
- , " https://www.haskell.org/ghc/reportabug"
+ , " https://github.com/stable-haskell/ghc/issues"
])
diff --git a/compiler/GHC/ByteCode/Types.hs b/compiler/GHC/ByteCode/Types.hs
index 611ac8550b18..0796728f5331 100644
--- a/compiler/GHC/ByteCode/Types.hs
+++ b/compiler/GHC/ByteCode/Types.hs
@@ -49,7 +49,9 @@ import GHCi.ResolvedBCO ( BCOByteArray(..), mkBCOByteArray )
import Foreign
import Data.ByteString (ByteString)
+#ifndef BOOTSTRAPPING
import qualified GHC.Exts.Heap as Heap
+#endif
import GHC.Cmm.Expr ( GlobalRegSet, emptyRegSet, regSetToList )
import GHC.Unit.Module
@@ -166,8 +168,13 @@ type AddrEnv = NameEnv (Name, AddrPtr)
-- We need the Name in the range so we know which
-- elements to filter out when unloading a module
+#ifndef BOOTSTRAPPING
newtype ItblPtr = ItblPtr (RemotePtr Heap.StgInfoTable)
deriving (Show, NFData)
+#else
+newtype ItblPtr = ItblPtr (RemotePtr ())
+ deriving (Show, NFData)
+#endif
newtype AddrPtr = AddrPtr (RemotePtr ())
deriving (NFData)
diff --git a/compiler/GHC/Cmm/Sink.hs b/compiler/GHC/Cmm/Sink.hs
index e311fabac1cf..653e655f82ff 100644
--- a/compiler/GHC/Cmm/Sink.hs
+++ b/compiler/GHC/Cmm/Sink.hs
@@ -26,76 +26,74 @@ import Data.Maybe
import GHC.Exts (inline)
--- -----------------------------------------------------------------------------
--- Sinking and inlining
+--------------------------------------------------------------------------------
+{- Note [Sinking and inlining]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Sinking is an optimisation pass that
+ (a) moves assignments closer to their uses, to reduce register pressure
+ (b) pushes assignments into a single branch of a conditional if possible
+ (c) inlines assignments to registers that are mentioned only once
+ (d) discards dead assignments
--- This is an optimisation pass that
--- (a) moves assignments closer to their uses, to reduce register pressure
--- (b) pushes assignments into a single branch of a conditional if possible
--- (c) inlines assignments to registers that are mentioned only once
--- (d) discards dead assignments
---
--- This tightens up lots of register-heavy code. It is particularly
--- helpful in the Cmm generated by the Stg->Cmm code generator, in
--- which every function starts with a copyIn sequence like:
---
--- x1 = R1
--- x2 = Sp[8]
--- x3 = Sp[16]
--- if (Sp - 32 < SpLim) then L1 else L2
---
--- we really want to push the x1..x3 assignments into the L2 branch.
---
--- Algorithm:
---
--- * Start by doing liveness analysis.
---
--- * Keep a list of assignments A; earlier ones may refer to later ones.
--- Currently we only sink assignments to local registers, because we don't
--- have liveness information about global registers.
---
--- * Walk forwards through the graph, look at each node N:
---
--- * If it is a dead assignment, i.e. assignment to a register that is
--- not used after N, discard it.
---
--- * Try to inline based on current list of assignments
--- * If any assignments in A (1) occur only once in N, and (2) are
--- not live after N, inline the assignment and remove it
--- from A.
---
--- * If an assignment in A is cheap (RHS is local register), then
--- inline the assignment and keep it in A in case it is used afterwards.
---
--- * Otherwise don't inline.
---
--- * If N is assignment to a local register pick up the assignment
--- and add it to A.
---
--- * If N is not an assignment to a local register:
--- * remove any assignments from A that conflict with N, and
--- place them before N in the current block. We call this
--- "dropping" the assignments.
---
--- * An assignment conflicts with N if it:
--- - assigns to a register mentioned in N
--- - mentions a register assigned by N
--- - reads from memory written by N
--- * do this recursively, dropping dependent assignments
---
--- * At an exit node:
--- * drop any assignments that are live on more than one successor
--- and are not trivial
--- * if any successor has more than one predecessor (a join-point),
--- drop everything live in that successor. Since we only propagate
--- assignments that are not dead at the successor, we will therefore
--- eliminate all assignments dead at this point. Thus analysis of a
--- join-point will always begin with an empty list of assignments.
---
---
--- As a result of above algorithm, sinking deletes some dead assignments
--- (transitively, even). This isn't as good as removeDeadAssignments,
--- but it's much cheaper.
+This tightens up lots of register-heavy code. It is particularly
+helpful in the Cmm generated by the Stg->Cmm code generator, in
+which every function starts with a copyIn sequence like:
+
+ x1 = R1
+ x2 = Sp[8]
+ x3 = Sp[16]
+ if (Sp - 32 < SpLim) then L1 else L2
+
+we really want to push the x1..x3 assignments into the L2 branch.
+
+Algorithm:
+
+ * Start by doing liveness analysis.
+
+ * Keep a list of assignments A; earlier ones may refer to later ones.
+ Currently we only sink assignments to local registers, because we don't
+ have liveness information about global registers.
+
+ * Walk forwards through the graph, look at each node N:
+
+ * If it is a dead assignment, i.e. assignment to a register that is
+ not used after N, discard it.
+
+ * Try to inline based on current list of assignments
+ * If any assignments in A (1) occur only once in N, and (2) are
+ not live after N, inline the assignment and remove it
+ from A.
+
+ * If an assignment in A is cheap (RHS is local register), then
+ inline the assignment and keep it in A in case it is used afterwards.
+
+ * Otherwise don't inline.
+
+ * If N is an assignment to a local register, pick up the assignment
+ and add it to A.
+
+ * If N is not an assignment to a local register:
+ * remove any assignments from A that conflict with N, and
+ place them before N in the current block. We call this
+ "dropping" the assignments.
+ (See Note [When does an assignment conflict?] for what it means for
+ A to conflict with N.)
+
+ * do this recursively, dropping dependent assignments
+
+ * At an exit node:
+ * drop any assignments that are live on more than one successor
+ and are not trivial
+ * if any successor has more than one predecessor (a join-point),
+ drop everything live in that successor. Since we only propagate
+ assignments that are not dead at the successor, we will therefore
+ eliminate all assignments dead at this point. Thus analysis of a
+ join-point will always begin with an empty list of assignments.
+
+As a result of above algorithm, sinking deletes some dead assignments
+(transitively, even). This isn't as good as removeDeadAssignments,
+but it's much cheaper.
+-}
-- -----------------------------------------------------------------------------
-- things that we aren't optimising very well yet.
@@ -648,110 +646,171 @@ okToInline _ _ _ = True
-- -----------------------------------------------------------------------------
+{- Note [When does an assignment conflict?]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+An assignment 'A' conflicts with a statement 'N' if any of the following
+conditions are satisfied:
+
+ (C1) 'A' assigns to a register mentioned in 'N'
+ (C2) 'A' mentions a register assigned by 'N'
+ (C3) 'A' reads from memory written by 'N'
+
+In such a situation, it is not safe to commute 'A' past 'N'. For example,
+it is not safe to commute
+
+ A: r = 1
+ N: s = r
+
+because 'r' may be undefined or hold a different value before 'A'.
+
+Remarks:
+
+ (C3) includes all foreign calls, as they may modify the heap/stack.
+
+ (C1) includes the following two situations:
+
+ (C1a) 'N' defines the LHS register in the assignment 'A', for example:
+
+ A: r =
+ N: r =
+
+ (C1b) 'N' defines a register used in the RHS of 'A', for example:
+
+ A: r = s
+ N: s =
+
+ (C1c) 'suspendThread' clobbers every global register not backed by a
+ real register, as noted in #19237.
+
+Forgetting (C1a) led to bug #26550, in which we incorrectly commuted
+
+ A: _c1rB::Fx2V128 = <0.0 :: W64, 0.0 :: W64>
+ N: _c1rB::Fx2V128 = %MO_VF_Insert_2_W64(<0.0 :: W64,0.0 :: W64>,%MO_F_Add_W64(F64[R1 + 7], 3.0 :: W64),0 :: W32)
+
+-}
+
-- | @conflicts (r,e) node@ is @False@ if and only if the assignment
-- @r = e@ can be safely commuted past statement @node@.
+--
+-- See Note [When does an assignment conflict?].
conflicts :: Platform -> Assignment -> CmmNode O x -> Bool
-conflicts platform (r, rhs, addr) node
+conflicts platform assig@(r, rhs, addr) node
- -- (1) node defines registers used by rhs of assignment. This catches
- -- assignments and all three kinds of calls. See Note [Sinking and calls]
- | globalRegistersConflict platform rhs node = True
- | localRegistersConflict platform rhs node = True
+ -- (C1) node defines registers that are either the assigned register or
+ -- are used by the rhs of the assignment.
+ -- This catches assignments and all three kinds of calls.
+ -- See Note [Sinking and calls]
+ | globalRegistersConflict platform rhs node = True
+ | localRegistersConflict platform assig node = True
- -- (2) node uses register defined by assignment
+ -- (C2) node uses register defined by assignment
| foldRegsUsed platform (\b r' -> r == r' || b) False node = True
- -- (3) a store to an address conflicts with a read of the same memory
+ -- (C3) Node writes to memory that is read by the assignment.
+
+ -- (a) a store to an address conflicts with a read of the same memory
| CmmStore addr' e _ <- node
, memConflicts addr (loadAddr platform addr' (cmmExprWidth platform e)) = True
- -- (4) an assignment to Hp/Sp conflicts with a heap/stack read respectively
- | HeapMem <- addr, CmmAssign (CmmGlobal (GlobalRegUse Hp _)) _ <- node = True
- | StackMem <- addr, CmmAssign (CmmGlobal (GlobalRegUse Sp _)) _ <- node = True
- | SpMem{} <- addr, CmmAssign (CmmGlobal (GlobalRegUse Sp _)) _ <- node = True
+ -- (b) an assignment to Hp/Sp conflicts with a heap/stack read respectively
+ | CmmAssign (CmmGlobal (GlobalRegUse Hp _)) _ <- node
+ , memConflicts addr HeapMem
+ = True
+ | CmmAssign (CmmGlobal (GlobalRegUse Sp _)) _ <- node
+ , memConflicts addr StackMem
+ = True
- -- (5) foreign calls clobber heap: see Note [Foreign calls clobber heap]
+ -- (c) foreign calls clobber heap: see Note [Foreign calls clobber heap]
| CmmUnsafeForeignCall{} <- node, memConflicts addr AnyMem = True
- -- (6) suspendThread clobbers every global register not backed by a real
- -- register. It also clobbers heap and stack but this is handled by (5)
+ -- (d) native calls clobber any memory
+ | CmmCall{} <- node, memConflicts addr AnyMem = True
+
+ -- (C1c) suspendThread clobbers every global register not backed by a real
+ -- register. (It also clobbers heap and stack, but this is handled by (C3)(c) above.)
| CmmUnsafeForeignCall (PrimTarget MO_SuspendThread) _ _ <- node
, foldRegsUsed platform (\b g -> globalRegMaybe platform g == Nothing || b) False rhs
= True
- -- (7) native calls clobber any memory
- | CmmCall{} <- node, memConflicts addr AnyMem = True
-
- -- (8) otherwise, no conflict
| otherwise = False
{- Note [Inlining foldRegsDefd]
- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- foldRegsDefd is, after optimization, *not* a small function so
- it's only marked INLINEABLE, but not INLINE.
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+foldRegsDefd is, after optimization, *not* a small function so
+it's only marked INLINEABLE, but not INLINE.
- However in some specific cases we call it *very* often making it
- important to avoid the overhead of allocating the folding function.
-
- So we simply force inlining via the magic inline function.
- For T3294 this improves allocation with -O by ~1%.
+However in some specific cases we call it *very* often making it
+important to avoid the overhead of allocating the folding function.
+So we simply force inlining via the magic inline function.
+For T3294 this improves allocation with -O by ~1%.
-}
--- Returns True if node defines any global registers that are used in the
--- Cmm expression
+-- | Returns @True@ if @node@ defines any global registers that are used in the
+-- Cmm expression.
+--
+-- See (C1) in Note [When does an assignment conflict?].
globalRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool
globalRegistersConflict platform expr node =
-- See Note [Inlining foldRegsDefd]
inline foldRegsDefd platform (\b r -> b || globalRegUsedIn platform (globalRegUse_reg r) expr)
False node
+ -- NB: no need to worry about (C1a), as the LHS of an assignment is always
+ -- a local register, never a global register.
--- Returns True if node defines any local registers that are used in the
--- Cmm expression
-localRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool
-localRegistersConflict platform expr node =
- -- See Note [Inlining foldRegsDefd]
- inline foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmLocal r) expr)
- False node
-
--- Note [Sinking and calls]
--- ~~~~~~~~~~~~~~~~~~~~~~~~
--- We have three kinds of calls: normal (CmmCall), safe foreign (CmmForeignCall)
--- and unsafe foreign (CmmUnsafeForeignCall). We perform sinking pass after
--- stack layout (see Note [Sinking after stack layout]) which leads to two
--- invariants related to calls:
---
--- a) during stack layout phase all safe foreign calls are turned into
--- unsafe foreign calls (see Note [Lower safe foreign calls]). This
--- means that we will never encounter CmmForeignCall node when running
--- sinking after stack layout
---
--- b) stack layout saves all variables live across a call on the stack
--- just before making a call (remember we are not sinking assignments to
--- stack):
---
--- L1:
--- x = R1
--- P64[Sp - 16] = L2
--- P64[Sp - 8] = x
--- Sp = Sp - 16
--- call f() returns L2
--- L2:
---
--- We will attempt to sink { x = R1 } but we will detect conflict with
--- { P64[Sp - 8] = x } and hence we will drop { x = R1 } without even
--- checking whether it conflicts with { call f() }. In this way we will
--- never need to check any assignment conflicts with CmmCall. Remember
--- that we still need to check for potential memory conflicts.
---
--- So the result is that we only need to worry about CmmUnsafeForeignCall nodes
--- when checking conflicts (see Note [Unsafe foreign calls clobber caller-save registers]).
--- This assumption holds only when we do sinking after stack layout. If we run
--- it before stack layout we need to check for possible conflicts with all three
--- kinds of calls. Our `conflicts` function does that by using a generic
--- foldRegsDefd and foldRegsUsed functions defined in DefinerOfRegs and
--- UserOfRegs typeclasses.
+-- | Given an assignment @local_reg := expr@, return @True@ if @node@ defines any
+-- local registers mentioned in the assignment.
--
+-- See (C1) in Note [When does an assignment conflict?].
+localRegistersConflict :: Platform -> Assignment -> CmmNode e x -> Bool
+localRegistersConflict platform (r, expr, _) node =
+ -- See Note [Inlining foldRegsDefd]
+ inline foldRegsDefd platform
+ (\b r' ->
+ b
+ || r' == r -- (C1a)
+ || regUsedIn platform (CmmLocal r') expr -- (C1b)
+ )
+ False node
+
+{- Note [Sinking and calls]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We have three kinds of calls: normal (CmmCall), safe foreign (CmmForeignCall)
+and unsafe foreign (CmmUnsafeForeignCall). We perform sinking pass after
+stack layout (see Note [Sinking after stack layout]) which leads to two
+invariants related to calls:
+
+ a) during stack layout phase all safe foreign calls are turned into
+ unsafe foreign calls (see Note [Lower safe foreign calls]). This
+ means that we will never encounter CmmForeignCall node when running
+ sinking after stack layout
+
+ b) stack layout saves all variables live across a call on the stack
+ just before making a call (remember we are not sinking assignments to
+ stack):
+
+ L1:
+ x = R1
+ P64[Sp - 16] = L2
+ P64[Sp - 8] = x
+ Sp = Sp - 16
+ call f() returns L2
+ L2:
+
+ We will attempt to sink { x = R1 } but we will detect conflict with
+ { P64[Sp - 8] = x } and hence we will drop { x = R1 } without even
+ checking whether it conflicts with { call f() }. In this way we will
+ never need to check any assignment conflicts with CmmCall. Remember
+ that we still need to check for potential memory conflicts.
+
+So the result is that we only need to worry about CmmUnsafeForeignCall nodes
+when checking conflicts (see Note [Unsafe foreign calls clobber caller-save registers]).
+This assumption holds only when we do sinking after stack layout. If we run
+it before stack layout we need to check for possible conflicts with all three
+kinds of calls. Our `conflicts` function does that by using a generic
+foldRegsDefd and foldRegsUsed functions defined in DefinerOfRegs and
+UserOfRegs typeclasses.
+-}
-- An abstraction of memory read or written.
data AbsMem
diff --git a/compiler/GHC/CmmToAsm/AArch64/CodeGen.hs b/compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
index 00d215d6065e..d0b792dcc467 100644
--- a/compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
@@ -17,7 +17,7 @@ import Data.Word
import GHC.Platform.Regs
import GHC.CmmToAsm.AArch64.Instr
import GHC.CmmToAsm.AArch64.Regs
-import GHC.CmmToAsm.AArch64.Cond
+import GHC.CmmToAsm.AArch64.Cond (Cond(..), invertCond)
import GHC.CmmToAsm.CPrim
import GHC.Cmm.DebugBlock
@@ -418,13 +418,12 @@ which will then be transalted to one of the immediate encodings implicitly.
For example mov x1, #0x10000 is allowed but will be assembled to movz x1, #0x1, lsl #16
-}
--- | Move (wide immediate)
+-- | Move (wide immediate) for MOVZ.
-- Allows for 16bit immediate which can be shifted by 0/16/32/48 bits.
--- Used with MOVZ,MOVN, MOVK
+-- Used with MOVZ. Only handles non-negative values.
-- See Note [Aarch64 immediates]
getMovWideImm :: Integer -> Width -> Maybe Operand
getMovWideImm n w
- -- TODO: Handle sign extension/negatives
| n <= 0
= Nothing
-- Fits in 16 bits
@@ -450,6 +449,57 @@ getMovWideImm n w
sized_n = fromIntegral truncated :: Word64
trailing_zeros = countTrailingZeros sized_n
+-- | Move (wide immediate) for MOVN.
+-- MOVN writes NOT(imm16 << shift) to the register. This is optimal for
+-- values where the bitwise complement has a single non-zero 16-bit halfword.
+-- Returns the operand for the MOVN instruction.
+-- See Note [Aarch64 immediates]
+getMovNImm :: Integer -> Width -> Maybe Operand
+getMovNImm n w
+ | inverted_n < 2^(16 :: Int)
+ = Just $ OpImm (ImmInteger (fromIntegral inverted_n))
+ | inv_trailing_zeros >= 16 && inverted_n < 2^(32 :: Int)
+ = Just $ OpImmShift (ImmInteger (fromIntegral (inverted_n `shiftR` 16))) SLSL 16
+ | inv_trailing_zeros >= 32 && inverted_n < 2^(48 :: Int)
+ = Just $ OpImmShift (ImmInteger (fromIntegral (inverted_n `shiftR` 32))) SLSL 32
+ | inv_trailing_zeros >= 48
+ = Just $ OpImmShift (ImmInteger (fromIntegral (inverted_n `shiftR` 48))) SLSL 48
+ | otherwise
+ = Nothing
+ where
+ -- Complement within the register width
+ truncated = narrowU w n
+ mask = case w of
+ W32 -> 0xFFFFFFFF
+ W64 -> 0xFFFFFFFFFFFFFFFF
+ _ -> (1 `shiftL` widthInBits w) - 1
+ inverted_n = (complement truncated) .&. mask :: Integer
+ inv_trailing_zeros = countTrailingZeros (fromIntegral inverted_n :: Word64)
+
+-- | Check if an integer is a power of 2. Returns the bit position if so.
+-- Used for TBZ/TBNZ pattern matching.
+-- We convert to Word64 for countTrailingZeros since Integer lacks FiniteBits.
+isPowerOf2 :: Integer -> Maybe Int
+isPowerOf2 n
+ | n > 0, n .&. (n - 1) == 0 = Just (countTrailingZeros (fromIntegral n :: Word64))
+ | otherwise = Nothing
+
+-- | Count non-0x0000 halfwords in a value (for MOVZ cost estimation)
+movzCost :: Word64 -> Int
+movzCost w = length $ filter (/= 0) halfwords
+ where halfwords = [ w .&. 0xFFFF
+ , (w `shiftR` 16) .&. 0xFFFF
+ , (w `shiftR` 32) .&. 0xFFFF
+ , (w `shiftR` 48) .&. 0xFFFF ]
+
+-- | Count non-0xFFFF halfwords in a value (for MOVN cost estimation)
+movnCost :: Word64 -> Int
+movnCost w = length $ filter (/= 0xFFFF) halfwords
+ where halfwords = [ w .&. 0xFFFF
+ , (w `shiftR` 16) .&. 0xFFFF
+ , (w `shiftR` 32) .&. 0xFFFF
+ , (w `shiftR` 48) .&. 0xFFFF ]
+
-- | Arithmetic(immediate)
-- Allows for 12bit immediates which can be shifted by 0 or 12 bits.
-- Used with ADD, ADDS, SUB, SUBS, CMP
@@ -561,6 +611,15 @@ opRegWidth w = pprPanic "opRegWidth" (text "Unsupported width" <+> ppr w)
-- sub-word-size value always contains the zero-extended form of that value
-- in between operations.
--
+-- IMPORTANT: this invariant only holds within a single expression tree as
+-- generated by the NCG (via truncateReg after each sub-word operation). It
+-- does NOT hold at function entry points or across basic block boundaries,
+-- because the GHC calling convention does not guarantee that callers
+-- zero-extend sub-word arguments. Therefore, any operation that is sensitive
+-- to the upper bits of its input (e.g. unsigned right shift, unsigned
+-- division) must explicitly zero- or sign-extend its operands rather than
+-- assuming they are already extended.
+--
-- For instance, consider the program,
--
-- test(bits64 buffer)
@@ -579,7 +638,7 @@ opRegWidth w = pprPanic "opRegWidth" (text "Unsupported width" <+> ppr w)
-- Next we compute `c`: The `%not` requires no extension of its operands, but
-- we must still truncate the result back down to 8-bits. Finally the `%shrl`
-- requires no extension and no truncate since we can assume that
--- `c` is zero-extended.
+-- `c` is zero-extended (it was produced by a truncateReg in the same block).
--
-- TODO:
-- Don't use Width in Operands
@@ -653,6 +712,12 @@ getRegister' config plat expr
, Just imm_op <- getMovWideImm i w -> do
return (Any (intFormat w) (\dst -> unitOL $ annExpr expr (MOVZ (OpReg w dst) imm_op)))
+ -- MOVN for negative values: MOVN writes NOT(imm16 << shift).
+ -- This handles common negative values like -1, -4, -8, etc. in a
+ -- single instruction instead of a 2-4 instruction MOVZ+MOVK chain.
+ CmmInt i w | Just imm_op <- getMovNImm i w -> do
+ return (Any (intFormat w) (\dst -> unitOL $ annExpr expr (MOVN (OpReg w dst) imm_op)))
+
CmmInt i w | isNbitEncodeable 16 i, i >= 0 -> do
return (Any (intFormat w) (\dst -> unitOL $ annExpr expr (MOV (OpReg W16 dst) (OpImm (ImmInteger i)))))
@@ -663,26 +728,75 @@ getRegister' config plat expr
$ MOV (OpReg W32 dst) (OpImm (ImmInt half0))
, MOVK (OpReg W32 dst) (OpImmShift (ImmInt half1) SLSL 16)
]))
- -- fallback for W32
+
+ -- Smart constant materialization: choose between MOVZ+MOVK and
+ -- MOVN+MOVK based on which needs fewer instructions.
+ -- MOVZ is better when most halfwords are 0x0000.
+ -- MOVN is better when most halfwords are 0xFFFF (common for negatives).
CmmInt i W32 -> do
- let half0 = fromIntegral (fromIntegral i :: Word16)
- half1 = fromIntegral (fromIntegral (i `shiftR` 16) :: Word16)
- return (Any (intFormat W32) (\dst -> toOL [ annExpr expr
- $ MOV (OpReg W32 dst) (OpImm (ImmInt half0))
- , MOVK (OpReg W32 dst) (OpImmShift (ImmInt half1) SLSL 16)
- ]))
- -- anything else
+ let unsigned = narrowU W32 i
+ word = fromIntegral unsigned :: Word64
+ half0 = fromIntegral (word .&. 0xFFFF) :: Int
+ half1 = fromIntegral ((word `shiftR` 16) .&. 0xFFFF) :: Int
+ return $ if movnCost word < movzCost word
+ then Any (intFormat W32) $ \dst ->
+ -- Use MOVN + MOVK: fewer instructions for values with many 0xFFFF halfwords
+ let inv = (complement word) .&. 0xFFFFFFFF
+ halves = [(half0, 0 :: Int), (half1, 16)]
+ -- Pick the first non-0xFFFF halfword for the MOVN base
+ (base_inv, base_shift) = case [ (fromIntegral ((inv `shiftR` s) .&. 0xFFFF) :: Int, s)
+ | (h, s) <- halves, h /= 0xFFFF ] of
+ (x:_) -> x
+ [] -> (fromIntegral (inv .&. 0xFFFF), 0) -- all 0xFFFF: handled by getMovNImm above
+ movn_op = if base_shift == 0 then OpImm (ImmInt base_inv)
+ else OpImmShift (ImmInt base_inv) SLSL base_shift
+ movk_fixups = [ MOVK (OpReg W32 dst) (OpImmShift (ImmInt h) SLSL s)
+ | (h, s) <- halves
+ , s /= base_shift
+ , h /= 0xFFFF ]
+ in annExpr expr (MOVN (OpReg W32 dst) movn_op) `consOL` toOL movk_fixups
+ else Any (intFormat W32) $ \dst ->
+ toOL [ annExpr expr $ MOV (OpReg W32 dst) (OpImm (ImmInt half0))
+ , MOVK (OpReg W32 dst) (OpImmShift (ImmInt half1) SLSL 16) ]
+
+ -- W64: smart constant materialization
CmmInt i W64 -> do
- let half0 = fromIntegral (fromIntegral i :: Word16)
- half1 = fromIntegral (fromIntegral (i `shiftR` 16) :: Word16)
- half2 = fromIntegral (fromIntegral (i `shiftR` 32) :: Word16)
- half3 = fromIntegral (fromIntegral (i `shiftR` 48) :: Word16)
- return (Any (intFormat W64) (\dst -> toOL [ annExpr expr
- $ MOV (OpReg W64 dst) (OpImm (ImmInt half0))
- , MOVK (OpReg W64 dst) (OpImmShift (ImmInt half1) SLSL 16)
- , MOVK (OpReg W64 dst) (OpImmShift (ImmInt half2) SLSL 32)
- , MOVK (OpReg W64 dst) (OpImmShift (ImmInt half3) SLSL 48)
- ]))
+ let unsigned = narrowU W64 i
+ word = fromIntegral unsigned :: Word64
+ half0 = fromIntegral (word .&. 0xFFFF) :: Int
+ half1 = fromIntegral ((word `shiftR` 16) .&. 0xFFFF) :: Int
+ half2 = fromIntegral ((word `shiftR` 32) .&. 0xFFFF) :: Int
+ half3 = fromIntegral ((word `shiftR` 48) .&. 0xFFFF) :: Int
+ return $ if movnCost word < movzCost word
+ then Any (intFormat W64) $ \dst ->
+ -- Use MOVN + MOVK chain
+ let inv = complement word
+ halves = [(half0, 0 :: Int), (half1, 16), (half2, 32), (half3, 48)]
+ (base_inv, base_shift) = case [ (fromIntegral ((inv `shiftR` s) .&. 0xFFFF) :: Int, s)
+ | (h, s) <- halves, h /= 0xFFFF ] of
+ (x:_) -> x
+ [] -> (fromIntegral (inv .&. 0xFFFF), 0)
+ movn_op = if base_shift == 0 then OpImm (ImmInt base_inv)
+ else OpImmShift (ImmInt base_inv) SLSL base_shift
+ movk_fixups = [ MOVK (OpReg W64 dst) (OpImmShift (ImmInt h) SLSL s)
+ | (h, s) <- halves
+ , s /= base_shift
+ , h /= 0xFFFF ]
+ in annExpr expr (MOVN (OpReg W64 dst) movn_op) `consOL` toOL movk_fixups
+ else Any (intFormat W64) $ \dst ->
+ -- MOVZ+MOVK path: skip zero halfwords since MOVZ zeroes them.
+ -- Pick the first non-zero halfword for MOVZ, then MOVK the rest.
+ let all_halves = [(half0, 0 :: Int), (half1, 16), (half2, 32), (half3, 48)]
+ (base_h, base_s) = case [(h,s) | (h,s) <- all_halves, h /= 0] of
+ (x:_) -> x
+ [] -> (0, 0) -- all zero: single MOVZ #0
+ movz_op = if base_s == 0 then OpImm (ImmInt base_h)
+ else OpImmShift (ImmInt base_h) SLSL base_s
+ movk_fixups = [ MOVK (OpReg W64 dst) (OpImmShift (ImmInt h) SLSL s)
+ | (h, s) <- all_halves
+ , s /= base_s
+ , h /= 0 ]
+ in annExpr expr (MOVZ (OpReg W64 dst) movz_op) `consOL` toOL movk_fixups
CmmInt _i rep -> do
(op, imm_code) <- litToImm' lit
return (Any (intFormat rep) (\dst -> imm_code `snocOL` annExpr expr (MOV (OpReg rep dst) op)))
@@ -882,13 +996,31 @@ getRegister' config plat expr
NEG (OpReg w' dst) (OpReg w' reg') `appOL`
truncateReg w' w dst
- ss_conv from to reg code =
+ ss_conv from to reg code
+ -- Widening: use the canonical sign-extend instructions
+ -- (SXTB, SXTH, SXTW) rather than raw SBFM, so that the
+ -- assembly output matches what signExtendReg would produce.
+ -- Note: SXTW/SXTH/SXTB require the source operand to use
+ -- the source register width (Wn), not the destination width.
+ | from < to =
+ let w_dst = opRegWidth to
+ w_src = opRegWidth from
+ ext = case from of
+ W8 -> SXTB
+ W16 -> SXTH
+ W32 -> SXTW
+ _ -> panic "ss_conv: unsupported widening"
+ in return $ Any (intFormat to) $ \dst ->
+ code `snocOL`
+ ext (OpReg w_dst dst) (OpReg w_src reg) `appOL`
+ truncateReg w_dst to dst
+ -- Narrowing or same-width: extract the lower bits via SBFM
+ -- and truncate to the target width.
+ | otherwise =
let w' = opRegWidth (max from to)
in return $ Any (intFormat to) $ \dst ->
code `snocOL`
SBFM (OpReg w' dst) (OpReg w' reg) (OpImm (ImmInt 0)) (toImm (min from to)) `appOL`
- -- At this point an 8- or 16-bit value would be sign-extended
- -- to 32-bits. Truncate back down the final width.
truncateReg w' to dst
-- Dyadic machops:
@@ -909,17 +1041,30 @@ getRegister' config plat expr
CmmMachOp (MO_U_Quot w) [x, y] | w == W8 -> do
(reg_x, _format_x, code_x) <- getSomeReg x
(reg_y, _format_y, code_y) <- getSomeReg y
- return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL`
- (UXTB (OpReg w reg_y) (OpReg w reg_y)) `snocOL`
- (UDIV (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
+ tmp_x <- getNewRegNat (intFormat w)
+ tmp_y <- getNewRegNat (intFormat w)
+ return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTB (OpReg w tmp_x) (OpReg w reg_x)) `snocOL`
+ (UXTB (OpReg w tmp_y) (OpReg w reg_y)) `snocOL`
+ (UDIV (OpReg w dst) (OpReg w tmp_x) (OpReg w tmp_y)))
CmmMachOp (MO_U_Quot w) [x, y] | w == W16 -> do
(reg_x, _format_x, code_x) <- getSomeReg x
(reg_y, _format_y, code_y) <- getSomeReg y
- return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL`
- (UXTH (OpReg w reg_y) (OpReg w reg_y)) `snocOL`
- (UDIV (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
+ tmp_x <- getNewRegNat (intFormat w)
+ tmp_y <- getNewRegNat (intFormat w)
+ return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTH (OpReg w tmp_x) (OpReg w reg_x)) `snocOL`
+ (UXTH (OpReg w tmp_y) (OpReg w reg_y)) `snocOL`
+ (UDIV (OpReg w dst) (OpReg w tmp_x) (OpReg w tmp_y)))
-- 2. Shifts. x << n, x >> n.
+ -- Sub-word left shifts by a constant: use UBFM (UBFIZ alias) to shift
+ -- and mask in a single instruction. See Note [Signed arithmetic on AArch64].
+ CmmMachOp (MO_Shl w) [x, (CmmLit (CmmInt n _))] | w == W8, 0 <= n, n < 8 -> do
+ (reg_x, _format_x, code_x) <- getSomeReg x
+ return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (UBFM (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger ((32 - n) `mod` 32))) (OpImm (ImmInteger (7 - n)))))
+ CmmMachOp (MO_Shl w) [x, (CmmLit (CmmInt n _))] | w == W16, 0 <= n, n < 16 -> do
+ (reg_x, _format_x, code_x) <- getSomeReg x
+ return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (UBFM (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger ((32 - n) `mod` 32))) (OpImm (ImmInteger (15 - n)))))
+
CmmMachOp (MO_Shl w) [x, (CmmLit (CmmInt n _))]
| w == W32 || w == W64
, 0 <= n, n < fromIntegral (widthInBits w) -> do
@@ -933,8 +1078,9 @@ getRegister' config plat expr
CmmMachOp (MO_S_Shr w) [x, y] | w == W8 -> do
(reg_x, _format_x, code_x) <- getSomeReg x
(reg_y, _format_y, code_y) <- getSomeReg y
- return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL`
- (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)) `snocOL`
+ tmp <- getNewRegNat (intFormat w)
+ return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTB (OpReg w tmp) (OpReg w reg_x)) `snocOL`
+ (ASR (OpReg w dst) (OpReg w tmp) (OpReg w reg_y)) `snocOL`
(UXTB (OpReg w dst) (OpReg w dst))) -- See Note [Signed arithmetic on AArch64]
CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W16, 0 <= n, n < 16 -> do
@@ -944,8 +1090,9 @@ getRegister' config plat expr
CmmMachOp (MO_S_Shr w) [x, y] | w == W16 -> do
(reg_x, _format_x, code_x) <- getSomeReg x
(reg_y, _format_y, code_y) <- getSomeReg y
- return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL`
- (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)) `snocOL`
+ tmp <- getNewRegNat (intFormat w)
+ return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTH (OpReg w tmp) (OpReg w reg_x)) `snocOL`
+ (ASR (OpReg w dst) (OpReg w tmp) (OpReg w reg_y)) `snocOL`
(UXTH (OpReg w dst) (OpReg w dst))) -- See Note [Signed arithmetic on AArch64]
CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))]
@@ -960,8 +1107,8 @@ getRegister' config plat expr
CmmMachOp (MO_U_Shr w) [x, y] | w == W8 -> do
(reg_x, _format_x, code_x) <- getSomeReg x
(reg_y, _format_y, code_y) <- getSomeReg y
- return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL`
- (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
+ tmp <- getNewRegNat (intFormat w)
+ return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` UXTB (OpReg w tmp) (OpReg w reg_x) `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w tmp) (OpReg w reg_y)))
CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W16, 0 <= n, n < 16 -> do
(reg_x, _format_x, code_x) <- getSomeReg x
@@ -969,8 +1116,8 @@ getRegister' config plat expr
CmmMachOp (MO_U_Shr w) [x, y] | w == W16 -> do
(reg_x, _format_x, code_x) <- getSomeReg x
(reg_y, _format_y, code_y) <- getSomeReg y
- return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTH (OpReg w reg_x) (OpReg w reg_x))
- `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)))
+ tmp <- getNewRegNat (intFormat w)
+ return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` UXTH (OpReg w tmp) (OpReg w reg_x) `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w tmp) (OpReg w reg_y)))
CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))]
| w == W32 || w == W64
@@ -1396,7 +1543,7 @@ signExtendReg w w' r =
W64 -> noop
W32
| w' == W32 -> noop
- | otherwise -> extend SXTH
+ | otherwise -> extend SXTW
W16 -> extend SXTH
W8 -> extend SXTB
_ -> panic "intOp"
@@ -1404,7 +1551,9 @@ signExtendReg w w' r =
noop = return (r, nilOL)
extend instr = do
r' <- getNewRegNat II64
- return (r', unitOL $ instr (OpReg w' r') (OpReg w' r))
+ -- Source operand uses the source register width (Wn) since
+ -- SXTW/SXTH/SXTB expect e.g. "sxtw Xd, Wn" not "sxtw Xd, Xn".
+ return (r', unitOL $ instr (OpReg w' r') (OpReg (opRegWidth w) r))
-- | Instructions to truncate the value in the given register from width @w@
-- down to width @w'@.
@@ -1544,6 +1693,31 @@ genCondJump bid expr = do
(reg_x, _format_x, code_x) <- getSomeReg x
return $ code_x `snocOL` (annExpr expr (CBNZ (OpReg w reg_x) (TBlock bid)))
+ -- TBZ/TBNZ: test single bit and branch.
+ -- Matches: (x & (1 << bit)) == 0 → TBZ x, #bit, label
+ -- Matches: (x & (1 << bit)) /= 0 → TBNZ x, #bit, label
+ CmmMachOp (MO_Eq _) [CmmMachOp (MO_And w) [x, CmmLit (CmmInt mask _)], CmmLit (CmmInt 0 _)]
+ | Just bit <- isPowerOf2 mask
+ , bit < widthInBits w -> do
+ (reg_x, _format_x, code_x) <- getSomeReg x
+ return $ code_x `snocOL` annExpr expr (TBZ (OpReg w reg_x) bit (TBlock bid))
+
+ CmmMachOp (MO_Ne _) [CmmMachOp (MO_And w) [x, CmmLit (CmmInt mask _)], CmmLit (CmmInt 0 _)]
+ | Just bit <- isPowerOf2 mask
+ , bit < widthInBits w -> do
+ (reg_x, _format_x, code_x) <- getSomeReg x
+ return $ code_x `snocOL` annExpr expr (TBNZ (OpReg w reg_x) bit (TBlock bid))
+
+ -- Sign bit test: x < 0 → TBNZ x, #(width-1), label (sign bit set)
+ CmmMachOp (MO_S_Lt w) [x, CmmLit (CmmInt 0 _)] -> do
+ (reg_x, _format_x, code_x) <- getSomeReg x
+ return $ code_x `snocOL` annExpr expr (TBNZ (OpReg w reg_x) (widthInBits w - 1) (TBlock bid))
+
+ -- Sign bit test: x >= 0 → TBZ x, #(width-1), label (sign bit clear)
+ CmmMachOp (MO_S_Ge w) [x, CmmLit (CmmInt 0 _)] -> do
+ (reg_x, _format_x, code_x) <- getSomeReg x
+ return $ code_x `snocOL` annExpr expr (TBZ (OpReg w reg_x) (widthInBits w - 1) (TBlock bid))
+
-- Generic case.
CmmMachOp mop [x, y] -> do
@@ -1598,20 +1772,14 @@ genCondJump bid expr = do
_ -> pprPanic "AArch64.genCondJump:case mop: " (text $ show expr)
_ -> pprPanic "AArch64.genCondJump: " (text $ show expr)
--- A conditional jump with at least +/-128M jump range
+-- | A conditional jump with at least +/-128M jump range.
+-- Uses condition inversion to save one instruction and one label:
+-- Before: BCOND cond jmp; B skip; jmp: B far; skip: (3 insns, 2 labels)
+-- After: BCOND !cond skip; B far; skip: (2 insns, 1 label)
genCondFarJump :: MonadGetUnique m => Cond -> Target -> m InstrBlock
genCondFarJump cond far_target = do
skip_lbl_id <- newBlockId
- jmp_lbl_id <- newBlockId
-
- -- TODO: We can improve this by inverting the condition
- -- but it's not quite trivial since we don't know if we
- -- need to consider float orderings.
- -- So we take the hit of the additional jump in the false
- -- case for now.
- return $ toOL [ BCOND cond (TBlock jmp_lbl_id)
- , B (TBlock skip_lbl_id)
- , NEWBLOCK jmp_lbl_id
+ return $ toOL [ BCOND (invertCond cond) (TBlock skip_lbl_id)
, B far_target
, NEWBLOCK skip_lbl_id]
@@ -1848,7 +2016,7 @@ genCCall target dest_regs arg_regs = do
-- the low 2w' of lo contains the full multiplication;
-- eg: int8 * int8 -> int16 result
-- so lo is in the last w of the register, and hi is in the second w.
- SMULL (OpReg w' lo) (OpReg w' reg_a) (OpReg w' reg_b) `snocOL`
+ SMULL (OpReg w' lo) (OpReg W32 reg_a) (OpReg W32 reg_b) `snocOL`
-- Make sure we hold onto the sign bits for dst_needed
ASR (OpReg w' hi) (OpReg w' lo) (OpImm (ImmInt $ widthInBits w)) `appOL`
-- lo can now be truncated so we can get at it's top bit easily.
@@ -2182,15 +2350,22 @@ genCCall target dest_regs arg_regs = do
-- Prefetch
MO_Prefetch_Data _n -> return nilOL -- Prefetch hint.
- -- Memory copy/set/move/cmp, with alignment for optimization
-
- -- TODO Optimize and use e.g. quad registers to move memory around instead
- -- of offloading this to memcpy. For small memcpys we can utilize
- -- the 128bit quad registers in NEON to move block of bytes around.
- -- Might also make sense of small memsets? Use xzr? What's the function
- -- call overhead?
+ -- Memory copy/set/move/cmp, with alignment for optimization.
+ -- For small, known-size copies/sets we emit inline load/store
+ -- sequences using paired registers (STP/LDP), avoiding the
+ -- function call overhead (~15-20 cycles for save/restore/branch).
+ MO_Memcpy align
+ | [dst, src, CmmLit (CmmInt n _)] <- arg_regs
+ , n >= 0, n <= 64
+ -> inlineMemcpy dst src (fromIntegral n) align
MO_Memcpy _align -> mkCCall "memcpy"
+
+ MO_Memset align
+ | [dst, val, CmmLit (CmmInt n _)] <- arg_regs
+ , n >= 0, n <= 64
+ -> inlineMemset dst val (fromIntegral n) align
MO_Memset _align -> mkCCall "memset"
+
MO_Memmove _align -> mkCCall "memmove"
MO_Memcmp _align -> mkCCall "memcmp"
@@ -2248,6 +2423,130 @@ genCCall target dest_regs arg_regs = do
let cconv = ForeignConvention CCallConv [NoHint] [NoHint] CmmMayReturn
genCCall (ForeignTarget target cconv) dest_regs arg_regs
+ -- | Generate inline load/store sequence for small memcpy.
+ -- For copies up to 64 bytes, we emit LDR/STR (or LDP/STP for 16-byte
+ -- chunks) instead of calling memcpy. The peephole optimizer will
+ -- further merge adjacent LDR/STR into LDP/STP pairs.
+ --
+ -- AArch64 single-register LDR/STR instructions handle unaligned
+ -- addresses without faulting, so we always use the widest available
+ -- single-register operation regardless of the stated alignment.
+ -- Only LDP/STP require natural alignment (8-byte for the II64 pair),
+ -- so we gate the 16-byte paired path on align >= 8.
+ inlineMemcpy :: CmmExpr -> CmmExpr -> Int -> Int -> NatM InstrBlock
+ inlineMemcpy dst_expr src_expr n align = do
+ (dst_reg, _fmt_d, code_d) <- getSomeReg dst_expr
+ (src_reg, _fmt_s, code_s) <- getSomeReg src_expr
+ tmp1 <- getNewRegNat II64
+ tmp2 <- getNewRegNat II64
+ let -- Generate copy instructions for the remaining bytes at the given offset.
+ -- We greedily pick the widest operation that fits the remaining size:
+ -- 16 bytes: LDP/STP (paired, needs align >= 8)
+ -- 8 bytes: LDR/STR II64 (unaligned ok)
+ -- 4 bytes: LDR/STR II32 (unaligned ok)
+ -- 2 bytes: LDR/STR II16 (unaligned ok)
+ -- 1 byte: LDR/STR II8
+ go :: Int -> Int -> OrdList Instr
+ go off remaining
+ | remaining <= 0 = nilOL
+ -- 16-byte chunk using LDP/STP (requires 8-byte alignment)
+ | remaining >= 16, align >= 8 =
+ toOL [ LDP II64 (OpReg W64 tmp1) (OpReg W64 tmp2)
+ (OpAddr (AddrRegImm src_reg (ImmInt off)))
+ , STP II64 (OpReg W64 tmp1) (OpReg W64 tmp2)
+ (OpAddr (AddrRegImm dst_reg (ImmInt off)))
+ ] `appOL` go (off + 16) (remaining - 16)
+ -- 8-byte chunk (AArch64 LDR/STR handles unaligned)
+ | remaining >= 8 =
+ toOL [ LDR II64 (OpReg W64 tmp1) (OpAddr (AddrRegImm src_reg (ImmInt off)))
+ , STR II64 (OpReg W64 tmp1) (OpAddr (AddrRegImm dst_reg (ImmInt off)))
+ ] `appOL` go (off + 8) (remaining - 8)
+ -- 4-byte chunk
+ | remaining >= 4 =
+ toOL [ LDR II32 (OpReg W32 tmp1) (OpAddr (AddrRegImm src_reg (ImmInt off)))
+ , STR II32 (OpReg W32 tmp1) (OpAddr (AddrRegImm dst_reg (ImmInt off)))
+ ] `appOL` go (off + 4) (remaining - 4)
+ -- 2-byte chunk
+ | remaining >= 2 =
+ toOL [ LDR II16 (OpReg W16 tmp1) (OpAddr (AddrRegImm src_reg (ImmInt off)))
+ , STR II16 (OpReg W16 tmp1) (OpAddr (AddrRegImm dst_reg (ImmInt off)))
+ ] `appOL` go (off + 2) (remaining - 2)
+ -- 1-byte chunk
+ | otherwise =
+ toOL [ LDR II8 (OpReg W8 tmp1) (OpAddr (AddrRegImm src_reg (ImmInt off)))
+ , STR II8 (OpReg W8 tmp1) (OpAddr (AddrRegImm dst_reg (ImmInt off)))
+ ] `appOL` go (off + 1) (remaining - 1)
+ return $ code_d `appOL` code_s `appOL` go 0 n
+
+ -- | Generate inline store sequence for small memset.
+ -- For sets up to 64 bytes, we emit stores using a register holding the
+ -- fill value. For zero fills, we emit MOVZ tmp, #0 and let the post-RA
+ -- peephole optimizer convert STR tmp → STR xzr. We cannot use
+ -- RealRegSingle (-1) (xzr) directly in pre-RA code because the linear
+ -- register allocator's FreeRegs uses Word32 bitmaps that overflow on
+ -- negative register indices.
+ inlineMemset :: CmmExpr -> CmmExpr -> Int -> Int -> NatM InstrBlock
+ inlineMemset dst_expr val_expr n align = do
+ (dst_reg, _fmt_d, code_d) <- getSomeReg dst_expr
+ (val_reg, _fmt_v, code_v) <- getSomeReg val_expr
+ -- Splat the byte value across all 8 bytes of a register.
+ -- For zero, we materialize zero in a virtual register. The post-RA
+ -- peephole will optimize STR of a zero-valued register to STR xzr.
+ -- For non-zero, we replicate the byte: val | val<<8 | val<<16 | ...
+ tmp <- getNewRegNat II64
+ let -- Check if the value is a constant zero
+ isZero = case val_expr of
+ CmmLit (CmmInt 0 _) -> True
+ _ -> False
+ -- The register to use for storing (zero in tmp, or splatted value)
+ (store_reg, splat_code)
+ | isZero = (tmp, unitOL $ MOVZ (OpReg W64 tmp) (OpImm (ImmInt 0)))
+ | otherwise =
+ -- Replicate byte across 64-bit register:
+ -- ORR tmp, val, val LSL #8
+ -- ORR tmp, tmp, tmp LSL #16
+ -- ORR tmp, tmp, tmp LSL #32
+ (tmp, toOL
+ [ ORR (OpReg W64 tmp) (OpReg W64 val_reg)
+ (OpRegShift W64 val_reg SLSL 8)
+ , ORR (OpReg W64 tmp) (OpReg W64 tmp)
+ (OpRegShift W64 tmp SLSL 16)
+ , ORR (OpReg W64 tmp) (OpReg W64 tmp)
+ (OpRegShift W64 tmp SLSL 32)
+ ])
+ -- Generate stores at offset. See inlineMemcpy for alignment
+ -- rationale: AArch64 single-register STR handles unaligned
+ -- addresses, only STP requires natural alignment.
+ go :: Int -> Int -> OrdList Instr
+ go off remaining
+ | remaining <= 0 = nilOL
+ -- 16-byte chunk using STP (requires 8-byte alignment)
+ | remaining >= 16, align >= 8 =
+ unitOL (STP II64 (OpReg W64 store_reg) (OpReg W64 store_reg)
+ (OpAddr (AddrRegImm dst_reg (ImmInt off))))
+ `appOL` go (off + 16) (remaining - 16)
+ -- 8-byte chunk (AArch64 STR handles unaligned)
+ | remaining >= 8 =
+ unitOL (STR II64 (OpReg W64 store_reg)
+ (OpAddr (AddrRegImm dst_reg (ImmInt off))))
+ `appOL` go (off + 8) (remaining - 8)
+ -- 4-byte chunk
+ | remaining >= 4 =
+ unitOL (STR II32 (OpReg W32 store_reg)
+ (OpAddr (AddrRegImm dst_reg (ImmInt off))))
+ `appOL` go (off + 4) (remaining - 4)
+ -- 2-byte chunk
+ | remaining >= 2 =
+ unitOL (STR II16 (OpReg W16 store_reg)
+ (OpAddr (AddrRegImm dst_reg (ImmInt off))))
+ `appOL` go (off + 2) (remaining - 2)
+ -- 1-byte chunk
+ | otherwise =
+ unitOL (STR II8 (OpReg W8 store_reg)
+ (OpAddr (AddrRegImm dst_reg (ImmInt off))))
+ `appOL` go (off + 1) (remaining - 1)
+ return $ code_d `appOL` code_v `appOL` splat_code `appOL` go 0 n
+
-- TODO: Optimize using paired stores and loads (STP, LDP). It is
-- automatically done by the allocator for us. However it's not optimal,
-- as we'd rather want to have control over
@@ -2470,12 +2769,20 @@ makeFarBranches {- only used when debugging -} _platform statics basic_blocks =
-- pprTrace "lblMap" (ppr lblMap) $ basic_blocks
where
- -- 2^18, 19 bit immediate with one bit is reserved for the sign
- max_jump_dist = 2^(18::Int) - 1 :: Int
+ -- 2^18, 19 bit immediate with one bit is reserved for the sign (for BCOND)
+ max_bcond_jump_dist = 2^(18::Int) - 1 :: Int
+ -- 2^13, 14 bit immediate with one bit reserved for sign (for TBZ/TBNZ/CBZ/CBNZ)
+ max_tbz_jump_dist = 2^(13::Int) - 1 :: Int
+ -- Use the more conservative distance for the overall check
+ max_jump_dist = max_tbz_jump_dist :: Int
-- Currently all inline info tables fit into 64 bytes.
max_info_size = 16 :: Int
- long_bc_jump_size = 3 :: Int
+ -- After condition inversion optimization: BCOND !cond skip; B far; skip:
+ long_bc_jump_size = 2 :: Int
+ -- CBZ/CBNZ far: CMP op, #0; BCOND !cond skip; B far; skip:
long_bz_jump_size = 4 :: Int
+ -- TBZ/TBNZ far: TBNZ/TBZ (inverted) skip; B far; skip:
+ long_tb_jump_size = 2 :: Int
-- Replace out of range conditional jumps with unconditional jumps.
replace_blk :: LabelMap Int -> Int -> GenBasicBlock Instr -> UniqDSM (Int, [GenBasicBlock Instr])
@@ -2501,13 +2808,16 @@ makeFarBranches {- only used when debugging -} _platform statics basic_blocks =
pure (idx, ANN ann instr':instrs')
(idx,[]) -> pprPanic "replace_jump" (text "empty return list for " <+> ppr idx)
BCOND cond t
- -> case target_in_range m t pos of
+ -> case target_in_range m t pos max_bcond_jump_dist of
InRange -> pure (pos+long_bc_jump_size,[instr])
NotInRange far_target -> do
jmp_code <- genCondFarJump cond far_target
pure (pos+long_bc_jump_size, fromOL jmp_code)
CBZ op t -> long_zero_jump op t EQ
CBNZ op t -> long_zero_jump op t NE
+ -- TBZ/TBNZ have 14-bit range (±32KB), same expansion strategy as CBZ/CBNZ
+ TBZ op bit t -> long_tbz_jump op bit t EQ
+ TBNZ op bit t -> long_tbz_jump op bit t NE
instr
| isMetaInstr instr -> pure (pos,[instr])
| otherwise -> pure (pos+1, [instr])
@@ -2515,33 +2825,49 @@ makeFarBranches {- only used when debugging -} _platform statics basic_blocks =
where
-- cmp_op: EQ = CBZ, NEQ = CBNZ
long_zero_jump op t cmp_op =
- case target_in_range m t pos of
+ case target_in_range m t pos max_tbz_jump_dist of
InRange -> pure (pos+long_bz_jump_size,[instr])
NotInRange far_target -> do
jmp_code <- genCondFarJump cmp_op far_target
- -- TODO: Fix zero reg so we can use it here
pure (pos + long_bz_jump_size, CMP op (OpImm (ImmInt 0)) : fromOL jmp_code)
+ -- TBZ/TBNZ far jump: use condition inversion.
+ -- TBZ reg, #bit, far → TBNZ reg, #bit, skip; B far; skip:
+ -- TBNZ reg, #bit, far → TBZ reg, #bit, skip; B far; skip:
+ -- The inverted TBZ/TBNZ always targets the skip label which is
+ -- only 1 instruction away, well within the 14-bit range.
+ long_tbz_jump op bit t _cmp_op =
+ case target_in_range m t pos max_tbz_jump_dist of
+ InRange -> pure (pos+long_tb_jump_size,[instr])
+ NotInRange far_target -> do
+ skip_lbl <- newBlockId
+ let inverted = case instr of
+ TBZ {} -> TBNZ op bit (TBlock skip_lbl)
+ TBNZ {} -> TBZ op bit (TBlock skip_lbl)
+ _ -> panic "long_tbz_jump: not TBZ/TBNZ"
+ pure (pos + long_tb_jump_size,
+ [inverted, B far_target, NEWBLOCK skip_lbl])
+
- target_in_range :: LabelMap Int -> Target -> Int -> BlockInRange
- target_in_range m target src =
+ target_in_range :: LabelMap Int -> Target -> Int -> Int -> BlockInRange
+ target_in_range m target src max_dist =
case target of
(TReg{}) -> InRange
- (TBlock bid) -> block_in_range m src bid
+ (TBlock bid) -> block_in_range m src bid max_dist
(TLabel clbl)
| Just bid <- maybeLocalBlockLabel clbl
- -> block_in_range m src bid
+ -> block_in_range m src bid max_dist
| otherwise
-- Maybe we should be pessimistic here, for now just fixing intra proc jumps
-> InRange
- block_in_range :: LabelMap Int -> Int -> BlockId -> BlockInRange
- block_in_range m src_pos dest_lbl =
+ block_in_range :: LabelMap Int -> Int -> BlockId -> Int -> BlockInRange
+ block_in_range m src_pos dest_lbl max_dist =
case mapLookup dest_lbl m of
Nothing ->
pprTrace "not in range" (ppr dest_lbl) $
NotInRange (TBlock dest_lbl)
- Just dest_pos -> if abs (dest_pos - src_pos) < max_jump_dist
+ Just dest_pos -> if abs (dest_pos - src_pos) < max_dist
then InRange
else NotInRange (TBlock dest_lbl)
@@ -2567,11 +2893,13 @@ makeFarBranches {- only used when debugging -} _platform statics basic_blocks =
Nothing -> 0 :: Int
Just _info_static -> max_info_size
- -- These jumps have a 19bit immediate as offset which is quite
- -- limiting so we potentially have to expand them into
- -- multiple instructions.
+ -- These jumps have limited immediate offsets:
+ -- BCOND: 19-bit (±1MB), CBZ/CBNZ: 19-bit, TBZ/TBNZ: 14-bit (±32KB).
+ -- We potentially have to expand them into multiple instructions.
is_expandable_jump i = case i of
CBZ{} -> Just long_bz_jump_size
CBNZ{} -> Just long_bz_jump_size
+ TBZ{} -> Just long_tb_jump_size
+ TBNZ{} -> Just long_tb_jump_size
BCOND{} -> Just long_bc_jump_size
_ -> Nothing
diff --git a/compiler/GHC/CmmToAsm/AArch64/Cond.hs b/compiler/GHC/CmmToAsm/AArch64/Cond.hs
index 7efbb9c70bf2..898c143b5d44 100644
--- a/compiler/GHC/CmmToAsm/AArch64/Cond.hs
+++ b/compiler/GHC/CmmToAsm/AArch64/Cond.hs
@@ -1,6 +1,11 @@
-module GHC.CmmToAsm.AArch64.Cond where
+module GHC.CmmToAsm.AArch64.Cond
+ ( Cond(..)
+ , invertCond
+ )
+where
import GHC.Prelude hiding (EQ)
+import GHC.Utils.Panic (panic)
-- https://developer.arm.com/documentation/den0024/a/the-a64-instruction-set/data-processing-instructions/conditional-instructions
@@ -70,3 +75,29 @@ data Cond
| VS -- oVerflow set
| VC -- oVerflow clear
deriving Eq
+
+-- | Invert a condition code. Used for far branch optimization where we
+-- invert the condition and skip over an unconditional far jump, saving
+-- one instruction and one label per far branch.
+invertCond :: Cond -> Cond
+invertCond ALWAYS = panic "invertCond: cannot invert ALWAYS"
+invertCond EQ = NE
+invertCond NE = EQ
+invertCond SLT = SGE
+invertCond SLE = SGT
+invertCond SGE = SLT
+invertCond SGT = SLE
+invertCond ULT = UGE
+invertCond ULE = UGT
+invertCond UGE = ULT
+invertCond UGT = ULE
+invertCond OLT = UOGE -- ordered LT → unordered GE (NaN becomes true)
+invertCond OLE = UOGT -- ordered LE → unordered GT
+invertCond OGE = UOLT -- ordered GE → unordered LT
+invertCond OGT = UOLE -- ordered GT → unordered LE
+invertCond UOLT = OGE -- unordered LT → ordered GE
+invertCond UOLE = OGT -- unordered LE → ordered GT
+invertCond UOGE = OLT -- unordered GE → ordered LT
+invertCond UOGT = OLE -- unordered GT → ordered LE
+invertCond VS = VC
+invertCond VC = VS
diff --git a/compiler/GHC/CmmToAsm/AArch64/Instr.hs b/compiler/GHC/CmmToAsm/AArch64/Instr.hs
index 39182be09f61..ea14292bc9e6 100644
--- a/compiler/GHC/CmmToAsm/AArch64/Instr.hs
+++ b/compiler/GHC/CmmToAsm/AArch64/Instr.hs
@@ -101,6 +101,7 @@ regUsageOfInstr platform instr = case instr of
SXTB dst src -> usage (regOp src, regOp dst)
UXTB dst src -> usage (regOp src, regOp dst)
SXTH dst src -> usage (regOp src, regOp dst)
+ SXTW dst src -> usage (regOp src, regOp dst)
UXTH dst src -> usage (regOp src, regOp dst)
CLZ dst src -> usage (regOp src, regOp dst)
RBIT dst src -> usage (regOp src, regOp dst)
@@ -114,7 +115,8 @@ regUsageOfInstr platform instr = case instr of
LSL dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
LSR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
MOV dst src -> usage (regOp src, regOp dst)
- MOVK dst src -> usage (regOp src, regOp dst)
+ MOVK dst src -> usage (regOp src ++ regOp dst, regOp dst)
+ MOVN dst src -> usage (regOp src, regOp dst)
MOVZ dst src -> usage (regOp src, regOp dst)
MVN dst src -> usage (regOp src, regOp dst)
ORR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
@@ -128,13 +130,20 @@ regUsageOfInstr platform instr = case instr of
-- 5. Atomic Instructions ----------------------------------------------------
-- 6. Conditional Instructions -----------------------------------------------
CSET dst _ -> usage ([], regOp dst)
+ CSEL dst src1 src2 _ -> usage (regOp src1 ++ regOp src2, regOp dst)
+ CSINC dst src1 src2 _ -> usage (regOp src1 ++ regOp src2, regOp dst)
+ CSNEG dst src1 src2 _ -> usage (regOp src1 ++ regOp src2, regOp dst)
CBZ src _ -> usage (regOp src, [])
CBNZ src _ -> usage (regOp src, [])
+ TBZ src _ _ -> usage (regOp src, [])
+ TBNZ src _ _ -> usage (regOp src, [])
-- 7. Load and Store Instructions --------------------------------------------
STR _ src dst -> usage (regOp src ++ regOp dst, [])
STLR _ src dst -> usage (regOp src ++ regOp dst, [])
LDR _ dst src -> usage (regOp src, regOp dst)
LDAR _ dst src -> usage (regOp src, regOp dst)
+ STP _ src1 src2 dst -> usage (regOp src1 ++ regOp src2 ++ regOp dst, [])
+ LDP _ dst1 dst2 src -> usage (regOp src, regOp dst1 ++ regOp dst2)
-- 8. Synchronization Instructions -------------------------------------------
DMBISH _ -> usage ([], [])
@@ -255,6 +264,7 @@ patchRegsOfInstr instr env = case instr of
SXTB o1 o2 -> SXTB (patchOp o1) (patchOp o2)
UXTB o1 o2 -> UXTB (patchOp o1) (patchOp o2)
SXTH o1 o2 -> SXTH (patchOp o1) (patchOp o2)
+ SXTW o1 o2 -> SXTW (patchOp o1) (patchOp o2)
UXTH o1 o2 -> UXTH (patchOp o1) (patchOp o2)
CLZ o1 o2 -> CLZ (patchOp o1) (patchOp o2)
RBIT o1 o2 -> RBIT (patchOp o1) (patchOp o2)
@@ -271,6 +281,7 @@ patchRegsOfInstr instr env = case instr of
LSR o1 o2 o3 -> LSR (patchOp o1) (patchOp o2) (patchOp o3)
MOV o1 o2 -> MOV (patchOp o1) (patchOp o2)
MOVK o1 o2 -> MOVK (patchOp o1) (patchOp o2)
+ MOVN o1 o2 -> MOVN (patchOp o1) (patchOp o2)
MOVZ o1 o2 -> MOVZ (patchOp o1) (patchOp o2)
MVN o1 o2 -> MVN (patchOp o1) (patchOp o2)
ORR o1 o2 o3 -> ORR (patchOp o1) (patchOp o2) (patchOp o3)
@@ -284,14 +295,21 @@ patchRegsOfInstr instr env = case instr of
-- 5. Atomic Instructions --------------------------------------------------
-- 6. Conditional Instructions ---------------------------------------------
- CSET o c -> CSET (patchOp o) c
- CBZ o l -> CBZ (patchOp o) l
- CBNZ o l -> CBNZ (patchOp o) l
+ CSET o c -> CSET (patchOp o) c
+ CSEL o1 o2 o3 c -> CSEL (patchOp o1) (patchOp o2) (patchOp o3) c
+ CSINC o1 o2 o3 c -> CSINC (patchOp o1) (patchOp o2) (patchOp o3) c
+ CSNEG o1 o2 o3 c -> CSNEG (patchOp o1) (patchOp o2) (patchOp o3) c
+ CBZ o l -> CBZ (patchOp o) l
+ CBNZ o l -> CBNZ (patchOp o) l
+ TBZ o b l -> TBZ (patchOp o) b l
+ TBNZ o b l -> TBNZ (patchOp o) b l
-- 7. Load and Store Instructions ------------------------------------------
STR f o1 o2 -> STR f (patchOp o1) (patchOp o2)
STLR f o1 o2 -> STLR f (patchOp o1) (patchOp o2)
LDR f o1 o2 -> LDR f (patchOp o1) (patchOp o2)
LDAR f o1 o2 -> LDAR f (patchOp o1) (patchOp o2)
+ STP f o1 o2 o3 -> STP f (patchOp o1) (patchOp o2) (patchOp o3)
+ LDP f o1 o2 o3 -> LDP f (patchOp o1) (patchOp o2) (patchOp o3)
-- 8. Synchronization Instructions -----------------------------------------
DMBISH c -> DMBISH c
@@ -333,6 +351,8 @@ isJumpishInstr instr = case instr of
ANN _ i -> isJumpishInstr i
CBZ{} -> True
CBNZ{} -> True
+ TBZ{} -> True
+ TBNZ{} -> True
J{} -> True
J_TBL{} -> True
B{} -> True
@@ -347,6 +367,8 @@ jumpDestsOfInstr :: Instr -> [BlockId]
jumpDestsOfInstr (ANN _ i) = jumpDestsOfInstr i
jumpDestsOfInstr (CBZ _ t) = [ id | TBlock id <- [t]]
jumpDestsOfInstr (CBNZ _ t) = [ id | TBlock id <- [t]]
+jumpDestsOfInstr (TBZ _ _ t) = [ id | TBlock id <- [t]]
+jumpDestsOfInstr (TBNZ _ _ t) = [ id | TBlock id <- [t]]
jumpDestsOfInstr (J t) = [id | TBlock id <- [t]]
jumpDestsOfInstr (J_TBL ids _mbLbl _r) = catMaybes ids
jumpDestsOfInstr (B t) = [id | TBlock id <- [t]]
@@ -374,6 +396,8 @@ patchJumpInstr instr patchF
ANN d i -> ANN d (patchJumpInstr i patchF)
CBZ r (TBlock bid) -> CBZ r (TBlock (patchF bid))
CBNZ r (TBlock bid) -> CBNZ r (TBlock (patchF bid))
+ TBZ r b (TBlock bid) -> TBZ r b (TBlock (patchF bid))
+ TBNZ r b (TBlock bid) -> TBNZ r b (TBlock (patchF bid))
J (TBlock bid) -> J (TBlock (patchF bid))
J_TBL ids mbLbl r -> J_TBL (map (fmap patchF) ids) mbLbl r
B (TBlock bid) -> B (TBlock (patchF bid))
@@ -594,8 +618,7 @@ data Instr
| UXTB Operand Operand
| SXTH Operand Operand
| UXTH Operand Operand
- -- | SXTW Operand Operand
- -- | SXTX Operand Operand
+ | SXTW Operand Operand
| PUSH_STACK_FRAME
| POP_STACK_FRAME
-- 1. Arithmetic Instructions ----------------------------------------------
@@ -660,7 +683,7 @@ data Instr
| LSR Operand Operand Operand -- rd = rn ≫ rm or rd = rn ≫ #i, i is 6 bits
| MOV Operand Operand -- rd = rn or rd = #i
| MOVK Operand Operand
- -- | MOVN Operand Operand
+ | MOVN Operand Operand -- rd = ~(imm16 << shift), move wide with NOT
| MOVZ Operand Operand
| MVN Operand Operand -- rd = ~rn
| ORR Operand Operand Operand -- rd = rn | op2
@@ -670,12 +693,22 @@ data Instr
| STLR Format Operand Operand -- stlr Xn, address-mode // Xn -> *addr
| LDR Format Operand Operand -- ldr Xn, address-mode // Xn <- *addr
| LDAR Format Operand Operand -- ldar Xn, address-mode // Xn <- *addr
+ -- Paired load/store: transfer two registers in a single operation,
+ -- using one decode slot instead of two.
+ | STP Format Operand Operand Operand -- stp Xt1, Xt2, [addr] // Xt1,Xt2 -> *addr
+ | LDP Format Operand Operand Operand -- ldp Xt1, Xt2, [addr] // Xt1,Xt2 <- *addr
-- Conditional instructions
| CSET Operand Cond -- if(cond) op <- 1 else op <- 0
+ | CSEL Operand Operand Operand Cond -- csel dst, src1, src2, cond: dst = cond ? src1 : src2
+ | CSINC Operand Operand Operand Cond -- csinc dst, src1, src2, cond: dst = cond ? src1 : src2+1
+ | CSNEG Operand Operand Operand Cond -- csneg dst, src1, src2, cond: dst = cond ? src1 : -src2
| CBZ Operand Target -- if op == 0, then branch.
| CBNZ Operand Target -- if op /= 0, then branch.
+ -- Test bit and branch: more efficient than AND+CMP+BCOND for single-bit tests
+ | TBZ Operand Int Target -- tbz reg, #bit, label: branch if bit is zero
+ | TBNZ Operand Int Target -- tbnz reg, #bit, label: branch if bit is nonzero
-- Branching.
| J Target -- like B, but only generated from genJump. Used to distinguish genJumps from others.
| J_TBL [Maybe BlockId] (Maybe CLabel) Reg -- A jump instruction with data for switch/jump tables
@@ -726,6 +759,7 @@ instrCon i =
SXTB{} -> "SXTB"
UXTB{} -> "UXTB"
SXTH{} -> "SXTH"
+ SXTW{} -> "SXTW"
UXTH{} -> "UXTH"
PUSH_STACK_FRAME{} -> "PUSH_STACK_FRAME"
POP_STACK_FRAME{} -> "POP_STACK_FRAME"
@@ -758,6 +792,7 @@ instrCon i =
LSR{} -> "LSR"
MOV{} -> "MOV"
MOVK{} -> "MOVK"
+ MOVN{} -> "MOVN"
MOVZ{} -> "MOVZ"
MVN{} -> "MVN"
ORR{} -> "ORR"
@@ -765,9 +800,16 @@ instrCon i =
STLR{} -> "STLR"
LDR{} -> "LDR"
LDAR{} -> "LDAR"
+ STP{} -> "STP"
+ LDP{} -> "LDP"
CSET{} -> "CSET"
+ CSEL{} -> "CSEL"
+ CSINC{} -> "CSINC"
+ CSNEG{} -> "CSNEG"
CBZ{} -> "CBZ"
CBNZ{} -> "CBNZ"
+ TBZ{} -> "TBZ"
+ TBNZ{} -> "TBNZ"
J{} -> "J"
J_TBL {} -> "J_TBL"
B{} -> "B"
diff --git a/compiler/GHC/CmmToAsm/AArch64/Peephole.hs b/compiler/GHC/CmmToAsm/AArch64/Peephole.hs
new file mode 100644
index 000000000000..e51a89836f7d
--- /dev/null
+++ b/compiler/GHC/CmmToAsm/AArch64/Peephole.hs
@@ -0,0 +1,228 @@
+{- |
+Module : GHC.CmmToAsm.AArch64.Peephole
+Description : Post-register-allocation peephole optimizer for AArch64
+Copyright : (c) Moritz Angermann , 2026
+License : BSD-3
+
+Post-register-allocation peephole optimizer. Runs over the final instruction
+stream and rewrites instruction sequences to take advantage of AArch64-specific
+instructions and idioms.
+
+Optimizations performed:
+
+ * LDP\/STP formation: Merges adjacent LDR\/STR at consecutive offsets
+ into paired load\/store instructions, saving a decode slot.
+ Only II32 and II64 formats are supported (AArch64 has no 8\/16-bit
+ paired load\/store instructions).
+
+ * STR-of-zero: Replaces MOV\/MOVZ reg,#0; STR reg,[addr] with
+ STR xzr,[addr], eliminating the move instruction entirely.
+
+ * Redundant move elimination: Removes identity moves (MOV r,r).
+
+ * Redundant extension elimination: Removes consecutive identical
+ sign\/zero extensions (e.g. UXTB w0,w0; UXTB w0,w0).
+
+ * CMP+CSET+CB{N}Z→BCOND: Rewrites a comparison that produces a boolean
+ followed by a conditional branch on that boolean into a single
+ conditional branch, saving 2 instructions.
+-}
+module GHC.CmmToAsm.AArch64.Peephole
+ ( peephole
+ )
+where
+
+import GHC.Prelude hiding (EQ)
+import GHC.CmmToAsm.AArch64.Instr
+import GHC.CmmToAsm.AArch64.Regs (AddrMode(..), Imm(..))
+import GHC.CmmToAsm.AArch64.Cond
+import GHC.CmmToAsm.Format
+import GHC.Platform.Reg
+
+-- | Run the peephole optimizer over an instruction list.
+-- This is designed to be called after register allocation, when final
+-- register assignments are known and pattern matching is most effective.
+peephole :: [Instr] -> [Instr]
+peephole = peep []
+ where
+ -- Process instructions, building result in reverse for efficiency.
+ -- We look ahead at 2-3 instructions for pattern matching.
+ peep :: [Instr] -> [Instr] -> [Instr]
+ peep acc [] = reverse acc
+ peep acc (i:rest) = case matchPattern i rest of
+ Just (replacement, remaining) -> peep acc (replacement ++ remaining)
+ Nothing -> peep (i:acc) rest
+
+-- | Try to match a peephole pattern starting at the given instruction.
+-- Returns Just (replacement, remaining) if a pattern matches.
+matchPattern :: Instr -> [Instr] -> Maybe ([Instr], [Instr])
+matchPattern i rest = case i of
+
+ -- Pattern: Identity move elimination
+ -- MOV r, r → (removed)
+ MOV o1 o2
+ | o1 == o2
+ -> Just ([], rest)
+
+ -- Pattern: STR-of-zero
+ -- MOV/MOVZ reg, #0; STR fmt reg addr → STR fmt xzr addr
+ -- Uses the hardware zero register to avoid materializing zero.
+ -- Restricted to II32/II64: pprReg only handles the zero register
+ -- (RealRegSingle -1) at W32 (wzr) and W64 (xzr) widths, so we cannot
+ -- substitute xzr into II8/II16 stores.
+ _ | Just (dst, dst_n) <- isZeroMov i
+ , (STR fmt (OpReg w' src) addr : rest') <- rest
+ , RegReal (RealRegSingle src_n) <- src
+ , dst_n == src_n
+ , dst_n < 32 -- GP register
+ , fmt == II32 || fmt == II64 -- zero register only printable at W32/W64
+ , not (addrUsesReg dst addr) -- dst not used in the address computation
+ -> Just ([STR fmt (OpReg w' (RegReal (RealRegSingle (-1)))) addr], rest')
+ -- regNo -1 is the zero register (xzr/wzr)
+
+ -- Pattern: LDP formation from consecutive LDRs
+ -- LDR fmt r1, [base, #off]; LDR fmt r2, [base, #off+size] → LDP fmt r1, r2, [base, #off]
+ -- Note: LDP/STP only support 32-bit and 64-bit integer registers (no 8/16-bit).
+ LDR fmt1 dst1@(OpReg _w1 r1) (OpAddr (AddrRegImm base1 (ImmInt off1)))
+ | (LDR fmt2 dst2@(OpReg _w2 r2) (OpAddr (AddrRegImm base2 (ImmInt off2))) : rest') <- rest
+ , fmt1 == fmt2
+ , base1 == base2
+ , r1 /= r2
+ , off2 == off1 + formatInBytes fmt1
+ , isLdpStpFormat fmt1
+ , isLdpStpOffset off1 fmt1
+ , not (isFloatFormat fmt1) -- Only integer registers for now
+ -> Just ([LDP fmt1 dst1 dst2 (OpAddr (AddrRegImm base1 (ImmInt off1)))], rest')
+
+ -- Pattern: LDP formation (reversed order)
+ -- LDR fmt r2, [base, #off+size]; LDR fmt r1, [base, #off] → LDP fmt r1, r2, [base, #off]
+ LDR fmt1 dst1@(OpReg _w1 r1) (OpAddr (AddrRegImm base1 (ImmInt off1)))
+ | (LDR fmt2 dst2@(OpReg _w2 r2) (OpAddr (AddrRegImm base2 (ImmInt off2))) : rest') <- rest
+ , fmt1 == fmt2
+ , base1 == base2
+ , r1 /= r2
+ , off1 == off2 + formatInBytes fmt1
+ , isLdpStpFormat fmt1
+ , isLdpStpOffset off2 fmt1
+ , not (isFloatFormat fmt1)
+ -- Ensure first load's destination isn't the base register
+ , not (regUsedIn r1 base1)
+ -> Just ([LDP fmt1 dst2 dst1 (OpAddr (AddrRegImm base1 (ImmInt off2)))], rest')
+
+ -- Pattern: STP formation from consecutive STRs
+ -- STR fmt r1, [base, #off]; STR fmt r2, [base, #off+size] → STP fmt r1, r2, [base, #off]
+ STR fmt1 src1@(OpReg _w1 _) (OpAddr (AddrRegImm base1 (ImmInt off1)))
+ | (STR fmt2 src2@(OpReg _w2 _) (OpAddr (AddrRegImm base2 (ImmInt off2))) : rest') <- rest
+ , fmt1 == fmt2
+ , base1 == base2
+ , off2 == off1 + formatInBytes fmt1
+ , isLdpStpFormat fmt1
+ , isLdpStpOffset off1 fmt1
+ , not (isFloatFormat fmt1)
+ -> Just ([STP fmt1 src1 src2 (OpAddr (AddrRegImm base1 (ImmInt off1)))], rest')
+
+ -- Pattern: STP formation (reversed order)
+ STR fmt1 src1@(OpReg _w1 _) (OpAddr (AddrRegImm base1 (ImmInt off1)))
+ | (STR fmt2 src2@(OpReg _w2 _) (OpAddr (AddrRegImm base2 (ImmInt off2))) : rest') <- rest
+ , fmt1 == fmt2
+ , base1 == base2
+ , off1 == off2 + formatInBytes fmt1
+ , isLdpStpFormat fmt1
+ , isLdpStpOffset off2 fmt1
+ , not (isFloatFormat fmt1)
+ -> Just ([STP fmt1 src2 src1 (OpAddr (AddrRegImm base1 (ImmInt off2)))], rest')
+
+ -- Pattern: Redundant extension elimination
+ -- EXT dst, src; EXT dst', src' where dst==dst'==src'==src → EXT dst, src
+ UXTB dst _src
+ | (UXTB dst' src' : rest') <- rest
+ , dst == dst', dst == src'
+ -> Just ([i], rest')
+ UXTH dst _src
+ | (UXTH dst' src' : rest') <- rest
+ , dst == dst', dst == src'
+ -> Just ([i], rest')
+ SXTB dst _src
+ | (SXTB dst' src' : rest') <- rest
+ , dst == dst', dst == src'
+ -> Just ([i], rest')
+ SXTH dst _src
+ | (SXTH dst' src' : rest') <- rest
+ , dst == dst', dst == src'
+ -> Just ([i], rest')
+
+ -- Pattern: CMP + CSET + CBNZ/CBZ → CMP + BCOND
+ -- CMP x, y; CSET w, cond; CBNZ w, lbl → CMP x, y; BCOND cond lbl
+ -- CMP x, y; CSET w, cond; CBZ w, lbl → CMP x, y; BCOND !cond lbl
+ --
+ -- Safety: This removes the CSET, so cset_dst no longer gets written.
+ -- This is safe because CBNZ/CBZ terminates the basic block, and
+ -- the peephole runs per-block. The CMP+CSET+CB{N}Z pattern is
+ -- generated by the backend specifically for conditional branches
+ -- where the boolean register is only consumed by the branch.
+ CMP _ _
+ | (CSET (OpReg _ cset_dst) cond : branch : rest') <- rest
+ , Just target <- cbnzTarget cset_dst branch
+ -> Just ([i, BCOND (branchCond cond branch) target], rest')
+
+ -- Annotations: look through annotations for pattern matching
+ ANN doc inner
+ | Just (replacement, remaining) <- matchPattern inner rest
+ -> Just (map (ANN doc) replacement, remaining)
+
+ _ -> Nothing
+
+-- | Recognize a zero-materializing move instruction.
+-- Matches both MOV reg, #0 and MOVZ reg, #0 (the latter is emitted
+-- by inlineMemset for zero fills).
+isZeroMov :: Instr -> Maybe (Reg, Int)
+isZeroMov (MOV (OpReg _w dst) (OpImm (ImmInt 0)))
+ | RegReal (RealRegSingle n) <- dst = Just (dst, n)
+isZeroMov (MOVZ (OpReg _w dst) (OpImm (ImmInt 0)))
+ | RegReal (RealRegSingle n) <- dst = Just (dst, n)
+isZeroMov _ = Nothing
+
+-- | Extract branch target from CBNZ/CBZ if it references the given register
+cbnzTarget :: Reg -> Instr -> Maybe Target
+cbnzTarget r (CBNZ (OpReg _ r') t) | r == r' = Just t
+cbnzTarget r (CBZ (OpReg _ r') t) | r == r' = Just t
+cbnzTarget _ _ = Nothing
+
+-- | Determine the effective condition for CMP+CSET+CBZ/CBNZ fusion.
+-- CBNZ tests "not zero" → the CSET condition is used directly.
+-- CBZ tests "zero" → the CSET condition is inverted.
+branchCond :: Cond -> Instr -> Cond
+branchCond cond (CBNZ _ _) = cond
+branchCond cond (CBZ _ _) = invertCond cond
+branchCond _ _ = error "branchCond: not a CBZ/CBNZ"
+
+-- | Check if a format is supported by LDP/STP.
+-- AArch64 LDP/STP only support 32-bit and 64-bit integer registers
+-- (and SIMD/FP registers, which we don't handle here). There are no
+-- 8-bit or 16-bit paired load/store instructions.
+isLdpStpFormat :: Format -> Bool
+isLdpStpFormat II32 = True
+isLdpStpFormat II64 = True
+isLdpStpFormat _ = False
+
+-- | Check if an offset is valid for LDP/STP.
+-- LDP/STP use a 7-bit signed immediate, scaled by the access size.
+-- 64-bit: offset must be multiple of 8, range [-512, 504]
+-- 32-bit: offset must be multiple of 4, range [-256, 252]
+isLdpStpOffset :: Int -> Format -> Bool
+isLdpStpOffset off fmt =
+ let scale = formatInBytes fmt
+ in off `mod` scale == 0
+ && off >= -64 * scale
+ && off <= 63 * scale
+
+-- | Check if a register is used in an address mode operand.
+addrUsesReg :: Reg -> Operand -> Bool
+addrUsesReg r (OpAddr (AddrRegReg r1 r2)) = r == r1 || r == r2
+addrUsesReg r (OpAddr (AddrRegImm r1 _)) = r == r1
+addrUsesReg r (OpAddr (AddrReg r1)) = r == r1
+addrUsesReg _ _ = False
+
+-- | Check if a register is the same as an address base register.
+regUsedIn :: Reg -> Reg -> Bool
+regUsedIn = (==)
diff --git a/compiler/GHC/CmmToAsm/AArch64/Ppr.hs b/compiler/GHC/CmmToAsm/AArch64/Ppr.hs
index 25c448feaf30..64532cf59583 100644
--- a/compiler/GHC/CmmToAsm/AArch64/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/AArch64/Ppr.hs
@@ -7,6 +7,7 @@ import GHC.Prelude hiding (EQ)
import GHC.CmmToAsm.AArch64.Instr
import GHC.CmmToAsm.AArch64.Regs
import GHC.CmmToAsm.AArch64.Cond
+import GHC.CmmToAsm.AArch64.Peephole (peephole)
import GHC.CmmToAsm.Ppr
import GHC.CmmToAsm.Format
import GHC.Platform.Reg
@@ -115,10 +116,11 @@ pprBasicBlock platform with_dwarf info_env (BasicBlock blockid instrs)
else empty
)
where
- -- Filter out identity moves. E.g. mov x18, x18 will be dropped.
- optInstrs = filter f instrs
- where f (MOV o1 o2) | o1 == o2 = False
- f _ = True
+ -- Post-register-allocation peephole optimizer.
+ -- Rewrites instruction sequences to use AArch64-specific instructions
+ -- like LDP/STP, eliminates redundant moves and extensions, and fuses
+ -- CMP+CSET+CB{N}Z into BCOND.
+ optInstrs = peephole instrs
asmLbl = blockLbl blockid
maybe_infotable c = case mapLookup blockid info_env of
@@ -408,6 +410,7 @@ pprInstr platform instr = case instr of
SXTB o1 o2 -> op2 (text "\tsxtb") o1 o2
UXTB o1 o2 -> op2 (text "\tuxtb") o1 o2
SXTH o1 o2 -> op2 (text "\tsxth") o1 o2
+ SXTW o1 o2 -> op2 (text "\tsxtw") o1 o2
UXTH o1 o2 -> op2 (text "\tuxth") o1 o2
-- 3. Logical and Move Instructions ------------------------------------------
@@ -420,6 +423,7 @@ pprInstr platform instr = case instr of
| isFloatOp o1 || isFloatOp o2 -> op2 (text "\tfmov") o1 o2
| otherwise -> op2 (text "\tmov") o1 o2
MOVK o1 o2 -> op2 (text "\tmovk") o1 o2
+ MOVN o1 o2 -> op2 (text "\tmovn") o1 o2
MOVZ o1 o2 -> op2 (text "\tmovz") o1 o2
MVN o1 o2 -> op2 (text "\tmvn") o1 o2
ORR o1 o2 o3 -> op3 (text "\torr") o1 o2 o3
@@ -442,6 +446,9 @@ pprInstr platform instr = case instr of
-- 5. Atomic Instructions ----------------------------------------------------
-- 6. Conditional Instructions -----------------------------------------------
CSET o c -> line $ text "\tcset" <+> pprOp platform o <> comma <+> pprCond c
+ CSEL o1 o2 o3 c -> line $ text "\tcsel" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprCond c
+ CSINC o1 o2 o3 c -> line $ text "\tcsinc" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprCond c
+ CSNEG o1 o2 o3 c -> line $ text "\tcsneg" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprCond c
CBZ o (TBlock bid) -> line $ text "\tcbz" <+> pprOp platform o <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid))
CBZ o (TLabel lbl) -> line $ text "\tcbz" <+> pprOp platform o <> comma <+> pprAsmLabel platform lbl
@@ -451,6 +458,14 @@ pprInstr platform instr = case instr of
CBNZ o (TLabel lbl) -> line $ text "\tcbnz" <+> pprOp platform o <> comma <+> pprAsmLabel platform lbl
CBNZ _ (TReg _) -> panic "AArch64.ppr: No conditional (cbnz) branching to registers!"
+ TBZ o bit (TBlock bid) -> line $ text "\ttbz" <+> pprOp platform o <> comma <+> char '#' <> int bit <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid))
+ TBZ o bit (TLabel lbl) -> line $ text "\ttbz" <+> pprOp platform o <> comma <+> char '#' <> int bit <> comma <+> pprAsmLabel platform lbl
+ TBZ _ _ (TReg _) -> panic "AArch64.ppr: No conditional (tbz) branching to registers!"
+
+ TBNZ o bit (TBlock bid) -> line $ text "\ttbnz" <+> pprOp platform o <> comma <+> char '#' <> int bit <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid))
+ TBNZ o bit (TLabel lbl) -> line $ text "\ttbnz" <+> pprOp platform o <> comma <+> char '#' <> int bit <> comma <+> pprAsmLabel platform lbl
+ TBNZ _ _ (TReg _) -> panic "AArch64.ppr: No conditional (tbnz) branching to registers!"
+
-- 7. Load and Store Instructions --------------------------------------------
-- NOTE: GHC may do whacky things where it only load the lower part of an
-- address. Not observing the correct size when loading will lead
@@ -481,6 +496,16 @@ pprInstr platform instr = case instr of
op_ldr o1 (ldr') $$
op_add o1 (check_off off)
+ -- Fold small offsets (pointer tags 1-7) into the @pageoff relocation,
+ -- saving one instruction per tagged closure reference.
+ -- Safe because closures are 8-byte aligned (max pageoff 4088) and
+ -- tags are at most 7, so 4088+7=4095 fits in 12 bits without
+ -- crossing a page boundary.
+ LDR _f o1 (OpImm (ImmIndex lbl off)) | off > 0, off <= 7 ->
+ let (adrp', add') = op_adrp_reloc_local $ pprAsmLabel platform lbl in
+ op_adrp o1 adrp' $$
+ op_add o1 (add' <> text " + " <> int off)
+
LDR _f o1 (OpImm (ImmIndex lbl off)) ->
let (adrp', add') = op_adrp_reloc_local $ pprAsmLabel platform lbl in
op_adrp o1 (adrp') $$
@@ -515,6 +540,9 @@ pprInstr platform instr = case instr of
LDR _f o1 o2 -> op2 (text "\tldr") o1 o2
LDAR _f o1 o2 -> op2 (text "\tldar") o1 o2
+ STP _f o1 o2 o3 -> op3 (text "\tstp") o1 o2 o3
+ LDP _f o1 o2 o3 -> op3 (text "\tldp") o1 o2 o3
+
-- 8. Synchronization Instructions -------------------------------------------
DMBISH DmbLoadStore -> line $ text "\tdmb ish"
DMBISH DmbLoad -> line $ text "\tdmb ishld"
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph.hs b/compiler/GHC/CmmToAsm/Reg/Graph.hs
index 37c80fa3960d..28c1f0dbd3ea 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph.hs
@@ -339,14 +339,14 @@ buildGraph platform code
-- Conflicts between virtual and real regs are recorded as exclusions.
graphAddConflictSet
:: Platform
- -> UniqSet RegWithFormat
+ -> Regs
-> Color.Graph VirtualReg RegClass RealReg
-> Color.Graph VirtualReg RegClass RealReg
graphAddConflictSet platform regs graph
= let arch = platformArch platform
- virtuals = takeVirtualRegs regs
- reals = takeRealRegs regs
+ virtuals = takeVirtualRegs $ getRegs regs
+ reals = takeRealRegs $ getRegs regs
graph1 = Color.addConflicts virtuals (classOfVirtualReg arch) graph
-- NB: we could add "arch" as argument to functions such as "addConflicts"
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/Coalesce.hs b/compiler/GHC/CmmToAsm/Reg/Graph/Coalesce.hs
index 5f0455747f82..4a38372f0b99 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/Coalesce.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/Coalesce.hs
@@ -13,10 +13,8 @@ import GHC.Cmm
import GHC.Data.Bag
import GHC.Data.Graph.Directed
import GHC.Platform (Platform)
-import GHC.Types.Unique (getUnique)
import GHC.Types.Unique.FM
import GHC.Types.Unique.Supply
-import GHC.Types.Unique.Set
-- | Do register coalescing on this top level thing
--
@@ -88,8 +86,8 @@ slurpJoinMovs platform live
slurpLI rs (LiveInstr _ Nothing) = rs
slurpLI rs (LiveInstr instr (Just live))
| Just (r1, r2) <- takeRegRegMoveInstr platform instr
- , elemUniqSet_Directly (getUnique r1) $ liveDieRead live
- , elemUniqSet_Directly (getUnique r2) $ liveBorn live
+ , r1 `elemRegs` liveDieRead live
+ , r2 `elemRegs` liveBorn live
-- only coalesce movs between two virtuals for now,
-- else we end up with allocatable regs in the live
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs b/compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs
index adc21b26a008..3c21f6c88d82 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs
@@ -144,7 +144,7 @@ regSpill_top platform regSlotMap cmm
-- then record the fact that these slots are now live in those blocks
-- in the given slotmap.
patchLiveSlot
- :: BlockMap IntSet -> BlockId -> UniqSet RegWithFormat-> BlockMap IntSet
+ :: BlockMap IntSet -> BlockId -> Regs -> BlockMap IntSet
patchLiveSlot slotMap blockId regsLive
= let
@@ -154,7 +154,8 @@ regSpill_top platform regSlotMap cmm
moreSlotsLive = IntSet.fromList
$ mapMaybe (lookupUFM regSlotMap . regWithFormat_reg)
- $ nonDetEltsUniqSet regsLive
+ $ nonDetEltsUniqSet
+ $ getRegs regsLive
-- See Note [Unique Determinism and code generation]
slotMap'
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs b/compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs
index 5c311af3e322..c3dc74ba2a43 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs
@@ -102,7 +102,7 @@ slurpSpillCostInfo platform cfg cmm
countBlock info freqMap (BasicBlock blockId instrs)
| LiveInfo _ _ blockLive _ <- info
, Just rsLiveEntry <- mapLookup blockId blockLive
- , rsLiveEntry_virt <- takeVirtualRegs rsLiveEntry
+ , rsLiveEntry_virt <- takeVirtualRegs $ getRegs rsLiveEntry
= countLIs (ceiling $ blockFreq freqMap blockId) rsLiveEntry_virt instrs
| otherwise
@@ -136,9 +136,9 @@ slurpSpillCostInfo platform cfg cmm
mapM_ (incDefs scale) $ nub $ mapMaybe (takeVirtualReg . regWithFormat_reg) written
-- Compute liveness for entry to next instruction.
- let liveDieRead_virt = takeVirtualRegs (liveDieRead live)
- let liveDieWrite_virt = takeVirtualRegs (liveDieWrite live)
- let liveBorn_virt = takeVirtualRegs (liveBorn live)
+ let liveDieRead_virt = takeVirtualRegs $ getRegs (liveDieRead live)
+ let liveDieWrite_virt = takeVirtualRegs $ getRegs (liveDieWrite live)
+ let liveBorn_virt = takeVirtualRegs $ getRegs (liveBorn live)
let rsLiveAcross
= rsLiveEntry `minusUniqSet` liveDieRead_virt
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear.hs b/compiler/GHC/CmmToAsm/Reg/Linear.hs
index 5756c17246c0..e6076cd133a2 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear.hs
@@ -207,7 +207,7 @@ linearRegAlloc
:: forall instr. (Instruction instr)
=> NCGConfig
-> [BlockId] -- ^ entry points
- -> BlockMap (UniqSet RegWithFormat)
+ -> BlockMap Regs
-- ^ live regs on entry to each basic block
-> [SCC (LiveBasicBlock instr)]
-- ^ instructions annotated with "deaths"
@@ -246,7 +246,7 @@ linearRegAlloc'
=> NCGConfig
-> freeRegs
-> [BlockId] -- ^ entry points
- -> BlockMap (UniqSet RegWithFormat) -- ^ live regs on entry to each basic block
+ -> BlockMap Regs -- ^ live regs on entry to each basic block
-> [SCC (LiveBasicBlock instr)] -- ^ instructions annotated with "deaths"
-> UniqDSM ([NatBasicBlock instr], RegAllocStats, Int)
@@ -260,7 +260,7 @@ linearRegAlloc' config initFreeRegs entry_ids block_live sccs
linearRA_SCCs :: OutputableRegConstraint freeRegs instr
=> [BlockId]
- -> BlockMap (UniqSet RegWithFormat)
+ -> BlockMap Regs
-> [NatBasicBlock instr]
-> [SCC (LiveBasicBlock instr)]
-> RegM freeRegs [NatBasicBlock instr]
@@ -295,7 +295,7 @@ linearRA_SCCs entry_ids block_live blocksAcc (CyclicSCC blocks : sccs)
process :: forall freeRegs instr. (OutputableRegConstraint freeRegs instr)
=> [BlockId]
- -> BlockMap (UniqSet RegWithFormat)
+ -> BlockMap Regs
-> [GenBasicBlock (LiveInstr instr)]
-> RegM freeRegs [[NatBasicBlock instr]]
process entry_ids block_live =
@@ -334,7 +334,7 @@ process entry_ids block_live =
--
processBlock
:: OutputableRegConstraint freeRegs instr
- => BlockMap (UniqSet RegWithFormat) -- ^ live regs on entry to each basic block
+ => BlockMap Regs -- ^ live regs on entry to each basic block
-> LiveBasicBlock instr -- ^ block to do register allocation on
-> RegM freeRegs [NatBasicBlock instr] -- ^ block with registers allocated
@@ -351,7 +351,7 @@ processBlock block_live (BasicBlock id instrs)
-- | Load the freeregs and current reg assignment into the RegM state
-- for the basic block with this BlockId.
initBlock :: FR freeRegs
- => BlockId -> BlockMap (UniqSet RegWithFormat) -> RegM freeRegs ()
+ => BlockId -> BlockMap Regs -> RegM freeRegs ()
initBlock id block_live
= do platform <- getPlatform
block_assig <- getBlockAssigR
@@ -368,7 +368,7 @@ initBlock id block_live
setFreeRegsR (frInitFreeRegs platform)
Just live ->
setFreeRegsR $ foldl' (flip $ frAllocateReg platform) (frInitFreeRegs platform)
- (nonDetEltsUniqSet $ takeRealRegs live)
+ (nonDetEltsUniqSet $ takeRealRegs $ getRegs live)
-- See Note [Unique Determinism and code generation]
setAssigR emptyRegMap
@@ -381,7 +381,7 @@ initBlock id block_live
-- | Do allocation for a sequence of instructions.
linearRA
:: forall freeRegs instr. (OutputableRegConstraint freeRegs instr)
- => BlockMap (UniqSet RegWithFormat) -- ^ map of what vregs are live on entry to each block.
+ => BlockMap Regs -- ^ map of what vregs are live on entry to each block.
-> BlockId -- ^ id of the current block, for debugging.
-> [LiveInstr instr] -- ^ liveness annotated instructions in this block.
-> RegM freeRegs
@@ -406,7 +406,7 @@ linearRA block_live block_id = go [] []
-- | Do allocation for a single instruction.
raInsn
:: OutputableRegConstraint freeRegs instr
- => BlockMap (UniqSet RegWithFormat) -- ^ map of what vregs are love on entry to each block.
+ => BlockMap Regs -- ^ map of what vregs are live on entry to each block.
-> [instr] -- ^ accumulator for instructions already processed.
-> BlockId -- ^ the id of the current block, for debugging
-> LiveInstr instr -- ^ the instr to have its regs allocated, with liveness info.
@@ -427,7 +427,7 @@ raInsn _ new_instrs _ (LiveInstr ii@(Instr i) Nothing)
raInsn block_live new_instrs id (LiveInstr (Instr instr) (Just live))
= do
platform <- getPlatform
- assig <- getAssigR :: RegM freeRegs (UniqFM Reg Loc)
+ assig <- getAssigR
-- If we have a reg->reg move between virtual registers, where the
-- src register is not live after this instruction, and the dst
@@ -437,12 +437,12 @@ raInsn block_live new_instrs id (LiveInstr (Instr instr) (Just live))
-- (we can't eliminate it if the source register is on the stack, because
-- we do not want to use one spill slot for different virtual registers)
case takeRegRegMoveInstr platform instr of
- Just (src,dst) | Just (RegWithFormat _ fmt) <- lookupUniqSet_Directly (liveDieRead live) (getUnique src),
+ Just (src,dst) | Just fmt <- lookupReg src (liveDieRead live),
isVirtualReg dst,
not (dst `elemUFM` assig),
isRealReg src || isInReg src assig -> do
case src of
- RegReal rr -> setAssigR (addToUFM assig dst (InReg $ RealRegUsage rr fmt))
+ RegReal rr -> setAssigR (addToUFM assig dst (Loc (InReg rr) fmt))
-- if src is a fixed reg, then we just map dest to this
-- reg in the assignment. src must be an allocatable reg,
-- otherwise it wouldn't be in r_dying.
@@ -461,8 +461,8 @@ raInsn block_live new_instrs id (LiveInstr (Instr instr) (Just live))
return (new_instrs, [])
_ -> genRaInsn block_live new_instrs id instr
- (map regWithFormat_reg $ nonDetEltsUniqSet $ liveDieRead live)
- (map regWithFormat_reg $ nonDetEltsUniqSet $ liveDieWrite live)
+ (map regWithFormat_reg $ nonDetEltsUniqSet $ getRegs $ liveDieRead live)
+ (map regWithFormat_reg $ nonDetEltsUniqSet $ getRegs $ liveDieWrite live)
-- See Note [Unique Determinism and code generation]
raInsn _ _ _ instr
@@ -485,13 +485,16 @@ raInsn _ _ _ instr
isInReg :: Reg -> RegMap Loc -> Bool
-isInReg src assig | Just (InReg _) <- lookupUFM assig src = True
- | otherwise = False
+isInReg src assig
+ | Just (Loc (InReg _) _) <- lookupUFM assig src
+ = True
+ | otherwise
+ = False
genRaInsn :: forall freeRegs instr.
(OutputableRegConstraint freeRegs instr)
- => BlockMap (UniqSet RegWithFormat)
+ => BlockMap Regs
-> [instr]
-> BlockId
-> instr
@@ -504,8 +507,8 @@ genRaInsn block_live new_instrs block_id instr r_dying w_dying = do
platform <- getPlatform
case regUsageOfInstr platform instr of { RU read written ->
do
- let real_written = [ rr | RegWithFormat {regWithFormat_reg = RegReal rr} <- written ]
- let virt_written = [ VirtualRegWithFormat vr fmt | RegWithFormat (RegVirtual vr) fmt <- written ]
+ let real_written = [ rr | RegWithFormat {regWithFormat_reg = RegReal rr} <- written ]
+ let virt_written = [ VirtualRegWithFormat vr fmt | RegWithFormat (RegVirtual vr) fmt <- written ]
-- we don't need to do anything with real registers that are
-- only read by this instr. (the list is typically ~2 elements,
@@ -643,14 +646,16 @@ releaseRegs regs = do
loop assig !free (RegReal rr : rs) = loop assig (frReleaseReg platform rr free) rs
loop assig !free (r:rs) =
case lookupUFM assig r of
- Just (InBoth real _) -> loop (delFromUFM assig r)
- (frReleaseReg platform (realReg real) free) rs
- Just (InReg real) -> loop (delFromUFM assig r)
- (frReleaseReg platform (realReg real) free) rs
- _ -> loop (delFromUFM assig r) free rs
+ Just (Loc (InBoth real _) _) ->
+ loop (delFromUFM assig r)
+ (frReleaseReg platform real free) rs
+ Just (Loc (InReg real) _) ->
+ loop (delFromUFM assig r)
+ (frReleaseReg platform real free) rs
+ _ ->
+ loop (delFromUFM assig r) free rs
loop assig free regs
-
-- -----------------------------------------------------------------------------
-- Clobber real registers
@@ -668,17 +673,18 @@ releaseRegs regs = do
saveClobberedTemps
:: forall instr freeRegs.
(Instruction instr, FR freeRegs)
- => [RealReg] -- real registers clobbered by this instruction
- -> [Reg] -- registers which are no longer live after this insn
- -> RegM freeRegs [instr] -- return: instructions to spill any temps that will
- -- be clobbered.
+ => [RealReg] -- ^ real registers clobbered by this instruction
+ -> [Reg] -- ^ registers which are no longer live after this instruction,
+ -- because read for the last time
+ -> RegM freeRegs [instr] -- return: instructions to spill any temps that will
+ -- be clobbered.
saveClobberedTemps [] _
= return []
saveClobberedTemps clobbered dying
= do
- assig <- getAssigR :: RegM freeRegs (UniqFM Reg Loc)
+ assig <- getAssigR
(assig',instrs) <- nonDetStrictFoldUFM_DirectlyM maybe_spill (assig,[]) assig
setAssigR assig'
return $ -- mkComment (text "") ++
@@ -687,19 +693,21 @@ saveClobberedTemps clobbered dying
where
-- Unique represents the VirtualReg
-- Here we separate the cases which we do want to spill from these we don't.
- maybe_spill :: Unique -> (RegMap Loc,[instr]) -> (Loc) -> RegM freeRegs (RegMap Loc,[instr])
+ maybe_spill :: Unique
+ -> (RegMap Loc,[instr])
+ -> Loc
+ -> RegM freeRegs (RegMap Loc,[instr])
maybe_spill !temp !(assig,instrs) !loc =
case loc of
-- This is non-deterministic but we do not
-- currently support deterministic code-generation.
-- See Note [Unique Determinism and code generation]
- InReg reg
- | any (realRegsAlias $ realReg reg) clobbered
+ Loc (InReg reg) fmt
+ | any (realRegsAlias reg) clobbered
, temp `notElem` map getUnique dying
- -> clobber temp (assig,instrs) reg
+ -> clobber temp (assig,instrs) (RealRegUsage reg fmt)
_ -> return (assig,instrs)
-
-- See Note [UniqFM and the register allocator]
clobber :: Unique -> (RegMap Loc,[instr]) -> RealRegUsage -> RegM freeRegs (RegMap Loc,[instr])
clobber temp (assig,instrs) (RealRegUsage reg fmt)
@@ -718,7 +726,7 @@ saveClobberedTemps clobbered dying
(my_reg : _) -> do
setFreeRegsR (frAllocateReg platform my_reg freeRegs)
- let new_assign = addToUFM_Directly assig temp (InReg (RealRegUsage my_reg fmt))
+ let new_assign = addToUFM_Directly assig temp (Loc (InReg my_reg) fmt)
let instr = mkRegRegMoveInstr config fmt
(RegReal reg) (RegReal my_reg)
@@ -726,12 +734,13 @@ saveClobberedTemps clobbered dying
-- (2) no free registers: spill the value
[] -> do
+
(spill, slot) <- spillR (RegWithFormat (RegReal reg) fmt) temp
-- record why this reg was spilled for profiling
recordSpill (SpillClobber temp)
- let new_assign = addToUFM_Directly assig temp (InBoth (RealRegUsage reg fmt) slot)
+ let new_assign = addToUFM_Directly assig temp (Loc (InBoth reg slot) fmt)
return (new_assign, (spill ++ instrs))
@@ -779,9 +788,9 @@ clobberRegs clobbered
clobber assig []
= assig
- clobber assig ((temp, InBoth reg slot) : rest)
- | any (realRegsAlias $ realReg reg) clobbered
- = clobber (addToUFM_Directly assig temp (InMem slot)) rest
+ clobber assig ((temp, Loc (InBoth reg slot) regFmt) : rest)
+ | any (realRegsAlias reg) clobbered
+ = clobber (addToUFM_Directly assig temp (Loc (InMem slot) regFmt)) rest
clobber assig (_:rest)
= clobber assig rest
@@ -790,9 +799,9 @@ clobberRegs clobbered
-- allocateRegsAndSpill
-- Why are we performing a spill?
-data SpillLoc = ReadMem StackSlot -- reading from register only in memory
- | WriteNew -- writing to a new variable
- | WriteMem -- writing to register only in memory
+data SpillLoc = ReadMem StackSlot Format -- reading from register only in memory
+ | WriteNew -- writing to a new variable
+ | WriteMem -- writing to register only in memory
-- Note that ReadNew is not valid, since you don't want to be reading
-- from an uninitialized register. We also don't need the location of
-- the register in memory, since that will be invalidated by the write.
@@ -818,28 +827,36 @@ allocateRegsAndSpill
allocateRegsAndSpill _ _ spills alloc []
= return (spills, reverse alloc)
-allocateRegsAndSpill reading keep spills alloc (r@(VirtualRegWithFormat vr _fmt):rs)
+allocateRegsAndSpill reading keep spills alloc (r@(VirtualRegWithFormat vr vrFmt):rs)
= do assig <- toVRegMap <$> getAssigR
-- pprTraceM "allocateRegsAndSpill:assig" (ppr (r:rs) $$ ppr assig)
-- See Note [UniqFM and the register allocator]
let doSpill = allocRegsAndSpill_spill reading keep spills alloc r rs assig
case lookupUFM assig vr of
-- case (1a): already in a register
- Just (InReg my_reg) ->
- allocateRegsAndSpill reading keep spills (realReg my_reg:alloc) rs
+ Just (Loc (InReg my_reg) in_reg_fmt) -> do
+ -- (RF1) from Note [Allocated register formats]:
+ -- writes redefine the format the register is used at.
+ when (not reading && vrFmt /= in_reg_fmt) $
+ setAssigR $ toRegMap $
+ addToUFM assig vr (Loc (InReg my_reg) vrFmt)
+ allocateRegsAndSpill reading keep spills (my_reg:alloc) rs
-- case (1b): already in a register (and memory)
- -- NB1. if we're writing this register, update its assignment to be
- -- InReg, because the memory value is no longer valid.
- -- NB2. This is why we must process written registers here, even if they
- -- are also read by the same instruction.
- Just (InBoth my_reg _)
- -> do when (not reading) (setAssigR $ toRegMap (addToUFM assig vr (InReg my_reg)))
- allocateRegsAndSpill reading keep spills (realReg my_reg:alloc) rs
+ Just (Loc (InBoth my_reg _) _) -> do
+ -- NB1. if we're writing this register, update its assignment to be
+ -- InReg, because the memory value is no longer valid.
+ -- NB2. This is why we must process written registers here, even if they
+ -- are also read by the same instruction.
+ when (not reading) $
+ setAssigR $ toRegMap $
+ addToUFM assig vr (Loc (InReg my_reg) vrFmt)
+ allocateRegsAndSpill reading keep spills (my_reg:alloc) rs
-- Not already in a register, so we need to find a free one...
- Just (InMem slot) | reading -> doSpill (ReadMem slot)
- | otherwise -> doSpill WriteMem
+ Just (Loc (InMem slot) memFmt)
+ | reading -> doSpill (ReadMem slot memFmt)
+ | otherwise -> doSpill WriteMem
Nothing | reading ->
pprPanic "allocateRegsAndSpill: Cannot read from uninitialized register" (ppr vr)
-- NOTE: if the input to the NCG contains some
@@ -875,7 +892,7 @@ allocRegsAndSpill_spill :: (FR freeRegs, Instruction instr)
-> UniqFM VirtualReg Loc
-> SpillLoc
-> RegM freeRegs ([instr], [RealReg])
-allocRegsAndSpill_spill reading keep spills alloc r@(VirtualRegWithFormat vr fmt) rs assig spill_loc
+allocRegsAndSpill_spill reading keep spills alloc r@(VirtualRegWithFormat vr vrFmt) rs assig spill_loc
= do platform <- getPlatform
freeRegs <- getFreeRegsR
let regclass = classOfVirtualReg (platformArch platform) vr
@@ -897,7 +914,7 @@ allocRegsAndSpill_spill reading keep spills alloc r@(VirtualRegWithFormat vr fmt
spills' <- loadTemp r spill_loc final_reg spills
setAssigR $ toRegMap
- $ (addToUFM assig vr $! newLocation spill_loc $ RealRegUsage final_reg fmt)
+ $ (addToUFM assig vr $! newLocation spill_loc $ RealRegUsage final_reg vrFmt)
setFreeRegsR $ frAllocateReg platform final_reg freeRegs
allocateRegsAndSpill reading keep spills' (final_reg : alloc) rs
@@ -911,7 +928,7 @@ allocRegsAndSpill_spill reading keep spills alloc r@(VirtualRegWithFormat vr fmt
let candidates' :: UniqFM VirtualReg Loc
candidates' =
flip delListFromUFM (fmap virtualRegWithFormat_reg keep) $
- filterUFM inRegOrBoth $
+ filterUFM (inRegOrBoth . locWithFormat_loc) $
assig
-- This is non-deterministic but we do not
-- currently support deterministic code-generation.
@@ -924,50 +941,54 @@ allocRegsAndSpill_spill reading keep spills alloc r@(VirtualRegWithFormat vr fmt
== regclass
candidates_inBoth :: [(Unique, RealRegUsage, StackSlot)]
candidates_inBoth
- = [ (temp, reg, mem)
- | (temp, InBoth reg mem) <- candidates
- , compat (realReg reg) ]
+ = [ (temp, RealRegUsage reg fmt, mem)
+ | (temp, Loc (InBoth reg mem) fmt) <- candidates
+ , compat reg ]
-- the vregs we could kick out that are only in a reg
-- this would require writing the reg to a new slot before using it.
let candidates_inReg
- = [ (temp, reg)
- | (temp, InReg reg) <- candidates
- , compat (realReg reg) ]
+ = [ (temp, RealRegUsage reg fmt)
+ | (temp, Loc (InReg reg) fmt) <- candidates
+ , compat reg ]
let result
-- we have a temporary that is in both register and mem,
-- just free up its register for use.
- | (temp, (RealRegUsage my_reg _old_fmt), slot) : _ <- candidates_inBoth
- = do spills' <- loadTemp r spill_loc my_reg spills
- let assig1 = addToUFM_Directly assig temp (InMem slot)
- let assig2 = addToUFM assig1 vr $! newLocation spill_loc (RealRegUsage my_reg fmt)
+ | (temp, (RealRegUsage cand_reg old_fmt), slot) : _ <- candidates_inBoth
+ = do spills' <- loadTemp r spill_loc cand_reg spills
+ let assig1 = addToUFM_Directly assig temp $ Loc (InMem slot) old_fmt
+ let assig2 = addToUFM assig1 vr $! newLocation spill_loc (RealRegUsage cand_reg vrFmt)
setAssigR $ toRegMap assig2
- allocateRegsAndSpill reading keep spills' (my_reg:alloc) rs
+ allocateRegsAndSpill reading keep spills' (cand_reg:alloc) rs
-- otherwise, we need to spill a temporary that currently
-- resides in a register.
- | (temp_to_push_out, RealRegUsage my_reg fmt) : _
+ | (temp_to_push_out, RealRegUsage cand_reg old_reg_fmt) : _
<- candidates_inReg
= do
- (spill_store, slot) <- spillR (RegWithFormat (RegReal my_reg) fmt) temp_to_push_out
+ -- Spill what's currently in the register, with the format of what's in the register.
+ (spill_store, slot) <- spillR (RegWithFormat (RegReal cand_reg) old_reg_fmt) temp_to_push_out
-- record that this temp was spilled
recordSpill (SpillAlloc temp_to_push_out)
- -- update the register assignment
- let assig1 = addToUFM_Directly assig temp_to_push_out (InMem slot)
- let assig2 = addToUFM assig1 vr $! newLocation spill_loc (RealRegUsage my_reg fmt)
+ -- Update the register assignment:
+ -- - the old data is now only in memory,
+ -- - the new data is now allocated to this register;
+ -- make sure to use the new format (#26542)
+ let assig1 = addToUFM_Directly assig temp_to_push_out $ Loc (InMem slot) old_reg_fmt
+ let assig2 = addToUFM assig1 vr $! newLocation spill_loc (RealRegUsage cand_reg vrFmt)
setAssigR $ toRegMap assig2
-- if need be, load up a spilled temp into the reg we've just freed up.
- spills' <- loadTemp r spill_loc my_reg spills
+ spills' <- loadTemp r spill_loc cand_reg spills
allocateRegsAndSpill reading keep
(spill_store ++ spills')
- (my_reg:alloc) rs
+ (cand_reg:alloc) rs
-- there wasn't anything to spill, so we're screwed.
@@ -976,7 +997,7 @@ allocRegsAndSpill_spill reading keep spills alloc r@(VirtualRegWithFormat vr fmt
$ vcat
[ text "allocating vreg: " <> text (show vr)
, text "assignment: " <> ppr assig
- , text "format: " <> ppr fmt
+ , text "format: " <> ppr vrFmt
, text "freeRegs: " <> text (showRegs freeRegs)
, text "initFreeRegs: " <> text (showRegs (frInitFreeRegs platform `asTypeOf` freeRegs))
]
@@ -988,9 +1009,12 @@ allocRegsAndSpill_spill reading keep spills alloc r@(VirtualRegWithFormat vr fmt
-- | Calculate a new location after a register has been loaded.
newLocation :: SpillLoc -> RealRegUsage -> Loc
-- if the tmp was read from a slot, then now its in a reg as well
-newLocation (ReadMem slot) my_reg = InBoth my_reg slot
+newLocation (ReadMem slot memFmt) (RealRegUsage r _regFmt) =
+ -- See Note [Use spilled format when reloading]
+ Loc (InBoth r slot) memFmt
+
-- writes will always result in only the register being available
-newLocation _ my_reg = InReg my_reg
+newLocation _ (RealRegUsage r regFmt) = Loc (InReg r) regFmt
-- | Load up a spilled temporary if we need to (read from memory).
loadTemp
@@ -1001,11 +1025,91 @@ loadTemp
-> [instr]
-> RegM freeRegs [instr]
-loadTemp (VirtualRegWithFormat vreg fmt) (ReadMem slot) hreg spills
+loadTemp (VirtualRegWithFormat vreg _fmt) (ReadMem slot memFmt) hreg spills
= do
- insn <- loadR (RegWithFormat (RegReal hreg) fmt) slot
+ -- See Note [Use spilled format when reloading]
+ insn <- loadR (RegWithFormat (RegReal hreg) memFmt) slot
recordSpill (SpillLoad $ getUnique vreg)
return $ {- mkComment (text "spill load") : -} insn ++ spills
loadTemp _ _ _ spills =
return spills
+
+{- Note [Allocated register formats]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We uphold the following principle for the format at which we keep track of
+alllocated registers:
+
+ RF1. Writes redefine the format.
+
+ When we write to a register 'r' at format 'fmt', we consider the register
+ to hold that format going forwards.
+
+ (In cases where a partial write is desired, the move instruction should
+ specify that the destination format is the full register, even if, say,
+ the instruction only writes to the low 64 bits of the register.
+ See also Wrinkle [Don't allow scalar partial writes] in
+ Note [Register formats in liveness analysis] in GHC.CmmToAsm.Reg.Liveness.)
+
+ RF2. Reads from a register do not redefine its format.
+
+ Generally speaking, as explained in Note [Register formats in liveness analysis]
+ in GHC.CmmToAsm.Reg.Liveness, when computing the used format from a collection
+ of reads, we take a least upper bound.
+
+It is particularly important to get (RF1) correct, as otherwise we can end up in
+the situation of T26411b, where code such as
+
+ movsd .Ln6m(%rip),%v1
+ shufpd $0,%v1,%v1
+
+we start off with %v1 :: F64, but after shufpd (which broadcasts the low part
+to the high part) we must consider that %v1 :: F64x2. If we fail to do that,
+then we will silently discard the top bits in spill/reload operations.
+-}
+
+{- Note [Use spilled format when reloading]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We always reload at the full format that a register was spilled at. The rationale
+is as follows:
+
+ 1. If later instructions only need the lower 64 bits of an XMM register,
+ then we should have only spilled the lower 64 bits in the first place.
+ (Whether this is true currently is another question.)
+ 2. If later instructions need say 128 bits, then we should immediately load
+ the entire 128 bits, as this avoids multiple load instructions.
+
+For (2), consider the situation of #26526, where we need to spill around a C
+call (because we are using the System V ABI with no callee saved XMM registers).
+Before register allocation, we have:
+
+ vmovupd %v1 %v0
+ call ...
+ movsd %v0 %v3
+ movhlps %v0 %v4
+
+The contents of %v0 need to be preserved across the call. We must spill %v0 at
+format F64x2 (as later instructions need the entire 128 bits), and reload it
+later. We thus expect something like:
+
+ vmovupd %xmm1 %xmm0
+ vmovupd %xmm0 72(%rsp) -- spill to preserve
+ call ...
+ vmovupd 72(%rsp) %xmm0 -- restore
+ movsd %xmm0 %xmm3
+ movhlps %xmm0 %xmm4
+
+This is certainly better than doing two loads from the stack, e.g.
+
+ call ...
+ movsd 72(%rsp) %xmm0 -- restore only lower 64 bits
+ movsd %xmm0 %xmm3
+ vmovupd 72(%rsp) %xmm0 -- restore the full 128 bits
+ movhlps %xmm0 %xmm4
+
+The latter being especially risky because we don't want to believe %v0 is 'InBoth'
+with format F64. The risk is that, when allocating registers for the 'VMOVUPD'
+instruction, we think our data is already in a register and thus doesn't need to
+be reloaded from memory, when in fact we have only loaded the lower 64 bits of
+the data.
+-}
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/Base.hs b/compiler/GHC/CmmToAsm/Reg/Linear/Base.hs
index ec96160f3ab3..70b63a358df1 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear/Base.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/Base.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
-- | Put common type definitions here to break recursive module dependencies.
@@ -9,7 +10,7 @@ module GHC.CmmToAsm.Reg.Linear.Base (
emptyBlockAssignment,
updateBlockAssignment,
- Loc(..),
+ VLoc(..), Loc(..), IgnoreFormat(..),
regsOfLoc,
RealRegUsage(..),
@@ -39,8 +40,6 @@ import GHC.Cmm.Dataflow.Label
import GHC.CmmToAsm.Reg.Utils
import GHC.CmmToAsm.Format
-import Data.Function ( on )
-
data ReadingOrWriting = Reading | Writing deriving (Eq,Ord)
-- | Used to store the register assignment on entry to a basic block.
@@ -70,8 +69,13 @@ updateBlockAssignment :: BlockId
-> BlockAssignment freeRegs
-> BlockAssignment freeRegs
updateBlockAssignment dest (freeRegs, regMap) (BlockAssignment {..}) =
- BlockAssignment (mapInsert dest (freeRegs, regMap) blockMap)
- (mergeUFM combWithExisting id (mapMaybeUFM fromLoc) (firstUsed) (toVRegMap regMap))
+ BlockAssignment
+ (mapInsert dest (freeRegs, regMap) blockMap)
+ (mergeUFM combWithExisting id
+ (mapMaybeUFM (fromVLoc . locWithFormat_loc))
+ firstUsed
+ (toVRegMap regMap)
+ )
where
-- The blocks are processed in dependency order, so if there's already an
-- entry in the map then keep that assignment rather than writing the new
@@ -79,13 +83,14 @@ updateBlockAssignment dest (freeRegs, regMap) (BlockAssignment {..}) =
combWithExisting :: RealReg -> Loc -> Maybe RealReg
combWithExisting old_reg _ = Just $ old_reg
- fromLoc :: Loc -> Maybe RealReg
- fromLoc (InReg rr) = Just $ realReg rr
- fromLoc (InBoth rr _) = Just $ realReg rr
- fromLoc _ = Nothing
-
+ fromVLoc :: VLoc -> Maybe RealReg
+ fromVLoc (InReg rr) = Just rr
+ fromVLoc (InBoth rr _) = Just rr
+ fromVLoc _ = Nothing
--- | Where a vreg is currently stored
+-- | Where a vreg is currently stored.
+--
+--
-- A temporary can be marked as living in both a register and memory
-- (InBoth), for example if it was recently loaded from a spill location.
-- This makes it cheap to spill (no save instruction required), but we
@@ -96,22 +101,41 @@ updateBlockAssignment dest (freeRegs, regMap) (BlockAssignment {..}) =
-- save it in a spill location, but mark it as InBoth because the current
-- instruction might still want to read it.
--
-data Loc
+data VLoc
-- | vreg is in a register
- = InReg {-# UNPACK #-} !RealRegUsage
+ = InReg {-# UNPACK #-} !RealReg
-- | vreg is held in stack slots
- | InMem {-# UNPACK #-} !StackSlot
-
+ | InMem {-# UNPACK #-} !StackSlot
-- | vreg is held in both a register and stack slots
- | InBoth {-# UNPACK #-} !RealRegUsage
- {-# UNPACK #-} !StackSlot
+ | InBoth {-# UNPACK #-} !RealReg
+ {-# UNPACK #-} !StackSlot
deriving (Eq, Ord, Show)
-instance Outputable Loc where
+-- | Where a virtual register is stored, together with the format it is stored at.
+--
+-- See 'VLoc'.
+data Loc
+ = Loc
+ { locWithFormat_loc :: {-# UNPACK #-} !VLoc
+ , locWithFormat_format :: Format
+ }
+
+-- | A newtype used to hang off 'Eq' and 'Ord' instances for 'Loc' which
+-- ignore the format, as used in 'GHC.CmmToAsm.Reg.Linear.JoinToTargets'.
+newtype IgnoreFormat a = IgnoreFormat a
+instance Eq (IgnoreFormat Loc) where
+ IgnoreFormat (Loc l1 _) == IgnoreFormat (Loc l2 _) = l1 == l2
+instance Ord (IgnoreFormat Loc) where
+ compare (IgnoreFormat (Loc l1 _)) (IgnoreFormat (Loc l2 _)) = compare l1 l2
+
+instance Outputable VLoc where
ppr l = text (show l)
+instance Outputable Loc where
+ ppr (Loc loc fmt) = parens (ppr loc <+> dcolon <+> ppr fmt)
+
-- | A 'RealReg', together with the specific 'Format' it is used at.
data RealRegUsage
= RealRegUsage
@@ -122,22 +146,12 @@ data RealRegUsage
instance Outputable RealRegUsage where
ppr (RealRegUsage r fmt) = ppr r <> dcolon <+> ppr fmt
--- NB: these instances only compare the underlying 'RealReg', as that is what
--- is important for register allocation.
---
--- (It would nonetheless be a good idea to remove these instances.)
-instance Eq RealRegUsage where
- (==) = (==) `on` realReg
-instance Ord RealRegUsage where
- compare = compare `on` realReg
-
-- | Get the reg numbers stored in this Loc.
-regsOfLoc :: Loc -> [RealRegUsage]
+regsOfLoc :: VLoc -> [RealReg]
regsOfLoc (InReg r) = [r]
regsOfLoc (InBoth r _) = [r]
regsOfLoc (InMem _) = []
-
-- | Reasons why instructions might be inserted by the spiller.
-- Used when generating stats for -ddrop-asm-stats.
--
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs b/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
index 0d9193d9c72d..fa8db27e93ad 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
@@ -33,12 +33,14 @@ import GHC.Utils.Outputable
import GHC.CmmToAsm.Format
import GHC.Types.Unique.Set
+import Data.Coerce (coerce)
+
-- | For a jump instruction at the end of a block, generate fixup code so its
-- vregs are in the correct regs for its destination.
--
joinToTargets
:: (FR freeRegs, Instruction instr)
- => BlockMap (UniqSet RegWithFormat) -- ^ maps the unique of the blockid to the set of vregs
+ => BlockMap Regs -- ^ maps the unique of the blockid to the set of vregs
-- that are known to be live on the entry to each block.
-> BlockId -- ^ id of the current block
@@ -62,7 +64,7 @@ joinToTargets block_live id instr
-----
joinToTargets'
:: (FR freeRegs, Instruction instr)
- => BlockMap (UniqSet RegWithFormat) -- ^ maps the unique of the blockid to the set of vregs
+ => BlockMap Regs -- ^ maps the unique of the blockid to the set of vregs
-- that are known to be live on the entry to each block.
-> [NatBasicBlock instr] -- ^ acc blocks of fixup code.
@@ -90,23 +92,23 @@ joinToTargets' block_live new_blocks block_id instr (dest:dests)
-- adjust the current assignment to remove any vregs that are not live
-- on entry to the destination block.
let live_set = expectJust $ mapLookup dest block_live
- let still_live uniq _ = uniq `elemUniqSet_Directly` live_set
+ let still_live uniq _ = uniq `elemUniqSet_Directly` getRegs live_set
let adjusted_assig = filterUFM_Directly still_live assig
-- and free up those registers which are now free.
let to_free =
- [ r | (reg, loc) <- nonDetUFMToList assig
+ [ r | (reg, Loc loc _locFmt) <- nonDetUFMToList assig
-- This is non-deterministic but we do not
-- currently support deterministic code-generation.
-- See Note [Unique Determinism and code generation]
- , not (elemUniqSet_Directly reg live_set)
+ , not (elemUniqSet_Directly reg $ getRegs live_set)
, r <- regsOfLoc loc ]
case lookupBlockAssignment dest block_assig of
Nothing
-> joinToTargets_first
block_live new_blocks block_id instr dest dests
- block_assig adjusted_assig $ map realReg to_free
+ block_assig adjusted_assig to_free
Just (_, dest_assig)
-> joinToTargets_again
@@ -116,7 +118,7 @@ joinToTargets' block_live new_blocks block_id instr (dest:dests)
-- this is the first time we jumped to this block.
joinToTargets_first :: (FR freeRegs, Instruction instr)
- => BlockMap (UniqSet RegWithFormat)
+ => BlockMap Regs
-> [NatBasicBlock instr]
-> BlockId
-> instr
@@ -142,10 +144,9 @@ joinToTargets_first block_live new_blocks block_id instr dest dests
joinToTargets' block_live new_blocks block_id instr dests
-
-- we've jumped to this block before
joinToTargets_again :: (Instruction instr, FR freeRegs)
- => BlockMap (UniqSet RegWithFormat)
+ => BlockMap Regs
-> [NatBasicBlock instr]
-> BlockId
-> instr
@@ -159,7 +160,9 @@ joinToTargets_again
src_assig dest_assig
-- the assignments already match, no problem.
- | nonDetUFMToList dest_assig == nonDetUFMToList src_assig
+ | equalIgnoringFormats
+ (nonDetUFMToList dest_assig)
+ (nonDetUFMToList src_assig)
-- This is non-deterministic but we do not
-- currently support deterministic code-generation.
-- See Note [Unique Determinism and code generation]
@@ -183,7 +186,7 @@ joinToTargets_again
--
-- We need to do the R2 -> R3 move before R1 -> R2.
--
- let sccs = stronglyConnCompFromEdgedVerticesOrdR graph
+ let sccs = movementGraphSCCs graph
-- debugging
{-
@@ -267,30 +270,36 @@ makeRegMovementGraph adjusted_assig dest_assig
--
expandNode
:: a
- -> Loc -- ^ source of move
- -> Loc -- ^ destination of move
- -> [Node Loc a ]
-
-expandNode vreg loc@(InReg src) (InBoth dst mem)
- | src == dst = [DigraphNode vreg loc [InMem mem]]
- | otherwise = [DigraphNode vreg loc [InReg dst, InMem mem]]
-
-expandNode vreg loc@(InMem src) (InBoth dst mem)
- | src == mem = [DigraphNode vreg loc [InReg dst]]
- | otherwise = [DigraphNode vreg loc [InReg dst, InMem mem]]
-
-expandNode _ (InBoth _ src) (InMem dst)
- | src == dst = [] -- guaranteed to be true
-
-expandNode _ (InBoth src _) (InReg dst)
- | src == dst = []
-
-expandNode vreg (InBoth src _) dst
- = expandNode vreg (InReg src) dst
-
-expandNode vreg src dst
- | src == dst = []
- | otherwise = [DigraphNode vreg src [dst]]
+ -> Loc -- ^ source of move
+ -> Loc -- ^ destination of move
+ -> [Node Loc a]
+expandNode vreg src@(Loc srcLoc srcFmt) dst@(Loc dstLoc dstFmt) =
+ case (srcLoc, dstLoc) of
+ (InReg srcReg, InBoth dstReg dstMem)
+ | srcReg == dstReg
+ -> [DigraphNode vreg src [Loc (InMem dstMem) dstFmt]]
+ | otherwise
+ -> [DigraphNode vreg src [Loc (InReg dstReg) dstFmt
+ ,Loc (InMem dstMem) dstFmt]]
+ (InMem srcMem, InBoth dstReg dstMem)
+ | srcMem == dstMem
+ -> [DigraphNode vreg src [Loc (InReg dstReg) dstFmt]]
+ | otherwise
+ -> [DigraphNode vreg src [Loc (InReg dstReg) dstFmt
+ ,Loc (InMem dstMem) dstFmt]]
+ (InBoth _ srcMem, InMem dstMem)
+ | srcMem == dstMem
+ -> [] -- guaranteed to be true
+ (InBoth srcReg _, InReg dstReg)
+ | srcReg == dstReg
+ -> []
+ (InBoth srcReg _, _)
+ -> expandNode vreg (Loc (InReg srcReg) srcFmt) dst
+ _
+ | srcLoc == dstLoc
+ -> []
+ | otherwise
+ -> [DigraphNode vreg src [dst]]
-- | Generate fixup code for a particular component in the move graph
@@ -327,7 +336,7 @@ handleComponent delta _ (AcyclicSCC (DigraphNode vreg src dsts))
-- require a fixup.
--
handleComponent delta instr
- (CyclicSCC ((DigraphNode vreg (InReg (RealRegUsage sreg scls)) ((InReg (RealRegUsage dreg dcls): _))) : rest))
+ (CyclicSCC ((DigraphNode vreg (Loc (InReg sreg) scls) ((Loc (InReg dreg) dcls: _))) : rest))
-- dest list may have more than one element, if the reg is also InMem.
= do
-- spill the source into its slot
@@ -338,7 +347,7 @@ handleComponent delta instr
instrLoad <- loadR (RegWithFormat (RegReal dreg) dcls) slot
remainingFixUps <- mapM (handleComponent delta instr)
- (stronglyConnCompFromEdgedVerticesOrdR rest)
+ (movementGraphSCCs rest)
-- make sure to do all the reloads after all the spills,
-- so we don't end up clobbering the source values.
@@ -347,29 +356,37 @@ handleComponent delta instr
handleComponent _ _ (CyclicSCC _)
= panic "Register Allocator: handleComponent cyclic"
+-- Helper functions that use the @Ord (IgnoreFormat Loc)@ instance.
+
+equalIgnoringFormats :: [(Unique, Loc)] -> [(Unique, Loc)] -> Bool
+equalIgnoringFormats =
+ coerce $ (==) @[(Unique, IgnoreFormat Loc)]
+movementGraphSCCs :: [Node Loc Unique] -> [SCC (Node Loc Unique)]
+movementGraphSCCs =
+ coerce $ stronglyConnCompFromEdgedVerticesOrdR @(IgnoreFormat Loc) @Unique
-- | Move a vreg between these two locations.
--
makeMove
:: Instruction instr
- => Int -- ^ current C stack delta.
- -> Unique -- ^ unique of the vreg that we're moving.
- -> Loc -- ^ source location.
- -> Loc -- ^ destination location.
- -> RegM freeRegs [instr] -- ^ move instruction.
+ => Int -- ^ current C stack delta
+ -> Unique -- ^ unique of the vreg that we're moving
+ -> Loc -- ^ source location
+ -> Loc -- ^ destination location
+ -> RegM freeRegs [instr] -- ^ move instruction
-makeMove delta vreg src dst
+makeMove delta vreg (Loc src _srcFmt) (Loc dst dstFmt)
= do config <- getConfig
case (src, dst) of
- (InReg (RealRegUsage s _), InReg (RealRegUsage d fmt)) ->
+ (InReg s, InReg d) ->
do recordSpill (SpillJoinRR vreg)
- return $ [mkRegRegMoveInstr config fmt (RegReal s) (RegReal d)]
- (InMem s, InReg (RealRegUsage d cls)) ->
+ return $ [mkRegRegMoveInstr config dstFmt (RegReal s) (RegReal d)]
+ (InMem s, InReg d) ->
do recordSpill (SpillJoinRM vreg)
- return $ mkLoadInstr config (RegWithFormat (RegReal d) cls) delta s
- (InReg (RealRegUsage s cls), InMem d) ->
+ return $ mkLoadInstr config (RegWithFormat (RegReal d) dstFmt) delta s
+ (InReg s, InMem d) ->
do recordSpill (SpillJoinRM vreg)
- return $ mkSpillInstr config (RegWithFormat (RegReal s) cls) delta d
+ return $ mkSpillInstr config (RegWithFormat (RegReal s) dstFmt) delta d
_ ->
-- we don't handle memory to memory moves.
-- they shouldn't happen because we don't share
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/StackMap.hs b/compiler/GHC/CmmToAsm/Reg/Linear/StackMap.hs
index da3863cc1848..0d458cb7b9bf 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear/StackMap.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/StackMap.hs
@@ -37,7 +37,11 @@ data StackMap
-- See Note [UniqFM and the register allocator]
-- | Assignment of vregs to stack slots.
- , stackMapAssignment :: UniqFM Unique StackSlot }
+ --
+ -- We record not just the slot, but also how many stack slots the vreg
+ -- takes up, in order to avoid re-using a stack slot for a register
+ -- that has grown but already had a stack slot (#26668).
+ , stackMapAssignment :: UniqFM Unique (StackSlot, Int) }
-- | An empty stack map, with all slots available.
@@ -50,14 +54,19 @@ emptyStackMap = StackMap 0 emptyUFM
--
getStackSlotFor :: StackMap -> Format -> Unique -> (StackMap, Int)
-getStackSlotFor fs@(StackMap _ reserved) _fmt regUnique
- | Just slot <- lookupUFM reserved regUnique = (fs, slot)
-
-getStackSlotFor (StackMap freeSlot reserved) fmt regUnique =
- let
- nbSlots = (formatInBytes fmt + 7) `div` 8
- in
- (StackMap (freeSlot+nbSlots) (addToUFM reserved regUnique freeSlot), freeSlot)
+getStackSlotFor fs@(StackMap freeSlot reserved) fmt regUnique
+ -- The register already has a stack slot; try to re-use it.
+ | Just (slot, nbSlots) <- lookupUFM reserved regUnique
+ -- Make sure the slot is big enough for this format, in case the register
+ -- has grown (#26668).
+ , nbNeededSlots <= nbSlots
+ = (fs, slot)
+ | otherwise
+ = (StackMap (freeSlot+nbNeededSlots) (addToUFM reserved regUnique (freeSlot, nbNeededSlots)), freeSlot)
+ -- NB: this can create fragmentation if a register keeps growing.
+ -- That's probably OK, as this is only happens very rarely.
+ where
+ !nbNeededSlots = (formatInBytes fmt + 7) `div` 8
-- | Return the number of stack slots that were allocated
getStackUse :: StackMap -> Int
diff --git a/compiler/GHC/CmmToAsm/Reg/Liveness.hs b/compiler/GHC/CmmToAsm/Reg/Liveness.hs
index 4642c417ee07..25f3aef44a20 100644
--- a/compiler/GHC/CmmToAsm/Reg/Liveness.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Liveness.hs
@@ -30,7 +30,9 @@ module GHC.CmmToAsm.Reg.Liveness (
patchRegsLiveInstr,
reverseBlocksInTops,
regLiveness,
- cmmTopLiveness
+ cmmTopLiveness,
+
+ module GHC.CmmToAsm.Reg.Regs
) where
import GHC.Prelude
@@ -41,13 +43,14 @@ import GHC.CmmToAsm.Config
import GHC.CmmToAsm.Format
import GHC.CmmToAsm.Types
import GHC.CmmToAsm.Utils
+import GHC.CmmToAsm.Reg.Regs
import GHC.Cmm.BlockId
import GHC.Cmm.Dataflow.Label
import GHC.Cmm
-import GHC.CmmToAsm.Reg.Target
import GHC.Data.Graph.Directed
+import GHC.Data.OrdList
import GHC.Utils.Monad
import GHC.Utils.Outputable
import GHC.Utils.Panic
@@ -188,9 +191,9 @@ data LiveInstr instr
data Liveness
= Liveness
- { liveBorn :: UniqSet RegWithFormat -- ^ registers born in this instruction (written to for first time).
- , liveDieRead :: UniqSet RegWithFormat -- ^ registers that died because they were read for the last time.
- , liveDieWrite :: UniqSet RegWithFormat} -- ^ registers that died because they were clobbered by something.
+ { liveBorn :: Regs -- ^ registers born in this instruction (written to for first time).
+ , liveDieRead :: Regs -- ^ registers that died because they were read for the last time.
+ , liveDieWrite :: Regs } -- ^ registers that died because they were clobbered by something.
-- | Stash regs live on entry to each basic block in the info part of the cmm code.
@@ -199,7 +202,7 @@ data LiveInfo
(LabelMap RawCmmStatics) -- cmm info table static stuff
[BlockId] -- entry points (first one is the
-- entry point for the proc).
- (BlockMap (UniqSet RegWithFormat)) -- argument locals live on entry to this block
+ (BlockMap Regs) -- argument locals live on entry to this block
(BlockMap IntSet) -- stack slots live on entry to this block
@@ -245,8 +248,8 @@ instance Outputable instr
, pprRegs (text "# w_dying: ") (liveDieWrite live) ]
$+$ space)
- where pprRegs :: SDoc -> UniqSet RegWithFormat -> SDoc
- pprRegs name regs
+ where pprRegs :: SDoc -> Regs -> SDoc
+ pprRegs name ( Regs regs )
| isEmptyUniqSet regs = empty
| otherwise = name <>
(pprUFM (getUniqSet regs) (hcat . punctuate space . map ppr))
@@ -329,7 +332,7 @@ slurpConflicts
:: Instruction instr
=> Platform
-> LiveCmmDecl statics instr
- -> (Bag (UniqSet RegWithFormat), Bag (Reg, Reg))
+ -> (Bag Regs, Bag (Reg, Reg))
slurpConflicts platform live
= slurpCmm (emptyBag, emptyBag) live
@@ -363,23 +366,22 @@ slurpConflicts platform live
= let
-- regs that die because they are read for the last time at the start of an instruction
-- are not live across it.
- rsLiveAcross = rsLiveEntry `minusUniqSet` (liveDieRead live)
+ rsLiveAcross = rsLiveEntry `minusRegs` (liveDieRead live)
-- regs live on entry to the next instruction.
-- be careful of orphans, make sure to delete dying regs _after_ unioning
-- in the ones that are born here.
- rsLiveNext = (rsLiveAcross `unionUniqSets` (liveBorn live))
- `minusUniqSet` (liveDieWrite live)
+ rsLiveNext = (rsLiveAcross `unionRegsMaxFmt` (liveBorn live))
+ `minusCoveredRegs` (liveDieWrite live)
-- orphan vregs are the ones that die in the same instruction they are born in.
-- these are likely to be results that are never used, but we still
-- need to assign a hreg to them..
- rsOrphans = intersectUniqSets
+ rsOrphans = intersectRegsMaxFmt
(liveBorn live)
- (unionUniqSets (liveDieWrite live) (liveDieRead live))
+ (unionRegsMaxFmt (liveDieWrite live) (liveDieRead live))
- --
- rsConflicts = unionUniqSets rsLiveNext rsOrphans
+ rsConflicts = unionRegsMaxFmt rsLiveNext rsOrphans
in case takeRegRegMoveInstr platform instr of
Just rr -> slurpLIs rsLiveNext
@@ -562,30 +564,26 @@ stripLiveBlock config (BasicBlock i lis)
= BasicBlock i instrs'
where (instrs', _)
- = runState (spillNat [] lis) 0
+ = runState (spillNat nilOL lis) 0
- -- spillNat :: [instr] -> [LiveInstr instr] -> State Int [instr]
- spillNat :: Instruction instr => [instr] -> [LiveInstr instr] -> State Int [instr]
+ spillNat :: Instruction instr => OrdList instr -> [LiveInstr instr] -> State Int [instr]
spillNat acc []
- = return (reverse acc)
+ = return (fromOL acc)
- -- The SPILL/RELOAD cases do not appear to be exercised by our codegens
- --
spillNat acc (LiveInstr (SPILL reg slot) _ : instrs)
= do delta <- get
- spillNat (mkSpillInstr config reg delta slot ++ acc) instrs
+ spillNat (acc `appOL` toOL (mkSpillInstr config reg delta slot)) instrs
spillNat acc (LiveInstr (RELOAD slot reg) _ : instrs)
= do delta <- get
- spillNat (mkLoadInstr config reg delta slot ++ acc) instrs
+ spillNat (acc `appOL` toOL (mkLoadInstr config reg delta slot)) instrs
spillNat acc (LiveInstr (Instr instr) _ : instrs)
| Just i <- takeDeltaInstr instr
= do put i
spillNat acc instrs
-
- spillNat acc (LiveInstr (Instr instr) _ : instrs)
- = spillNat (instr : acc) instrs
+ | otherwise
+ = spillNat (acc `snocOL` instr) instrs
-- | Erase Delta instructions.
@@ -622,7 +620,7 @@ patchEraseLive platform patchF cmm
| LiveInfo static id blockMap mLiveSlots <- info
= let
-- See Note [Unique Determinism and code generation]
- blockMap' = mapMap (mapRegFormatSet patchF) blockMap
+ blockMap' = mapMap (mapRegs patchF) blockMap
info' = LiveInfo static id blockMap' mLiveSlots
in CmmProc info' label live $ map patchSCC sccs
@@ -651,8 +649,8 @@ patchEraseLive platform patchF cmm
| r1 == r2 = True
-- destination reg is never used
- | elemUniqSet_Directly (getUnique r2) (liveBorn live)
- , elemUniqSet_Directly (getUnique r2) (liveDieRead live) || elemUniqSet_Directly (getUnique r2) (liveDieWrite live)
+ | r2 `elemRegs` liveBorn live
+ , r2 `elemRegs` liveDieRead live || r2 `elemRegs` liveDieWrite live
= True
| otherwise = False
@@ -676,9 +674,9 @@ patchRegsLiveInstr platform patchF li
(patchRegsOfInstr platform instr patchF)
(Just live
{ -- WARNING: have to go via lists here because patchF changes the uniq in the Reg
- liveBorn = mapRegFormatSet patchF $ liveBorn live
- , liveDieRead = mapRegFormatSet patchF $ liveDieRead live
- , liveDieWrite = mapRegFormatSet patchF $ liveDieWrite live })
+ liveBorn = mapRegs patchF $ liveBorn live
+ , liveDieRead = mapRegs patchF $ liveDieRead live
+ , liveDieWrite = mapRegs patchF $ liveDieWrite live })
-- See Note [Unique Determinism and code generation]
--------------------------------------------------------------------------------
@@ -868,7 +866,7 @@ computeLiveness
-> [SCC (LiveBasicBlock instr)]
-> ([SCC (LiveBasicBlock instr)], -- instructions annotated with list of registers
-- which are "dead after this instruction".
- BlockMap (UniqSet RegWithFormat)) -- blocks annotated with set of live registers
+ BlockMap Regs) -- blocks annotated with set of live registers
-- on entry to the block.
computeLiveness platform sccs
@@ -883,11 +881,11 @@ computeLiveness platform sccs
livenessSCCs
:: Instruction instr
=> Platform
- -> BlockMap (UniqSet RegWithFormat)
+ -> BlockMap Regs
-> [SCC (LiveBasicBlock instr)] -- accum
-> [SCC (LiveBasicBlock instr)]
-> ( [SCC (LiveBasicBlock instr)]
- , BlockMap (UniqSet RegWithFormat))
+ , BlockMap Regs)
livenessSCCs _ blockmap done []
= (done, blockmap)
@@ -916,13 +914,14 @@ livenessSCCs platform blockmap done
linearLiveness
:: Instruction instr
- => BlockMap (UniqSet RegWithFormat) -> [LiveBasicBlock instr]
- -> (BlockMap (UniqSet RegWithFormat), [LiveBasicBlock instr])
+ => BlockMap Regs -> [LiveBasicBlock instr]
+ -> (BlockMap Regs, [LiveBasicBlock instr])
linearLiveness = mapAccumL (livenessBlock platform)
-- probably the least efficient way to compare two
-- BlockMaps for equality.
+ equalBlockMaps :: BlockMap Regs -> BlockMap Regs -> Bool
equalBlockMaps a b
= a' == b'
where a' = mapToList a
@@ -936,14 +935,14 @@ livenessSCCs platform blockmap done
livenessBlock
:: Instruction instr
=> Platform
- -> BlockMap (UniqSet RegWithFormat)
+ -> BlockMap Regs
-> LiveBasicBlock instr
- -> (BlockMap (UniqSet RegWithFormat), LiveBasicBlock instr)
+ -> (BlockMap Regs, LiveBasicBlock instr)
livenessBlock platform blockmap (BasicBlock block_id instrs)
= let
(regsLiveOnEntry, instrs1)
- = livenessBack platform emptyUniqSet blockmap [] (reverse instrs)
+ = livenessBack platform noRegs blockmap [] (reverse instrs)
blockmap' = mapInsert block_id regsLiveOnEntry blockmap
instrs2 = livenessForward platform regsLiveOnEntry instrs1
@@ -958,23 +957,26 @@ livenessBlock platform blockmap (BasicBlock block_id instrs)
livenessForward
:: Instruction instr
=> Platform
- -> UniqSet RegWithFormat -- regs live on this instr
+ -> Regs -- regs live on this instr
-> [LiveInstr instr] -> [LiveInstr instr]
livenessForward _ _ [] = []
livenessForward platform rsLiveEntry (li@(LiveInstr instr mLive) : lis)
| Just live <- mLive
= let
- RU _ written = regUsageOfInstr platform instr
+ RU _ rsWritten = regUsageOfInstr platform instr
-- Regs that are written to but weren't live on entry to this instruction
-- are recorded as being born here.
- rsBorn = mkUniqSet
- $ filter (\ r -> not $ elemUniqSet_Directly (getUnique r) rsLiveEntry)
- $ written
+ rsBorn = mkRegsMaxFmt
+ [ reg
+ | reg@( RegWithFormat r _ ) <- rsWritten
+ , not $ r `elemRegs` rsLiveEntry
+ ]
- rsLiveNext = (rsLiveEntry `unionUniqSets` rsBorn)
- `minusUniqSet` (liveDieRead live)
- `minusUniqSet` (liveDieWrite live)
+ -- See Note [Register formats in liveness analysis]
+ rsLiveNext = (rsLiveEntry `addRegsMaxFmt` rsWritten)
+ `minusRegs` (liveDieRead live) -- (FmtFwd1)
+ `minusRegs` (liveDieWrite live) -- (FmtFwd2)
in LiveInstr instr (Just live { liveBorn = rsBorn })
: livenessForward platform rsLiveNext lis
@@ -989,11 +991,11 @@ livenessForward platform rsLiveEntry (li@(LiveInstr instr mLive) : lis)
livenessBack
:: Instruction instr
=> Platform
- -> UniqSet RegWithFormat -- regs live on this instr
- -> BlockMap (UniqSet RegWithFormat) -- regs live on entry to other BBs
- -> [LiveInstr instr] -- instructions (accum)
- -> [LiveInstr instr] -- instructions
- -> (UniqSet RegWithFormat, [LiveInstr instr])
+ -> Regs -- ^ regs live on this instr
+ -> BlockMap Regs -- ^ regs live on entry to other BBs
+ -> [LiveInstr instr] -- ^ instructions (accum)
+ -> [LiveInstr instr] -- ^ instructions
+ -> (Regs, [LiveInstr instr])
livenessBack _ liveregs _ done [] = (liveregs, done)
@@ -1001,15 +1003,14 @@ livenessBack platform liveregs blockmap acc (instr : instrs)
= let !(!liveregs', instr') = liveness1 platform liveregs blockmap instr
in livenessBack platform liveregs' blockmap (instr' : acc) instrs
-
-- don't bother tagging comments or deltas with liveness
liveness1
:: Instruction instr
=> Platform
- -> UniqSet RegWithFormat
- -> BlockMap (UniqSet RegWithFormat)
+ -> Regs
+ -> BlockMap Regs
-> LiveInstr instr
- -> (UniqSet RegWithFormat, LiveInstr instr)
+ -> (Regs, LiveInstr instr)
liveness1 _ liveregs _ (LiveInstr instr _)
| isMetaInstr instr
@@ -1020,14 +1021,14 @@ liveness1 platform liveregs blockmap (LiveInstr instr _)
| not_a_branch
= (liveregs1, LiveInstr instr
(Just $ Liveness
- { liveBorn = emptyUniqSet
+ { liveBorn = noRegs
, liveDieRead = r_dying
, liveDieWrite = w_dying }))
| otherwise
= (liveregs_br, LiveInstr instr
(Just $ Liveness
- { liveBorn = emptyUniqSet
+ { liveBorn = noRegs
, liveDieRead = r_dying_br
, liveDieWrite = w_dying }))
@@ -1036,21 +1037,22 @@ liveness1 platform liveregs blockmap (LiveInstr instr _)
-- registers that were written here are dead going backwards.
-- registers that were read here are live going backwards.
- liveregs1 = (liveregs `delListFromUniqSet` written)
- `addListToUniqSet` read
+ -- As for the formats, see Note [Register formats in liveness analysis]
+ liveregs1 = (liveregs `minusCoveredRegs` mkRegsMaxFmt written) -- (FmtBwd2)
+ `addRegsMaxFmt` read -- (FmtBwd1)
- -- registers that are not live beyond this point, are recorded
- -- as dying here.
- r_dying = mkUniqSet
+ -- registers that are not live beyond this point are recorded
+ -- as dying here.
+ r_dying = mkRegsMaxFmt
[ reg
| reg@(RegWithFormat r _) <- read
, not $ any (\ w -> getUnique w == getUnique r) written
- , not (elementOfUniqSet reg liveregs) ]
+ , not $ r `elemRegs` liveregs ]
- w_dying = mkUniqSet
+ w_dying = mkRegsMaxFmt
[ reg
- | reg <- written
- , not (elementOfUniqSet reg liveregs) ]
+ | reg@(RegWithFormat r _) <- written
+ , not $ r `elemRegs` liveregs ]
-- union in the live regs from all the jump destinations of this
-- instruction.
@@ -1060,14 +1062,91 @@ liveness1 platform liveregs blockmap (LiveInstr instr _)
targetLiveRegs target
= case mapLookup target blockmap of
Just ra -> ra
- Nothing -> emptyUniqSet
-
- live_from_branch = unionManyUniqSets (map targetLiveRegs targets)
-
- liveregs_br = liveregs1 `unionUniqSets` live_from_branch
+ Nothing -> noRegs
-- registers that are live only in the branch targets should
-- be listed as dying here.
- live_branch_only = live_from_branch `minusUniqSet` liveregs
- r_dying_br = (r_dying `unionUniqSets` live_branch_only)
- -- See Note [Unique Determinism and code generation]
+ live_from_branch = unionManyRegsMaxFmt (map targetLiveRegs targets)
+ liveregs_br = liveregs1 `unionRegsMaxFmt` live_from_branch
+ live_branch_only = live_from_branch `minusRegs` liveregs
+ r_dying_br = r_dying `unionRegsMaxFmt` live_branch_only
+ -- NB: we treat registers live in branches similar to any other
+ -- registers read by the instruction, so the logic here matches
+ -- the logic in the definition of 'r_dying' above.
+
+{- Note [Register formats in liveness analysis]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We keep track of which format each virtual register is live at, and make use
+of this information during liveness analysis.
+
+First, we do backwards liveness analysis:
+
+ (FmtBwd1) Take the larger format when computing registers live going backwards.
+
+ Suppose for example that we have:
+
+
+ movps %v0 %v1
+ movupd %v0 %v2
+
+ Here we read %v0 both at format F64 and F64x2, so we must consider it live
+ at format F64x2, going backwards, in the previous instructions.
+ Not doing so caused #26411.
+
+ (FmtBwd2) Only consider fully clobbered registers to be dead going backwards.
+
+ Consider for example the liveness of %v0 going backwards in the following
+ instruction block:
+
+ movlhps %v5 %v0 -- write the upper F64 of %v0
+ movupd %v1 %v2 -- some unrelated instruction
+ movsd %v3 %v0 -- write the lower F64 of %v0
+ movupd %v0 %v4 -- read %v0 at format F64x2
+
+ We must not consider %v0 to be dead going backwards from 'movsd %v3 %v0'.
+ If we do, that means we think %v0 is dead during 'movupd %v1 %v2', and thus
+ that we can assign both %v0 and %v2 to the same real register. However, this
+ would be catastrophic, as 'movupd %v1 %v2' would then clobber the data
+ written to '%v0' in 'movlhps %v5 %v0'.
+
+ Wrinkle [Don't allow scalar partial writes]
+
+ We don't allow partial writes within scalar registers, for many reasons:
+
+ - partial writes can cause partial register stalls, which can have
+ disastrous performance implications (as seen in #20405)
+ - partial writes makes register allocation more difficult, as they can
+ require preserving the contents of a register across many instructions,
+ as in:
+
+ mulw %v0 -- 32-bit write to %rax
+
+ mulb %v1 -- 16-bit partial write to %rax
+
+ The current register allocator is not equipped for spilling real
+ registers (only virtual registers), which means that e.g. on i386 we
+ end up with only 2 allocatable real GP registers for ,
+ which is insufficient for instructions that require 3 registers.
+
+ We could allow this to be customised depending on the architecture, but
+ currently we simply never allow scalar partial writes.
+
+The forwards analysis is a bit simpler:
+
+ (FmtFwd1) Remove without considering format when dead going forwards.
+
+ If a register is no longer read after an instruction, then it is dead
+ going forwards. The format doesn't matter.
+
+ (FmtFwd2) Consider all writes as making a register dead going forwards.
+
+ If we write to the lower 64 bits of a 128 bit register, we don't currently
+ have a way to say "the lower 64 bits are dead but the top 64 bits are still live".
+ We would need a notion of partial register, similar to 'VirtualRegHi' for
+ the top 32 bits of a I32x2 virtual register.
+
+ As a result, the current approach is to consider the entire register to
+ be dead. This might cause us to unnecessarily spill/reload an entire vector
+ register to avoid its lower bits getting clobbered even though later
+ instructions might only care about its upper bits.
+-}
diff --git a/compiler/GHC/CmmToAsm/Reg/Regs.hs b/compiler/GHC/CmmToAsm/Reg/Regs.hs
new file mode 100644
index 000000000000..e51fde5c3a32
--- /dev/null
+++ b/compiler/GHC/CmmToAsm/Reg/Regs.hs
@@ -0,0 +1,119 @@
+{-# LANGUAGE DerivingStrategies #-}
+
+module GHC.CmmToAsm.Reg.Regs (
+ Regs(..),
+ noRegs,
+ addRegMaxFmt, addRegsMaxFmt,
+ mkRegsMaxFmt,
+ minusCoveredRegs,
+ minusRegs,
+ unionRegsMaxFmt,
+ unionManyRegsMaxFmt,
+ intersectRegsMaxFmt,
+ shrinkingRegs,
+ mapRegs,
+ elemRegs, lookupReg,
+
+ ) where
+
+import GHC.Prelude
+
+import GHC.Platform.Reg ( Reg )
+import GHC.CmmToAsm.Format ( Format, RegWithFormat(..), isVecFormat )
+
+import GHC.Utils.Outputable ( Outputable )
+import GHC.Types.Unique ( Uniquable(..) )
+import GHC.Types.Unique.Set
+
+import Data.Coerce ( coerce )
+
+-----------------------------------------------------------------------------
+
+-- | A set of registers, with their respective formats, mostly for use in
+-- register liveness analysis. See Note [Register formats in liveness analysis]
+-- in GHC.CmmToAsm.Reg.Liveness.
+newtype Regs = Regs { getRegs :: UniqSet RegWithFormat }
+ deriving newtype (Eq, Outputable)
+
+maxRegWithFormat :: RegWithFormat -> RegWithFormat -> RegWithFormat
+maxRegWithFormat r1@(RegWithFormat _ fmt1) r2@(RegWithFormat _ fmt2)
+ = if fmt1 >= fmt2
+ then r1
+ else r2
+ -- Re-using one of the arguments avoids allocating a new 'RegWithFormat',
+ -- compared with returning 'RegWithFormat r1 (max fmt1 fmt2)'.
+
+noRegs :: Regs
+noRegs = Regs emptyUniqSet
+
+addRegsMaxFmt :: Regs -> [RegWithFormat] -> Regs
+addRegsMaxFmt = foldl' addRegMaxFmt
+
+mkRegsMaxFmt :: [RegWithFormat] -> Regs
+mkRegsMaxFmt = addRegsMaxFmt noRegs
+
+addRegMaxFmt :: Regs -> RegWithFormat -> Regs
+addRegMaxFmt = coerce $ strictAddOneToUniqSet_C maxRegWithFormat
+ -- Don't build up thunks when combining with 'maxRegWithFormat'
+
+-- | Remove 2nd argument registers from the 1st argument, but only
+-- if the format in the second argument is at least as large as the format
+-- in the first argument.
+minusCoveredRegs :: Regs -> Regs -> Regs
+minusCoveredRegs = coerce $ minusUniqSet_C f
+ where
+ f :: RegWithFormat -> RegWithFormat -> Maybe RegWithFormat
+ f r1@(RegWithFormat _ fmt1) (RegWithFormat _ fmt2) =
+ if fmt2 >= fmt1
+ ||
+ not ( isVecFormat fmt1 )
+ -- See Wrinkle [Don't allow scalar partial writes]
+ -- in Note [Register formats in liveness analysis] in GHC.CmmToAsm.Reg.Liveness.
+ then Nothing
+ else Just r1
+
+-- | Remove 2nd argument registers from the 1st argument, regardless of format.
+--
+-- See also 'minusCoveredRegs', which looks at the formats.
+minusRegs :: Regs -> Regs -> Regs
+minusRegs = coerce $ minusUniqSet @RegWithFormat
+
+unionRegsMaxFmt :: Regs -> Regs -> Regs
+unionRegsMaxFmt = coerce $ strictUnionUniqSets_C maxRegWithFormat
+ -- Don't build up thunks when combining with 'maxRegWithFormat'
+
+unionManyRegsMaxFmt :: [Regs] -> Regs
+unionManyRegsMaxFmt = coerce $ strictUnionManyUniqSets_C maxRegWithFormat
+ -- Don't build up thunks when combining with 'maxRegWithFormat'
+
+intersectRegsMaxFmt :: Regs -> Regs -> Regs
+intersectRegsMaxFmt = coerce $ strictIntersectUniqSets_C maxRegWithFormat
+ -- Don't build up thunks when combining with 'maxRegWithFormat'
+
+-- | Computes the set of registers in both arguments whose size is smaller in
+-- the second argument than in the first.
+shrinkingRegs :: Regs -> Regs -> Regs
+shrinkingRegs = coerce $ minusUniqSet_C f
+ where
+ f :: RegWithFormat -> RegWithFormat -> Maybe RegWithFormat
+ f (RegWithFormat _ fmt1) r2@(RegWithFormat _ fmt2)
+ | fmt2 < fmt1
+ = Just r2
+ | otherwise
+ = Nothing
+
+-- | Map a function that may change the 'Unique' of the register,
+-- which entails going via lists.
+--
+-- See Note [UniqSet invariant] in GHC.Types.Unique.Set.
+mapRegs :: (Reg -> Reg) -> Regs -> Regs
+mapRegs f (Regs live) =
+ Regs $
+ mapUniqSet (\ (RegWithFormat r fmt) -> RegWithFormat (f r) fmt) live
+
+elemRegs :: Reg -> Regs -> Bool
+elemRegs r (Regs live) = elemUniqSet_Directly (getUnique r) live
+
+lookupReg :: Reg -> Regs -> Maybe Format
+lookupReg r (Regs live) =
+ regWithFormat_format <$> lookupUniqSet_Directly live (getUnique r)
diff --git a/compiler/GHC/CmmToAsm/Reg/Target.hs b/compiler/GHC/CmmToAsm/Reg/Target.hs
index 595684210564..28655fa01874 100644
--- a/compiler/GHC/CmmToAsm/Reg/Target.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Target.hs
@@ -15,7 +15,6 @@ module GHC.CmmToAsm.Reg.Target (
targetMkVirtualReg,
targetRegDotColor,
targetClassOfReg,
- mapRegFormatSet,
)
where
@@ -27,10 +26,8 @@ import GHC.Platform.Reg.Class
import GHC.CmmToAsm.Format
import GHC.Utils.Outputable
-import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Types.Unique
-import GHC.Types.Unique.Set
import GHC.Platform
import qualified GHC.CmmToAsm.X86.Regs as X86
@@ -142,6 +139,3 @@ targetClassOfReg platform reg
= case reg of
RegVirtual vr -> classOfVirtualReg (platformArch platform) vr
RegReal rr -> targetClassOfRealReg platform rr
-
-mapRegFormatSet :: HasDebugCallStack => (Reg -> Reg) -> UniqSet RegWithFormat -> UniqSet RegWithFormat
-mapRegFormatSet f = mapUniqSet (\ ( RegWithFormat r fmt ) -> RegWithFormat ( f r ) fmt)
diff --git a/compiler/GHC/CmmToAsm/Wasm/Asm.hs b/compiler/GHC/CmmToAsm/Wasm/Asm.hs
index 392ab34b7fbd..13d59315f220 100644
--- a/compiler/GHC/CmmToAsm/Wasm/Asm.hs
+++ b/compiler/GHC/CmmToAsm/Wasm/Asm.hs
@@ -188,6 +188,12 @@ asmTellDataSection ty_word def_syms sym DataSection {..} = do
when (getUnique sym `memberUniqueSet` def_syms) $ asmTellDefSym sym
asmTellSectionHeader sec_name
asmTellAlign dataSectionAlignment
+ -- The LLVM WASM assembler requires .size for every data symbol. Although some
+ -- symbols (e.g. stg_WHITEHOLE_info) also appear in funcTypes because Cmm's
+ -- lookupName misclassifies bare unimported names as CmmCode labels, we rely on
+ -- asm_functypes in asmTellEverything to suppress .functype for any symbol that
+ -- is already defined as a data section. The assembler therefore sees the symbol
+ -- purely as DATA, and .size is both required and harmless.
asmTellTabLine asm_size
asmTellLine $ asm_sym <> ":"
for_ dataSectionContents $ asmTellDataSectionContent ty_word
@@ -549,8 +555,18 @@ asmTellEverything ty_word WasmCodeGenState {..} = do
asmTellTargetFeatures
where
asm_functypes = do
+ -- Emit .functype only for symbols that are:
+ -- * known to be functions (in funcTypes), AND
+ -- * not defined locally (not in funcBodies, those get their own entry), AND
+ -- * not defined as data sections in this module (not in dataSections).
+ -- The last exclusion handles the case where a symbol like stg_WHITEHOLE_info
+ -- ends up in funcTypes because Cmm's lookupName defaults unimported bare
+ -- names to mkCmmCodeLabel (CodeLabel -> SymFunc), but the symbol is actually
+ -- a data section defined in the same Cmm file via INFO_TABLE/CLOSURE/etc.
+ -- Emitting .functype for such symbols would make wasm-ld see them as
+ -- FUNCTION, conflicting with the DATA classification in C object files.
for_
- (detEltsUniqMap $ funcTypes `minusUniqMap` funcBodies)
+ (detEltsUniqMap $ (funcTypes `minusUniqMap` funcBodies) `minusUniqMap` dataSections)
(uncurry asmTellFuncType)
asmTellLF
diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
index c65a0914387c..c4844baaa2d2 100644
--- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
@@ -374,7 +374,7 @@ stmtToInstrs bid stmt = do
--We try to arrange blocks such that the likely branch is the fallthrough
--in GHC.Cmm.ContFlowOpt. So we can assume the condition is likely false here.
CmmCondBranch arg true false _ -> genCondBranch bid true false arg
- CmmSwitch arg ids -> genSwitch arg ids
+ CmmSwitch arg ids -> genSwitch arg ids bid
CmmCall { cml_target = arg
, cml_args_regs = gregs } -> genJump arg (jumpRegs platform gregs)
_ ->
@@ -487,13 +487,6 @@ is32BitInteger i = i64 <= 0x7fffffff && i64 >= -0x80000000
where i64 = fromIntegral i :: Int64
--- | Convert a BlockId to some CmmStatic data
-jumpTableEntry :: NCGConfig -> Maybe BlockId -> CmmStatic
-jumpTableEntry config Nothing = CmmStaticLit (CmmInt 0 (ncgWordWidth config))
-jumpTableEntry _ (Just blockid) = CmmStaticLit (CmmLabel blockLabel)
- where blockLabel = blockLbl blockid
-
-
-- -----------------------------------------------------------------------------
-- General things for putting together code sequences
@@ -5337,11 +5330,52 @@ index (1),
indexExpr = UU_Conv(indexOffset); // == 1::I64
See #21186.
--}
-genSwitch :: CmmExpr -> SwitchTargets -> NatM InstrBlock
+Note [Jump tables]
+~~~~~~~~~~~~~~~~~~
+The x86 backend has a virtual JMP_TBL instruction which payload can be used to
+generate both the jump instruction and the jump table contents. `genSwitch` is
+responsible for generating these JMP_TBL instructions.
+
+Depending on `-fPIC` flag and on the architecture, we generate the following
+jump table variants:
+
+ | Variant | Arch | Table's contents | Reference to the table |
+ |---------|--------|----------------------------------------|------------------------|
+ | PIC | Both | Relative offset: target_lbl - base_lbl | PIC |
+ | Non-PIC | 64-bit | Absolute: target_lbl | Non-PIC (rip-relative) |
+ | Non-PIC | 32-bit | Absolute: target_lbl | Non-PIC (absolute) |
+
+For the PIC variant, we store relative entries (`target_lbl - base_lbl`) in the
+jump table. Using absolute entries with PIC would require target_lbl symbols to
+be resolved at link time, hence to be global labels (currently they are local
+labels).
+
+We use the block_id of the code containing the jump as `base_lbl`. It ensures
+that target_lbl and base_lbl are close enough to each others, avoiding
+overflows.
+
+Historical note: in the past we used the table label `table_lbl` as base_lbl. It
+allowed the jumping code to only compute one global address (table_lbl) both to
+read the table and to compute the target address. However:
-genSwitch expr targets = do
+ * the table could be too far from the jump and on Windows which only
+ has 32-bit relative relocations (IMAGE_REL_AMD64_REL64 doesn't exist),
+ `dest_lbl - table_lbl` overflowed (see #24016)
+
+ * Mac OS X/x86-64 linker was unable to handle `.quad L1 - L0`
+ relocations if L0 wasn't preceded by a non-anonymous label in its
+ section (which was the case with table_lbl). Hence we used to put the
+ jump table in the .text section in this case.
+
+
+-}
+
+-- | Generate a JMP_TBL instruction
+--
+-- See Note [Jump tables]
+genSwitch :: CmmExpr -> SwitchTargets -> BlockId -> NatM InstrBlock
+genSwitch expr targets bid = do
config <- getConfig
let platform = ncgPlatform config
expr_w = cmmExprWidth platform expr
@@ -5352,79 +5386,76 @@ genSwitch expr targets = do
indexExpr = CmmMachOp
(MO_UU_Conv expr_w (platformWordWidth platform))
[indexExpr0]
- if ncgPIC config
- then do
- (reg,e_code) <- getNonClobberedReg indexExpr
- -- getNonClobberedReg because it needs to survive across t_code
- lbl <- getNewLabelNat
- let is32bit = target32Bit platform
- os = platformOS platform
- -- Might want to use .rodata. instead, but as
- -- long as it's something unique it'll work out since the
- -- references to the jump table are in the appropriate section.
- rosection = case os of
- -- on Mac OS X/x86_64, put the jump table in the text section to
- -- work around a limitation of the linker.
- -- ld64 is unable to handle the relocations for
- -- .quad L1 - L0
- -- if L0 is not preceded by a non-anonymous label in its section.
- OSDarwin | not is32bit -> Section Text lbl
- _ -> Section ReadOnlyData lbl
- dynRef <- cmmMakeDynamicReference config DataReference lbl
- (tableReg,t_code) <- getSomeReg $ dynRef
- let op = OpAddr (AddrBaseIndex (EABaseReg tableReg)
- (EAIndex reg (platformWordSizeInBytes platform)) (ImmInt 0))
-
- return $ e_code `appOL` t_code `appOL` toOL [
- ADD (intFormat (platformWordWidth platform)) op (OpReg tableReg),
- JMP_TBL (OpReg tableReg) ids rosection lbl
- ]
- else do
- (reg,e_code) <- getSomeReg indexExpr
- lbl <- getNewLabelNat
- let is32bit = target32Bit platform
- if is32bit
- then let op = OpAddr (AddrBaseIndex EABaseNone (EAIndex reg (platformWordSizeInBytes platform)) (ImmCLbl lbl))
- jmp_code = JMP_TBL op ids (Section ReadOnlyData lbl) lbl
- in return $ e_code `appOL` unitOL jmp_code
- else do
+
+ (offset, blockIds) = switchTargetsToTable targets
+ ids = map (fmap DestBlockId) blockIds
+
+ is32bit = target32Bit platform
+ fmt = archWordFormat is32bit
+
+ table_lbl <- getNewLabelNat
+ let bid_lbl = blockLbl bid
+ let table_section = Section ReadOnlyData table_lbl
+
+ -- see Note [Jump tables] for a description of the following 3 variants.
+ if
+ | ncgPIC config -> do
+ -- PIC support: store relative offsets in the jump table to allow the code
+ -- to be relocated without updating the table. The table itself and the
+ -- block label used to make the relative labels absolute are read in a PIC
+ -- way (via cmmMakeDynamicReference).
+ (reg,e_code) <- getNonClobberedReg indexExpr -- getNonClobberedReg because it needs to survive across t_code and j_code
+ (tableReg,t_code) <- getNonClobberedReg =<< cmmMakeDynamicReference config DataReference table_lbl
+ (targetReg,j_code) <- getSomeReg =<< cmmMakeDynamicReference config DataReference bid_lbl
+ pure $ e_code `appOL` t_code `appOL` j_code `appOL` toOL
+ [ ADD fmt (OpAddr (AddrBaseIndex (EABaseReg tableReg) (EAIndex reg (platformWordSizeInBytes platform)) (ImmInt 0)))
+ (OpReg targetReg)
+ , JMP_TBL (OpReg targetReg) ids table_section table_lbl (Just bid_lbl)
+ ]
+
+ | not is32bit -> do
+ -- 64-bit non-PIC code
+ (reg,e_code) <- getSomeReg indexExpr
+ tableReg <- getNewRegNat (intFormat (platformWordWidth platform))
+ targetReg <- getNewRegNat (intFormat (platformWordWidth platform))
+ pure $ e_code `appOL` toOL
-- See Note [%rip-relative addressing on x86-64].
- tableReg <- getNewRegNat (intFormat (platformWordWidth platform))
- targetReg <- getNewRegNat (intFormat (platformWordWidth platform))
- let op = OpAddr (AddrBaseIndex (EABaseReg tableReg) (EAIndex reg (platformWordSizeInBytes platform)) (ImmInt 0))
- fmt = archWordFormat is32bit
- code = e_code `appOL` toOL
- [ LEA fmt (OpAddr (AddrBaseIndex EABaseRip EAIndexNone (ImmCLbl lbl))) (OpReg tableReg)
- , MOV fmt op (OpReg targetReg)
- , JMP_TBL (OpReg targetReg) ids (Section ReadOnlyData lbl) lbl
- ]
- return code
- where
- (offset, blockIds) = switchTargetsToTable targets
- ids = map (fmap DestBlockId) blockIds
+ [ LEA fmt (OpAddr (AddrBaseIndex EABaseRip EAIndexNone (ImmCLbl table_lbl))) (OpReg tableReg)
+ , MOV fmt (OpAddr (AddrBaseIndex (EABaseReg tableReg) (EAIndex reg (platformWordSizeInBytes platform)) (ImmInt 0)))
+ (OpReg targetReg)
+ , JMP_TBL (OpReg targetReg) ids table_section table_lbl Nothing
+ ]
+
+ | otherwise -> do
+ -- 32-bit non-PIC code is a straightforward jump to &table[entry].
+ (reg,e_code) <- getSomeReg indexExpr
+ pure $ e_code `appOL` unitOL
+ ( JMP_TBL (OpAddr (AddrBaseIndex EABaseNone (EAIndex reg (platformWordSizeInBytes platform)) (ImmCLbl table_lbl)))
+ ids table_section table_lbl Nothing
+ )
generateJumpTableForInstr :: NCGConfig -> Instr -> Maybe (NatCmmDecl (Alignment, RawCmmStatics) Instr)
-generateJumpTableForInstr config (JMP_TBL _ ids section lbl)
- = let getBlockId (DestBlockId id) = id
- getBlockId _ = panic "Non-Label target in Jump Table"
- blockIds = map (fmap getBlockId) ids
- in Just (createJumpTable config blockIds section lbl)
-generateJumpTableForInstr _ _ = Nothing
-
-createJumpTable :: NCGConfig -> [Maybe BlockId] -> Section -> CLabel
- -> GenCmmDecl (Alignment, RawCmmStatics) h g
-createJumpTable config ids section lbl
- = let jumpTable
- | ncgPIC config =
- let ww = ncgWordWidth config
- jumpTableEntryRel Nothing
- = CmmStaticLit (CmmInt 0 ww)
- jumpTableEntryRel (Just blockid)
- = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0 ww)
- where blockLabel = blockLbl blockid
- in map jumpTableEntryRel ids
- | otherwise = map (jumpTableEntry config) ids
- in CmmData section (mkAlignment 1, CmmStaticsRaw lbl jumpTable)
+generateJumpTableForInstr config = \case
+ JMP_TBL _ ids section table_lbl mrel_lbl ->
+ let getBlockId (DestBlockId id) = id
+ getBlockId _ = panic "Non-Label target in Jump Table"
+ block_ids = map (fmap getBlockId) ids
+
+ jumpTable = case mrel_lbl of
+ Nothing -> map mk_absolute block_ids -- absolute entries
+ Just rel_lbl -> map (mk_relative rel_lbl) block_ids -- offsets relative to rel_lbl
+
+ mk_absolute = \case
+ Nothing -> CmmStaticLit (CmmInt 0 (ncgWordWidth config))
+ Just blockid -> CmmStaticLit (CmmLabel (blockLbl blockid))
+
+ mk_relative rel_lbl = \case
+ Nothing -> CmmStaticLit (CmmInt 0 (ncgWordWidth config))
+ Just blockid -> CmmStaticLit (CmmLabelDiffOff (blockLbl blockid) rel_lbl 0 (ncgWordWidth config))
+
+ in Just (CmmData section (mkAlignment 1, CmmStaticsRaw table_lbl jumpTable))
+
+ _ -> Nothing
extractUnwindPoints :: [Instr] -> [UnwindPoint]
extractUnwindPoints instrs =
diff --git a/compiler/GHC/CmmToAsm/X86/Instr.hs b/compiler/GHC/CmmToAsm/X86/Instr.hs
index 3a7939a58049..d62070d275e5 100644
--- a/compiler/GHC/CmmToAsm/X86/Instr.hs
+++ b/compiler/GHC/CmmToAsm/X86/Instr.hs
@@ -115,9 +115,12 @@ data Instr
-- | X86 scalar move instruction.
--
- -- When used at a vector format, only moves the lower 64 bits of data;
- -- the rest of the data in the destination may either be zeroed or
- -- preserved, depending on the specific format and operands.
+ -- The format is the format the destination is written to. For an XMM
+ -- register, using a scalar format means that we don't care about the
+ -- upper bits, while using a vector format means that we care about the
+ -- upper bits, even though we are only writing to the lower bits.
+ --
+ -- See also Note [Allocated register formats] in GHC.CmmToAsm.Reg.Linear.
| MOV Format Operand Operand
-- N.B. Due to AT&T assembler quirks, when used with 'II64'
-- 'Format' immediate source and memory target operand, the source
@@ -250,6 +253,7 @@ data Instr
[Maybe JumpDest] -- Targets of the jump table
Section -- Data section jump table should be put in
CLabel -- Label of jump table
+ !(Maybe CLabel) -- Label used to compute relative offsets. Otherwise we store absolute addresses.
-- | X86 call instruction
| CALL (Either Imm Reg) -- ^ Jump target
[RegWithFormat] -- ^ Arguments (required for register allocation)
@@ -406,18 +410,27 @@ data FMAPermutation = FMA132 | FMA213 | FMA231
regUsageOfInstr :: Platform -> Instr -> RegUsage
regUsageOfInstr platform instr
= case instr of
- MOV fmt src dst
+
+ -- Recall that MOV is always a scalar move instruction, but when the destination
+ -- is an XMM register, we make the distinction between:
+ --
+ -- - a scalar format, meaning that from now on we no longer care about the top bits
+ -- of the register, and
+ -- - a vector format, meaning that we still care about what's in the high bits.
+ --
+ -- See Note [Allocated register formats] in GHC.CmmToAsm.Reg.Linear.
+ MOV dst_fmt src dst
-- MOVSS/MOVSD preserve the upper half of vector registers,
-- but only for reg-2-reg moves
- | VecFormat _ sFmt <- fmt
+ | VecFormat _ sFmt <- dst_fmt
, isFloatScalarFormat sFmt
, OpReg {} <- src
, OpReg {} <- dst
- -> usageRM fmt src dst
+ -> usageRM dst_fmt src dst
-- other MOV instructions zero any remaining upper part of the destination
-- (largely to avoid partial register stalls)
| otherwise
- -> usageRW fmt src dst
+ -> usageRW dst_fmt src dst
MOVD fmt1 fmt2 src dst ->
-- NB: MOVD and MOVQ always zero any remaining upper part of destination,
-- so the destination is "written" not "modified".
@@ -433,7 +446,7 @@ regUsageOfInstr platform instr
IMUL fmt src dst -> usageRM fmt src dst
-- Result of IMULB will be in just in %ax
- IMUL2 II8 src -> mkRU (mk II8 eax:use_R II8 src []) [mk II8 eax]
+ IMUL2 II8 src -> mkRU (mk II8 eax:use_R II8 src []) [mk II16 eax]
-- Result of IMUL for wider values, will be split between %dx/%edx/%rdx and
-- %ax/%eax/%rax.
IMUL2 fmt src -> mkRU (mk fmt eax:use_R fmt src []) [mk fmt eax,mk fmt edx]
@@ -476,7 +489,7 @@ regUsageOfInstr platform instr
JXX _ _ -> mkRU [] []
JXX_GBL _ _ -> mkRU [] []
JMP op regs -> mkRU (use_R addrFmt op regs) []
- JMP_TBL op _ _ _ -> mkRU (use_R addrFmt op []) []
+ JMP_TBL op _ _ _ _ -> mkRU (use_R addrFmt op []) []
CALL (Left _) params -> mkRU params (map mkFmt $ callClobberedRegs platform)
CALL (Right reg) params -> mkRU (mk addrFmt reg:params) (map mkFmt $ callClobberedRegs platform)
CLTD fmt -> mkRU [mk fmt eax] [mk fmt edx]
@@ -795,7 +808,7 @@ patchRegsOfInstr platform instr env
POP fmt op -> patch1 (POP fmt) op
SETCC cond op -> patch1 (SETCC cond) op
JMP op regs -> JMP (patchOp op) regs
- JMP_TBL op ids s lbl -> JMP_TBL (patchOp op) ids s lbl
+ JMP_TBL op ids s tl jl -> JMP_TBL (patchOp op) ids s tl jl
FMA3 fmt perm var x1 x2 x3 -> patch3 (FMA3 fmt perm var) x1 x2 x3
@@ -997,9 +1010,9 @@ isJumpishInstr instr
canFallthroughTo :: Instr -> BlockId -> Bool
canFallthroughTo insn bid
= case insn of
- JXX _ target -> bid == target
- JMP_TBL _ targets _ _ -> all isTargetBid targets
- _ -> False
+ JXX _ target -> bid == target
+ JMP_TBL _ targets _ _ _ -> all isTargetBid targets
+ _ -> False
where
isTargetBid target = case target of
Nothing -> True
@@ -1012,9 +1025,9 @@ jumpDestsOfInstr
jumpDestsOfInstr insn
= case insn of
- JXX _ id -> [id]
- JMP_TBL _ ids _ _ -> [id | Just (DestBlockId id) <- ids]
- _ -> []
+ JXX _ id -> [id]
+ JMP_TBL _ ids _ _ _ -> [id | Just (DestBlockId id) <- ids]
+ _ -> []
patchJumpInstr
@@ -1023,8 +1036,8 @@ patchJumpInstr
patchJumpInstr insn patchF
= case insn of
JXX cc id -> JXX cc (patchF id)
- JMP_TBL op ids section lbl
- -> JMP_TBL op (map (fmap (patchJumpDest patchF)) ids) section lbl
+ JMP_TBL op ids section table_lbl rel_lbl
+ -> JMP_TBL op (map (fmap (patchJumpDest patchF)) ids) section table_lbl rel_lbl
_ -> insn
where
patchJumpDest f (DestBlockId id) = DestBlockId (f id)
@@ -1485,14 +1498,14 @@ shortcutJump fn insn = shortcutJump' fn (setEmpty :: LabelSet) insn
Just (DestBlockId id') -> shortcutJump' fn seen' (JXX cc id')
Just (DestImm imm) -> shortcutJump' fn seen' (JXX_GBL cc imm)
where seen' = setInsert id seen
- shortcutJump' fn _ (JMP_TBL addr blocks section tblId) =
+ shortcutJump' fn _ (JMP_TBL addr blocks section table_lbl rel_lbl) =
let updateBlock (Just (DestBlockId bid)) =
case fn bid of
Nothing -> Just (DestBlockId bid )
Just dest -> Just dest
updateBlock dest = dest
blocks' = map updateBlock blocks
- in JMP_TBL addr blocks' section tblId
+ in JMP_TBL addr blocks' section table_lbl rel_lbl
shortcutJump' _ _ other = other
-- Here because it knows about JumpDest
diff --git a/compiler/GHC/CmmToAsm/X86/Ppr.hs b/compiler/GHC/CmmToAsm/X86/Ppr.hs
index df4262f02ca3..8a6208332997 100644
--- a/compiler/GHC/CmmToAsm/X86/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/X86/Ppr.hs
@@ -889,7 +889,7 @@ pprInstr platform i = case i of
JMP op _
-> line $ text "\tjmp *" <> pprOperand platform (archWordFormat (target32Bit platform)) op
- JMP_TBL op _ _ _
+ JMP_TBL op _ _ _ _
-> pprInstr platform (JMP op [])
CALL (Left imm) _
diff --git a/compiler/GHC/Core/Make.hs b/compiler/GHC/Core/Make.hs
index 70a70ced7a89..7db02e85cd30 100644
--- a/compiler/GHC/Core/Make.hs
+++ b/compiler/GHC/Core/Make.hs
@@ -111,7 +111,7 @@ sortQuantVars vs = sorted_tcvs ++ ids
-- | Bind a binding group over an expression, using a @let@ or @case@ as
-- appropriate (see "GHC.Core#let_can_float_invariant")
-mkCoreLet :: CoreBind -> CoreExpr -> CoreExpr
+mkCoreLet :: HasDebugCallStack => CoreBind -> CoreExpr -> CoreExpr
mkCoreLet (NonRec bndr rhs) body -- See Note [Core let-can-float invariant]
= bindNonRec bndr rhs body
mkCoreLet bind body
@@ -133,7 +133,7 @@ mkCoreTyLams binders body = mkCast lam co
-- | Bind a list of binding groups over an expression. The leftmost binding
-- group becomes the outermost group in the resulting expression
-mkCoreLets :: [CoreBind] -> CoreExpr -> CoreExpr
+mkCoreLets :: HasDebugCallStack => [CoreBind] -> CoreExpr -> CoreExpr
mkCoreLets binds body = foldr mkCoreLet body binds
-- | Construct an expression which represents the application of a number of
diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs
index 6c9b7563ab59..96dcc58cdb21 100644
--- a/compiler/GHC/Core/Opt/ConstantFold.hs
+++ b/compiler/GHC/Core/Opt/ConstantFold.hs
@@ -3422,7 +3422,7 @@ caseRules _ (Var f `App` Type lev `App` Type ty `App` v) -- dataToTag x
, "be a future bug in GHC, or it may be caused by an unsupported"
, "use of the ghc-internal primops dataToTagSmall# and dataToTagLarge#."
, "In either case, the GHC developers would like to know about it!"
- , "Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug"
+ , "Please report this as a GHC bug: https://github.com/stable-haskell/ghc/issues"
]
caseRules _ _ = Nothing
diff --git a/compiler/GHC/Core/Opt/Pipeline.hs b/compiler/GHC/Core/Opt/Pipeline.hs
index 038c7ab1ab7b..1a68da6acc76 100644
--- a/compiler/GHC/Core/Opt/Pipeline.hs
+++ b/compiler/GHC/Core/Opt/Pipeline.hs
@@ -13,6 +13,7 @@ import GHC.Prelude
import GHC.Driver.DynFlags
import GHC.Driver.Plugins ( withPlugins, installCoreToDos )
import GHC.Driver.Env
+import GHC.Driver.Config (initSimpleOpts)
import GHC.Driver.Config.Core.Lint ( endPass )
import GHC.Driver.Config.Core.Opt.LiberateCase ( initLiberateCaseOpts )
import GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyOpts, initSimplMode, initGentleSimplMode )
@@ -21,9 +22,10 @@ import GHC.Driver.Config.Core.Rules ( initRuleOpts )
import GHC.Platform.Ways ( hasWay, Way(WayProf) )
import GHC.Core
+import GHC.Core.SimpleOpt (simpleOptPgm)
import GHC.Core.Opt.CSE ( cseProgram )
import GHC.Core.Rules ( RuleBase, ruleCheckProgram, getRules )
-import GHC.Core.Ppr ( pprCoreBindings )
+import GHC.Core.Ppr ( pprCoreBindings, pprRules )
import GHC.Core.Utils ( dumpIdInfoOfProgram )
import GHC.Core.Lint ( lintAnnots )
import GHC.Core.Lint.Interactive ( interactiveInScope )
@@ -202,10 +204,14 @@ getCoreToDo dflags hpt_rule_base extra_vars
core_todo =
[
- -- We want to do the static argument transform before full laziness as it
- -- may expose extra opportunities to float things outwards. However, to fix
- -- up the output of the transformation we need at do at least one simplify
- -- after this before anything else
+ -- We always perform a run of the simple optimizer after desugaring to
+ -- remove really bad code
+ CoreDesugarOpt,
+
+ -- We want to do the static argument transform before full laziness as it
+ -- may expose extra opportunities to float things outwards. However, to fix
+ -- up the output of the transformation we need at do at least one simplify
+ -- after this before anything else
runWhen static_args (CoreDoPasses [ simpl_gently, CoreDoStaticArgs ]),
-- initial simplify: mk specialiser happy: minimum effort please
@@ -467,6 +473,7 @@ doCorePass pass guts = do
let fam_envs = (p_fam_env, mg_fam_inst_env guts)
let updateBinds f = return $ guts { mg_binds = f (mg_binds guts) }
let updateBindsM f = f (mg_binds guts) >>= \b' -> return $ guts { mg_binds = b' }
+ let updateBindsAndRulesM f = f (mg_binds guts) (mg_rules guts) >>= \(b',r') -> return $ guts { mg_binds = b', mg_rules = r' }
-- Important to force this now as name_ppr_ctx lives through an entire phase in
-- the optimiser and if it's not forced then the entire previous `ModGuts` will
-- be retained until the end of the phase. (See #24328 for more analysis)
@@ -479,6 +486,9 @@ doCorePass pass guts = do
case pass of
+ CoreDesugarOpt -> {-# SCC "DesugarOpt" #-}
+ updateBindsAndRulesM (desugarOpt dflags logger (mg_module guts))
+
CoreDoSimplify opts -> {-# SCC "Simplify" #-}
liftIOWithCount $ simplifyPgm logger (hsc_unit_env hsc_env) name_ppr_ctx opts guts
@@ -537,7 +547,6 @@ doCorePass pass guts = do
CoreDoPluginPass _ p -> {-# SCC "Plugin" #-} p guts
CoreDesugar -> pprPanic "doCorePass" (ppr pass)
- CoreDesugarOpt -> pprPanic "doCorePass" (ppr pass)
CoreTidy -> pprPanic "doCorePass" (ppr pass)
CorePrep -> pprPanic "doCorePass" (ppr pass)
@@ -580,3 +589,25 @@ dmdAnal logger before_ww dflags fam_envs rules binds = do
dumpIdInfoOfProgram (hasPprDebug dflags) (ppr . zapDmdEnvSig . dmdSigInfo) binds_plus_dmds
-- See Note [Stamp out space leaks in demand analysis] in GHC.Core.Opt.DmdAnal
seqBinds binds_plus_dmds `seq` return binds_plus_dmds
+
+
+-- | Simple optimization after desugaring.
+--
+-- This is used to remove the bad code that the desugarer produces (top-level
+-- dictionnary bindings, type bindings, etc.).
+--
+-- It does things that the real Simplifier doesn't do: e.g. floating-in
+-- top-level String literals. Hence we can't fully remove it.
+--
+-- It has been moved from being called by the desugarer directly to being the
+-- first Core-to-Core pass to accomodate Core plugins that want to see Core even
+-- before the first (simple) optimization took place. See #23337
+desugarOpt :: DynFlags -> Logger -> Module -> CoreProgram -> [CoreRule] -> CoreM (CoreProgram,[CoreRule])
+desugarOpt dflags logger mod binds rules = liftIO $ do
+ let simpl_opts = initSimpleOpts dflags
+ let !(ds_binds, ds_rules_for_imps, occ_anald_binds) = simpleOptPgm simpl_opts mod binds rules
+
+ putDumpFileMaybe logger Opt_D_dump_occur_anal "Occurrence analysis"
+ FormatCore (pprCoreBindings occ_anald_binds $$ pprRules ds_rules_for_imps )
+
+ pure (ds_binds, ds_rules_for_imps)
diff --git a/compiler/GHC/Core/Opt/Pipeline/Types.hs b/compiler/GHC/Core/Opt/Pipeline/Types.hs
index 1630506a7d5a..d317e9038924 100644
--- a/compiler/GHC/Core/Opt/Pipeline/Types.hs
+++ b/compiler/GHC/Core/Opt/Pipeline/Types.hs
@@ -10,7 +10,7 @@ import GHC.Core ( CoreProgram )
import GHC.Core.Opt.Monad ( CoreM, FloatOutSwitches )
import GHC.Core.Opt.Simplify ( SimplifyOpts(..) )
-import GHC.Types.Basic ( CompilerPhase(..) )
+import GHC.Types.Basic ( CompilerPhase )
import GHC.Unit.Module.ModGuts
import GHC.Utils.Outputable as Outputable
@@ -52,14 +52,13 @@ data CoreToDo -- These are diff core-to-core passes,
| CoreDoSpecialising
| CoreDoSpecConstr
| CoreCSE
- | CoreDoRuleCheck CompilerPhase String -- Check for non-application of rules
- -- matching this string
+ | CoreDoRuleCheck CompilerPhase String -- Check for non-application of rules
+ -- matching this string
| CoreDoNothing -- Useful when building up
| CoreDoPasses [CoreToDo] -- lists of these things
| CoreDesugar -- Right after desugaring, no simple optimisation yet!
- | CoreDesugarOpt -- CoreDesugarXXX: Not strictly a core-to-core pass, but produces
- -- Core output, and hence useful to pass to endPass
+ | CoreDesugarOpt -- Simple optimisation after desugaring
| CoreTidy
| CorePrep
diff --git a/compiler/GHC/Core/Opt/SetLevels.hs b/compiler/GHC/Core/Opt/SetLevels.hs
index 20433cdf6089..e2790ab8d053 100644
--- a/compiler/GHC/Core/Opt/SetLevels.hs
+++ b/compiler/GHC/Core/Opt/SetLevels.hs
@@ -91,6 +91,7 @@ import GHC.Core.Utils
import GHC.Core.Opt.Arity ( exprBotStrictness_maybe, isOneShotBndr )
import GHC.Core.FVs -- all of it
import GHC.Core.Subst
+import GHC.Core.TyCo.Subst( lookupTyVar )
import GHC.Core.Make ( sortQuantVars )
import GHC.Core.Type ( Type, tyCoVarsOfType
, mightBeUnliftedType, closeOverKindsDSet
@@ -466,8 +467,8 @@ lvlCase env scrut_fvs scrut' case_bndr ty alts
ty' = substTyUnchecked (le_subst env) ty
incd_lvl = incMinorLvl (le_ctxt_lvl env)
- dest_lvl = maxFvLevel (const True) env scrut_fvs
- -- Don't abstract over type variables, hence const True
+ dest_lvl = maxFvLevel includeTyVars env scrut_fvs
+ -- Don't abstract over type variables, hence includeTyVars
lvl_alt alts_env (AnnAlt con bs rhs)
= do { rhs' <- lvlMFE new_env True rhs
@@ -719,8 +720,11 @@ hasFreeJoin :: LevelEnv -> DVarSet -> Bool
-- (In the latter case it won't be a join point any more.)
-- Not treating top-level ones specially had a massive effect
-- on nofib/minimax/Prog.prog
-hasFreeJoin env fvs
- = not (maxFvLevel isJoinId env fvs == tOP_LEVEL)
+hasFreeJoin env fvs = anyDVarSet bad_join fvs
+ where
+ bad_join v = isJoinId v &&
+ maxIn True env v tOP_LEVEL /= tOP_LEVEL
+
{- Note [Saving work]
~~~~~~~~~~~~~~~~~~~~~
@@ -1607,10 +1611,10 @@ destLevel env fvs fvs_ty is_function is_bot
| otherwise = max_fv_id_level
where
- max_fv_id_level = maxFvLevel isId env fvs -- Max over Ids only; the
- -- tyvars will be abstracted
+ max_fv_id_level = maxFvLevel idsOnly env fvs -- Max over Ids only; the
+ -- tyvars will be abstracted
- as_far_as_poss = maxFvLevel' isId env fvs_ty
+ as_far_as_poss = maxFvLevel' idsOnly env fvs_ty
-- See Note [Floating and kind casts]
{- Note [Floating and kind casts]
@@ -1768,28 +1772,47 @@ extendCaseBndrEnv le@(LE { le_subst = subst, le_env = id_env })
, le_env = add_id id_env (case_bndr, scrut_var) }
extendCaseBndrEnv env _ _ = env
-maxFvLevel :: (Var -> Bool) -> LevelEnv -> DVarSet -> Level
-maxFvLevel max_me env var_set
- = nonDetStrictFoldDVarSet (maxIn max_me env) tOP_LEVEL var_set
+includeTyVars, idsOnly :: Bool
+idsOnly = False
+includeTyVars = True
+
+maxFvLevel :: Bool -> LevelEnv -> DVarSet -> Level
+maxFvLevel include_tyvars env var_set
+ = nonDetStrictFoldDVarSet (maxIn include_tyvars env) tOP_LEVEL var_set
-- It's OK to use a non-deterministic fold here because maxIn commutes.
-maxFvLevel' :: (Var -> Bool) -> LevelEnv -> TyCoVarSet -> Level
+maxFvLevel' :: Bool -> LevelEnv -> TyCoVarSet -> Level
-- Same but for TyCoVarSet
-maxFvLevel' max_me env var_set
- = nonDetStrictFoldUniqSet (maxIn max_me env) tOP_LEVEL var_set
+maxFvLevel' include_tyvars env var_set
+ = nonDetStrictFoldUniqSet (maxIn include_tyvars env) tOP_LEVEL var_set
-- It's OK to use a non-deterministic fold here because maxIn commutes.
-maxIn :: (Var -> Bool) -> LevelEnv -> InVar -> Level -> Level
-maxIn max_me (LE { le_lvl_env = lvl_env, le_env = id_env }) in_var lvl
+maxIn :: Bool -> LevelEnv -> InVar -> Level -> Level
+-- True <=> include tyvars
+maxIn include_tyvars env@(LE { le_subst = subst, le_env = id_env }) in_var lvl
+ | isId in_var
= case lookupVarEnv id_env in_var of
+ Nothing -> maxOut env in_var lvl
Just (abs_vars, _) -> foldr max_out lvl abs_vars
- Nothing -> max_out in_var lvl
- where
- max_out out_var lvl
- | max_me out_var = case lookupVarEnv lvl_env out_var of
- Just lvl' -> maxLvl lvl' lvl
- Nothing -> lvl
- | otherwise = lvl -- Ignore some vars depending on max_me
+ where
+ max_out out_var lvl
+ | isTyVar out_var && not include_tyvars
+ = lvl
+ | otherwise = maxOut env out_var lvl
+
+ | include_tyvars -- TyVars
+ = case lookupTyVar subst in_var of
+ Just ty -> nonDetStrictFoldVarSet (maxOut env) lvl (tyCoVarsOfType ty)
+ Nothing -> maxOut env in_var lvl
+
+ | otherwise -- Ignore free tyvars
+ = lvl
+
+maxOut :: LevelEnv -> OutVar -> Level -> Level
+maxOut (LE { le_lvl_env = lvl_env }) out_var lvl
+ = case lookupVarEnv lvl_env out_var of
+ Just lvl' -> maxLvl lvl' lvl
+ Nothing -> lvl
lookupVar :: LevelEnv -> Id -> LevelledExpr
lookupVar le v = case lookupVarEnv (le_env le) v of
diff --git a/compiler/GHC/Core/Opt/Simplify/Env.hs b/compiler/GHC/Core/Opt/Simplify/Env.hs
index e6dab49e56c1..df2470e574a5 100644
--- a/compiler/GHC/Core/Opt/Simplify/Env.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Env.hs
@@ -12,6 +12,7 @@ module GHC.Core.Opt.Simplify.Env (
-- * Environments
SimplEnv(..), pprSimplEnv, -- Temp not abstract
+ SimplPhase(..), isActive,
seArityOpts, seCaseCase, seCaseFolding, seCaseMerge, seCastSwizzle,
seDoEtaReduction, seEtaExpand, seFloatEnable, seInline, seNames,
seOptCoercionOpts, sePhase, sePlatform, sePreInline,
@@ -145,7 +146,7 @@ here is between "freely set by the caller" and "internally managed by the pass".
Note that it doesn't matter for the decision procedure wheter a value is altered
throughout an iteration of the Simplify pass: The fields sm_phase, sm_inline,
sm_rules, sm_cast_swizzle and sm_eta_expand are updated locally (See the
-definitions of `updModeForStableUnfoldings` and `updModeForRules` in
+definitions of `updModeForStableUnfoldings` and `updModeForRule{LHS,RHS}` in
GHC.Core.Opt.Simplify.Utils) but they are still part of `SimplMode` as the
caller of the Simplify pass needs to provide the initial values for those fields.
@@ -250,7 +251,7 @@ seNames env = sm_names (seMode env)
seOptCoercionOpts :: SimplEnv -> OptCoercionOpts
seOptCoercionOpts env = sm_co_opt_opts (seMode env)
-sePhase :: SimplEnv -> CompilerPhase
+sePhase :: SimplEnv -> SimplPhase
sePhase env = sm_phase (seMode env)
sePlatform :: SimplEnv -> Platform
@@ -270,7 +271,7 @@ seUnfoldingOpts env = sm_uf_opts (seMode env)
-- See Note [The environments of the Simplify pass]
data SimplMode = SimplMode -- See comments in GHC.Core.Opt.Simplify.Monad
- { sm_phase :: !CompilerPhase
+ { sm_phase :: !SimplPhase -- ^ The phase of the simplifier
, sm_names :: ![String] -- ^ Name(s) of the phase
, sm_rules :: !Bool -- ^ Whether RULES are enabled
, sm_inline :: !Bool -- ^ Whether inlining is enabled
@@ -288,13 +289,76 @@ data SimplMode = SimplMode -- See comments in GHC.Core.Opt.Simplify.Monad
, sm_co_opt_opts :: !OptCoercionOpts -- ^ Coercion optimiser options
}
+-- | See Note [SimplPhase]
+data SimplPhase
+ -- | A simplifier phase: InitialPhase, Phase 2, Phase 1, Phase 0, FinalPhase
+ = SimplPhase CompilerPhase
+ -- | Simplifying the RHS of a rule or of a stable unfolding: the range of
+ -- phases of the activation of the rule/stable unfolding.
+ --
+ -- _Invariant:_ 'simplStartPhase' is not a later phase than 'simplEndPhase'.
+ -- Equivalently, 'SimplPhaseRange' is always a non-empty interval of phases.
+ --
+ -- See Note [What is active in the RHS of a RULE?] in GHC.Core.Opt.Simplify.Utils.
+ | SimplPhaseRange
+ { simplStartPhase :: CompilerPhase
+ , simplEndPhase :: CompilerPhase
+ }
+
+ deriving Eq
+
+instance Outputable SimplPhase where
+ ppr (SimplPhase p) = ppr p
+ ppr (SimplPhaseRange s e) = brackets $ ppr s <> text "..." <> ppr e
+
+-- | Is this activation active in this simplifier phase?
+--
+-- For a phase range, @isActive simpl_phase_range act@ is true if and only if
+-- @act@ is active throughout the entire range, as per
+-- Note [What is active in the RHS of a RULE?] in GHC.Core.Opt.Simplify.Utils.
+--
+-- See Note [SimplPhase].
+isActive :: SimplPhase -> Activation -> Bool
+isActive (SimplPhase p) act = isActiveInPhase p act
+isActive (SimplPhaseRange start end) act =
+ -- To check whether the activation is active throughout the whole phase range,
+ -- it's sufficient to check the endpoints of the phase range, because an
+ -- activation can never have gaps (all activations are phase intervals).
+ isActiveInPhase start act && isActiveInPhase end act
+
+{- Note [SimplPhase]
+~~~~~~~~~~~~~~~~~~~~
+In general, the simplifier is invoked in successive phases:
+
+ InitialPhase, Phase 2, Phase 1, Phase 0, FinalPhase
+
+This allows us to control which rules, specialisations and inlinings are
+active at any given point. For example,
+
+ {-# RULE "myRule" [1] lhs = rhs #-}
+
+starts being active in Phase 1, and stays active thereafter. Thus it is active
+in Phase 1, Phase 0, FinalPhase, but not active in InitialPhase or Phase 2.
+
+This simplifier phase is stored in the sm_phase field of SimplMode, usin
+the 'SimplPhase' constructor. This allows us to determine which rules/inlinings
+are active.
+
+When we invoke the simplifier on the RHS of a rule, such as 'rhs' above, instead
+of setting the simplifier mode to a single phase, we use a phase range
+corresponding to the range of phases in which the rule is active, with the
+'SimplPhaseRange' constructor. This allows us to check whether other rules or
+inlinings are active throughout the whole activation of the rule.
+See Note [What is active in the RHS of a RULE?] in GHC.Core.Opt.Simplify.Utils.
+-}
+
instance Outputable SimplMode where
- ppr (SimplMode { sm_phase = p , sm_names = ss
+ ppr (SimplMode { sm_phase = phase , sm_names = ss
, sm_rules = r, sm_inline = i
, sm_cast_swizzle = cs
, sm_eta_expand = eta, sm_case_case = cc })
= text "SimplMode" <+> braces (
- sep [ text "Phase =" <+> ppr p <+>
+ sep [ text "Phase =" <+> ppr phase <+>
brackets (text (concat $ intersperse "," ss)) <> comma
, pp_flag i (text "inline") <> comma
, pp_flag r (text "rules") <> comma
@@ -312,9 +376,8 @@ data FloatEnable -- Controls local let-floating
| FloatNestedOnly -- Local let-floating for nested (NotTopLevel) bindings only
| FloatEnabled -- Do local let-floating on all bindings
-{-
-Note [Local floating]
-~~~~~~~~~~~~~~~~~~~~~
+{- Note [Local floating]
+~~~~~~~~~~~~~~~~~~~~~~~~
The Simplifier can perform local let-floating: it floats let-bindings
out of the RHS of let-bindings. See
Let-floating: moving bindings to give faster programs (ICFP'96)
diff --git a/compiler/GHC/Core/Opt/Simplify/Inline.hs b/compiler/GHC/Core/Opt/Simplify/Inline.hs
index 1f71384b8b30..ea57bd7c3450 100644
--- a/compiler/GHC/Core/Opt/Simplify/Inline.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Inline.hs
@@ -29,7 +29,7 @@ import GHC.Core.FVs( exprFreeIds )
import GHC.Types.Id
import GHC.Types.Var.Env( InScopeSet, lookupInScope )
import GHC.Types.Var.Set
-import GHC.Types.Basic ( Arity, RecFlag(..), isActive )
+import GHC.Types.Basic ( Arity, RecFlag(..) )
import GHC.Utils.Logger
import GHC.Utils.Misc
import GHC.Utils.Outputable
@@ -124,7 +124,7 @@ activeUnfolding mode id
| isCompulsoryUnfolding (realIdUnfolding id)
= True -- Even sm_inline can't override compulsory unfoldings
| otherwise
- = isActive (sm_phase mode) (idInlineActivation id)
+ = isActive (sm_phase mode) (idInlineActivation id)
&& sm_inline mode
-- `or` isStableUnfolding (realIdUnfolding id)
-- Inline things when
diff --git a/compiler/GHC/Core/Opt/Simplify/Iteration.hs b/compiler/GHC/Core/Opt/Simplify/Iteration.hs
index c41053f00466..b5fcdb9a0703 100644
--- a/compiler/GHC/Core/Opt/Simplify/Iteration.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Iteration.hs
@@ -471,14 +471,14 @@ leaving a simpler job for demand-analysis worker/wrapper. See #19874.
Wrinkles
-1. We must /not/ do cast w/w on
+(CWW1) We must /not/ do cast w/w on
f = g |> co
otherwise it'll just keep repeating forever! You might think this
is avoided because the call to tryCastWorkerWrapper is guarded by
- preInlineUnconditinally, but I'm worried that a loop-breaker or an
- exported Id might say False to preInlineUnonditionally.
+ preInlineUnconditionally, but I'm worried that a loop-breaker or an
+ exported Id might say False to preInlineUnconditionally.
-2. We need to be careful with inline/noinline pragmas:
+(CWW2) We need to be careful with inline/noinline pragmas:
rec { {-# NOINLINE f #-}
f = (...g...) |> co
; g = ...f... }
@@ -493,15 +493,15 @@ Wrinkles
f = $wf |> co
; g = ...f... }
and that is bad: the whole point is that we want to inline that
- cast! We want to transfer the pagma to $wf:
+ cast! We want to transfer the pragma to $wf:
rec { {-# NOINLINE $wf #-}
$wf = ...g...
; f = $wf |> co
; g = ...f... }
c.f. Note [Worker/wrapper for NOINLINE functions] in GHC.Core.Opt.WorkWrap.
-3. We should still do cast w/w even if `f` is INLINEABLE. E.g.
- {- f: Stable unfolding = -}
+(CWW3) We should still do cast w/w even if `f` is INLINEABLE. E.g.
+ {- f: Stable unfolding (arity 2) = -}
f = (\xy. ) |> co
Then we want to w/w to
{- $wf: Stable unfolding = |> sym co -}
@@ -510,15 +510,43 @@ Wrinkles
Notice that the stable unfolding moves to the worker! Now demand analysis
will work fine on $wf, whereas it has trouble with the original f.
c.f. Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap.
- This point also applies to strong loopbreakers with INLINE pragmas, see
- wrinkle (4).
-4. We should /not/ do cast w/w for non-loop-breaker INLINE functions (hence
- hasInlineUnfolding in tryCastWorkerWrapper, which responds False to
- loop-breakers) because they'll definitely be inlined anyway, cast and
- all. And if we do cast w/w for an INLINE function with arity zero, we get
+(CWW4) We should /not/ do cast w/w for INLINE functions (hence `hasInlineUnfolding`
+ in `tryCastWorkerWrapper`) because they'll definitely be inlined anyway, cast
+ and all.
+
+ Moreover, if we do cast w/w for an INLINE function with arity zero, we get
something really silly: we inline that "worker" right back into the wrapper!
- Worse than a no-op, because we have then lost the stable unfolding.
+ In fact it is Much Worse than a no-op, because we have then lost the stable
+ unfolding --- aargh (see #26903). E.g. similar example to (CWW3)
+ {- g: Stable unfolding (arity 0) = -} NB arity 0!
+ g = (\xy. ) |> co
+ If we w/w to this:
+ {- $wg: Stable unfolding (arity 0) = |> sym co -}
+ $wg = \xy.
+ g = $wg |> co
+ then we'll inline $wg at the call site in `g` giving
+ {- $wg: Stable unfolding (arity 0) = |> sym co -}
+ $wg = \xy.
+ g = ( |> sym co) |> co
+ and now we'll drop `$wg` as dead and we have lost the unfolding on `g`.
+ (We could /also/ give the binding `g = $wf |> co` a stable unfolding. Then
+ things would work right; but there is also no point in doing the cast
+ worker/wrapper in the first place.)
+
+ NB: you might wonder about a loop-breaker with an INLINE pragma; after all, a
+ loop breaker won't "definitely be inlined anyway", so arguably we should not
+ disable cast w/w/ for it. But a Rec group can /look/ recursive at an early
+ stage, and subsequently /become/ non-recursive after some simplification.
+ (This is common in instance decls; see Note [Checking for INLINE loop breakers]
+ in GHC.Core.Lint.) So the danger is that we'll permanently lose that stable
+ unfolding that we specifically wanted (#26903). Simple solution: disable cast
+ w/w for /any/ INLINE function. See the defn
+ of `GHC.Types.Id.Info.hasInlineUnfolding`.
+
+ The danger is that an INLINE pragma on a genuninely-recursive function
+ will kill worker-wrapper. Well, so be it. They are pretty suspicious anyway;
+ see Note [Checking for INLINE loop breakers].
All these wrinkles are exactly like worker/wrapper for strictness analysis:
f is the wrapper and must inline like crazy
@@ -583,11 +611,11 @@ tryCastWorkerWrapper env bind_cxt old_bndr bndr (Cast rhs co)
| BC_Let top_lvl is_rec <- bind_cxt -- Not join points
, not (isDFunId bndr) -- nor DFuns; cast w/w is no help, and we can't transform
-- a DFunUnfolding in mk_worker_unfolding
- , not (exprIsTrivial rhs) -- Not x = y |> co; Wrinkle 1
- , not (hasInlineUnfolding info) -- Not INLINE things: Wrinkle 4
- , typeHasFixedRuntimeRep work_ty -- Don't peel off a cast if doing so would
- -- lose the underlying runtime representation.
- -- See Note [Preserve RuntimeRep info in cast w/w]
+ , not (exprIsTrivial rhs) -- Not x = y |> co; see (CWW1)
+ , not (hasInlineUnfolding info) -- Not INLINE things: see (CWW4)
+ , typeHasFixedRuntimeRep work_ty -- Don't peel off a cast if doing so would
+ -- lose the underlying runtime representation.
+ -- See Note [Preserve RuntimeRep info in cast w/w]
, not (isOpaquePragma (idInlinePragma old_bndr)) -- Not for OPAQUE bindings
-- See Note [OPAQUE pragma]
= do { uniq <- getUniqueM
@@ -634,13 +662,13 @@ tryCastWorkerWrapper env bind_cxt old_bndr bndr (Cast rhs co)
`setArityInfo` work_arity
-- We do /not/ want to transfer OccInfo, Rules
-- Note [Preserve strictness in cast w/w]
- -- and Wrinkle 2 of Note [Cast worker/wrapper]
+ -- and (CWW2) of Note [Cast worker/wrapper]
----------- Worker unfolding -----------
-- Stable case: if there is a stable unfolding we have to compose with (Sym co);
-- the next round of simplification will do the job
-- Non-stable case: use work_rhs
- -- Wrinkle 3 of Note [Cast worker/wrapper]
+ -- See (CWW4) of Note [Cast worker/wrapper]
mk_worker_unfolding top_lvl work_id work_rhs
= case realUnfoldingInfo info of -- NB: the real one, even for loop-breakers
unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src })
@@ -2458,7 +2486,11 @@ tryInlining env logger var cont
| not (logHasDumpFlag logger Opt_D_verbose_core2core)
= when (isExternalName (idName var)) $
log_inlining $
- sep [text "Inlining done:", nest 4 (ppr var)]
+ sep [text "Inlining done:", nest 4 (ppr var)]
+ -- $$ nest 2 (vcat
+ -- [ text "Simplifier phase:" <+> ppr (sePhase env)
+ -- , text "Unfolding activation:" <+> ppr (idInlineActivation var)
+ -- ])
| otherwise
= log_inlining $
sep [text "Inlining done: " <> ppr var,
@@ -2645,6 +2677,8 @@ tryRules env rules fn args
= log_rule Opt_D_dump_rule_rewrites "Rule fired" $ vcat
[ text "Rule:" <+> ftext (ruleName rule)
, text "Module:" <+> printRuleModule rule
+ --, text "Simplifier phase:" <+> ppr (sePhase env)
+ --, text "Rule activation:" <+> ppr (ruleActivation rule)
, text "Full arity:" <+> ppr (ruleArity rule)
, text "Before:" <+> hang (ppr fn) 2 (sep (map ppr args))
, text "After: " <+> pprCoreExpr rule_rhs ]
@@ -4790,9 +4824,12 @@ simplRules env mb_new_id rules bind_cxt
rhs_cont = case bind_cxt of -- See Note [Rules and unfolding for join points]
BC_Let {} -> mkBoringStop rhs_ty
BC_Join _ cont -> assertPpr join_ok bad_join_msg cont
- lhs_env = updMode updModeForRules env'
- rhs_env = updMode (updModeForStableUnfoldings act) env'
- -- See Note [Simplifying the RHS of a RULE]
+
+ -- See Note [Simplifying rules] and Note [What is active in the RHS of a RULE?]
+ -- in GHC.Core.Opt.Simplify.Utils.
+ lhs_env = updMode updModeForRuleLHS env'
+ rhs_env = updMode (updModeForRuleRHS act) env'
+
-- Force this to avoid retaining reference to old Id
!fn_name' = case mb_new_id of
Just id -> idName id
@@ -4816,12 +4853,3 @@ simplRules env mb_new_id rules bind_cxt
, ru_rhs = occurAnalyseExpr rhs' }) }
-- Remember to occ-analyse, to drop dead code.
-- See Note [OccInfo in unfoldings and rules] in GHC.Core
-
-{- Note [Simplifying the RHS of a RULE]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We can simplify the RHS of a RULE much as we do the RHS of a stable
-unfolding. We used to use the much more conservative updModeForRules
-for the RHS as well as the LHS, but that seems more conservative
-than necesary. Allowing some inlining might, for example, eliminate
-a binding.
--}
diff --git a/compiler/GHC/Core/Opt/Simplify/Utils.hs b/compiler/GHC/Core/Opt/Simplify/Utils.hs
index 839782a36b79..e17fa323cbe1 100644
--- a/compiler/GHC/Core/Opt/Simplify/Utils.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Utils.hs
@@ -15,7 +15,7 @@ module GHC.Core.Opt.Simplify.Utils (
preInlineUnconditionally, postInlineUnconditionally,
activeRule,
getUnfoldingInRuleMatch,
- updModeForStableUnfoldings, updModeForRules,
+ updModeForStableUnfoldings, updModeForRuleLHS, updModeForRuleRHS,
-- The BindContext type
BindContext(..), bindContextLevel,
@@ -719,7 +719,7 @@ the LHS.
This is a pretty pathological example, so I'm not losing sleep over
it, but the simplest solution was to check sm_inline; if it is False,
-which it is on the LHS of a rule (see updModeForRules), then don't
+which it is on the LHS of a rule (see updModeForRuleLHS), then don't
make use of the strictness info for the function.
-}
@@ -1069,22 +1069,22 @@ Reason for (b): we want to inline integerCompare here
updModeForStableUnfoldings :: Activation -> SimplMode -> SimplMode
-- See Note [The environments of the Simplify pass]
+-- See Note [Simplifying inside stable unfoldings]
updModeForStableUnfoldings unf_act current_mode
- = current_mode { sm_phase = phaseFromActivation unf_act
- , sm_eta_expand = False
- , sm_inline = True }
- -- sm_eta_expand: see Note [Eta expansion in stable unfoldings and rules]
- -- sm_rules: just inherit; sm_rules might be "off"
- -- because of -fno-enable-rewrite-rules
- where
- phaseFromActivation (ActiveAfter _ n) = Phase n
- phaseFromActivation _ = InitialPhase
+ = current_mode
+ { sm_phase = phaseFromActivation (sm_phase current_mode) unf_act
+ -- See Note [What is active in the RHS of a RULE?]
+ , sm_eta_expand = False
+ -- See Note [Eta expansion in stable unfoldings and rules]
+ , sm_inline = True
+ -- sm_rules: just inherit; sm_rules might be "off" because of -fno-enable-rewrite-rules
+ }
-updModeForRules :: SimplMode -> SimplMode
+updModeForRuleLHS :: SimplMode -> SimplMode
-- See Note [Simplifying rules]
-- See Note [The environments of the Simplify pass]
-updModeForRules current_mode
- = current_mode { sm_phase = InitialPhase
+updModeForRuleLHS current_mode
+ = current_mode { sm_phase = SimplPhase InitialPhase -- doesn't matter
, sm_inline = False
-- See Note [Do not expose strictness if sm_inline=False]
, sm_rules = False
@@ -1092,8 +1092,34 @@ updModeForRules current_mode
-- See Note [Cast swizzling on rule LHSs]
, sm_eta_expand = False }
+updModeForRuleRHS :: Activation -> SimplMode -> SimplMode
+updModeForRuleRHS rule_act current_mode =
+ current_mode
+ -- See Note [What is active in the RHS of a RULE?]
+ { sm_phase = phaseFromActivation (sm_phase current_mode) rule_act
+ , sm_eta_expand = False
+ -- See Note [Eta expansion in stable unfoldings and rules]
+ }
+
+-- | Compute the phase range to set the 'SimplMode' to
+-- when simplifying the RHS of a rule or of a stable unfolding.
+--
+-- See Note [What is active in the RHS of a RULE?]
+phaseFromActivation
+ :: SimplPhase -- ^ the current simplifier phase
+ -> Activation -- ^ the activation of the RULE or stable unfolding
+ -> SimplPhase
+phaseFromActivation p act
+ | isNeverActive act
+ = p
+ | otherwise
+ = SimplPhaseRange act_start act_end
+ where
+ act_start = beginPhase act
+ act_end = endPhase act
+
{- Note [Simplifying rules]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
When simplifying a rule LHS, refrain from /any/ inlining or applying
of other RULES. Doing anything to the LHS is plain confusing, because
it means that what the rule matches is not what the user
@@ -1136,7 +1162,7 @@ where `cv` is a coercion variable. Critically, we really only want
coercion /variables/, not general coercions, on the LHS of a RULE. So
we don't want to swizzle this to
(\x. blah) |> (Refl xty `FunCo` CoVar cv)
-So we switch off cast swizzling in updModeForRules.
+So we switch off cast swizzling in updModeForRuleLHS.
Note [Eta expansion in stable unfoldings and rules]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1200,6 +1226,62 @@ running it, we don't want to use -O2. Indeed, we don't want to inline
anything, because the byte-code interpreter might get confused about
unboxed tuples and suchlike.
+Note [What is active in the RHS of a RULE?]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Suppose we have either a RULE or an inline pragma with an explicit activation:
+
+ {-# RULE "R" [p] lhs = rhs #-}
+ {-# INLINE [p] foo #-}
+
+We should do some modest rules/inlining stuff in the right-hand sides, partly to
+eliminate senseless crap, and partly to break the recursive knots generated by
+instance declarations. However, we have to be careful about precisely which
+rules/inlinings are active. In particular:
+
+ a) Rules/inlinings that *cease* being active before p should not apply.
+ b) Rules/inlinings that only become active *after* p should also not apply.
+
+In the rest of this Note, we will focus on rules, but everything applies equally
+to the RHSs of stable unfoldings.
+
+Our carefully crafted plan is as follows:
+
+ -------------------------------------------------------------
+ When simplifying the RHS of a RULE R with activation range A,
+ fire only other rules R' that are active throughout all of A.
+ -------------------------------------------------------------
+
+Reason: R might fire in any phase in A. Then R' can fire only if R' is active
+in that phase. If not, it's not safe to unconditionally fire R' in the RHS of R.
+
+This plan is implemented by:
+
+ 1. Setting the simplifier phase to the range of phases
+ corresponding to the start/end phases of the rule's activation.
+ 2. When checking whether another rule is active, we use the function
+ isActive :: SimplPhase -> Activation -> Bool
+ from GHC.Core.Opt.Simplify.Env, which checks whether the other rule is
+ active throughout the whole range of phases.
+
+However, if the rule whose RHS we are simplifying is never active, instead of
+setting the phase range to an empty interval, we keep the current simplifier
+phase. This special case avoids firing ALL rules in the RHS of a never-active
+rule.
+
+You might wonder about a situation such as the following:
+
+ module M1 where
+ {-# RULES "r1" [1] lhs1 = rhs1 #-}
+ {-# RULES "r2" [2] lhs2 = rhs2 #-}
+
+ Current simplifier phase: 1
+
+It looks tempting to use "r1" when simplifying the RHS of "r2", yet we
+**must not** do so: for any module M that imports M1, we are going to start
+simplification in M starting at InitialPhase, and we will see the
+fully simplified rules RHSs imported from M1.
+Conclusion: stick to the plan.
+
Note [Simplifying inside stable unfoldings]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We must take care with simplification inside stable unfoldings (which come from
@@ -1216,33 +1298,9 @@ and thence copied multiple times when g is inlined. HENCE we treat
any occurrence in a stable unfolding as a multiple occurrence, not a single
one; see OccurAnal.addRuleUsage.
-Second, we do want *do* to some modest rules/inlining stuff in stable
-unfoldings, partly to eliminate senseless crap, and partly to break
-the recursive knots generated by instance declarations.
-
-However, suppose we have
- {-# INLINE f #-}
- f =
-meaning "inline f in phases p where activation (p) holds".
-Then what inlinings/rules can we apply to the copy of captured in
-f's stable unfolding? Our model is that literally is substituted for
-f when it is inlined. So our conservative plan (implemented by
-updModeForStableUnfoldings) is this:
-
- -------------------------------------------------------------
- When simplifying the RHS of a stable unfolding, set the phase
- to the phase in which the stable unfolding first becomes active
- -------------------------------------------------------------
-
-That ensures that
-
- a) Rules/inlinings that *cease* being active before p will
- not apply to the stable unfolding, consistent with it being
- inlined in its *original* form in phase p.
-
- b) Rules/inlinings that only become active *after* p will
- not apply to the stable unfolding, again to be consistent with
- inlining the *original* rhs in phase p.
+Second, we must be careful when simplifying the RHS that we do not apply RULES
+which are not active over the whole active range of the stable unfolding.
+This is all explained in Note [What is active in the RHS of a RULE?].
For example,
{-# INLINE f #-}
@@ -1291,8 +1349,7 @@ getUnfoldingInRuleMatch env
= ISE in_scope id_unf
where
in_scope = seInScope env
- phase = sePhase env
- id_unf = whenActiveUnfoldingFun (isActive phase)
+ id_unf = whenActiveUnfoldingFun (isActive (sePhase env))
-- When sm_rules was off we used to test for a /stable/ unfolding,
-- but that seems wrong (#20941)
@@ -1468,7 +1525,8 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env
one_occ _ = False
pre_inline_unconditionally = sePreInline env
- active = isActive (sePhase env) (inlinePragmaActivation inline_prag)
+ active = isActive (sePhase env)
+ $ inlinePragmaActivation inline_prag
-- See Note [pre/postInlineUnconditionally in gentle mode]
inline_prag = idInlinePragma bndr
@@ -1504,7 +1562,10 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env
-- not ticks. Counting ticks cannot be duplicated, and non-counting
-- ticks around a Lam will disappear anyway.
- early_phase = sePhase env /= FinalPhase
+ early_phase =
+ case sePhase env of
+ SimplPhase p -> p /= FinalPhase
+ SimplPhaseRange _start end -> end /= FinalPhase
-- If we don't have this early_phase test, consider
-- x = length [1,2,3]
-- The full laziness pass carefully floats all the cons cells to
@@ -1515,9 +1576,8 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env
--
-- On the other hand, I have seen cases where top-level fusion is
-- lost if we don't inline top level thing (e.g. string constants)
- -- Hence the test for phase zero (which is the phase for all the final
- -- simplifications). Until phase zero we take no special notice of
- -- top level things, but then we become more leery about inlining
+ -- Hence the final phase test: until the final phase, we take no special
+ -- notice of top level things, but then we become more leery about inlining
-- them.
--
-- What exactly to check in `early_phase` above is the subject of #17910.
@@ -1644,8 +1704,7 @@ postInlineUnconditionally env bind_cxt old_bndr bndr rhs
occ_info = idOccInfo old_bndr
unfolding = idUnfolding bndr
uf_opts = seUnfoldingOpts env
- phase = sePhase env
- active = isActive phase (idInlineActivation bndr)
+ active = isActive (sePhase env) $ idInlineActivation bndr
-- See Note [pre/postInlineUnconditionally in gentle mode]
{- Note [Inline small things to avoid creating a thunk]
diff --git a/compiler/GHC/Core/Opt/Specialise.hs b/compiler/GHC/Core/Opt/Specialise.hs
index 703c0f9f3cb8..345d3dd28bc4 100644
--- a/compiler/GHC/Core/Opt/Specialise.hs
+++ b/compiler/GHC/Core/Opt/Specialise.hs
@@ -20,18 +20,23 @@ import GHC.Core.SimpleOpt( defaultSimpleOpts, simpleOptExprWith, exprIsConApp_ma
import GHC.Core.Predicate
import GHC.Core.Class( classMethods )
import GHC.Core.Coercion( Coercion )
-import GHC.Core.Opt.Monad
+import GHC.Core.DataCon (dataConTyCon)
+
import qualified GHC.Core.Subst as Core
import GHC.Core.Unfold.Make
import GHC.Core
import GHC.Core.Make ( mkLitRubbish )
import GHC.Core.Unify ( tcMatchTy )
import GHC.Core.Rules
+import GHC.Core.Subst (substTickish)
+import GHC.Core.TyCon (tyConClass_maybe)
import GHC.Core.Utils ( exprIsTrivial, exprIsTopLevelBindable
, mkCast, exprType, exprIsHNF
, stripTicksTop, mkInScopeSetBndrs )
import GHC.Core.FVs
import GHC.Core.Opt.Arity( collectBindersPushingCo )
+import GHC.Core.Opt.Monad
+import GHC.Core.Opt.Simplify.Env ( SimplPhase(..), isActive )
import GHC.Builtin.Types ( unboxedUnitTy )
@@ -653,9 +658,7 @@ specProgram guts@(ModGuts { mg_module = this_mod
-- Easiest thing is to do it all at once, as if all the top-level
-- decls were mutually recursive
; let top_env = SE { se_subst = Core.mkEmptySubst $
- mkInScopeSetBndrs binds
- -- mkInScopeSetList $
- -- bindersOfBinds binds
+ mkInScopeSetBndrs binds
, se_module = this_mod
, se_rules = rule_env
, se_dflags = dflags }
@@ -815,9 +818,12 @@ spec_imports env callers dict_binds calls
go :: SpecEnv -> [CallInfoSet] -> CoreM (SpecEnv, [CoreRule], [CoreBind])
go env [] = return (env, [], [])
go env (cis : other_calls)
- = do { -- debugTraceMsg (text "specImport {" <+> ppr cis)
+ = do {
+-- debugTraceMsg (text "specImport {" <+> vcat [ ppr cis
+-- , text "callers" <+> ppr callers
+-- , text "dict_binds" <+> ppr dict_binds ])
; (env, rules1, spec_binds1) <- spec_import env callers dict_binds cis
- ; -- debugTraceMsg (text "specImport }" <+> ppr cis)
+-- ; debugTraceMsg (text "specImport }" <+> ppr cis)
; (env, rules2, spec_binds2) <- go env other_calls
; return (env, rules1 ++ rules2, spec_binds1 ++ spec_binds2) }
@@ -834,13 +840,18 @@ spec_import :: SpecEnv -- Passed in so that all top-level Ids are
, [CoreBind] ) -- Specialised bindings
spec_import env callers dict_binds cis@(CIS fn _)
| isIn "specImport" fn callers
- = return (env, [], []) -- No warning. This actually happens all the time
- -- when specialising a recursive function, because
- -- the RHS of the specialised function contains a recursive
- -- call to the original function
+ = do {
+-- debugTraceMsg (text "specImport1-bad" <+> (ppr fn $$ text "callers" <+> ppr callers))
+ ; return (env, [], []) }
+ -- No warning. This actually happens all the time
+ -- when specialising a recursive function, because
+ -- the RHS of the specialised function contains a recursive
+ -- call to the original function
| null good_calls
- = return (env, [], [])
+ = do {
+-- debugTraceMsg (text "specImport1-no-good" <+> (ppr cis $$ text "dict_binds" <+> ppr dict_binds))
+ ; return (env, [], []) }
| Just rhs <- canSpecImport dflags fn
= do { -- Get rules from the external package state
@@ -889,7 +900,10 @@ spec_import env callers dict_binds cis@(CIS fn _)
; return (env, rules2 ++ rules1, final_binds) }
| otherwise
- = do { tryWarnMissingSpecs dflags callers fn good_calls
+ = do {
+-- debugTraceMsg (hang (text "specImport1-missed")
+-- 2 (vcat [ppr cis, text "can-spec" <+> ppr (canSpecImport dflags fn)]))
+ ; tryWarnMissingSpecs dflags callers fn good_calls
; return (env, [], [])}
where
@@ -1510,7 +1524,9 @@ specBind top_lvl env (NonRec fn rhs) do_body
; (fn4, spec_defns, body_uds1) <- specDefn env body_uds fn3 rhs
- ; let (free_uds, dump_dbs, float_all) = dumpBindUDs [fn4] body_uds1
+ ; let can_float_this_one = exprIsTopLevelBindable rhs (idType fn)
+ -- exprIsTopLevelBindable: see Note [Care with unlifted bindings]
+ (free_uds, dump_dbs, float_all) = dumpBindUDs can_float_this_one [fn4] body_uds1
all_free_uds = free_uds `thenUDs` rhs_uds
pairs = spec_defns ++ [(fn4, rhs')]
@@ -1526,10 +1542,8 @@ specBind top_lvl env (NonRec fn rhs) do_body
= [mkDB $ NonRec b r | (b,r) <- pairs]
++ fromOL dump_dbs
- can_float_this_one = exprIsTopLevelBindable rhs (idType fn)
- -- exprIsTopLevelBindable: see Note [Care with unlifted bindings]
- ; if float_all && can_float_this_one then
+ ; if float_all then
-- Rather than discard the calls mentioning the bound variables
-- we float this (dictionary) binding along with the others
return ([], body', all_free_uds `snocDictBinds` final_binds)
@@ -1564,7 +1578,7 @@ specBind top_lvl env (Rec pairs) do_body
<- specDefns rec_env uds2 (bndrs2 `zip` rhss)
; return (bndrs3, spec_defns3 ++ spec_defns2, uds3) }
- ; let (final_uds, dumped_dbs, float_all) = dumpBindUDs bndrs1 uds3
+ ; let (final_uds, dumped_dbs, float_all) = dumpBindUDs True bndrs1 uds3
final_bind = recWithDumpedDicts (spec_defns3 ++ zip bndrs3 rhss')
dumped_dbs
@@ -1675,7 +1689,8 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
fn_unf = realIdUnfolding fn -- Ignore loop-breaker-ness here
inl_prag = idInlinePragma fn
inl_act = inlinePragmaActivation inl_prag
- is_active = isActive (beginPhase inl_act) :: Activation -> Bool
+ is_active :: Activation -> Bool
+ is_active = isActive (SimplPhaseRange (beginPhase inl_act) (endPhase inl_act))
-- is_active: inl_act is the activation we are going to put in the new
-- SPEC rule; so we want to see if it is covered by another rule with
-- that same activation.
@@ -1684,7 +1699,6 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
dflags = se_dflags env
this_mod = se_module env
subst = se_subst env
- in_scope = Core.substInScopeSet subst
-- Figure out whether the function has an INLINE pragma
-- See Note [Inline specialisations]
@@ -1700,9 +1714,6 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
| otherwise
= inl_prag
- not_in_scope :: InterestingVarFun
- not_in_scope v = isLocalVar v && not (v `elemInScopeSet` in_scope)
-
----------------------------------------------------------
-- Specialise to one particular call pattern
spec_call :: SpecInfo -- Accumulating parameter
@@ -1716,47 +1727,34 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
mk_extra_dfun_arg bndr | isTyVar bndr = UnspecType
| otherwise = UnspecArg
- -- Find qvars, the type variables to add to the binders for the rule
- -- Namely those free in `ty` that aren't in scope
- -- See (MP2) in Note [Specialising polymorphic dictionaries]
- ; let poly_qvars = scopedSort $ fvVarList $ specArgsFVs not_in_scope call_args
- subst' = subst `Core.extendSubstInScopeList` poly_qvars
- -- Maybe we should clone the poly_qvars telescope?
-
- -- Any free Ids will have caused the call to be dropped
- ; massertPpr (all isTyCoVar poly_qvars)
- (ppr fn $$ ppr all_call_args $$ ppr poly_qvars)
-
- ; (useful, subst'', rule_bndrs, rule_lhs_args, spec_bndrs, dx_binds, spec_args)
- <- specHeader subst' rhs_bndrs all_call_args
- ; let all_rule_bndrs = poly_qvars ++ rule_bndrs
- env' = env { se_subst = subst'' }
+ ; (useful, subst', rule_bndrs, rule_lhs_args, spec_bndrs, dx_binds, spec_args)
+ <- specHeader subst rhs_bndrs all_call_args
+ ; let env' = env { se_subst = subst' }
-- Check for (a) usefulness and (b) not already covered
-- See (SC1) in Note [Specialisations already covered]
; let all_rules = rules_acc ++ existing_rules
-- all_rules: we look both in the rules_acc (generated by this invocation
-- of specCalls), and in existing_rules (passed in to specCalls)
- already_covered = alreadyCovered env' all_rule_bndrs fn
+ already_covered = alreadyCovered env' rule_bndrs fn
rule_lhs_args is_active all_rules
-{- ; pprTrace "spec_call" (vcat
- [ text "fun: " <+> ppr fn
- , text "call info: " <+> ppr _ci
- , text "useful: " <+> ppr useful
- , text "already_covered:" <+> ppr already_covered
- , text "poly_qvars: " <+> ppr poly_qvars
- , text "useful: " <+> ppr useful
- , text "all_rule_bndrs:" <+> ppr all_rule_bndrs
- , text "rule_lhs_args:" <+> ppr rule_lhs_args
- , text "spec_bndrs:" <+> ppr spec_bndrs
- , text "dx_binds:" <+> ppr dx_binds
- , text "spec_args: " <+> ppr spec_args
- , text "rhs_bndrs" <+> ppr rhs_bndrs
- , text "rhs_body" <+> ppr rhs_body
- , text "subst''" <+> ppr subst'' ]) $
- return ()
--}
+-- ; pprTrace "spec_call" (vcat
+-- [ text "fun: " <+> ppr fn
+-- , text "call info: " <+> ppr _ci
+-- , text "useful: " <+> ppr useful
+-- , text "already_covered:" <+> ppr already_covered
+-- , text "useful: " <+> ppr useful
+-- , text "rule_bndrs:" <+> ppr (sep (map (pprBndr LambdaBind) rule_bndrs))
+-- , text "rule_lhs_args:" <+> ppr rule_lhs_args
+-- , text "spec_bndrs:" <+> ppr (sep (map (pprBndr LambdaBind) spec_bndrs))
+-- , text "dx_binds:" <+> ppr dx_binds
+-- , text "spec_args: " <+> ppr spec_args
+-- , text "rhs_bndrs" <+> ppr (sep (map (pprBndr LambdaBind) rhs_bndrs))
+-- , text "rhs_body" <+> ppr rhs_body
+-- , text "subst'" <+> ppr subst'
+-- ]) $ return ()
+
; if not useful -- No useful specialisation
|| already_covered -- Useful, but done already
@@ -1770,23 +1768,15 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
-- Run the specialiser on the specialised RHS
; (rhs_body', rhs_uds) <- specExpr env'' rhs_body
-{- ; pprTrace "spec_call2" (vcat
- [ text "fun:" <+> ppr fn
- , text "rhs_body':" <+> ppr rhs_body' ]) $
- return ()
--}
-
-- Make the RHS of the specialised function
; let spec_rhs_bndrs = spec_bndrs ++ inner_rhs_bndrs'
- (rhs_uds1, inner_dumped_dbs) = dumpUDs spec_rhs_bndrs rhs_uds
- (rhs_uds2, outer_dumped_dbs) = dumpUDs poly_qvars (dx_binds `consDictBinds` rhs_uds1)
- -- dx_binds comes from the arguments to the call, and so can mention
- -- poly_qvars but no other local binders
- spec_rhs = mkLams poly_qvars $
- wrapDictBindsE outer_dumped_dbs $
- mkLams spec_rhs_bndrs $
+ (rhs_uds2, inner_dumped_dbs) = dumpUDs spec_rhs_bndrs $
+ dx_binds `consDictBinds` rhs_uds
+ -- dx_binds comes from the arguments to the call,
+ -- and so can mention poly_qvars but no other local binders
+ spec_rhs = mkLams spec_rhs_bndrs $
wrapDictBindsE inner_dumped_dbs rhs_body'
- rule_rhs_args = poly_qvars ++ spec_bndrs
+ rule_rhs_args = spec_bndrs
-- Maybe add a void arg to the specialised function,
-- to avoid unlifted bindings
@@ -1841,7 +1831,7 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
text "SPEC"
spec_rule = mkSpecRule dflags this_mod True inl_act
- herald fn all_rule_bndrs rule_lhs_args
+ herald fn rule_bndrs rule_lhs_args
(mkVarApps (Var spec_fn) rule_rhs_args1)
_rule_trace_doc = vcat [ ppr fn <+> dcolon <+> ppr fn_type
@@ -1852,8 +1842,12 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
, text "existing" <+> ppr existing_rules
]
- ; -- pprTrace "spec_call: rule" _rule_trace_doc
- return ( spec_rule : rules_acc
+-- ; pprTrace "spec_call: rule" (vcat [ -- text "poly_qvars" <+> ppr poly_qvars
+-- text "rule_bndrs" <+> ppr rule_bndrs
+-- , text "rule_lhs_args" <+> ppr rule_lhs_args
+-- , text "all_call_args" <+> ppr all_call_args
+-- , ppr spec_rule ]) $
+ ; return ( spec_rule : rules_acc
, (spec_fn, spec_rhs1) : pairs_acc
, rhs_uds2 `thenUDs` uds_acc
) } }
@@ -2000,6 +1994,16 @@ floating to top level anyway; but that is hard to spot (since we don't know what
the non-top-level in-scope binders are) and rare (since the binding must satisfy
Note [Core let-can-float invariant] in GHC.Core).
+Arguably we'd be better off if we had left that `x` in the RHS of `n`, thus
+ f x = let n::Natural = let x::ByteArray# = in
+ NB x
+ in wombat @192827 (n |> co)
+Now we could float `n` happily. But that's in conflict with exposing the `NB`
+data constructor in the body of the `let`, so I'm leaving this unresolved.
+
+Another case came up in #26682, where the binding had an unlifted sum type
+(# Word# | ByteArray# #), itself arising from an UNPACK pragma. Test case
+T26682.
Note [Specialising Calls]
~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2647,12 +2651,22 @@ specHeader subst _ [] = pure (False, subst, [], [], [], [], [])
-- 'a->T1', as well as a LHS argument for the resulting RULE and unfolding
-- details.
specHeader subst (bndr:bndrs) (SpecType ty : args)
- = do { let subst1 = Core.extendTvSubst subst bndr ty
- ; (useful, subst2, rule_bs, rule_args, spec_bs, dx, spec_args)
- <- specHeader subst1 bndrs args
- ; pure ( useful, subst2
- , rule_bs, Type ty : rule_args
- , spec_bs, dx, Type ty : spec_args ) }
+ = do { -- Find free_tvs, the type variables to add to the binders for the rule
+ -- Namely those free in `ty` that aren't in scope
+ -- See (MP2) in Note [Specialising polymorphic dictionaries]
+ let in_scope = Core.substInScopeSet subst
+ not_in_scope tv = not (tv `elemInScopeSet` in_scope)
+ free_tvs = scopedSort $ fvVarList $
+ filterFV not_in_scope $
+ tyCoFVsOfType ty
+ subst1 = subst `Core.extendSubstInScopeList` free_tvs
+
+ ; let subst2 = Core.extendTvSubst subst1 bndr ty
+ ; (useful, subst3, rule_bs, rule_args, spec_bs, dx, spec_args)
+ <- specHeader subst2 bndrs args
+ ; pure ( useful, subst3
+ , free_tvs ++ rule_bs, Type ty : rule_args
+ , free_tvs ++ spec_bs, dx, Type ty : spec_args ) }
-- Next we have a type that we don't want to specialise. We need to perform
-- a substitution on it (in case the type refers to 'a'). Additionally, we need
@@ -2736,7 +2750,7 @@ bindAuxiliaryDict subst orig_dict_id fresh_dict_id dict_arg
-- don’t bother creating a new dict binding; just substitute
| exprIsTrivial dict_arg
, let subst' = Core.extendSubst subst orig_dict_id dict_arg
- = -- pprTrace "bindAuxiliaryDict:trivial" (ppr orig_dict_id <+> ppr dict_id) $
+ = -- pprTrace "bindAuxiliaryDict:trivial" (ppr orig_dict_id <+> ppr dict_arg) $
(subst', Nothing, dict_arg)
| otherwise -- Non-trivial dictionary arg; make an auxiliary binding
@@ -3032,7 +3046,8 @@ pprCallInfo fn (CI { ci_key = key })
instance Outputable CallInfo where
ppr (CI { ci_key = key, ci_fvs = _fvs })
- = text "CI" <> braces (sep (map ppr key))
+ = text "CI" <> braces (text "fvs" <+> ppr _fvs
+ $$ sep (map ppr key))
unionCalls :: CallDetails -> CallDetails -> CallDetails
unionCalls c1 c2 = plusDVarEnv_C unionCallInfoSet c1 c2
@@ -3448,38 +3463,49 @@ wrapDictBindsE dbs expr
----------------------
dumpUDs :: [CoreBndr] -> UsageDetails -> (UsageDetails, OrdList DictBind)
--- Used at a lambda or case binder; just dump anything mentioning the binder
+-- Used at binder; just dump anything mentioning the binder
dumpUDs bndrs uds@(MkUD { ud_binds = orig_dbs, ud_calls = orig_calls })
| null bndrs = (uds, nilOL) -- Common in case alternatives
| otherwise = -- pprTrace "dumpUDs" (vcat
- -- [ text "bndrs" <+> ppr bndrs
- -- , text "uds" <+> ppr uds
- -- , text "free_uds" <+> ppr free_uds
- -- , text "dump-dbs" <+> ppr dump_dbs ]) $
+ -- [ text "bndrs" <+> ppr bndrs
+ -- , text "uds" <+> ppr uds
+ -- , text "free_uds" <+> ppr free_uds
+ -- , text "dump_dbs" <+> ppr dump_dbs ]) $
(free_uds, dump_dbs)
where
free_uds = uds { ud_binds = free_dbs, ud_calls = free_calls }
bndr_set = mkVarSet bndrs
(free_dbs, dump_dbs, dump_set) = splitDictBinds orig_dbs bndr_set
- free_calls = deleteCallsMentioning dump_set $ -- Drop calls mentioning bndr_set on the floor
- deleteCallsFor bndrs orig_calls -- Discard calls for bndr_set; there should be
- -- no calls for any of the dicts in dump_dbs
-dumpBindUDs :: [CoreBndr] -> UsageDetails -> (UsageDetails, OrdList DictBind, Bool)
+ -- Delete calls:
+ -- * For any binder in `bndrs`
+ -- * That mention a dictionary bound in `dump_set`
+ -- These variables aren't in scope "above" the binding and the `dump_dbs`,
+ -- so no call should mention them. (See #26682.)
+ free_calls = deleteCallsMentioning dump_set $
+ deleteCallsFor bndrs orig_calls
+
+dumpBindUDs :: Bool -- Main binding can float to top
+ -> [CoreBndr] -> UsageDetails
+ -> (UsageDetails, OrdList DictBind, Bool)
-- Used at a let(rec) binding.
--- We return a boolean indicating whether the binding itself is mentioned,
--- directly or indirectly, by any of the ud_calls; in that case we want to
--- float the binding itself;
--- See Note [Floated dictionary bindings]
-dumpBindUDs bndrs (MkUD { ud_binds = orig_dbs, ud_calls = orig_calls })
- = -- pprTrace "dumpBindUDs" (ppr bndrs $$ ppr free_uds $$ ppr dump_dbs $$ ppr float_all) $
- (free_uds, dump_dbs, float_all)
+-- We return a boolean indicating whether the binding itself
+-- is mentioned, directly or indirectly, by any of the ud_calls;
+-- in that case we want to float the binding itself.
+-- See Note [Floated dictionary bindings]
+-- If the boolean is True, then the returned ud_calls can mention `bndrs`;
+-- if False, then returned ud_calls must not mention `bndrs`
+dumpBindUDs can_float_bind bndrs (MkUD { ud_binds = orig_dbs, ud_calls = orig_calls })
+ = ( MkUD { ud_binds = free_dbs, ud_calls = free_calls2 }
+ , dump_dbs
+ , can_float_bind && calls_mention_bndrs )
where
- free_uds = MkUD { ud_binds = free_dbs, ud_calls = free_calls }
bndr_set = mkVarSet bndrs
(free_dbs, dump_dbs, dump_set) = splitDictBinds orig_dbs bndr_set
- free_calls = deleteCallsFor bndrs orig_calls
- float_all = dump_set `intersectsVarSet` callDetailsFVs free_calls
+ free_calls1 = deleteCallsFor bndrs orig_calls
+ calls_mention_bndrs = dump_set `intersectsVarSet` callDetailsFVs free_calls1
+ free_calls2 | can_float_bind = free_calls1
+ | otherwise = deleteCallsMentioning dump_set free_calls1
callsForMe :: Id -> UsageDetails -> (UsageDetails, [CallInfo])
callsForMe fn uds@MkUD { ud_binds = orig_dbs, ud_calls = orig_calls }
diff --git a/compiler/GHC/Core/Opt/WorkWrap.hs b/compiler/GHC/Core/Opt/WorkWrap.hs
index 0b40eed5c30d..6f4b4ca34feb 100644
--- a/compiler/GHC/Core/Opt/WorkWrap.hs
+++ b/compiler/GHC/Core/Opt/WorkWrap.hs
@@ -176,8 +176,9 @@ several liked-named Ids bouncing around at the same time---absolute
mischief.)
Notice that we refrain from w/w'ing an INLINE function even if it is
-in a recursive group. It might not be the loop breaker. (We could
-test for loop-breaker-hood, but I'm not sure that ever matters.)
+in a recursive group. It might not be the loop breaker. (We used to
+test for loop-breaker-hood, but see (CWW4) in Note [Cast worker/wrapper]
+in GHC.Core.Opt.Simplify.Iteration.)
Note [Worker/wrapper for INLINABLE functions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -921,10 +922,8 @@ mkStrWrapperInlinePrag (InlinePragma { inl_inline = fn_inl
-- The phase /after/ the rule is first active
get_rule_phase rule = nextPhase (beginPhase (ruleActivation rule))
-{-
-Note [Demand on the worker]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
+{- Note [Demand on the worker]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If the original function is called once, according to its demand info, then
so is the worker. This is important so that the occurrence analyser can
attach OneShot annotations to the worker’s lambda binders.
diff --git a/compiler/GHC/Core/PatSyn.hs b/compiler/GHC/Core/PatSyn.hs
index 91476667cf3f..7cdb20b407a4 100644
--- a/compiler/GHC/Core/PatSyn.hs
+++ b/compiler/GHC/Core/PatSyn.hs
@@ -9,7 +9,7 @@
module GHC.Core.PatSyn (
-- * Main data types
- PatSyn, PatSynMatcher, PatSynBuilder, mkPatSyn,
+ PatSyn(..), PatSynMatcher, PatSynBuilder, mkPatSyn,
-- ** Type deconstruction
patSynName, patSynArity, patSynVisArity,
diff --git a/compiler/GHC/Core/Rules.hs b/compiler/GHC/Core/Rules.hs
index 87e8816535fe..09beacb1622c 100644
--- a/compiler/GHC/Core/Rules.hs
+++ b/compiler/GHC/Core/Rules.hs
@@ -1902,7 +1902,7 @@ ruleCheckProgram :: RuleOpts -- ^ Rule options
-> (Id -> [CoreRule]) -- ^ Rules for an Id
-> CoreProgram -- ^ Bindings to check in
-> SDoc -- ^ Resulting check message
-ruleCheckProgram ropts phase rule_pat rules binds
+ruleCheckProgram ropts curr_phase rule_pat rules binds
| isEmptyBag results
= text "Rule check results: no rule application sites"
| otherwise
@@ -1912,9 +1912,9 @@ ruleCheckProgram ropts phase rule_pat rules binds
]
where
line = text (replicate 20 '-')
- env = RuleCheckEnv { rc_is_active = isActive phase
- , rc_id_unf = idUnfolding -- Not quite right
- -- Should use activeUnfolding
+ is_active = isActiveInPhase curr_phase
+ env = RuleCheckEnv { rc_is_active = is_active
+ , rc_id_unf = whenActiveUnfoldingFun is_active
, rc_pattern = rule_pat
, rc_rules = rules
, rc_ropts = ropts
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index 9ca6ee734d72..f0473666a439 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -394,9 +394,11 @@ buildUnit session cid insts lunit = do
-- nope
unitLibraries = [],
unitExtDepLibsSys = [],
+ unitExtDepLibsStaticSys = [],
unitExtDepLibsGhc = [],
unitLibraryDynDirs = [],
unitLibraryDirs = [],
+ unitLibraryDirsStatic = [],
unitExtDepFrameworks = [],
unitExtDepFrameworkDirs = [],
unitCcOptions = [],
diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs
index ff5a25c3bae0..023c4e1e365f 100644
--- a/compiler/GHC/Driver/CodeOutput.hs
+++ b/compiler/GHC/Driver/CodeOutput.hs
@@ -255,12 +255,11 @@ outputJS _ _ _ _ _ = pgmError $ "codeOutput: Hit JavaScript case. We should neve
-}
{-
-Note [Packaging libffi headers]
+Note [libffi headers]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The C code emitted by GHC for libffi adjustors must depend upon the ffi_arg type,
-defined in . For this reason, we must ensure that is available
-in binary distributions. To do so, we install these headers as part of the
-`rts` package.
+defined in . On systems where GHC uses the libffi adjustors, the libffi
+library, and headers must be installed.
-}
outputForeignStubs
diff --git a/compiler/GHC/Driver/Config/Core/Lint.hs b/compiler/GHC/Driver/Config/Core/Lint.hs
index 9f232061e0d4..1f755eddd91f 100644
--- a/compiler/GHC/Driver/Config/Core/Lint.hs
+++ b/compiler/GHC/Driver/Config/Core/Lint.hs
@@ -20,7 +20,7 @@ import GHC.Core.Lint
import GHC.Core.Lint.Interactive
import GHC.Core.Opt.Pipeline.Types
import GHC.Core.Opt.Simplify ( SimplifyOpts(..) )
-import GHC.Core.Opt.Simplify.Env ( SimplMode(..) )
+import GHC.Core.Opt.Simplify.Env ( SimplMode(..), SimplPhase(..) )
import GHC.Core.Opt.Monad
import GHC.Core.Coercion
@@ -114,9 +114,9 @@ initLintPassResultConfig dflags extra_vars pass = LintPassResultConfig
showLintWarnings :: CoreToDo -> Bool
-- Disable Lint warnings on the first simplifier pass, because
-- there may be some INLINE knots still tied, which is tiresomely noisy
-showLintWarnings (CoreDoSimplify cfg) = case sm_phase (so_mode cfg) of
- InitialPhase -> False
- _ -> True
+showLintWarnings (CoreDoSimplify cfg)
+ | SimplPhase InitialPhase <- sm_phase (so_mode cfg)
+ = False
showLintWarnings _ = True
perPassFlags :: DynFlags -> CoreToDo -> LintFlags
@@ -147,6 +147,12 @@ perPassFlags dflags pass
check_lbs = case pass of
CoreDesugar -> False
CoreDesugarOpt -> False
+
+ -- Disable Lint warnings on the first simplifier pass, because
+ -- there may be some INLINE knots still tied, which is tiresomely noisy
+ CoreDoSimplify cfg
+ | SimplPhase InitialPhase <- sm_phase (so_mode cfg)
+ -> False
_ -> True
-- See Note [Checking StaticPtrs]
diff --git a/compiler/GHC/Driver/Config/Core/Opt/Simplify.hs b/compiler/GHC/Driver/Config/Core/Opt/Simplify.hs
index 0b5b496cdc41..d7b46cee799e 100644
--- a/compiler/GHC/Driver/Config/Core/Opt/Simplify.hs
+++ b/compiler/GHC/Driver/Config/Core/Opt/Simplify.hs
@@ -10,7 +10,7 @@ import GHC.Prelude
import GHC.Core.Rules ( RuleBase )
import GHC.Core.Opt.Pipeline.Types ( CoreToDo(..) )
import GHC.Core.Opt.Simplify ( SimplifyExprOpts(..), SimplifyOpts(..) )
-import GHC.Core.Opt.Simplify.Env ( FloatEnable(..), SimplMode(..) )
+import GHC.Core.Opt.Simplify.Env ( FloatEnable(..), SimplMode(..), SimplPhase(..) )
import GHC.Core.Opt.Simplify.Monad ( TopEnvConfig(..) )
import GHC.Driver.Config ( initOptCoercionOpts )
@@ -59,7 +59,7 @@ initSimplifyOpts dflags extra_vars iterations mode hpt_rule_base = let
initSimplMode :: DynFlags -> CompilerPhase -> String -> SimplMode
initSimplMode dflags phase name = SimplMode
{ sm_names = [name]
- , sm_phase = phase
+ , sm_phase = SimplPhase phase
, sm_rules = gopt Opt_EnableRewriteRules dflags
, sm_eta_expand = gopt Opt_DoLambdaEtaExpansion dflags
, sm_cast_swizzle = True
diff --git a/compiler/GHC/Driver/Config/Interpreter.hs b/compiler/GHC/Driver/Config/Interpreter.hs
new file mode 100644
index 000000000000..03a39e30fb33
--- /dev/null
+++ b/compiler/GHC/Driver/Config/Interpreter.hs
@@ -0,0 +1,46 @@
+module GHC.Driver.Config.Interpreter
+ ( initInterpOpts
+ )
+where
+
+import GHC.Prelude
+import GHC.Runtime.Interpreter.Init
+import GHC.Driver.DynFlags
+import GHC.Driver.Session
+import GHC.Driver.Config.Finder
+import GHC.Driver.Config.StgToJS
+import GHC.SysTools.Tasks
+import GHC.Linker.Executable
+
+import System.FilePath
+import System.Directory
+
+initInterpOpts :: DynFlags -> IO InterpOpts
+initInterpOpts dflags = do
+ wasm_dyld <- makeAbsolute $ topDir dflags "dyld.mjs"
+ js_interp <- makeAbsolute $ topDir dflags "ghc-interp.js"
+ pure $ InterpOpts
+ { interpExternal = gopt Opt_ExternalInterpreter dflags
+ , interpProg = pgm_i dflags
+ , interpOpts = getOpts dflags opt_i
+ , interpWays = ways dflags
+ , interpNameVer = ghcNameVersion dflags
+ , interpCreateProcess = Nothing
+ , interpWasmDyld = wasm_dyld
+ , interpBrowser = gopt Opt_GhciBrowser dflags
+ , interpBrowserHost = ghciBrowserHost dflags
+ , interpBrowserPort = ghciBrowserPort dflags
+ , interpBrowserRedirectWasiConsole = gopt Opt_GhciBrowserRedirectWasiConsole dflags
+ , interpBrowserPuppeteerLaunchOpts = ghciBrowserPuppeteerLaunchOpts dflags
+ , interpBrowserPlaywrightBrowserType = ghciBrowserPlaywrightBrowserType dflags
+ , interpBrowserPlaywrightLaunchOpts = ghciBrowserPlaywrightLaunchOpts dflags
+ , interpJsInterp = js_interp
+ , interpTmpDir = tmpDir dflags
+ , interpJsCodegenCfg = initStgToJSConfig dflags
+ , interpFinderOpts = initFinderOpts dflags
+ , interpVerbosity = verbosity dflags
+ , interpLdConfig = configureLd dflags
+ , interpCcConfig = configureCc dflags
+ , interpExecutableLinkOpts = initExecutableLinkOpts dflags
+ }
+
diff --git a/compiler/GHC/Driver/Config/Linker.hs b/compiler/GHC/Driver/Config/Linker.hs
index bf4cc95f2dbf..496b087f31e2 100644
--- a/compiler/GHC/Driver/Config/Linker.hs
+++ b/compiler/GHC/Driver/Config/Linker.hs
@@ -10,6 +10,7 @@ import GHC.Linker.Config
import GHC.Driver.DynFlags
import GHC.Driver.Session
+import GHC.Settings
import Data.List (isPrefixOf)
@@ -47,11 +48,14 @@ initLinkerConfig dflags =
post_args = map Option (getOpts dflags opt_l)
in LinkerConfig
- { linkerProgram = p
+ { linkerC = p
+ , linkerCXX = pgm_cxx dflags
, linkerOptionsPre = pre_args
, linkerOptionsPost = post_args
, linkerTempDir = tmpDir dflags
, linkerFilter = ld_filter
+ , linkerSupportsCompactUnwind = toolSettings_ldSupportsCompactUnwind (toolSettings dflags)
+ , linkerIsGnuLd = toolSettings_ldIsGnuLd (toolSettings dflags)
}
{- Note [Solaris linker]
diff --git a/compiler/GHC/Driver/Downsweep.hs b/compiler/GHC/Driver/Downsweep.hs
index fc0cf2217b9e..2912eddaf0de 100644
--- a/compiler/GHC/Driver/Downsweep.hs
+++ b/compiler/GHC/Driver/Downsweep.hs
@@ -31,6 +31,7 @@ import GHC.Platform.Ways
import GHC.Driver.Config.Finder (initFinderOpts)
import GHC.Driver.Config.Parser (initParserOpts)
+import GHC.Driver.DynFlags
import GHC.Driver.Phases
import {-# SOURCE #-} GHC.Driver.Pipeline (preprocess)
import GHC.Driver.Session
@@ -708,7 +709,7 @@ linkNodes summaries uid hue =
do_linking = main_sum || no_hs_main || ghcLink dflags == LinkDynLib || ghcLink dflags == LinkStaticLib
- in if | ghcLink dflags == LinkBinary && isJust ofile && not do_linking ->
+ in if | isExecutableLink (ghcLink dflags) && isJust ofile && not do_linking ->
Just (Left $ singleMessage $ mkPlainErrorMsgEnvelope noSrcSpan (DriverRedirectedNoMain $ mainModuleNameIs dflags))
-- This should be an error, not a warning (#10895).
| ghcLink dflags /= NoLink, do_linking -> Just (Right (LinkNode unit_nodes uid))
diff --git a/compiler/GHC/Driver/DynFlags.hs b/compiler/GHC/Driver/DynFlags.hs
index 05483271ac34..bfe6fd33fe39 100644
--- a/compiler/GHC/Driver/DynFlags.hs
+++ b/compiler/GHC/Driver/DynFlags.hs
@@ -28,9 +28,11 @@ module GHC.Driver.DynFlags (
ParMakeCount(..),
ways,
HasDynFlags(..), ContainsDynFlags(..),
- RtsOptsEnabled(..),
+ RtsOptsEnabled(..), haveRtsOptsFlags,
GhcMode(..), isOneShot,
GhcLink(..), isNoLink,
+ isExecutableLink,
+ ExecutableLinkMode(..),
PackageFlag(..), PackageArg(..), ModRenaming(..),
packageFlagsChanged,
IgnorePackageFlag(..), TrustFlag(..),
@@ -64,6 +66,8 @@ module GHC.Driver.DynFlags (
--
baseUnitId,
+ rtsWayUnitId',
+ rtsWayUnitId,
-- * Include specifications
@@ -476,9 +480,46 @@ data DynFlags = DynFlags {
-- 'Int' because it can be used to test uniques in decreasing order.
-- | Temporary: CFG Edge weights for fast iterations
- cfgWeights :: Weights
+ cfgWeights :: Weights,
+
+ -- | Archive prelinking configuration
+ -- See Note [Archive Prelinking]
+ prelinkArchiveThreshold :: Maybe Word64,
+ -- ^ Size threshold in bytes for prelinking archives.
+ -- Nothing = prelinking disabled
+ -- Just n = prelink archives larger than n bytes
+ prelinkCacheDir :: Maybe FilePath
+ -- ^ Persistent cache directory for prelinked objects.
+ -- Nothing = use per-session temp files only
+ -- Just dir = store prelinked objects in dir for reuse across sessions
}
+-- Note [Archive Prelinking]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~
+-- Historically, GHC generated prelinked objects (.o files) at build time
+-- for use with GHCi. This was slow and disk-intensive. Instead, we now
+-- create prelinked objects on-demand when the internal linker loads large
+-- static archives.
+--
+-- When loading an archive (.a file), instead of loading each member object
+-- individually, we use 'ld -r' to merge all members into a single object.
+-- This provides several benefits:
+--
+-- 1. Faster loading: Fewer objects for the RTS linker to process
+-- 2. Fewer system calls: Single loadObj instead of many
+-- 3. Better relocation handling: 'ld -r' resolves internal relocations
+-- 4. On-demand: Only prelink when actually needed
+-- 5. Cacheable: Optional persistent cache for reuse across sessions
+--
+-- Configuration:
+-- - prelinkArchiveThreshold: Size threshold (default 5MB). Archives larger
+-- than this are prelinked on first load. Set to Nothing to disable.
+-- - prelinkCacheDir: Optional persistent cache directory. If set, prelinked
+-- objects are cached here for reuse across GHC sessions. If Nothing, temp
+-- files are used and discarded after the session.
+--
+-- See also: GHC.Linker.ArchivePrelink
+
class HasDynFlags m where
getDynFlags :: m DynFlags
@@ -547,7 +588,7 @@ defaultDynFlags mySettings =
-- See Note [Updating flag description in the User's Guide]
DynFlags {
ghcMode = CompManager,
- ghcLink = LinkBinary,
+ ghcLink = LinkExecutable Dynamic,
backend = platformDefaultBackend (sTargetPlatform mySettings),
verbosity = 0,
debugLevel = 0,
@@ -738,7 +779,14 @@ defaultDynFlags mySettings =
reverseErrors = False,
maxErrors = Nothing,
- cfgWeights = defaultWeights
+ cfgWeights = defaultWeights,
+
+ -- Archive prelinking defaults
+ -- Default threshold: 5MB (5 * 1024 * 1024 bytes)
+ -- This avoids prelinking overhead for small archives while fixing
+ -- "strange closure type" crashes for large archives in DYNAMIC=1 builds
+ prelinkArchiveThreshold = Just (5 * 1024 * 1024),
+ prelinkCacheDir = Nothing -- No persistent cache by default
}
type FatalMessager = String -> IO ()
@@ -797,7 +845,7 @@ isOneShot _other = False
-- | What to do in the link step, if there is one.
data GhcLink
= NoLink -- ^ Don't link at all
- | LinkBinary -- ^ Link object code into a binary
+ | LinkExecutable ExecutableLinkMode -- ^ Link object code into an executable
| LinkInMemory -- ^ Use the in-memory dynamic linker (works for both
-- bytecode and object code).
| LinkDynLib -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms)
@@ -805,6 +853,21 @@ data GhcLink
| LinkMergedObj -- ^ Link objects into a merged "GHCi object"
deriving (Eq, Show)
+isExecutableLink :: GhcLink -> Bool
+isExecutableLink (LinkExecutable _) = True
+isExecutableLink _ = False
+
+-- | How we link the binary.
+--
+-- This mostly deals with how external system dependencies are treated.
+-- The 'Ways' determine how Haskell libraries are linked.
+data ExecutableLinkMode
+ = FullyStatic -- ^ fully static binary (incompatible with 'WayDyn')
+ | MostlyStatic [String] -- ^ we link system libraries statically, except the ones provided
+ | Dynamic -- ^ default
+ deriving (Eq, Show)
+
+
isNoLink :: GhcLink -> Bool
isNoLink NoLink = True
isNoLink _ = False
@@ -875,7 +938,9 @@ packageFlagsChanged idflags1 idflags0 =
packageGFlags dflags = map (`gopt` dflags)
[ Opt_HideAllPackages
, Opt_HideAllPluginPackages
- , Opt_AutoLinkPackages ]
+ , Opt_AutoLinkPackages
+ , Opt_NoRts
+ , Opt_NoGhcInternal ]
instance Outputable PackageFlag where
ppr (ExposePackage n arg rn) = text n <> braces (ppr arg <+> ppr rn)
@@ -891,6 +956,13 @@ data RtsOptsEnabled
| RtsOptsAll
deriving (Show)
+haveRtsOptsFlags :: DynFlags -> Bool
+haveRtsOptsFlags dflags =
+ isJust (rtsOpts dflags) || case rtsOptsEnabled dflags of
+ RtsOptsSafeOnly -> False
+ _ -> True
+
+
-- | Are we building with @-fPIE@ or @-fPIC@ enabled?
positionIndependent :: DynFlags -> Bool
positionIndependent dflags = gopt Opt_PIC dflags || gopt Opt_PIE dflags
@@ -1278,7 +1350,7 @@ default_PIC platform =
-- there will be a 4GB __ZEROPAGE that prevents us from using 32bit addresses
-- while we could work around this on x86_64 (like WINE does), we won't be
-- able on aarch64, where this is enforced.
- (OSDarwin, ArchX86_64) -> [Opt_PIC]
+ (OSDarwin, ArchX86_64) -> [Opt_PIC, Opt_ExternalDynamicRefs]
-- For AArch64, we need to always have PIC enabled. The relocation model
-- on AArch64 does not permit arbitrary relocations. Under ASLR, we can't
-- control much how far apart symbols are in memory for our in-memory static
@@ -1286,17 +1358,24 @@ default_PIC platform =
-- This requires PIC on AArch64, and ExternalDynamicRefs on Linux as on top
-- of that. Subsequently we expect all code on aarch64/linux (and macOS) to
-- be built with -fPIC.
- (OSDarwin, ArchAArch64) -> [Opt_PIC]
+ (OSDarwin, ArchAArch64) -> [Opt_PIC, Opt_ExternalDynamicRefs]
(OSLinux, ArchAArch64) -> [Opt_PIC, Opt_ExternalDynamicRefs]
(OSLinux, ArchARM {}) -> [Opt_PIC, Opt_ExternalDynamicRefs]
(OSLinux, ArchRISCV64 {}) -> [Opt_PIC, Opt_ExternalDynamicRefs]
- (OSOpenBSD, ArchX86_64) -> [Opt_PIC] -- Due to PIE support in
+ (OSOpenBSD, ArchX86_64) -> [Opt_PIC, Opt_ExternalDynamicRefs]
+ -- Due to PIE support in
-- OpenBSD since 5.3 release
-- (1 May 2013) we need to
-- always generate PIC. See
-- #10597 for more
-- information.
(OSLinux, ArchLoongArch64) -> [Opt_PIC, Opt_ExternalDynamicRefs]
+ -- On x86_64, PIC is required for correct RTS static linker behavior when
+ -- loading .o files into processes with shared libraries at high addresses.
+ -- Without ExternalDynamicRefs, R_X86_64_PC32 relocations can overflow and
+ -- the X86_64_ELF_NONPIC_HACK jump islands corrupt data references. See #26390.
+ (OSLinux, ArchX86_64) -> [Opt_PIC, Opt_ExternalDynamicRefs]
+ (OSFreeBSD, ArchX86_64) -> [Opt_PIC, Opt_ExternalDynamicRefs]
_ -> []
-- | The language extensions implied by the various language variants.
@@ -1473,6 +1552,20 @@ versionedFilePath platform = uniqueSubdir platform
baseUnitId :: DynFlags -> UnitId
baseUnitId dflags = unitSettings_baseUnitId (unitSettings dflags)
+rtsWayUnitId' :: Ways -> UnitId
+rtsWayUnitId' ways | ways `hasWay` WayThreaded
+ , ways `hasWay` WayDebug
+ = stringToUnitId "rts:threaded-debug"
+ | ways `hasWay` WayThreaded
+ = stringToUnitId "rts:threaded-nodebug"
+ | ways `hasWay` WayDebug
+ = stringToUnitId "rts:nonthreaded-debug"
+ | otherwise
+ = stringToUnitId "rts:nonthreaded-nodebug"
+
+rtsWayUnitId :: DynFlags -> UnitId
+rtsWayUnitId dflags = rtsWayUnitId' (ways dflags)
+
-- SDoc
-------------------------------------------
-- | Initialize the pretty-printing options
diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs
index 6b7365b0e003..2377f84d0419 100644
--- a/compiler/GHC/Driver/Flags.hs
+++ b/compiler/GHC/Driver/Flags.hs
@@ -760,6 +760,8 @@ data GeneralFlag
-- | Instruct GHCi to load all targets on startup
| Opt_GhciDoLoadTargets
+ -- | Instruct GHCi to import all loaded targets on startup
+ | Opt_GhciImportLoadedTargets
| Opt_HelpfulErrors
| Opt_DeferTypeErrors -- Since 7.6
@@ -862,6 +864,8 @@ data GeneralFlag
-- temporary flags
| Opt_AutoLinkPackages
+ | Opt_NoRts
+ | Opt_NoGhcInternal
| Opt_ImplicitImportQualified
-- keeping stuff
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index f4190f772a04..1b85504e21d5 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -71,7 +71,7 @@ import GHC.SysTools
import GHC.SysTools.Cpp
import GHC.Utils.TmpFs
-import GHC.Linker.ExtraObj
+import GHC.Linker.Executable
import GHC.Linker.Static
import GHC.Linker.Static.Utils
import GHC.Linker.Types
@@ -367,7 +367,7 @@ link ghcLink logger tmpfs fc hooks dflags unit_env batch_attempt_linking mHscMes
case linkHook hooks of
Nothing -> case ghcLink of
NoLink -> return Succeeded
- LinkBinary -> normal_link
+ LinkExecutable _ -> normal_link
LinkStaticLib -> normal_link
LinkDynLib -> normal_link
LinkMergedObj -> normal_link
@@ -441,16 +441,18 @@ link' logger tmpfs fc dflags unit_env batch_attempt_linking mHscMessager hpt
-- Don't showPass in Batch mode; doLink will do that for us.
case ghcLink dflags of
- LinkBinary
+ LinkExecutable _
| backendUseJSLinker (backend dflags) -> linkJSBinary logger tmpfs fc dflags unit_env obj_files pkg_deps
- | otherwise -> linkBinary logger tmpfs dflags unit_env obj_files pkg_deps
+ | otherwise -> do
+ let opts = initExecutableLinkOpts dflags
+ linkExecutable logger tmpfs opts unit_env obj_files pkg_deps
LinkStaticLib -> linkStaticLib logger dflags unit_env obj_files pkg_deps
LinkDynLib -> linkDynLibCheck logger tmpfs dflags unit_env obj_files pkg_deps
other -> panicBadLink other
debugTraceMsg logger 3 (text "link: done")
- -- linkBinary only returns if it succeeds
+ -- linkExecutable only returns if it succeeds
return Succeeded
| otherwise
@@ -510,7 +512,8 @@ linkingNeeded logger dflags unit_env staticLink linkables pkg_deps = do
if not (null lib_errs) || any (t <) lib_times
then return $ needsRecompileBecause LibraryChanged
else do
- res <- checkLinkInfo logger dflags unit_env pkg_deps exe_file
+ let opts = initExecutableLinkOpts dflags
+ res <- checkLinkInfo logger opts unit_env pkg_deps exe_file
if res
then return $ needsRecompileBecause FlagsChanged
else return UpToDate
@@ -581,10 +584,12 @@ doLink hsc_env o_files = do
case ghcLink dflags of
NoLink -> return ()
- LinkBinary
+ LinkExecutable _
| backendUseJSLinker (backend dflags)
-> linkJSBinary logger tmpfs fc dflags unit_env o_files []
- | otherwise -> linkBinary logger tmpfs dflags unit_env o_files []
+ | otherwise -> do
+ let opts = initExecutableLinkOpts dflags
+ linkExecutable logger tmpfs opts unit_env o_files []
LinkStaticLib -> linkStaticLib logger dflags unit_env o_files []
LinkDynLib -> linkDynLibCheck logger tmpfs dflags unit_env o_files []
LinkMergedObj
diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs
index ce1634512b17..f7a39668c0e6 100644
--- a/compiler/GHC/Driver/Pipeline/Execute.hs
+++ b/compiler/GHC/Driver/Pipeline/Execute.hs
@@ -15,6 +15,7 @@ import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Catch
import GHC.Driver.Hooks
+import GHC.Driver.DynFlags
import Control.Monad.Trans.Reader
import GHC.Driver.Pipeline.Monad
import GHC.Driver.Pipeline.Phases
@@ -71,7 +72,6 @@ import GHC.CmmToLlvm.Config (LlvmTarget (..), LlvmConfig (..))
import {-# SOURCE #-} GHC.Driver.Pipeline (compileForeign, compileEmptyStub)
import GHC.Settings
import System.IO
-import GHC.Linker.ExtraObj
import GHC.Linker.Dynamic
import GHC.Utils.Panic
import GHC.Utils.Touch
@@ -411,6 +411,7 @@ runCcPhase cc_phase pipe_env hsc_env location input_fn = do
let unit_env = hsc_unit_env hsc_env
let home_unit = hsc_home_unit_maybe hsc_env
let tmpfs = hsc_tmpfs hsc_env
+ let tmpdir = tmpDir dflags
let platform = ue_platform unit_env
let hcc = cc_phase `eqPhase` HCc
@@ -432,7 +433,7 @@ runCcPhase cc_phase pipe_env hsc_env location input_fn = do
let include_paths = include_paths_quote ++ include_paths_global
let gcc_extra_viac_flags = extraGccViaCFlags dflags
- let pic_c_flags = picCCOpts dflags
+ let cc_config = configureCc dflags
let verbFlags = getVerbFlags dflags
@@ -481,14 +482,14 @@ runCcPhase cc_phase pipe_env hsc_env location input_fn = do
ghcVersionH <- getGhcVersionIncludeFlags dflags unit_env
withAtomicRename output_fn $ \temp_outputFilename ->
- GHC.SysTools.runCc (phaseForeignLanguage cc_phase) logger tmpfs dflags (
+ GHC.SysTools.runCc (phaseForeignLanguage cc_phase) logger tmpfs tmpdir cc_config (
[ GHC.SysTools.Option "-c"
, GHC.SysTools.FileOption "" input_fn
, GHC.SysTools.Option "-o"
, GHC.SysTools.FileOption "" temp_outputFilename
]
++ map GHC.SysTools.Option (
- pic_c_flags
+ (ccPicOpts cc_config)
-- See Note [Produce big objects on Windows]
++ [ "-Wa,-mbig-obj"
@@ -1135,7 +1136,8 @@ joinObjectFiles hsc_env o_files output_fn
| otherwise = do
withAtomicRename output_fn $ \tmp_ar ->
- liftIO $ runAr logger dflags Nothing $ map Option $ ["qc" ++ dashL, tmp_ar] ++ o_files
+ let ar_opts = configureAr dflags
+ in liftIO $ runAr logger ar_opts Nothing $ map Option $ ["qc" ++ dashL, tmp_ar] ++ o_files
where
dashLSupported = sArSupportsDashL (settings dflags)
dashL = if dashLSupported then "L" else ""
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 601e1531405b..c48e4985c58d 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -635,6 +635,47 @@ setHiDir f d = d { hiDir = Just f}
setHieDir f d = d { hieDir = Just f}
setStubDir f d = d { stubDir = Just f
, includePaths = addGlobalInclude (includePaths d) [f] }
+
+-- | Set the archive prelinking size threshold from a string like "5m", "10M", "1024"
+-- Accepts: plain bytes (e.g., "1024"), kilobytes ("5k"), megabytes ("5m")
+-- Suffixes are case-insensitive
+setPrelinkArchiveThreshold :: String -> DynFlags -> Either String DynFlags
+setPrelinkArchiveThreshold str d =
+ case parseSize str of
+ Left err -> Left err
+ Right size -> Right $ d { prelinkArchiveThreshold = Just size }
+ where
+ parseSize :: String -> Either String Word64
+ parseSize s =
+ let (numStr, suffix) = span (\c -> c `elem` "0123456789") s
+ in case reads numStr of
+ [(n, "")] ->
+ case map toLower suffix of
+ "" -> Right n
+ "k" -> Right (n * 1024)
+ "m" -> Right (n * 1024 * 1024)
+ "g" -> Right (n * 1024 * 1024 * 1024)
+ _ -> Left $ "Invalid size suffix in -fprelink-archives=" ++ str ++
+ ". Valid suffixes: k, m, g (case-insensitive)"
+ _ -> Left $ "Invalid size number in -fprelink-archives=" ++ str
+
+ toLower :: Char -> Char
+ toLower c | c >= 'A' && c <= 'Z' = toEnum (fromEnum c + 32)
+ | otherwise = c
+
+setPrelinkCacheDir :: FilePath -> DynFlags -> DynFlags
+setPrelinkCacheDir dir d = d { prelinkCacheDir = Just dir }
+
+-- | Disable archive prelinking
+disablePrelinkArchives :: DynFlags -> DynFlags
+disablePrelinkArchives d = d { prelinkArchiveThreshold = Nothing }
+
+-- | Wrapper for setPrelinkArchiveThreshold that works with DynP monad
+setPrelinkArchiveThresholdM :: String -> DynFlags -> DynP DynFlags
+setPrelinkArchiveThresholdM str d =
+ case setPrelinkArchiveThreshold str d of
+ Left err -> addErr err >> return d
+ Right d' -> return d'
-- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file
-- \#included from the .hc file when compiling via C (i.e. unregisterised
-- builds).
@@ -1113,6 +1154,15 @@ dynamic_flags_deps = [
(NoArg (setGeneralFlag Opt_SingleLibFolder))
, make_ord_flag defGhcFlag "pie" (NoArg (setGeneralFlag Opt_PICExecutable))
, make_ord_flag defGhcFlag "no-pie" (NoArg (unSetGeneralFlag Opt_PICExecutable))
+ , make_ord_flag defGhcFlag "static-external" (noArg (\d -> d { ghcLink=LinkExecutable (MostlyStatic ["c", "m", "rt", "dl", "pthread", "stdc++", "c++", "c++abi", "atomic", "wsock32", "gdi32", "winmm", "dbghelp", "psapi", "user32", "shell32", "mingw32", "kernel32", "advapi32", "mingwex", "ws2_32", "shlwapi", "ole32", "rpcrt4", "ntdll", "ucrt"]) }))
+ , make_ord_flag defGhcFlag "exclude-static-external"
+ (OptPrefix (\str -> upd $ \d -> case ghcLink d of
+ LinkExecutable (MostlyStatic _) ->
+ d { ghcLink = LinkExecutable (MostlyStatic (split ',' str)) }
+ _ -> d
+ )
+ )
+ , make_ord_flag defGhcFlag "fully-static" (noArg (\d -> d { ghcLink=LinkExecutable FullyStatic }))
------- Specific phases --------------------------------------------
-- need to appear before -pgmL to be parsed as LLVM flags.
@@ -1233,6 +1283,15 @@ dynamic_flags_deps = [
, make_ord_flag defGhcFlag "dynload" (hasArg parseDynLibLoaderMode)
, make_ord_flag defGhcFlag "dylib-install-name" (hasArg setDylibInstallName)
+ -------- Archive Prelinking -----------------------------------------
+ -- See Note [Archive Prelinking] in GHC.Driver.DynFlags
+ , make_ord_flag defGhcFlag "prelink-archives"
+ (sepArgM setPrelinkArchiveThresholdM)
+ , make_ord_flag defGhcFlag "prelink-cache"
+ (hasArg setPrelinkCacheDir)
+ , make_ord_flag defGhcFlag "no-prelink-archives"
+ (noArg disablePrelinkArchives)
+
------- Libraries ---------------------------------------------------
, make_ord_flag defFlag "L" (Prefix addLibraryPath)
, make_ord_flag defFlag "l" (hasArg (addLdInputs . Option . ("-l" ++)))
@@ -1312,6 +1371,13 @@ dynamic_flags_deps = [
(NoArg (unSetGeneralFlag Opt_AutoLinkPackages))
, make_ord_flag defGhcFlag "no-hs-main"
(NoArg (setGeneralFlag Opt_NoHsMain))
+ , make_ord_flag defGhcFlag "no-rts"
+ (NoArg (setGeneralFlag Opt_NoRts))
+ -- Prevent ghc-internal from being auto-injected when building RTS sublibraries.
+ -- When building rts sublibaries with GHC, we may try to load ghc-internal
+ -- due to auto-injection. This flag, like -no-rts, prevents that.
+ , make_ord_flag defGhcFlag "no-ghc-internal"
+ (NoArg (setGeneralFlag Opt_NoGhcInternal))
, make_ord_flag defGhcFlag "fno-state-hack"
(NoArg (setGeneralFlag Opt_G_NoStateHack))
, make_ord_flag defGhcFlag "fno-opt-coercion"
@@ -2507,6 +2573,7 @@ fFlagsDeps = [
-- load all targets on GHCi startup
flagGhciSpec "load-initial-targets" Opt_GhciDoLoadTargets,
+ flagGhciSpec "import-loaded-targets" Opt_GhciImportLoadedTargets,
flagSpec "helpful-errors" Opt_HelpfulErrors,
flagSpec "hpc" Opt_Hpc,
@@ -2852,6 +2919,9 @@ hasArg fn = HasArg (upd . fn)
sepArg :: (String -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
sepArg fn = SepArg (upd . fn)
+sepArgM :: (String -> DynFlags -> DynP DynFlags) -> OptKind (CmdLineP DynFlags)
+sepArgM fn = SepArg (\s -> updM (fn s))
+
intSuffix :: (Int -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
intSuffix fn = IntSuffix (\n -> upd (fn n))
@@ -3181,7 +3251,7 @@ parseReexportedModule str
-- code are allowed (requests for other target types are ignored).
setBackend :: Backend -> DynP ()
setBackend l = upd $ \ dfs ->
- if ghcLink dfs /= LinkBinary || backendWritesFiles l
+ if not (isExecutableLink (ghcLink dfs)) || backendWritesFiles l
then dfs{ backend = l }
else dfs
@@ -3457,6 +3527,7 @@ compilerInfo dflags
: map (fmap $ expandDirectories (topDir dflags) (toolDir dflags))
(rawSettings dflags)
++ [("Project version", projectVersion dflags),
+ ("Edition", "Stable Haskell"),
("Project Git commit id", cProjectGitCommitId),
("Project Version Int", cProjectVersionInt),
("Project Patch Level", cProjectPatchLevel),
@@ -3702,6 +3773,28 @@ makeDynFlagsConsistent dflags
setGeneralFlag' Opt_ExternalInterpreter $
addWay' WayDyn dflags
+ | LinkExecutable FullyStatic <- ghcLink dflags
+ , ways dflags `hasWay` WayDyn
+ = let warn = "-dynamic is ignored when using -fully-static"
+ in loop dflags{targetWays_ = removeWay WayDyn (targetWays_ dflags)} warn
+ | LinkStaticLib <- ghcLink dflags
+ , ways dflags `hasWay` WayDyn
+ = let warn = "-dynamic is ignored when using -staticlib"
+ in loop dflags{targetWays_ = removeWay WayDyn (targetWays_ dflags)} warn
+ -- For the wasm target, when ghc is invoked with -dynamic,
+ -- when linking the final .wasm binary we must still ensure
+ -- the static archives are selected. Otherwise wasm-ld would
+ -- fail to find and link the .so library dependencies. wasm-ld
+ -- can link PIC objects into static .wasm binaries fine, so we
+ -- only adjust the ways in the final linking step, and only
+ -- when linking .wasm binary (which is supposed to be fully
+ -- static), not when linking .so shared libraries.
+ | LinkExecutable _ <- ghcLink dflags
+ , ArchWasm32 <- arch
+ , ways dflags `hasWay` WayDyn
+ = let warn = "-dynamic is ignored when linking binaries on WASM"
+ in loop dflags{targetWays_ = removeWay WayDyn (targetWays_ dflags)} warn
+
| LinkInMemory <- ghcLink dflags
, not (gopt Opt_ExternalInterpreter dflags)
, targetWays_ dflags /= hostFullWays
diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs
index c49e93f4e10e..00228593266c 100644
--- a/compiler/GHC/Hs/Binds.hs
+++ b/compiler/GHC/Hs/Binds.hs
@@ -734,13 +734,14 @@ instance NoAnn AnnSpecSig where
data ActivationAnn
= ActivationAnn {
aa_openc :: EpToken "[",
+ aa_phase :: SourceText,
aa_closec :: EpToken "]",
aa_tilde :: Maybe (EpToken "~"),
aa_val :: Maybe EpaLocation
} deriving (Data, Eq)
instance NoAnn ActivationAnn where
- noAnn = ActivationAnn noAnn noAnn noAnn noAnn
+ noAnn = ActivationAnn noAnn NoSourceText noAnn noAnn noAnn
-- | Optional namespace specifier for fixity signatures,
diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs
index 6bc384cf15b0..eb0e6ac3ed03 100644
--- a/compiler/GHC/HsToCore.hs
+++ b/compiler/GHC/HsToCore.hs
@@ -48,7 +48,7 @@ import GHC.Core.TyCo.Compare( eqType )
import GHC.Core.TyCon ( tyConDataCons )
import GHC.Core
import GHC.Core.FVs ( exprsSomeFreeVarsList, exprFreeVars )
-import GHC.Core.SimpleOpt ( simpleOptPgm, simpleOptExpr )
+import GHC.Core.SimpleOpt ( simpleOptExpr )
import GHC.Core.Utils
import GHC.Core.Unfold.Make
import GHC.Core.Coercion
@@ -200,27 +200,18 @@ deSugar hsc_env
do { -- Add export flags to bindings
keep_alive <- readIORef keep_var
- ; let (rules_for_locals, rules_for_imps) = partition isLocalRule all_rules
+ ; let (rules_for_locals, ds_rules_for_imps) = partition isLocalRule all_rules
final_prs = addExportFlagsAndRules bcknd export_set keep_alive
rules_for_locals (fromOL all_prs)
- final_pgm = combineEvBinds ds_ev_binds final_prs
+ ds_binds = combineEvBinds ds_ev_binds final_prs
-- Notice that we put the whole lot in a big Rec, even the foreign binds
-- When compiling PrelFloat, which defines data Float = F# Float#
-- we want F# to be in scope in the foreign marshalling code!
-- You might think it doesn't matter, but the simplifier brings all top-level
-- things into the in-scope set before simplifying; so we get no unfolding for F#!
- ; endPassHscEnvIO hsc_env name_ppr_ctx CoreDesugar final_pgm rules_for_imps
- ; let simpl_opts = initSimpleOpts dflags
- ; let (ds_binds, ds_rules_for_imps, occ_anald_binds)
- = simpleOptPgm simpl_opts mod final_pgm rules_for_imps
- -- The simpleOptPgm gets rid of type
- -- bindings plus any stupid dead code
- ; putDumpFileMaybe logger Opt_D_dump_occur_anal "Occurrence analysis"
- FormatCore (pprCoreBindings occ_anald_binds $$ pprRules ds_rules_for_imps )
-
- ; endPassHscEnvIO hsc_env name_ppr_ctx CoreDesugarOpt ds_binds ds_rules_for_imps
+ ; endPassHscEnvIO hsc_env name_ppr_ctx CoreDesugar ds_binds ds_rules_for_imps
; let pluginModules = map lpModule (loadedPlugins (hsc_plugins hsc_env))
home_unit = hsc_home_unit hsc_env
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index e81aa40335e2..d1312b238d28 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -1189,11 +1189,11 @@ repRuleMatch ConLike = dataCon conLikeDataConName
repRuleMatch FunLike = dataCon funLikeDataConName
repPhases :: Activation -> MetaM (Core TH.Phases)
-repPhases (ActiveBefore _ i) = do { MkC arg <- coreIntLit i
- ; dataCon' beforePhaseDataConName [arg] }
-repPhases (ActiveAfter _ i) = do { MkC arg <- coreIntLit i
- ; dataCon' fromPhaseDataConName [arg] }
-repPhases _ = dataCon allPhasesDataConName
+repPhases (ActiveBefore i) = do { MkC arg <- coreIntLit i
+ ; dataCon' beforePhaseDataConName [arg] }
+repPhases (ActiveAfter i) = do { MkC arg <- coreIntLit i
+ ; dataCon' fromPhaseDataConName [arg] }
+repPhases _ = dataCon allPhasesDataConName
rep_complete_sig :: [LocatedN Name]
-> Maybe (LocatedN Name)
diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs
index cff7481d8a88..e53fefc413b4 100644
--- a/compiler/GHC/HsToCore/Utils.hs
+++ b/compiler/GHC/HsToCore/Utils.hs
@@ -259,12 +259,12 @@ wrapBind new old body -- NB: this function must deal with term
seqVar :: Var -> CoreExpr -> CoreExpr
seqVar var body = mkDefaultCase (Var var) var body
-mkCoLetMatchResult :: CoreBind -> MatchResult CoreExpr -> MatchResult CoreExpr
+mkCoLetMatchResult :: HasDebugCallStack => CoreBind -> MatchResult CoreExpr -> MatchResult CoreExpr
mkCoLetMatchResult bind = fmap (mkCoreLet bind)
-- (mkViewMatchResult var' viewExpr mr) makes the expression
-- let var' = viewExpr in mr
-mkViewMatchResult :: Id -> CoreExpr -> MatchResult CoreExpr -> MatchResult CoreExpr
+mkViewMatchResult :: HasDebugCallStack => Id -> CoreExpr -> MatchResult CoreExpr -> MatchResult CoreExpr
mkViewMatchResult var' viewExpr = fmap $ mkCoreLet $ NonRec var' viewExpr
mkEvalMatchResult :: Id -> Type -> MatchResult CoreExpr -> MatchResult CoreExpr
diff --git a/compiler/GHC/Iface/Errors/Ppr.hs b/compiler/GHC/Iface/Errors/Ppr.hs
index fc3d9f63ae34..f08b99cbe4ed 100644
--- a/compiler/GHC/Iface/Errors/Ppr.hs
+++ b/compiler/GHC/Iface/Errors/Ppr.hs
@@ -42,6 +42,7 @@ import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Iface.Errors.Types
+import qualified Data.List as List
defaultIfaceMessageOpts :: IfaceMessageOpts
defaultIfaceMessageOpts = IfaceMessageOpts { ifaceShowTriedFiles = False
@@ -174,14 +175,12 @@ cantFindErrorX pkg_hidden_hint may_show_locations mod_or_interface (CantFindInst
looks_like_srcpkgid =
-- Unsafely coerce a unit id (i.e. an installed package component
-- identifier) into a PackageId and see if it means anything.
- case cands of
- (pkg:pkgs) ->
- parens (text "This unit ID looks like the source package ID;" $$
- text "the real unit ID is" <+> quotes (ftext (unitIdFS (unitId pkg))) $$
- (if null pkgs then empty
- else text "and" <+> int (length pkgs) <+> text "other candidate" <> plural pkgs))
+ case List.sortOn unitPackageNameString cands of
-- Todo: also check if it looks like a package name!
[] -> empty
+ pkgs ->
+ parens (text "This unit-id looks like a source package name-version;" <+>
+ text "candidates real unit-ids are:" $$ vcat (map (quotes . ftext . unitIdFS . unitId) pkgs))
in hsep [ text "no unit id matching" <+> quotes (ppr pkg)
, text "was found"] $$ looks_like_srcpkgid
@@ -346,6 +345,7 @@ 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/ArchivePrelink.hs b/compiler/GHC/Linker/ArchivePrelink.hs
new file mode 100644
index 000000000000..2a6191830ff9
--- /dev/null
+++ b/compiler/GHC/Linker/ArchivePrelink.hs
@@ -0,0 +1,208 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
+
+-------------------------------------------------------------------------------
+--
+-- | On-Demand Archive Prelinking for GHC Internal Linker
+--
+-- This module provides on-demand prelinking of static archives (.a files)
+-- for the GHC internal linker, replacing the traditional approach of
+-- pre-generating GHCi prelinked objects.
+--
+-- Instead of creating prelinked objects at build time (which was slow and
+-- disk-intensive), we now create them on-demand when the internal linker
+-- loads large archives. This speeds up loading and linking by merging
+-- archive members into a single object file using 'ld -r', which:
+--
+-- 1. Reduces the number of objects the RTS linker must process
+-- 2. Eliminates relocation range issues in large archives
+-- 3. Speeds up loading through fewer system calls
+-- 4. Provides optional persistent caching for reuse across sessions
+--
+-- Copyright (c) Moritz Angermann , zw3rk pte. ltd.
+-- License: Apache 2
+--
+-------------------------------------------------------------------------------
+
+module GHC.Linker.ArchivePrelink
+ ( shouldPrelinkArchive
+ , prelinkArchive
+ , computeArchiveHash
+ , findCachedPrelink
+ , getCacheDir
+ ) where
+
+import GHC.Prelude
+
+import GHC.Driver.Session
+import GHC.Utils.Logger
+import GHC.Utils.TmpFs
+import GHC.Utils.Outputable
+import GHC.Utils.Fingerprint
+import GHC.Utils.Panic
+import GHC.Utils.Error
+import GHC.SysTools.Tasks
+
+import Control.Monad
+import qualified Control.Exception as E
+import System.FilePath
+import System.Directory
+import System.Environment (lookupEnv)
+import Data.Maybe
+
+-- | Determine if an archive should be prelinked
+--
+-- Prelinking is enabled when:
+-- 1. The prelinkArchiveThreshold is set (Just threshold)
+-- 2. The file is a static archive (*.a extension)
+-- 3. The file size >= threshold
+-- 4. The merge objects linker (ld -r) is configured
+shouldPrelinkArchive :: DynFlags -> FilePath -> IO Bool
+shouldPrelinkArchive dflags path = do
+ case prelinkArchiveThreshold dflags of
+ Nothing -> return False -- Prelinking disabled
+ Just threshold -> do
+ -- Only prelink static archives (*.a extension)
+ let isStaticArchive = takeExtension path == ".a"
+ if not isStaticArchive
+ then return False
+ else do
+ -- Check if file exists (might be in a library search path)
+ exists <- doesFileExist path
+ if not exists
+ then return False
+ else do
+ size <- getFileSize path
+ let hasLdR = isJust (pgm_lm dflags)
+ let shouldPrelink = fromIntegral size >= threshold && hasLdR
+ return shouldPrelink
+
+-- | Compute a hash of an archive file for cache key
+--
+-- Uses GHC's built-in MD5 fingerprinting (getFileHash) for consistency
+-- with other GHC fingerprinting operations.
+computeArchiveHash :: FilePath -> IO String
+computeArchiveHash path = do
+ fp <- getFileHash path
+ return $ show fp -- Fingerprint has a Show instance that produces hex string
+
+-- | Find existing prelinked object in cache
+--
+-- Returns Nothing if:
+-- - Persistent cache is disabled (cacheDir = Nothing)
+-- - Cache file doesn't exist
+-- - Cache file exists but is invalid (corrupt, wrong version, etc.)
+findCachedPrelink :: Logger -> Maybe FilePath -> FilePath -> IO (Maybe FilePath)
+findCachedPrelink logger cacheDir archivePath = do
+ case cacheDir of
+ Nothing -> return Nothing -- Per-session only, no persistent cache
+ Just dir -> do
+ hash <- computeArchiveHash archivePath
+ let originalName = takeFileName archivePath
+ let cachedName = hash ++ "-" ++ replaceExtension originalName ".o"
+ let cachedPath = dir cachedName
+ exists <- doesFileExist cachedPath
+ if exists
+ then do
+ debugTraceMsg logger 3 $ text "Found cached prelink:" <+> text cachedPath
+ return (Just cachedPath)
+ else return Nothing
+
+-- | Extract archive members to temporary directory
+--
+-- Uses 'ar x' to extract all member object files.
+-- Returns list of extracted object file paths.
+extractArchiveMembers :: Logger -> ArConfig -> FilePath -> FilePath -> IO [FilePath]
+extractArchiveMembers logger arConfig archivePath tempDir = do
+ debugTraceMsg logger 3 $ text "Extracting archive:" <+> text archivePath
+
+ -- Use 'ar x' to extract all members to temp directory
+ let cwd = Just tempDir
+ runAr logger arConfig cwd [Option "x", FileOption "" archivePath]
+
+ -- List extracted files and filter for .o files
+ files <- listDirectory tempDir
+ let objFiles = filter (\f -> takeExtension f == ".o") files
+
+ when (null objFiles) $
+ throwGhcException $ UsageError $
+ "Archive " ++ archivePath ++ " contains no object files"
+
+ return $ map (tempDir ) objFiles
+
+-- | Prelink an archive into a single merged object file
+--
+-- This is the main entry point for prelinking. It:
+-- 1. Checks the cache for an existing prelinked object
+-- 2. If not cached, extracts archive members to a temp directory
+-- 3. Runs 'ld -r' to merge all objects into a single .o file
+-- 4. Stores the result in cache (if persistent cache enabled)
+-- 5. Returns the path to the prelinked object
+--
+-- If any step fails, returns Nothing and the caller should fall back
+-- to loading the original archive.
+prelinkArchive :: Logger -> TmpFs -> DynFlags -> FilePath -> IO (Maybe FilePath)
+prelinkArchive logger tmpfs dflags archivePath =
+ E.catch doPrelink $ \(e :: E.SomeException) -> do
+ logInfo logger $ text "Prelinking failed for" <+> text archivePath
+ <> text ":" <+> text (E.displayException e)
+ logInfo logger $ text "Falling back to normal archive loading"
+ return Nothing
+ where
+ doPrelink = do
+ debugTraceMsg logger 2 $ text "Prelinking archive:" <+> text archivePath
+
+ -- Check cache first
+ let arConfig = configureAr dflags
+ cacheDir <- getCacheDir dflags
+ cached <- findCachedPrelink logger cacheDir archivePath
+ case cached of
+ Just path -> do
+ debugTraceMsg logger 2 $ text "Using cached prelink:" <+> text path
+ return (Just path)
+ Nothing -> do
+ -- Extract members to temp directory
+ tempDir <- newTempSubDir logger tmpfs (tmpDir dflags)
+ members <- extractArchiveMembers logger arConfig archivePath tempDir
+
+ debugTraceMsg logger 3 $ text "Extracted" <+> int (length members) <+> text "members"
+
+ -- Determine output path (cached or temp)
+ outputPath <- case cacheDir of
+ Nothing -> do
+ -- Per-session temp file
+ newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession "o"
+ Just dir -> do
+ -- Persistent cache
+ createDirectoryIfMissing True dir
+ hash <- computeArchiveHash archivePath
+ let originalName = takeFileName archivePath
+ let cachedName = hash ++ "-" ++ replaceExtension originalName ".o"
+ return $ dir cachedName
+
+ -- Run ld -r to merge objects
+ -- Note: -r flag is already included in pgm_lm configuration
+ debugTraceMsg logger 3 $ text "Merging" <+> int (length members) <+> text "objects into" <+> text outputPath
+ let mergeArgs = [ Option "-o"
+ , FileOption "" outputPath
+ ]
+ ++ map (FileOption "") members
+ runMergeObjects logger tmpfs dflags mergeArgs
+
+ debugTraceMsg logger 2 $ text "Created prelinked object:" <+> text outputPath
+ return (Just outputPath)
+
+-- | Get cache directory from configuration
+--
+-- Priority (highest to lowest):
+-- 1. Command-line flag: prelinkCacheDir in DynFlags
+-- 2. Environment variable: GHC_PRELINK_CACHE
+-- 3. Default: Nothing (per-session temp files only)
+getCacheDir :: DynFlags -> IO (Maybe FilePath)
+getCacheDir dflags = do
+ case prelinkCacheDir dflags of
+ Just dir -> return (Just dir) -- Command-line flag wins
+ Nothing -> do
+ -- Check environment variable
+ envVar <- lookupEnv "GHC_PRELINK_CACHE"
+ return envVar
diff --git a/compiler/GHC/Linker/Config.hs b/compiler/GHC/Linker/Config.hs
index 91d0df26c0e8..9c6b4ccc4e99 100644
--- a/compiler/GHC/Linker/Config.hs
+++ b/compiler/GHC/Linker/Config.hs
@@ -18,10 +18,13 @@ data FrameworkOpts = FrameworkOpts
-- | External linker configuration
data LinkerConfig = LinkerConfig
- { linkerProgram :: String -- ^ Linker program
+ { linkerC :: String -- ^ C Linker program
+ , linkerCXX :: String -- ^ C++ Linker program
, linkerOptionsPre :: [Option] -- ^ Linker options (before user options)
, linkerOptionsPost :: [Option] -- ^ Linker options (after user options)
, linkerTempDir :: TempDir -- ^ Temporary directory to use
, linkerFilter :: [String] -> [String] -- ^ Output filter
+ , linkerSupportsCompactUnwind :: !Bool -- ^ Does the linker support compact unwind
+ , linkerIsGnuLd :: !Bool -- ^ Is it GNU LD (used for gc-sections support)
}
diff --git a/compiler/GHC/Linker/Dynamic.hs b/compiler/GHC/Linker/Dynamic.hs
index 4c8c1943eb6f..9a6346309cb2 100644
--- a/compiler/GHC/Linker/Dynamic.hs
+++ b/compiler/GHC/Linker/Dynamic.hs
@@ -12,6 +12,7 @@ import GHC.Prelude
import GHC.Platform
import GHC.Platform.Ways
import GHC.Settings (ToolSettings(toolSettings_ldSupportsSingleModule))
+import GHC.SysTools.Tasks
import GHC.Driver.Config.Linker
import GHC.Driver.Session
@@ -24,6 +25,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
@@ -85,17 +87,15 @@ linkDynLib logger tmpfs dflags0 unit_env o_files dep_packages
-- WASM_DYLINK_NEEDED, otherwise dyld can't load it.
--
--
- let pkgs_without_rts = filter ((/= rtsUnitId) . unitId) pkgs_with_rts
+ let pkgs_without_rts = filter ((/= PackageName (fsLit "rts")) . unitPackageName) pkgs_with_rts
pkgs
| ArchWasm32 <- arch = pkgs_with_rts
| OSMinGW32 <- os = pkgs_with_rts
| gopt Opt_LinkRts dflags = pkgs_with_rts
| otherwise = pkgs_without_rts
- pkg_link_opts = hsLibs unit_link_opts ++ extraLibs unit_link_opts ++ otherFlags unit_link_opts
- where
- namever = ghcNameVersion dflags
- ways_ = ways dflags
- unit_link_opts = collectLinkOpts namever ways_ pkgs
+ unit_link_opts <- collectLinkOpts (ghcNameVersion dflags) (ways dflags) Nothing pkgs
+ let pkg_link_opts = hsLibs unit_link_opts ++ extraLibs unit_link_opts ++ otherFlags unit_link_opts
+
-- probably _stub.o files
-- and last temporary shared object file
@@ -106,6 +106,7 @@ linkDynLib logger tmpfs dflags0 unit_env o_files dep_packages
let framework_opts = getFrameworkOpts (initFrameworkOpts dflags) platform
let linker_config = initLinkerConfig dflags
+ let require_cxx = any ((==) (PackageName (fsLit "system-cxx-std-lib")) . unitPackageName) pkgs
case os of
OSMinGW32 -> do
@@ -116,7 +117,7 @@ linkDynLib logger tmpfs dflags0 unit_env o_files dep_packages
Just s -> s
Nothing -> "HSdll.dll"
- runLink logger tmpfs linker_config (
+ runLink logger tmpfs linker_config require_cxx (
map Option verbFlags
++ [ Option "-o"
, FileOption "" output_fn
@@ -175,7 +176,7 @@ linkDynLib logger tmpfs dflags0 unit_env o_files dep_packages
instName <- case dylibInstallName dflags of
Just n -> return n
Nothing -> return $ "@rpath" `combine` (takeFileName output_fn)
- runLink logger tmpfs linker_config (
+ runLink logger tmpfs linker_config require_cxx (
map Option verbFlags
++ [ Option "-dynamiclib"
, Option "-o"
@@ -207,8 +208,10 @@ linkDynLib logger tmpfs dflags0 unit_env o_files dep_packages
++ [ Option "-Wl,-dead_strip_dylibs", Option "-Wl,-headerpad,8000" ]
)
-- Make sure to honour -fno-use-rpaths if set on darwin as well; see #20004
- when (gopt Opt_RPath dflags) $
- runInjectRPaths logger (toolSettings dflags) pkg_lib_paths output_fn
+ when (gopt Opt_RPath dflags) $ do
+ let otool_opts = configureOtool dflags
+ let install_name_opts = configureInstallName dflags
+ runInjectRPaths logger otool_opts install_name_opts pkg_lib_paths output_fn
_ -> do
-------------------------------------------------------------------
-- Making a DSO
@@ -224,7 +227,7 @@ linkDynLib logger tmpfs dflags0 unit_env o_files dep_packages
-- wasm-ld accepts --Bsymbolic instead
["-Wl,-Bsymbolic" | not unregisterised && arch /= ArchWasm32 ]
- runLink logger tmpfs linker_config (
+ runLink logger tmpfs linker_config require_cxx (
map Option verbFlags
++ libmLinkOpts platform
++ [ Option "-o"
diff --git a/compiler/GHC/Linker/Executable.hs b/compiler/GHC/Linker/Executable.hs
new file mode 100644
index 000000000000..e1c4928986c3
--- /dev/null
+++ b/compiler/GHC/Linker/Executable.hs
@@ -0,0 +1,643 @@
+-- | Linking executables
+module GHC.Linker.Executable
+ ( linkExecutable
+ , ExecutableLinkOpts (..)
+ , initExecutableLinkOpts
+ , mkExtraObjToLinkIntoBinary
+ , mkNoteObjsToLinkIntoBinary
+ -- RTS Opts
+ , RtsOptsEnabled (..)
+ -- * Link info
+ , LinkInfo (..)
+ , initLinkInfo
+ , checkLinkInfo
+ , ghcLinkInfoSectionName
+ , ghcLinkInfoNoteName
+ , platformSupportsSavingLinkOpts
+ )
+where
+
+import GHC.Prelude
+import GHC.Platform
+import GHC.Platform.Ways
+
+import GHC.Unit
+import GHC.Unit.Env
+
+import GHC.Utils.Asm
+import GHC.Utils.Error
+import GHC.Utils.Misc
+import GHC.Utils.Outputable as Outputable
+import GHC.Utils.Logger
+import GHC.Utils.TmpFs
+import GHC.Data.FastString
+import GHC.Data.ShortText qualified as ST
+import GHC.Types.SrcLoc (noSrcSpan)
+
+import GHC.Driver.Session
+import GHC.Driver.DynFlags
+import GHC.Driver.Config.Linker
+
+import GHC.SysTools
+import GHC.SysTools.Elf
+import GHC.Linker.Config
+import GHC.Linker.Unit
+import GHC.Linker.MacOS
+import GHC.Linker.Windows
+import GHC.Linker.Dynamic (libmLinkOpts)
+import GHC.Linker.External (runLink)
+import GHC.Linker.Static.Utils (exeFileName)
+
+import Control.Monad
+import Data.Maybe
+import System.FilePath
+import System.Directory
+
+data ExecutableLinkOpts = ExecutableLinkOpts
+ { leOutputFile :: Maybe FilePath
+ , leNameVersion :: GhcNameVersion
+ , leWays :: Ways
+ , leDynLibLoader :: DynLibLoader
+ , leRelativeDynlibPaths :: !Bool
+ , leUseXLinkerRPath :: !Bool
+ , leSingleLibFolder :: !Bool
+ , leWholeArchiveHsLibs :: !Bool
+ , leGenManifest :: !Bool
+ , leRPath :: !Bool
+ , leCompactUnwind :: !Bool
+ , leLibraryPaths :: [String]
+ , leFrameworkOpts :: FrameworkOpts
+ , leManifestOpts :: ManifestOpts
+ , leLinkerConfig :: LinkerConfig
+ , leOtoolConfig :: OtoolConfig
+ , leCcConfig :: CcConfig
+ , leLdConfig :: LdConfig
+ , leInstallNameConfig :: InstallNameConfig
+ , leInputs :: [Option]
+ , lePieOpts :: [String]
+ , leTempDir :: TempDir
+ , leVerbFlags :: [String]
+ , leNoHsMain :: !Bool
+ , leMainSymbol :: String
+ , leRtsOptsEnabled :: !RtsOptsEnabled
+ , leRtsOptsSuggestions :: !Bool
+ , leKeepCafs :: !Bool
+ , leRtsOpts :: Maybe String
+ , leLinkMode :: ExecutableLinkMode
+ }
+
+initExecutableLinkOpts :: DynFlags -> ExecutableLinkOpts
+initExecutableLinkOpts dflags =
+ let
+ platform = targetPlatform dflags
+ os = platformOS platform
+ in ExecutableLinkOpts
+ { leOutputFile = outputFile_ dflags
+ , leNameVersion = ghcNameVersion dflags
+ , leWays = ways dflags
+ , leDynLibLoader = dynLibLoader dflags
+ , leRelativeDynlibPaths = gopt Opt_RelativeDynlibPaths dflags
+ , leUseXLinkerRPath = useXLinkerRPath dflags os
+ , leSingleLibFolder = gopt Opt_SingleLibFolder dflags
+ , leWholeArchiveHsLibs = gopt Opt_WholeArchiveHsLibs dflags
+ , leGenManifest = gopt Opt_GenManifest dflags
+ , leRPath = gopt Opt_RPath dflags
+ , leCompactUnwind = gopt Opt_CompactUnwind dflags
+ , leLibraryPaths = libraryPaths dflags
+ , leFrameworkOpts = initFrameworkOpts dflags
+ , leManifestOpts = initManifestOpts dflags
+ , leLinkerConfig = initLinkerConfig dflags
+ , leLdConfig = configureLd dflags
+ , leCcConfig = configureCc dflags
+ , leOtoolConfig = configureOtool dflags
+ , leInstallNameConfig = configureInstallName dflags
+ , leInputs = ldInputs dflags
+ , lePieOpts = pieCCLDOpts dflags
+ , leTempDir = tmpDir dflags
+ , leVerbFlags = getVerbFlags dflags
+ , leNoHsMain = gopt Opt_NoHsMain dflags
+ , leMainSymbol = "ZCMain_main"
+ , leRtsOptsEnabled = rtsOptsEnabled dflags
+ , leRtsOptsSuggestions = rtsOptsSuggestions dflags
+ , leKeepCafs = gopt Opt_KeepCAFs dflags
+ , leRtsOpts = rtsOpts dflags
+ , leLinkMode = case ghcLink dflags of
+ LinkExecutable m -> m
+ _ -> Dynamic -- defaults to Dynamic
+ }
+
+leHaveRtsOptsFlags :: ExecutableLinkOpts -> Bool
+leHaveRtsOptsFlags opts =
+ isJust (leRtsOpts opts)
+ || case leRtsOptsEnabled opts of
+ RtsOptsSafeOnly -> False
+ _ -> True
+
+linkExecutable :: Logger -> TmpFs -> ExecutableLinkOpts -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
+linkExecutable logger tmpfs opts unit_env o_files dep_units = do
+ let static_link = False
+ let platform = ue_platform unit_env
+ unit_state = ue_homeUnitState unit_env
+ verbFlags = leVerbFlags opts
+ arch_os = platformArchOS platform
+ output_fn = exeFileName arch_os static_link (leOutputFile opts)
+ namever = leNameVersion opts
+ ways_ = leWays opts
+
+ full_output_fn <- if isAbsolute output_fn
+ then return output_fn
+ else do d <- getCurrentDirectory
+ return $ normalise (d output_fn)
+
+ -- get the full list of packages to link with, by combining the
+ -- explicit packages with the auto packages and all of their
+ -- dependencies, and eliminating duplicates.
+ pkgs <- mayThrowUnitErr (preloadUnitsInfo' unit_env dep_units)
+ let pkg_lib_paths = collectLibraryDirs ways_ pkgs
+ let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths
+ get_pkg_lib_path_opts l
+ | osElfTarget (platformOS platform) &&
+ leDynLibLoader opts == SystemDependent &&
+ ways_ `hasWay` WayDyn
+ = let libpath = if leRelativeDynlibPaths opts
+ then "$ORIGIN"
+ (l `makeRelativeTo` full_output_fn)
+ else l
+ -- See Note [-Xlinker -rpath vs -Wl,-rpath]
+ rpath = if leUseXLinkerRPath opts
+ then ["-Xlinker", "-rpath", "-Xlinker", libpath]
+ else []
+ -- Solaris 11's linker does not support -rpath-link option. It silently
+ -- ignores it and then complains about next option which is -l as being a directory and not expected object file, E.g
+ -- ld: elf error: file
+ -- /tmp/ghc-src/libraries/base/dist-install/build:
+ -- elf_begin: I/O error: region read: Is a directory
+ rpathlink = if (platformOS platform) == OSSolaris2
+ then []
+ else ["-Xlinker", "-rpath-link", "-Xlinker", l]
+ in ["-L" ++ l] ++ rpathlink ++ rpath
+ | osMachOTarget (platformOS platform) &&
+ leDynLibLoader opts == SystemDependent &&
+ ways_ `hasWay` WayDyn &&
+ leUseXLinkerRPath opts
+ = let libpath = if leRelativeDynlibPaths opts
+ then "@loader_path"
+ (l `makeRelativeTo` full_output_fn)
+ else l
+ in ["-L" ++ l] ++ ["-Xlinker", "-rpath", "-Xlinker", libpath]
+ | otherwise = ["-L" ++ l]
+
+ pkg_lib_path_opts <-
+ if leSingleLibFolder opts
+ then do
+ libs <- getLibs namever ways_ unit_env dep_units
+ tmpDir <- newTempSubDir logger tmpfs (leTempDir opts)
+ sequence_ [ copyFile lib (tmpDir basename)
+ | (lib, basename) <- libs]
+ return [ "-L" ++ tmpDir ]
+ else pure pkg_lib_path_opts
+
+ let
+ dead_strip
+ | leWholeArchiveHsLibs opts = []
+ | otherwise = if osSubsectionsViaSymbols (platformOS platform)
+ then ["-Wl,-dead_strip"]
+ else []
+ let lib_paths = leLibraryPaths opts
+ let lib_path_opts = map ("-L"++) lib_paths
+
+ extraLinkObj <- maybeToList <$> mkExtraObjToLinkIntoBinary logger tmpfs opts unit_state
+ noteLinkObjs <- mkNoteObjsToLinkIntoBinary logger tmpfs opts unit_env dep_units
+ wasmGlobalRegsObj <- maybeToList <$> mkWasmGlobalRegsObj logger tmpfs opts unit_env
+
+ let
+ (pre_hs_libs, post_hs_libs)
+ | leWholeArchiveHsLibs opts
+ = if platformOS platform == OSDarwin
+ then (["-Wl,-all_load"], [])
+ -- OS X does not have a flag to turn off -all_load
+ else (["-Wl,--whole-archive"], ["-Wl,--no-whole-archive"])
+ | otherwise
+ = ([],[])
+
+ pkg_link_opts <- do
+ let supports_verbatim = ldSupportsVerbatimNamespace (leLdConfig opts)
+ let blm = leLinkMode opts
+ unit_link_opts <- getUnitLinkOpts namever ways_ (Just (blm, supports_verbatim)) unit_env dep_units
+ return $ otherFlags unit_link_opts ++ dead_strip
+ ++ pre_hs_libs ++ hsLibs unit_link_opts ++ post_hs_libs
+ ++ extraLibs unit_link_opts
+ ++ (if blm == FullyStatic then ["-static"] else [])
+ -- -Wl,-u, contained in other_flags
+ -- needs to be put before -l,
+ -- otherwise Solaris linker fails linking
+ -- a binary with unresolved symbols in RTS
+ -- which are defined in base package
+ -- the reason for this is a note in ld(1) about
+ -- '-u' option: "The placement of this option
+ -- on the command line is significant.
+ -- This option must be placed before the library
+ -- that defines the symbol."
+
+ -- frameworks
+ pkg_framework_opts <- getUnitFrameworkOpts unit_env dep_units
+ let framework_opts = getFrameworkOpts (leFrameworkOpts opts) platform
+
+ -- probably _stub.o files
+ let extra_ld_inputs = leInputs opts
+
+ rc_objs <- case platformOS platform of
+ OSMinGW32 | leGenManifest opts -> maybeCreateManifest logger tmpfs (leManifestOpts opts) output_fn
+ _ -> return []
+
+ let linker_config = leLinkerConfig opts
+ let args = ( map GHC.SysTools.Option verbFlags
+ ++ [ GHC.SysTools.Option "-o"
+ , GHC.SysTools.FileOption "" output_fn
+ ]
+ ++ libmLinkOpts platform
+ ++ map GHC.SysTools.Option (
+ []
+
+ -- See Note [No PIE when linking]
+ ++ lePieOpts opts
+
+ -- Permit the linker to auto link _symbol to _imp_symbol.
+ -- This lets us link against DLLs without needing an "import library".
+ ++ (if platformOS platform == OSMinGW32
+ then ["-Wl,--enable-auto-import"]
+ else [])
+
+ -- '-no_compact_unwind'
+ -- C++/Objective-C exceptions cannot use optimised
+ -- stack unwinding code. The optimised form is the
+ -- default in Xcode 4 on at least x86_64, and
+ -- without this flag we're also seeing warnings
+ -- like
+ -- ld: warning: could not create compact unwind for .LFB3: non-standard register 5 being saved in prolog
+ -- on x86.
+ ++ (if not (leCompactUnwind opts) &&
+ linkerSupportsCompactUnwind (leLinkerConfig opts) &&
+ (platformOS platform == OSDarwin) &&
+ case platformArch platform of
+ ArchX86_64 -> True
+ ArchAArch64 -> True
+ _ -> False
+ then ["-Wl,-no_compact_unwind"]
+ else [])
+
+ -- We should rather be asking does it support --gc-sections?
+ ++ (if linkerIsGnuLd (leLinkerConfig opts) &&
+ not (leWholeArchiveHsLibs opts)
+ then ["-Wl,--gc-sections"]
+ else [])
+
+ -- See Note [Export dynamic symbols for GHC API programs]
+ ++ (if leLinkMode opts /= FullyStatic &&
+ any ((== "ghc") . unitPackageNameString) pkgs
+ then case platformOS platform of
+ os | osElfTarget os -> ["-rdynamic"]
+ OSDarwin -> ["-Wl,-flat_namespace"]
+ _ -> []
+ else [])
+
+ ++ o_files
+ ++ lib_path_opts)
+ ++ extra_ld_inputs
+ ++ map GHC.SysTools.Option (
+ rc_objs
+ ++ framework_opts
+ ++ pkg_lib_path_opts
+ ++ extraLinkObj
+ ++ noteLinkObjs
+ ++ wasmGlobalRegsObj
+ -- See Note [RTS/ghc-internal interface]
+ -- (-u must come before -lghc-internal...!)
+ ++ (if ghcInternalUnitId `elem` map unitId pkgs
+ then [concat [ "-Wl,-u,"
+ , ['_' | platformLeadingUnderscore platform]
+ , "init_ghc_hs_iface" ]]
+ else [])
+ ++ pkg_link_opts
+ ++ pkg_framework_opts
+ ++ (if platformOS platform == OSDarwin
+ -- dead_strip_dylibs, will remove unused dylibs, and thus save
+ -- space in the load commands. The -headerpad is necessary so
+ -- that we can inject more @rpath's later for the left over
+ -- libraries during runInjectRpaths phase.
+ --
+ -- See Note [Dynamic linking on macOS].
+ then [ "-Wl,-dead_strip_dylibs", "-Wl,-headerpad,8000" ]
+ else [])
+ ))
+
+ let require_cxx = any ((==) (PackageName (fsLit "system-cxx-std-lib")) . unitPackageName) pkgs
+ runLink logger tmpfs linker_config require_cxx args
+
+ -- Make sure to honour -fno-use-rpaths if set on darwin as well; see #20004
+ when (platformOS platform == OSDarwin && leRPath opts) $
+ GHC.Linker.MacOS.runInjectRPaths logger (leOtoolConfig opts) (leInstallNameConfig opts) pkg_lib_paths output_fn
+
+mkExtraObj :: Logger -> TmpFs -> TempDir -> CcConfig -> UnitState -> Suffix -> String -> IO FilePath
+mkExtraObj logger tmpfs tmpdir cc_config unit_state extn xs
+ = do
+ -- Pass a different set of options to the C compiler depending one whether
+ -- we're compiling C or assembler. When compiling C, we pass the usual
+ -- set of include directories and PIC flags.
+ let
+ depClosure :: UnitState -> [UnitInfo] -> [UnitInfo]
+ depClosure us initial = go [] initial
+ where
+ go seen [] = seen
+ go seen (ui:uis)
+ | ui `elem` seen = go seen uis
+ | otherwise =
+ let deps = map (unsafeLookupUnitId us) (unitDepends ui)
+ in go (ui:seen) (deps ++ uis)
+ let cOpts = map Option (ccPicOpts cc_config)
+ ++ map (FileOption "-I")
+ (collectIncludeDirs $ depClosure unit_state [unsafeLookupUnit unit_state rtsUnit])
+ cFile <- newTempName logger tmpfs tmpdir TFL_CurrentModule extn
+ oFile <- newTempName logger tmpfs tmpdir TFL_GhcSession "o"
+ writeFile cFile xs
+ runCc Nothing logger tmpfs tmpdir cc_config
+ ([Option "-c",
+ FileOption "" cFile,
+ Option "-o",
+ FileOption "" oFile]
+ ++ if extn /= "s"
+ then cOpts
+ else [])
+ return oFile
+
+-- | Create object containing main() entry point
+--
+-- When linking a binary, we need to create a C main() function that
+-- starts everything off. This used to be compiled statically as part
+-- of the RTS, but that made it hard to change the -rtsopts setting,
+-- so now we generate and compile a main() stub as part of every
+-- binary and pass the -rtsopts setting directly to the RTS (#5373)
+mkExtraObjToLinkIntoBinary :: Logger -> TmpFs -> ExecutableLinkOpts -> UnitState -> IO (Maybe FilePath)
+mkExtraObjToLinkIntoBinary logger tmpfs opts unit_state = do
+ when (leNoHsMain opts && leHaveRtsOptsFlags opts) $
+ logInfo logger $ withPprStyle defaultUserStyle
+ (text "Warning: -rtsopts and -with-rtsopts have no effect with -no-hs-main." $$
+ text " Call hs_init_ghc() from your main() function to set these options.")
+
+ if leNoHsMain opts
+ -- Don't try to build the extra object if it is not needed. Compiling the
+ -- extra object assumes the presence of the RTS in the unit database
+ -- (because the extra object imports Rts.h) but GHC's build system may try
+ -- to build some helper programs before building and registering the RTS!
+ -- See #18938 for an example where hp2ps failed to build because of a failed
+ -- (unsafe) lookup for the RTS in the unit db.
+ then pure Nothing
+ else mk_extra_obj exeMain
+
+ where
+ tmpdir = leTempDir opts
+ cc_config = leCcConfig opts
+ mk_extra_obj = fmap Just . mkExtraObj logger tmpfs tmpdir cc_config unit_state "c" . renderWithContext defaultSDocContext
+
+ exeMain = vcat [
+ text "#include ",
+ text "extern StgClosure " <> text (leMainSymbol opts) <> text "_closure;",
+ text "int main(int argc, char *argv[])",
+ char '{',
+ text " RtsConfig __conf = defaultRtsConfig;",
+ text " __conf.rts_opts_enabled = "
+ <> text (show (leRtsOptsEnabled opts)) <> semi,
+ text " __conf.rts_opts_suggestions = "
+ <> (if leRtsOptsSuggestions opts
+ then text "true"
+ else text "false") <> semi,
+ text "__conf.keep_cafs = "
+ <> (if leKeepCafs opts
+ then text "true"
+ else text "false") <> semi,
+ case leRtsOpts opts of
+ Nothing -> Outputable.empty
+ Just rts_opts -> text " __conf.rts_opts= " <>
+ text (show rts_opts) <> semi,
+ text " __conf.rts_hs_main = true;",
+ text " return hs_main(argc,argv,&" <> text (leMainSymbol opts) <> text "_closure,__conf);",
+ char '}',
+ char '\n' -- final newline, to keep gcc happy
+ ]
+
+-- Write out the link info section into a new assembly file. Previously
+-- this was included as inline assembly in the main.c file but this
+-- is pretty fragile. gas gets upset trying to calculate relative offsets
+-- that span the .note section (notably .text) when debug info is present
+mkNoteObjsToLinkIntoBinary :: Logger -> TmpFs -> ExecutableLinkOpts -> UnitEnv -> [UnitId] -> IO [FilePath]
+mkNoteObjsToLinkIntoBinary logger tmpfs opts unit_env dep_packages = do
+ link_info <- initLinkInfo opts unit_env dep_packages
+
+ if (platformSupportsSavingLinkOpts (platformOS platform ))
+ then fmap (:[]) $ mkExtraObj logger tmpfs tmpdir cc_config unit_state "s" (renderWithContext defaultSDocContext (link_opts link_info))
+ else return []
+
+ where
+ unit_state = ue_homeUnitState unit_env
+ platform = ue_platform unit_env
+ tmpdir = leTempDir opts
+ cc_config = leCcConfig opts
+ link_opts info = hcat
+ [ -- "link info" section (see Note [LinkInfo section])
+ makeElfNote platform ghcLinkInfoSectionName ghcLinkInfoNoteName 0 (show info)
+
+ -- ALL generated assembly must have this section to disable
+ -- executable stacks. See also
+ -- "GHC.CmmToAsm" for another instance
+ -- where we need to do this.
+ , if platformHasGnuNonexecStack platform
+ then text ".section .note.GNU-stack,\"\","
+ <> sectionType platform "progbits" <> char '\n'
+ else Outputable.empty
+ ]
+
+-- | Compile WASM GlobalRegs on-demand for executable linking
+--
+-- WASM executables (both static and dynamic) need STG GlobalRegs injected
+-- at link time. These cannot be in the RTS because they would get linked
+-- into libraries and conflict with dyld.mjs (which supplies GlobalRegs for
+-- GHCi/Template Haskell at runtime).
+--
+-- This function compiles rts/wasm/WasmGlobalRegs.S to WasmGlobalRegs.o
+-- on-demand during executable linking and returns the path.
+--
+-- See Note [WASM GlobalRegs Linking] in rts/wasm/WasmGlobalRegs.S
+mkWasmGlobalRegsObj :: Logger -> TmpFs -> ExecutableLinkOpts -> UnitEnv -> IO (Maybe FilePath)
+mkWasmGlobalRegsObj logger tmpfs opts unit_env
+ | ArchWasm32 <- platformArch platform = do
+ let unit_state = ue_homeUnitState unit_env
+ let rts_info = unsafeLookupUnit unit_state rtsUnit
+
+ -- Search for WasmGlobalRegs.S in multiple locations:
+ -- 1. PRIMARY: Package data directory (proper Cabal mechanism)
+ -- 2. FALLBACK: Relative to RTS library directory (in-tree builds)
+ -- 3. DEVELOPMENT: Source tree fallback
+ let rts_lib_dirs = collectLibraryDirs (leWays opts) [rts_info]
+ search_paths =
+ [ -- PRIMARY: Package data directory (installed by Cabal data-files)
+ -- e.g., /wasm/WasmGlobalRegs.S
+ ST.unpack data_dir "wasm" "WasmGlobalRegs.S"
+ | Just data_dir <- [unitDataDir rts_info]
+ ] ++
+ [ -- FALLBACK: Relative to library directory (in-tree builds)
+ -- e.g., /../wasm/WasmGlobalRegs.S
+ lib_dir ".." "wasm" "WasmGlobalRegs.S"
+ | lib_dir <- rts_lib_dirs
+ ] ++
+ [ -- DEVELOPMENT: Source tree fallback
+ "rts" "wasm" "WasmGlobalRegs.S"
+ ]
+
+ -- Find first existing path
+ found_paths <- filterM doesFileExist search_paths
+ case found_paths of
+ (wasm_source:_) -> do
+ -- Compile WasmGlobalRegs.S to WasmGlobalRegs.o
+ -- Use "S" (uppercase) so clang runs the C preprocessor on the file,
+ -- expanding CPP macros such as W_ (#define W_ i32) and processing
+ -- the #include directives for ghcconfig.h / DerivedConstants.h.
+ -- Using "s" (lowercase) would skip CPP and leave W_ unexpanded,
+ -- causing "Unknown type in .globaltype directive: W_" errors.
+ obj <- mkExtraObj logger tmpfs (leTempDir opts) (leCcConfig opts) unit_state "S"
+ =<< readFile wasm_source
+ return (Just obj)
+ [] -> do
+ -- Source file not found - this is a build configuration error
+ let msg = "WASM executable linking requires rts/wasm/WasmGlobalRegs.S but file not found.\n" ++
+ "Searched in:\n" ++ unlines (map (" - " ++) search_paths)
+ logMsg logger errorDiagnostic noSrcSpan $ text msg
+ return Nothing
+ | otherwise = return Nothing
+ where
+ platform = ue_platform unit_env
+
+data LinkInfo = LinkInfo
+ { liPkgLinkOpts :: UnitLinkOpts
+ , liPkgFrameworks :: [String]
+ , liRtsOpts :: Maybe String
+ , liRtsOptsEnabled :: !RtsOptsEnabled
+ , liNoHsMain :: !Bool
+ , liLdInputs :: [String]
+ , liLdOpts :: [String]
+ }
+ deriving (Show)
+
+
+-- | Return the "link info"
+--
+-- See Note [LinkInfo section]
+initLinkInfo :: ExecutableLinkOpts -> UnitEnv -> [UnitId] -> IO LinkInfo
+initLinkInfo opts unit_env dep_packages = do
+ package_link_opts <- getUnitLinkOpts (leNameVersion opts) (leWays opts) (Just (leLinkMode opts, ldSupportsVerbatimNamespace (leLdConfig opts))) unit_env dep_packages
+ pkg_frameworks <- if not (platformUsesFrameworks (ue_platform unit_env))
+ then return []
+ else do
+ ps <- mayThrowUnitErr (preloadUnitsInfo' unit_env dep_packages)
+ return (collectFrameworks ps)
+ pure $ LinkInfo
+ { liPkgLinkOpts = package_link_opts
+ , liPkgFrameworks = pkg_frameworks
+ , liRtsOpts = leRtsOpts opts
+ , liRtsOptsEnabled = leRtsOptsEnabled opts
+ , liNoHsMain = leNoHsMain opts
+ , liLdInputs = map showOpt (leInputs opts)
+ , liLdOpts = map showOpt (linkerOptionsPost (leLinkerConfig opts))
+ }
+
+platformSupportsSavingLinkOpts :: OS -> Bool
+platformSupportsSavingLinkOpts os
+ | os == OSSolaris2 = False -- see #5382
+ | otherwise = osElfTarget os
+
+-- See Note [LinkInfo section]
+ghcLinkInfoSectionName :: String
+ghcLinkInfoSectionName = ".debug-ghc-link-info"
+ -- if we use the ".debug" prefix, then strip will strip it by default
+
+-- Identifier for the note (see Note [LinkInfo section])
+ghcLinkInfoNoteName :: String
+ghcLinkInfoNoteName = "GHC link info"
+
+-- Returns 'False' if it was, and we can avoid linking, because the
+-- previous binary was linked with "the same options".
+checkLinkInfo :: Logger -> ExecutableLinkOpts -> UnitEnv -> [UnitId] -> FilePath -> IO Bool
+checkLinkInfo logger opts unit_env pkg_deps exe_file
+ | not (platformSupportsSavingLinkOpts (platformOS (ue_platform unit_env)))
+ -- ToDo: Windows and OS X do not use the ELF binary format, so
+ -- readelf does not work there. We need to find another way to do
+ -- this.
+ = return False -- conservatively we should return True, but not
+ -- linking in this case was the behaviour for a long
+ -- time so we leave it as-is.
+ | otherwise
+ = do
+ link_info <- initLinkInfo opts unit_env pkg_deps
+ debugTraceMsg logger 3 $ text ("Link info: " ++ show link_info)
+ m_exe_link_info <- readElfNoteAsString logger exe_file
+ ghcLinkInfoSectionName ghcLinkInfoNoteName
+ let sameLinkInfo = (Just (show link_info) == m_exe_link_info)
+ debugTraceMsg logger 3 $ case m_exe_link_info of
+ Nothing -> text "Exe link info: Not found"
+ Just s
+ | sameLinkInfo -> text ("Exe link info is the same")
+ | otherwise -> text ("Exe link info is different: " ++ s)
+ return (not sameLinkInfo)
+
+{- Note [LinkInfo section]
+ ~~~~~~~~~~~~~~~~~~~~~~~
+
+The "link info" is a string representing the parameters of the link. We save
+this information in the binary, and the next time we link, if nothing else has
+changed, we use the link info stored in the existing binary to decide whether
+to re-link or not.
+
+The "link info" string is stored in a ELF section called ".debug-ghc-link-info"
+(see ghcLinkInfoSectionName) with the SHT_NOTE type. For some time, it used to
+not follow the specified record-based format (see #11022).
+
+-}
+
+{-
+Note [-Xlinker -rpath vs -Wl,-rpath]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+-Wl takes a comma-separated list of options which in the case of
+-Wl,-rpath -Wl,some,path,with,commas parses the path with commas
+as separate options.
+Buck, the build system, produces paths with commas in them.
+
+-Xlinker doesn't have this disadvantage and as far as I can tell
+it is supported by both gcc and clang. Anecdotally nvcc supports
+-Xlinker, but not -Wl.
+-}
+
+{-
+Note [Export dynamic symbols for GHC API programs]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Programs linking against the ghc package need to export symbols from
+the RTS to dynamically loaded libraries. When running GHCi or Template
+Haskell, these programs load Haskell shared libraries via dlopen() that
+reference RTS symbols like stg_INTLIKE_closure. Without exporting these
+symbols from the executable, dlopen will fail with "undefined symbol".
+
+Platform-specific solutions:
+ Linux/FreeBSD: -rdynamic (passes --export-dynamic to ld)
+ macOS: -flat_namespace (makes all symbols visible across namespaces)
+ Windows: not needed (--enable-auto-import handles this)
+
+We apply this unconditionally for non-static executables linking against the
+ghc package, regardless of whether -dynamic is passed. This is because the
+GHC API may load shared libraries at runtime (via dlopen) even when the
+executable itself wasn't compiled with -dynamic. We only skip this for
+FullyStatic executables since they won't be loading dynamic libraries.
+
+This is the same issue that ghc-iserv faces, and is documented in
+utils/ghc-iserv/ghc-iserv.cabal.in as Note [ghc-iserv and dynamic symbol export].
+-}
+
diff --git a/compiler/GHC/Linker/External.hs b/compiler/GHC/Linker/External.hs
index cd013971c7b8..41bc9764e7a7 100644
--- a/compiler/GHC/Linker/External.hs
+++ b/compiler/GHC/Linker/External.hs
@@ -14,13 +14,19 @@ import GHC.SysTools.Process
import GHC.Linker.Config
-- | Run the external linker
-runLink :: Logger -> TmpFs -> LinkerConfig -> [Option] -> IO ()
-runLink logger tmpfs cfg args = traceSystoolCommand logger "linker" $ do
+runLink :: Logger -> TmpFs -> LinkerConfig -> Bool -> [Option] -> IO ()
+runLink logger tmpfs cfg require_cxx args = traceSystoolCommand logger "linker" $ do
let all_args = linkerOptionsPre cfg ++ args ++ linkerOptionsPost cfg
-- on Windows, mangle environment variables to account for a bug in Windows
-- Vista
mb_env <- getGccEnv all_args
+
+ -- sneakily switch to C++ compiler when we need C++ standard lib
+ let prog
+ | require_cxx = linkerCXX cfg
+ | otherwise = linkerC cfg
+ -- FIXME: ld flags may be totally inappropriate for the C++ compiler?
runSomethingResponseFile logger tmpfs (linkerTempDir cfg) (linkerFilter cfg)
- "Linker" (linkerProgram cfg) all_args mb_env
+ "Linker" prog all_args mb_env
diff --git a/compiler/GHC/Linker/ExtraObj.hs b/compiler/GHC/Linker/ExtraObj.hs
deleted file mode 100644
index a26a31eed7c3..000000000000
--- a/compiler/GHC/Linker/ExtraObj.hs
+++ /dev/null
@@ -1,257 +0,0 @@
------------------------------------------------------------------------------
---
--- GHC Extra object linking code
---
--- (c) The GHC Team 2017
---
------------------------------------------------------------------------------
-
-module GHC.Linker.ExtraObj
- ( mkExtraObj
- , mkExtraObjToLinkIntoBinary
- , mkNoteObjsToLinkIntoBinary
- , checkLinkInfo
- , getLinkInfo
- , ghcLinkInfoSectionName
- , ghcLinkInfoNoteName
- , platformSupportsSavingLinkOpts
- , haveRtsOptsFlags
- )
-where
-
-import GHC.Prelude
-import GHC.Platform
-
-import GHC.Unit
-import GHC.Unit.Env
-
-import GHC.Utils.Asm
-import GHC.Utils.Error
-import GHC.Utils.Misc
-import GHC.Utils.Outputable as Outputable
-import GHC.Utils.Logger
-import GHC.Utils.TmpFs
-
-import GHC.Driver.Session
-import GHC.Driver.Ppr
-
-import qualified GHC.Data.ShortText as ST
-
-import GHC.SysTools.Elf
-import GHC.SysTools.Tasks
-import GHC.Linker.Unit
-
-import Control.Monad
-import Data.Maybe
-
-mkExtraObj :: Logger -> TmpFs -> DynFlags -> UnitState -> Suffix -> String -> IO FilePath
-mkExtraObj logger tmpfs dflags unit_state extn xs
- = do cFile <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule extn
- oFile <- newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession "o"
- writeFile cFile xs
- runCc Nothing logger tmpfs dflags
- ([Option "-c",
- FileOption "" cFile,
- Option "-o",
- FileOption "" oFile]
- ++ if extn /= "s"
- then cOpts
- else [])
- return oFile
- where
- -- Pass a different set of options to the C compiler depending one whether
- -- we're compiling C or assembler. When compiling C, we pass the usual
- -- set of include directories and PIC flags.
- cOpts = map Option (picCCOpts dflags)
- ++ map (FileOption "-I" . ST.unpack)
- (unitIncludeDirs $ unsafeLookupUnit unit_state rtsUnit)
-
--- When linking a binary, we need to create a C main() function that
--- starts everything off. This used to be compiled statically as part
--- of the RTS, but that made it hard to change the -rtsopts setting,
--- so now we generate and compile a main() stub as part of every
--- binary and pass the -rtsopts setting directly to the RTS (#5373)
---
--- On Windows, when making a shared library we also may need a DllMain.
---
-mkExtraObjToLinkIntoBinary :: Logger -> TmpFs -> DynFlags -> UnitState -> IO (Maybe FilePath)
-mkExtraObjToLinkIntoBinary logger tmpfs dflags unit_state = do
- when (gopt Opt_NoHsMain dflags && haveRtsOptsFlags dflags) $
- logInfo logger $ withPprStyle defaultUserStyle
- (text "Warning: -rtsopts and -with-rtsopts have no effect with -no-hs-main." $$
- text " Call hs_init_ghc() from your main() function to set these options.")
-
- case ghcLink dflags of
- -- Don't try to build the extra object if it is not needed. Compiling the
- -- extra object assumes the presence of the RTS in the unit database
- -- (because the extra object imports Rts.h) but GHC's build system may try
- -- to build some helper programs before building and registering the RTS!
- -- See #18938 for an example where hp2ps failed to build because of a failed
- -- (unsafe) lookup for the RTS in the unit db.
- _ | gopt Opt_NoHsMain dflags
- -> return Nothing
-
- LinkDynLib
- | OSMinGW32 <- platformOS (targetPlatform dflags)
- -> mk_extra_obj dllMain
-
- | otherwise
- -> return Nothing
-
- _ -> mk_extra_obj exeMain
-
- where
- mk_extra_obj = fmap Just . mkExtraObj logger tmpfs dflags unit_state "c" . showSDoc dflags
-
- exeMain = vcat [
- text "#include ",
- text "extern StgClosure ZCMain_main_closure;",
- text "int main(int argc, char *argv[])",
- char '{',
- text " RtsConfig __conf = defaultRtsConfig;",
- text " __conf.rts_opts_enabled = "
- <> text (show (rtsOptsEnabled dflags)) <> semi,
- text " __conf.rts_opts_suggestions = "
- <> (if rtsOptsSuggestions dflags
- then text "true"
- else text "false") <> semi,
- text "__conf.keep_cafs = "
- <> (if gopt Opt_KeepCAFs dflags
- then text "true"
- else text "false") <> semi,
- case rtsOpts dflags of
- Nothing -> Outputable.empty
- Just opts -> text " __conf.rts_opts= " <>
- text (show opts) <> semi,
- text " __conf.rts_hs_main = true;",
- text " return hs_main(argc,argv,&ZCMain_main_closure,__conf);",
- char '}',
- char '\n' -- final newline, to keep gcc happy
- ]
-
- dllMain = vcat [
- text "#include ",
- text "#include ",
- text "#include ",
- char '\n',
- text "bool",
- text "WINAPI",
- text "DllMain ( HINSTANCE hInstance STG_UNUSED",
- text " , DWORD reason STG_UNUSED",
- text " , LPVOID reserved STG_UNUSED",
- text " )",
- text "{",
- text " return true;",
- text "}",
- char '\n' -- final newline, to keep gcc happy
- ]
-
--- Write out the link info section into a new assembly file. Previously
--- this was included as inline assembly in the main.c file but this
--- is pretty fragile. gas gets upset trying to calculate relative offsets
--- that span the .note section (notably .text) when debug info is present
-mkNoteObjsToLinkIntoBinary :: Logger -> TmpFs -> DynFlags -> UnitEnv -> [UnitId] -> IO [FilePath]
-mkNoteObjsToLinkIntoBinary logger tmpfs dflags unit_env dep_packages = do
- link_info <- getLinkInfo dflags unit_env dep_packages
-
- if (platformSupportsSavingLinkOpts (platformOS platform ))
- then fmap (:[]) $ mkExtraObj logger tmpfs dflags unit_state "s" (showSDoc dflags (link_opts link_info))
- else return []
-
- where
- unit_state = ue_homeUnitState unit_env
- platform = ue_platform unit_env
- link_opts info = hcat
- [ -- "link info" section (see Note [LinkInfo section])
- makeElfNote platform ghcLinkInfoSectionName ghcLinkInfoNoteName 0 info
-
- -- ALL generated assembly must have this section to disable
- -- executable stacks. See also
- -- "GHC.CmmToAsm" for another instance
- -- where we need to do this.
- , if platformHasGnuNonexecStack platform
- then text ".section .note.GNU-stack,\"\","
- <> sectionType platform "progbits" <> char '\n'
- else Outputable.empty
- ]
-
--- | Return the "link info" string
---
--- See Note [LinkInfo section]
-getLinkInfo :: DynFlags -> UnitEnv -> [UnitId] -> IO String
-getLinkInfo dflags unit_env dep_packages = do
- package_link_opts <- getUnitLinkOpts (ghcNameVersion dflags) (ways dflags) unit_env dep_packages
- pkg_frameworks <- if not (platformUsesFrameworks (ue_platform unit_env))
- then return []
- else do
- ps <- mayThrowUnitErr (preloadUnitsInfo' unit_env dep_packages)
- return (collectFrameworks ps)
- let link_info =
- ( package_link_opts
- , pkg_frameworks
- , rtsOpts dflags
- , rtsOptsEnabled dflags
- , gopt Opt_NoHsMain dflags
- , map showOpt (ldInputs dflags)
- , getOpts dflags opt_l
- )
- return (show link_info)
-
-platformSupportsSavingLinkOpts :: OS -> Bool
-platformSupportsSavingLinkOpts os
- | os == OSSolaris2 = False -- see #5382
- | otherwise = osElfTarget os
-
--- See Note [LinkInfo section]
-ghcLinkInfoSectionName :: String
-ghcLinkInfoSectionName = ".debug-ghc-link-info"
- -- if we use the ".debug" prefix, then strip will strip it by default
-
--- Identifier for the note (see Note [LinkInfo section])
-ghcLinkInfoNoteName :: String
-ghcLinkInfoNoteName = "GHC link info"
-
--- Returns 'False' if it was, and we can avoid linking, because the
--- previous binary was linked with "the same options".
-checkLinkInfo :: Logger -> DynFlags -> UnitEnv -> [UnitId] -> FilePath -> IO Bool
-checkLinkInfo logger dflags unit_env pkg_deps exe_file
- | not (platformSupportsSavingLinkOpts (platformOS (ue_platform unit_env)))
- -- ToDo: Windows and OS X do not use the ELF binary format, so
- -- readelf does not work there. We need to find another way to do
- -- this.
- = return False -- conservatively we should return True, but not
- -- linking in this case was the behaviour for a long
- -- time so we leave it as-is.
- | otherwise
- = do
- link_info <- getLinkInfo dflags unit_env pkg_deps
- debugTraceMsg logger 3 $ text ("Link info: " ++ link_info)
- m_exe_link_info <- readElfNoteAsString logger exe_file
- ghcLinkInfoSectionName ghcLinkInfoNoteName
- let sameLinkInfo = (Just link_info == m_exe_link_info)
- debugTraceMsg logger 3 $ case m_exe_link_info of
- Nothing -> text "Exe link info: Not found"
- Just s
- | sameLinkInfo -> text ("Exe link info is the same")
- | otherwise -> text ("Exe link info is different: " ++ s)
- return (not sameLinkInfo)
-
-{- Note [LinkInfo section]
- ~~~~~~~~~~~~~~~~~~~~~~~
-
-The "link info" is a string representing the parameters of the link. We save
-this information in the binary, and the next time we link, if nothing else has
-changed, we use the link info stored in the existing binary to decide whether
-to re-link or not.
-
-The "link info" string is stored in a ELF section called ".debug-ghc-link-info"
-(see ghcLinkInfoSectionName) with the SHT_NOTE type. For some time, it used to
-not follow the specified record-based format (see #11022).
-
--}
-
-haveRtsOptsFlags :: DynFlags -> Bool
-haveRtsOptsFlags dflags =
- isJust (rtsOpts dflags) || case rtsOptsEnabled dflags of
- RtsOptsSafeOnly -> False
- _ -> True
diff --git a/compiler/GHC/Linker/Loader.hs b/compiler/GHC/Linker/Loader.hs
index 96624742ba30..b9b4399d4bf0 100644
--- a/compiler/GHC/Linker/Loader.hs
+++ b/compiler/GHC/Linker/Loader.hs
@@ -49,6 +49,7 @@ import GHC.Driver.Session
import GHC.Driver.Ppr
import GHC.Driver.Config.Diagnostic
import GHC.Driver.Config.Finder
+import GHC.Driver.DynFlags (rtsWayUnitId)
import GHC.Tc.Utils.Monad
@@ -95,6 +96,8 @@ import GHC.Linker.Deps
import GHC.Linker.MacOS
import GHC.Linker.Dynamic
import GHC.Linker.Types
+import GHC.Linker.Unit
+import GHC.Linker.ArchivePrelink
-- Standard libraries
import Control.Monad
@@ -175,8 +178,8 @@ getLoaderState :: Interp -> IO (Maybe LoaderState)
getLoaderState interp = readMVar (loader_state (interpLoader interp))
-emptyLoaderState :: LoaderState
-emptyLoaderState = LoaderState
+emptyLoaderState :: UnitEnv -> DynFlags -> LoaderState
+emptyLoaderState unit_env dflags = LoaderState
{ linker_env = LinkerEnv
{ closure_env = emptyNameEnv
, itbl_env = emptyNameEnv
@@ -196,7 +199,16 @@ emptyLoaderState = LoaderState
--
-- The linker's symbol table is populated with RTS symbols using an
-- explicit list. See rts/Linker.c for details.
- where init_pkgs = unitUDFM rtsUnitId (LoadedPkgInfo rtsUnitId [] [] [] emptyUniqDSet)
+ where deps = getUnitDepends unit_env rtsUnitId
+ pkg_to_dfm unit_id = (unit_id, (LoadedPkgInfo unit_id [] [] [] emptyUniqDSet))
+ init_pkgs = let addToUDFM' (k, v) m = addToUDFM m k v
+ in foldr addToUDFM' emptyUDFM $ [
+ pkg_to_dfm rtsUnitId,
+ -- FIXME? Should this be the rtsWayUnitId of the current ghc, or the one
+ -- for the target build? I think target-build seems right, but I'm
+ -- not fully convinced.
+ pkg_to_dfm (rtsWayUnitId dflags)
+ ] ++ fmap pkg_to_dfm deps
extendLoadedEnv :: Interp -> [(Name,ForeignHValue)] -> IO ()
extendLoadedEnv interp new_bindings =
@@ -336,7 +348,7 @@ initLoaderState interp hsc_env = do
reallyInitLoaderState :: Interp -> HscEnv -> IO LoaderState
reallyInitLoaderState interp hsc_env = do
-- Initialise the linker state
- let pls0 = emptyLoaderState
+ let pls0 = emptyLoaderState (hsc_unit_env hsc_env) (hsc_dflags hsc_env)
case platformArch (targetPlatform (hsc_dflags hsc_env)) of
-- FIXME: we don't initialize anything with the JS interpreter.
@@ -393,6 +405,7 @@ loadCmdLineLibs'' interp hsc_env pls =
, libraryPaths = lib_paths_base})
= hsc_dflags hsc_env
let logger = hsc_logger hsc_env
+ let ld_config = configureLd dflags
-- (c) Link libraries from the command-line
let minus_ls_1 = [ lib | Option ('-':'l':lib) <- cmdline_ld_inputs ]
@@ -408,7 +421,7 @@ loadCmdLineLibs'' interp hsc_env pls =
OSMinGW32 -> "pthread" : minus_ls_1
_ -> minus_ls_1
-- See Note [Fork/Exec Windows]
- gcc_paths <- getGCCPaths logger dflags os
+ gcc_paths <- getGCCPaths logger platform ld_config
lib_paths_env <- addEnvPaths "LIBRARY_PATH" lib_paths_base
@@ -807,11 +820,19 @@ loadObjects interp hsc_env pls objs = do
let (objs_loaded', new_objs) = rmDupLinkables (objs_loaded pls) objs
pls1 = pls { objs_loaded = objs_loaded' }
wanted_objs = concatMap linkableFiles new_objs
+ logger = hsc_logger hsc_env
+ dflags = hsc_dflags hsc_env
+ tmpfs = hsc_tmpfs hsc_env
if interpreterDynamic interp
then do pls2 <- dynLoadObjs interp hsc_env pls1 wanted_objs
return (pls2, Succeeded)
- else do mapM_ (loadObj interp) wanted_objs
+ else do
+ -- Prelink large archives before loading (see Note [Archive Prelinking])
+ objs_to_load <- mapM (prelinkIfNeeded logger tmpfs dflags) wanted_objs
+
+ -- Load objects (prelinked or original)
+ mapM_ (loadObj interp) objs_to_load
-- Link them all together
ok <- resolveObjs interp
@@ -823,6 +844,26 @@ loadObjects interp hsc_env pls objs = do
else do
pls2 <- unload_wkr interp [] pls1
return (pls2, Failed)
+ where
+ -- | Check if an object/archive should be prelinked, and if so, prelink it.
+ -- Returns the path to load (either prelinked object or original path).
+ -- Fallback to original path on any error.
+ prelinkIfNeeded :: Logger -> TmpFs -> DynFlags -> FilePath -> IO FilePath
+ prelinkIfNeeded logger tmpfs dflags obj_path = do
+ should_prelink <- shouldPrelinkArchive dflags obj_path
+ if should_prelink
+ then do
+ debugTraceMsg logger 3 $ text "Checking if prelinking needed:" <+> text obj_path
+ m_prelinked <- prelinkArchive logger tmpfs dflags obj_path
+ case m_prelinked of
+ Just prelinked -> do
+ debugTraceMsg logger 2 $ text "Using prelinked object:" <+> text prelinked
+ return prelinked
+ Nothing -> do
+ debugTraceMsg logger 3 $ text "Prelinking failed or skipped, using original"
+ return obj_path
+ else
+ return obj_path
-- | Create a shared library containing the given object files and load it.
@@ -1161,18 +1202,12 @@ loadPackage interp hsc_env pkg
= do
let dflags = hsc_dflags hsc_env
let logger = hsc_logger hsc_env
+ ld_config = configureLd dflags
platform = targetPlatform dflags
is_dyn = interpreterDynamic interp
- dirs | is_dyn = map ST.unpack $ Packages.unitLibraryDynDirs pkg
- | otherwise = map ST.unpack $ Packages.unitLibraryDirs pkg
+ dirs = libraryDirsForWay' is_dyn pkg
let hs_libs = map ST.unpack $ Packages.unitLibraries pkg
- -- The FFI GHCi import lib isn't needed as
- -- GHC.Linker.Loader + rts/Linker.c link the
- -- interpreted references to FFI to the compiled FFI.
- -- We therefore filter it out so that we don't get
- -- duplicate symbol errors.
- hs_libs' = filter ("HSffi" /=) hs_libs
-- Because of slight differences between the GHC dynamic linker and
-- the native system linker some packages have to link with a
@@ -1188,11 +1223,11 @@ loadPackage interp hsc_env pkg
extra_libs = extdeplibs ++ linkerlibs
-- See Note [Fork/Exec Windows]
- gcc_paths <- getGCCPaths logger dflags (platformOS platform)
+ gcc_paths <- getGCCPaths logger platform ld_config
dirs_env <- addEnvPaths "LIBRARY_PATH" dirs
hs_classifieds
- <- mapM (locateLib interp hsc_env True dirs_env gcc_paths) hs_libs'
+ <- mapM (locateLib interp hsc_env True dirs_env gcc_paths) hs_libs
extra_classifieds
<- mapM (locateLib interp hsc_env False dirs_env gcc_paths) extra_libs
let classifieds = hs_classifieds ++ extra_classifieds
@@ -1301,21 +1336,29 @@ restriction very easily.
-- ("/usr/lib/libfoo.so"), or unqualified ("libfoo.so"). In the latter case,
-- loadDLL is going to search the system paths to find the library.
load_dyn :: Interp -> HscEnv -> Bool -> FilePath -> IO (Maybe (RemotePtr LoadedDLL))
-load_dyn interp hsc_env crash_early dll = do
- r <- loadDLL interp dll
- case r of
- Right loaded_dll -> pure (Just loaded_dll)
- Left err ->
- if crash_early
- then cmdLineErrorIO err
- else do
- when (diag_wopt Opt_WarnMissedExtraSharedLib diag_opts)
- $ logMsg logger
- (mkMCDiagnostic diag_opts (WarningWithFlag Opt_WarnMissedExtraSharedLib) Nothing)
- noSrcSpan $ withPprStyle defaultUserStyle (note err)
- pure Nothing
+load_dyn interp hsc_env crash_early dll
+ -- See Note [Skip loading libc/libm on Unix]
+ -- Skip loading fundamental system libraries that are always linked into the process.
+ -- On some systems, loading these via dlopen can load a different version than what
+ -- the interpreter is linked against, causing memory corruption.
+ | isAlwaysLinkedLib platform dll = pure Nothing
+ | otherwise = do
+ r <- loadDLL interp dll
+ case r of
+ Right loaded_dll -> pure (Just loaded_dll)
+ Left err ->
+ if crash_early
+ then cmdLineErrorIO err
+ else do
+ when (diag_wopt Opt_WarnMissedExtraSharedLib diag_opts)
+ $ logMsg logger
+ (mkMCDiagnostic diag_opts (WarningWithFlag Opt_WarnMissedExtraSharedLib) Nothing)
+ noSrcSpan $ withPprStyle defaultUserStyle (note err)
+ pure Nothing
where
- diag_opts = initDiagOpts (hsc_dflags hsc_env)
+ dflags = hsc_dflags hsc_env
+ platform = targetPlatform dflags
+ diag_opts = initDiagOpts dflags
logger = hsc_logger hsc_env
note err = vcat $ map text
[ err
@@ -1323,6 +1366,20 @@ load_dyn interp hsc_env crash_early dll = do
, "(the package DLL is loaded by the system linker"
, " which manages dependencies by itself)." ]
+-- | Check if a library name refers to a fundamental system library that is
+-- always linked into any process. On Unix, libc, libm, libpthread, libdl, and
+-- librt are always available. We skip loading these to avoid loading a second
+-- copy (which can happen on systems where the dynamic linker finds a different
+-- version than what was linked).
+isAlwaysLinkedLib :: Platform -> FilePath -> Bool
+isAlwaysLinkedLib platform dll
+ | platformOS platform == OSMinGW32 = False -- Windows handles this differently
+ | otherwise = baseName `elem` alwaysLinkedLibs
+ where
+ -- Extract base library name from paths like "libc.so", "libc.so.6", "/path/to/libc.so.6"
+ baseName = takeBaseName $ takeFileName dll
+ alwaysLinkedLibs = ["libc", "libm", "libpthread", "libdl", "librt"]
+
loadFrameworks :: Interp -> Platform -> UnitInfo -> IO ()
loadFrameworks interp platform pkg
= when (platformUsesFrameworks platform) $ mapM_ load frameworks
@@ -1405,6 +1462,7 @@ locateLib interp hsc_env is_hs lib_dirs gcc_dirs lib0
dflags = hsc_dflags hsc_env
logger = hsc_logger hsc_env
diag_opts = initDiagOpts dflags
+ ld_config = configureLd dflags
dirs = lib_dirs ++ gcc_dirs
gcc = False
user = True
@@ -1468,7 +1526,7 @@ locateLib interp hsc_env is_hs lib_dirs gcc_dirs lib0
findSysDll = fmap (fmap $ DLL . dropExtension . takeFileName) $
findSystemLibrary interp so_name
#endif
- tryGcc = let search = searchForLibUsingGcc logger dflags
+ tryGcc = let search = searchForLibUsingGcc logger ld_config
#if defined(CAN_LOAD_DLL)
dllpath = liftM (fmap DLLPath)
short = dllpath $ search so_name lib_dirs
@@ -1523,11 +1581,11 @@ locateLib interp hsc_env is_hs lib_dirs gcc_dirs lib0
#endif
os = platformOS platform
-searchForLibUsingGcc :: Logger -> DynFlags -> String -> [FilePath] -> IO (Maybe FilePath)
-searchForLibUsingGcc logger dflags so dirs = do
+searchForLibUsingGcc :: Logger -> LdConfig -> String -> [FilePath] -> IO (Maybe FilePath)
+searchForLibUsingGcc logger ld_config so dirs = do
-- GCC does not seem to extend the library search path (using -L) when using
-- --print-file-name. So instead pass it a new base location.
- str <- askLd logger dflags (map (FileOption "-B") dirs
+ str <- askLd logger ld_config (map (FileOption "-B") dirs
++ [Option "--print-file-name", Option so])
let file = case lines str of
[] -> ""
@@ -1539,10 +1597,10 @@ searchForLibUsingGcc logger dflags so dirs = do
-- | Retrieve the list of search directory GCC and the System use to find
-- libraries and components. See Note [Fork/Exec Windows].
-getGCCPaths :: Logger -> DynFlags -> OS -> IO [FilePath]
-getGCCPaths logger dflags os
- | os == OSMinGW32 || platformArch (targetPlatform dflags) == ArchWasm32 =
- do gcc_dirs <- getGccSearchDirectory logger dflags "libraries"
+getGCCPaths :: Logger -> Platform -> LdConfig -> IO [FilePath]
+getGCCPaths logger platform ld_config
+ | platformOS platform == OSMinGW32 || platformArch platform == ArchWasm32 =
+ do gcc_dirs <- getGccSearchDirectory logger ld_config "libraries"
sys_dirs <- getSystemDirectories
return $ nub $ gcc_dirs ++ sys_dirs
| otherwise = return []
@@ -1562,13 +1620,13 @@ gccSearchDirCache = unsafePerformIO $ newIORef []
-- which hopefully is written in an optimized manner to take advantage of
-- caching. At the very least we remove the overhead of the fork/exec and waits
-- which dominate a large percentage of startup time on Windows.
-getGccSearchDirectory :: Logger -> DynFlags -> String -> IO [FilePath]
-getGccSearchDirectory logger dflags key = do
+getGccSearchDirectory :: Logger -> LdConfig -> String -> IO [FilePath]
+getGccSearchDirectory logger ld_config key = do
cache <- readIORef gccSearchDirCache
case lookup key cache of
Just x -> return x
Nothing -> do
- str <- askLd logger dflags [Option "--print-search-dirs"]
+ str <- askLd logger ld_config [Option "--print-search-dirs"]
let line = dropWhile isSpace str
name = key ++ ": ="
if null line
diff --git a/compiler/GHC/Linker/MacOS.hs b/compiler/GHC/Linker/MacOS.hs
index 6d8970e20c0a..d730925d2ddf 100644
--- a/compiler/GHC/Linker/MacOS.hs
+++ b/compiler/GHC/Linker/MacOS.hs
@@ -17,7 +17,6 @@ import GHC.Unit.Types
import GHC.Unit.State
import GHC.Unit.Env
-import GHC.Settings
import GHC.SysTools.Tasks
import GHC.Runtime.Interpreter
@@ -49,13 +48,13 @@ import Text.ParserCombinators.ReadP as Parser
-- dynamic library through @-add_rpath@.
--
-- See Note [Dynamic linking on macOS]
-runInjectRPaths :: Logger -> ToolSettings -> [FilePath] -> FilePath -> IO ()
-runInjectRPaths logger toolSettings lib_paths dylib = do
- info <- lines <$> askOtool logger toolSettings Nothing [Option "-L", Option dylib]
+runInjectRPaths :: Logger -> OtoolConfig -> InstallNameConfig -> [FilePath] -> FilePath -> IO ()
+runInjectRPaths logger otool_opts install_name_opts lib_paths dylib = do
+ info <- lines <$> askOtool logger otool_opts Nothing [Option "-L", Option dylib]
-- filter the output for only the libraries. And then drop the @rpath prefix.
let libs = fmap (drop 7) $ filter (isPrefixOf "@rpath") $ fmap (head.words) $ info
-- find any pre-existing LC_PATH items
- info <- lines <$> askOtool logger toolSettings Nothing [Option "-l", Option dylib]
+ info <- lines <$> askOtool logger otool_opts Nothing [Option "-l", Option dylib]
let paths = mapMaybe get_rpath info
lib_paths' = [ p | p <- lib_paths, not (p `elem` paths) ]
-- only find those rpaths, that aren't already in the library.
@@ -63,7 +62,7 @@ runInjectRPaths logger toolSettings lib_paths dylib = do
-- inject the rpaths
case rpaths of
[] -> return ()
- _ -> runInstallNameTool logger toolSettings $ map Option $ "-add_rpath":(intersperse "-add_rpath" rpaths) ++ [dylib]
+ _ -> runInstallNameTool logger install_name_opts $ map Option $ "-add_rpath":(intersperse "-add_rpath" rpaths) ++ [dylib]
get_rpath :: String -> Maybe FilePath
get_rpath l = case readP_to_S rpath_parser l of
diff --git a/compiler/GHC/Linker/Static.hs b/compiler/GHC/Linker/Static.hs
index e92e438fefe1..2595c7794d13 100644
--- a/compiler/GHC/Linker/Static.hs
+++ b/compiler/GHC/Linker/Static.hs
@@ -1,6 +1,5 @@
module GHC.Linker.Static
- ( linkBinary
- , linkStaticLib
+ ( linkStaticLib
)
where
@@ -11,6 +10,7 @@ import GHC.Settings
import GHC.SysTools
import GHC.SysTools.Ar
+import GHC.SysTools.Tasks (configureRanlib, runRanlib)
import GHC.Unit.Env
import GHC.Unit.Types
@@ -19,24 +19,17 @@ import GHC.Unit.State
import GHC.Utils.Logger
import GHC.Utils.Monad
-import GHC.Utils.Misc
-import GHC.Utils.TmpFs
-import GHC.Linker.MacOS
import GHC.Linker.Unit
-import GHC.Linker.Dynamic
-import GHC.Linker.ExtraObj
-import GHC.Linker.External
-import GHC.Linker.Windows
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
-import Data.Maybe
-----------------------------------------------------------------------------
-- Static linking, of .o files
@@ -51,225 +44,6 @@ import Data.Maybe
-- read any interface files), so the user must explicitly specify all
-- the packages.
-{-
-Note [-Xlinker -rpath vs -Wl,-rpath]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
--Wl takes a comma-separated list of options which in the case of
--Wl,-rpath -Wl,some,path,with,commas parses the path with commas
-as separate options.
-Buck, the build system, produces paths with commas in them.
-
--Xlinker doesn't have this disadvantage and as far as I can tell
-it is supported by both gcc and clang. Anecdotally nvcc supports
--Xlinker, but not -Wl.
--}
-
-linkBinary :: Logger -> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
-linkBinary = linkBinary' False
-
-linkBinary' :: Bool -> Logger -> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
-linkBinary' staticLink logger tmpfs dflags unit_env o_files dep_units = do
- let platform = ue_platform unit_env
- unit_state = ue_homeUnitState unit_env
- toolSettings' = toolSettings dflags
- verbFlags = getVerbFlags dflags
- arch_os = platformArchOS platform
- output_fn = exeFileName arch_os staticLink (outputFile_ dflags)
- namever = ghcNameVersion dflags
- -- For the wasm target, when ghc is invoked with -dynamic,
- -- when linking the final .wasm binary we must still ensure
- -- the static archives are selected. Otherwise wasm-ld would
- -- fail to find and link the .so library dependencies. wasm-ld
- -- can link PIC objects into static .wasm binaries fine, so we
- -- only adjust the ways in the final linking step, and only
- -- when linking .wasm binary (which is supposed to be fully
- -- static), not when linking .so shared libraries.
- ways_
- | ArchWasm32 <- platformArch platform = removeWay WayDyn $ targetWays_ dflags
- | otherwise = ways dflags
-
- full_output_fn <- if isAbsolute output_fn
- then return output_fn
- else do d <- getCurrentDirectory
- return $ normalise (d output_fn)
-
- -- get the full list of packages to link with, by combining the
- -- explicit packages with the auto packages and all of their
- -- dependencies, and eliminating duplicates.
- pkgs <- mayThrowUnitErr (preloadUnitsInfo' unit_env dep_units)
- let pkg_lib_paths = collectLibraryDirs ways_ pkgs
- let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths
- get_pkg_lib_path_opts l
- | osElfTarget (platformOS platform) &&
- dynLibLoader dflags == SystemDependent &&
- ways_ `hasWay` WayDyn
- = let libpath = if gopt Opt_RelativeDynlibPaths dflags
- then "$ORIGIN"
- (l `makeRelativeTo` full_output_fn)
- else l
- -- See Note [-Xlinker -rpath vs -Wl,-rpath]
- rpath = if useXLinkerRPath dflags (platformOS platform)
- then ["-Xlinker", "-rpath", "-Xlinker", libpath]
- else []
- -- Solaris 11's linker does not support -rpath-link option. It silently
- -- ignores it and then complains about next option which is -l as being a directory and not expected object file, E.g
- -- ld: elf error: file
- -- /tmp/ghc-src/libraries/base/dist-install/build:
- -- elf_begin: I/O error: region read: Is a directory
- rpathlink = if (platformOS platform) == OSSolaris2
- then []
- else ["-Xlinker", "-rpath-link", "-Xlinker", l]
- in ["-L" ++ l] ++ rpathlink ++ rpath
- | osMachOTarget (platformOS platform) &&
- dynLibLoader dflags == SystemDependent &&
- ways_ `hasWay` WayDyn &&
- useXLinkerRPath dflags (platformOS platform)
- = let libpath = if gopt Opt_RelativeDynlibPaths dflags
- then "@loader_path"
- (l `makeRelativeTo` full_output_fn)
- else l
- in ["-L" ++ l] ++ ["-Xlinker", "-rpath", "-Xlinker", libpath]
- | otherwise = ["-L" ++ l]
-
- pkg_lib_path_opts <-
- if gopt Opt_SingleLibFolder dflags
- then do
- libs <- getLibs namever ways_ unit_env dep_units
- tmpDir <- newTempSubDir logger tmpfs (tmpDir dflags)
- sequence_ [ copyFile lib (tmpDir basename)
- | (lib, basename) <- libs]
- return [ "-L" ++ tmpDir ]
- else pure pkg_lib_path_opts
-
- let
- dead_strip
- | gopt Opt_WholeArchiveHsLibs dflags = []
- | otherwise = if osSubsectionsViaSymbols (platformOS platform)
- then ["-Wl,-dead_strip"]
- else []
- let lib_paths = libraryPaths dflags
- let lib_path_opts = map ("-L"++) lib_paths
-
- extraLinkObj <- maybeToList <$> mkExtraObjToLinkIntoBinary logger tmpfs dflags unit_state
- noteLinkObjs <- mkNoteObjsToLinkIntoBinary logger tmpfs dflags unit_env dep_units
-
- let
- (pre_hs_libs, post_hs_libs)
- | gopt Opt_WholeArchiveHsLibs dflags
- = if platformOS platform == OSDarwin
- then (["-Wl,-all_load"], [])
- -- OS X does not have a flag to turn off -all_load
- else (["-Wl,--whole-archive"], ["-Wl,--no-whole-archive"])
- | otherwise
- = ([],[])
-
- pkg_link_opts <- do
- unit_link_opts <- getUnitLinkOpts namever ways_ unit_env dep_units
- return $ otherFlags unit_link_opts ++ dead_strip
- ++ pre_hs_libs ++ hsLibs unit_link_opts ++ post_hs_libs
- ++ extraLibs unit_link_opts
- -- -Wl,-u, contained in other_flags
- -- needs to be put before -l,
- -- otherwise Solaris linker fails linking
- -- a binary with unresolved symbols in RTS
- -- which are defined in base package
- -- the reason for this is a note in ld(1) about
- -- '-u' option: "The placement of this option
- -- on the command line is significant.
- -- This option must be placed before the library
- -- that defines the symbol."
-
- -- frameworks
- pkg_framework_opts <- getUnitFrameworkOpts unit_env dep_units
- let framework_opts = getFrameworkOpts (initFrameworkOpts dflags) platform
-
- -- probably _stub.o files
- let extra_ld_inputs = ldInputs dflags
-
- rc_objs <- case platformOS platform of
- OSMinGW32 | gopt Opt_GenManifest dflags -> maybeCreateManifest logger tmpfs dflags output_fn
- _ -> return []
-
- let linker_config = initLinkerConfig dflags
- 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
- when (platformOS platform == OSDarwin && gopt Opt_RPath dflags) $
- GHC.Linker.MacOS.runInjectRPaths logger (toolSettings dflags) pkg_lib_paths output_fn
-
- link dflags (
- map GHC.SysTools.Option verbFlags
- ++ [ GHC.SysTools.Option "-o"
- , GHC.SysTools.FileOption "" output_fn
- ]
- ++ libmLinkOpts platform
- ++ map GHC.SysTools.Option (
- []
-
- -- See Note [No PIE when linking]
- ++ pieCCLDOpts dflags
-
- -- Permit the linker to auto link _symbol to _imp_symbol.
- -- This lets us link against DLLs without needing an "import library".
- ++ (if platformOS platform == OSMinGW32
- then ["-Wl,--enable-auto-import"]
- else [])
-
- -- '-no_compact_unwind'
- -- C++/Objective-C exceptions cannot use optimised
- -- stack unwinding code. The optimised form is the
- -- default in Xcode 4 on at least x86_64, and
- -- without this flag we're also seeing warnings
- -- like
- -- ld: warning: could not create compact unwind for .LFB3: non-standard register 5 being saved in prolog
- -- on x86.
- ++ (if not (gopt Opt_CompactUnwind dflags) &&
- toolSettings_ldSupportsCompactUnwind toolSettings' &&
- (platformOS platform == OSDarwin) &&
- case platformArch platform of
- ArchX86_64 -> True
- ArchAArch64 -> True
- _ -> False
- then ["-Wl,-no_compact_unwind"]
- else [])
-
- -- We should rather be asking does it support --gc-sections?
- ++ (if toolSettings_ldIsGnuLd toolSettings' &&
- not (gopt Opt_WholeArchiveHsLibs dflags)
- then ["-Wl,--gc-sections"]
- else [])
-
- ++ o_files
- ++ lib_path_opts)
- ++ extra_ld_inputs
- ++ map GHC.SysTools.Option (
- rc_objs
- ++ framework_opts
- ++ pkg_lib_path_opts
- ++ extraLinkObj
- ++ noteLinkObjs
- -- See Note [RTS/ghc-internal interface]
- -- (-u must come before -lghc-internal...!)
- ++ (if ghcInternalUnitId `elem` map unitId pkgs
- then [concat [ "-Wl,-u,"
- , ['_' | platformLeadingUnderscore platform]
- , "init_ghc_hs_iface" ]]
- else [])
- ++ pkg_link_opts
- ++ pkg_framework_opts
- ++ (if platformOS platform == OSDarwin
- -- dead_strip_dylibs, will remove unused dylibs, and thus save
- -- space in the load commands. The -headerpad is necessary so
- -- that we can inject more @rpath's later for the left over
- -- libraries during runInjectRpaths phase.
- --
- -- See Note [Dynamic linking on macOS].
- then [ "-Wl,-dead_strip_dylibs", "-Wl,-headerpad,8000" ]
- else [])
- ))
-
-- | Linking a static lib will not really link anything. It will merely produce
-- a static archive of all dependent static libraries. The resulting library
-- will still need to be linked with any remaining link flags.
@@ -296,7 +70,7 @@ linkStaticLib logger dflags unit_env o_files dep_units = do
| gopt Opt_LinkRts dflags
= pkg_cfgs_init
| otherwise
- = filter ((/= rtsUnitId) . unitId) pkg_cfgs_init
+ = filter ((/= PackageName (fsLit "rts")) . unitPackageName) pkg_cfgs_init
archives <- concatMapM (collectArchives namever ways_) pkg_cfgs
@@ -309,4 +83,4 @@ linkStaticLib logger dflags unit_env o_files dep_units = do
else writeBSDAr output_fn $ afilter (not . isBSDSymdef) ar
-- run ranlib over the archive. write*Ar does *not* create the symbol index.
- runRanlib logger dflags [GHC.SysTools.FileOption "" output_fn]
+ runRanlib logger (configureRanlib dflags) [GHC.SysTools.FileOption "" output_fn]
diff --git a/compiler/GHC/Linker/Types.hs b/compiler/GHC/Linker/Types.hs
index 07ca22683808..0cf21fe34e12 100644
--- a/compiler/GHC/Linker/Types.hs
+++ b/compiler/GHC/Linker/Types.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
-----------------------------------------------------------------------------
--
diff --git a/compiler/GHC/Linker/Unit.hs b/compiler/GHC/Linker/Unit.hs
index 652a515b4859..6e2e51087f04 100644
--- a/compiler/GHC/Linker/Unit.hs
+++ b/compiler/GHC/Linker/Unit.hs
@@ -6,9 +6,11 @@ module GHC.Linker.Unit
, collectArchives
, getUnitLinkOpts
, getLibs
+ , getUnitDepends
)
where
+import GHC.Driver.DynFlags
import GHC.Prelude
import GHC.Platform.Ways
import GHC.Unit.Types
@@ -16,12 +18,15 @@ import GHC.Unit.Info
import GHC.Unit.State
import GHC.Unit.Env
import GHC.Utils.Misc
+import GHC.Utils.Panic
import qualified GHC.Data.ShortText as ST
import GHC.Settings
import Control.Monad
+import Data.List (nub)
+import Data.Semigroup ( Semigroup(..) )
import System.Directory
import System.FilePath
@@ -33,19 +38,56 @@ data UnitLinkOpts = UnitLinkOpts
}
deriving (Show)
+instance Semigroup UnitLinkOpts where
+ (UnitLinkOpts l1 el1 of1) <> (UnitLinkOpts l2 el2 of2) = (UnitLinkOpts (l1 <> l2) (el1 <> el2) (of1 <> of2))
+
+instance Monoid UnitLinkOpts where
+ mempty = UnitLinkOpts [] [] []
+
-- | Find all the link options in these and the preload packages,
-- returning (package hs lib options, extra library options, other flags)
-getUnitLinkOpts :: GhcNameVersion -> Ways -> UnitEnv -> [UnitId] -> IO UnitLinkOpts
-getUnitLinkOpts namever ways unit_env pkgs = do
+getUnitLinkOpts :: GhcNameVersion -> Ways -> Maybe (ExecutableLinkMode, Bool) -> UnitEnv -> [UnitId] -> IO UnitLinkOpts
+getUnitLinkOpts namever ways mExecutableLinkMode unit_env pkgs = do
ps <- mayThrowUnitErr $ preloadUnitsInfo' unit_env pkgs
- return (collectLinkOpts namever ways ps)
+ collectLinkOpts namever ways mExecutableLinkMode ps
-collectLinkOpts :: GhcNameVersion -> Ways -> [UnitInfo] -> UnitLinkOpts
-collectLinkOpts namever ways ps = UnitLinkOpts
- { hsLibs = concatMap (map ("-l" ++) . unitHsLibs namever ways) ps
- , extraLibs = concatMap (map ("-l" ++) . map ST.unpack . unitExtDepLibsSys) ps
- , otherFlags = concatMap (map ST.unpack . unitLinkerOptions) ps
- }
+collectLinkOpts :: GhcNameVersion -> Ways -> Maybe (ExecutableLinkMode, Bool) -> [UnitInfo] -> IO UnitLinkOpts
+collectLinkOpts namever ways mExecutableLinkMode ps = do
+ fmap mconcat $ forM ps $ \pc -> do
+ extraLibs <- getExtraLibs pc
+ pure UnitLinkOpts
+ { hsLibs = map ("-l" ++) . unitHsLibs namever ways $ pc
+ , extraLibs = extraLibs
+ , otherFlags = map ST.unpack . unitLinkerOptions $ pc
+ }
+ where
+ -- extra libs can be represented in different ways, depending on the platform and how we link:
+ -- * static linking on most system: -l:libfoo.a -l:libbar.a
+ -- * static linking on e.g. mac: /some/path/libfoo.a /some/path/libbar.a
+ -- * dynamic linking: -lfoo -lbar
+ getExtraLibs pc
+ -- We don't do anything here for 'FullyStatic', because appending '-static' to the linker is enough.
+ | Just (MostlyStatic exclLibs, supportsVerbatim) <- mExecutableLinkMode
+ = do
+ let allLibs = map ST.unpack . unitExtDepLibsStaticSys $ pc
+ staticLibs = filter (`notElem` exclLibs) allLibs
+ dynamicLibs = filter (`elem` exclLibs) allLibs
+ dynamicLinkOpts = map ("-l" ++) dynamicLibs
+ staticLinkOpts <- if supportsVerbatim
+ then pure (map (\d -> "-l:lib" ++ d ++ ".a") staticLibs)
+ else do forM staticLibs $ \l -> do
+ archives <- filterM doesFileExist
+ [ searchPath ("lib" ++ l ++ ".a")
+ | searchPath <- (nub . filter notNull . map ST.unpack . unitLibraryDirsStatic $ pc)
+ ]
+ case archives of
+ [] -> throwGhcExceptionIO (ProgramError $ "Failed to find static archive of " ++ show l)
+ -- prefer the "last" as is the canonical way for linker options
+ xs -> pure $ last xs
+ pure (staticLinkOpts ++ dynamicLinkOpts)
+ | Just (FullyStatic, _) <- mExecutableLinkMode
+ = pure . map ("-l" ++) . map ST.unpack . unitExtDepLibsStaticSys $ pc
+ | otherwise = pure . map ("-l" ++) . map ST.unpack . unitExtDepLibsSys $ pc
collectArchives :: GhcNameVersion -> Ways -> UnitInfo -> IO [FilePath]
collectArchives namever ways pc =
@@ -53,13 +95,7 @@ collectArchives namever ways pc =
| searchPath <- searchPaths
, lib <- libs ]
where searchPaths = ordNub . filter notNull . libraryDirsForWay ways $ pc
- libs = unitHsLibs namever ways pc ++ map ST.unpack (unitExtDepLibsSys pc)
-
--- | Either the 'unitLibraryDirs' or 'unitLibraryDynDirs' as appropriate for the way.
-libraryDirsForWay :: Ways -> UnitInfo -> [String]
-libraryDirsForWay ws
- | hasWay ws WayDyn = map ST.unpack . unitLibraryDynDirs
- | otherwise = map ST.unpack . unitLibraryDirs
+ libs = unitHsLibs namever ways pc ++ (map ST.unpack . unitExtDepLibsStaticSys $ pc)
getLibs :: GhcNameVersion -> Ways -> UnitEnv -> [UnitId] -> IO [(String,String)]
getLibs namever ways unit_env pkgs = do
@@ -69,3 +105,9 @@ getLibs namever ways unit_env pkgs = do
, f <- (\n -> "lib" ++ n ++ ".a") <$> unitHsLibs namever ways p ]
filterM (doesFileExist . fst) candidates
+getUnitDepends :: HasDebugCallStack => UnitEnv -> UnitId -> [UnitId]
+getUnitDepends unit_env pkg =
+ let unit_state = ue_homeUnitState unit_env
+ unit_info = unsafeLookupUnitId unit_state pkg
+ in (unitDepends unit_info)
+
diff --git a/compiler/GHC/Linker/Windows.hs b/compiler/GHC/Linker/Windows.hs
index b09f68f5db0b..88dba27335dc 100644
--- a/compiler/GHC/Linker/Windows.hs
+++ b/compiler/GHC/Linker/Windows.hs
@@ -1,5 +1,7 @@
module GHC.Linker.Windows
- ( maybeCreateManifest
+ ( ManifestOpts (..)
+ , initManifestOpts
+ , maybeCreateManifest
)
where
@@ -12,13 +14,28 @@ import GHC.Utils.Logger
import System.FilePath
import System.Directory
+data ManifestOpts = ManifestOpts
+ { manifestEmbed :: !Bool -- ^ Should the manifest be embedded in the binary with Windres
+ , manifestTempdir :: TempDir
+ , manifestWindresConfig :: WindresConfig
+ , manifestObjectSuf :: String
+ }
+
+initManifestOpts :: DynFlags -> ManifestOpts
+initManifestOpts dflags = ManifestOpts
+ { manifestEmbed = gopt Opt_EmbedManifest dflags
+ , manifestTempdir = tmpDir dflags
+ , manifestWindresConfig = configureWindres dflags
+ , manifestObjectSuf = objectSuf dflags
+ }
+
maybeCreateManifest
:: Logger
-> TmpFs
- -> DynFlags
+ -> ManifestOpts
-> FilePath -- ^ filename of executable
-> IO [FilePath] -- ^ extra objects to embed, maybe
-maybeCreateManifest logger tmpfs dflags exe_filename = do
+maybeCreateManifest logger tmpfs opts exe_filename = do
let manifest_filename = exe_filename <.> "manifest"
manifest =
"\n\
@@ -42,18 +59,18 @@ maybeCreateManifest logger tmpfs dflags exe_filename = do
-- foo.exe.manifest. However, for extra robustness, and so that
-- we can move the binary around, we can embed the manifest in
-- the binary itself using windres:
- if not (gopt Opt_EmbedManifest dflags)
+ if not (manifestEmbed opts)
then return []
else do
- rc_filename <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "rc"
+ rc_filename <- newTempName logger tmpfs (manifestTempdir opts) TFL_CurrentModule "rc"
rc_obj_filename <-
- newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession (objectSuf dflags)
+ newTempName logger tmpfs (manifestTempdir opts) TFL_GhcSession (manifestObjectSuf opts)
writeFile rc_filename $
"1 24 MOVEABLE PURE \"" ++ manifest_filename ++ "\"\n"
-- magic numbers :-)
- runWindres logger dflags $ map GHC.SysTools.Option $
+ runWindres logger (manifestWindresConfig opts) $ map GHC.SysTools.Option $
["--input="++rc_filename,
"--output="++rc_obj_filename,
"--output-format=coff"]
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index 98261979e633..22f968dafcc3 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -1949,7 +1949,7 @@ rule :: { LRuleDecl GhcPs }
, rd_bndrs = ruleBndrsOrDef $3
, rd_lhs = $4, rd_rhs = $6 }) }
--- Rules can be specified to be NeverActive, unlike inline/specialize pragmas
+-- Rules can be specified to be never active, unlike inline/specialize pragmas
rule_activation :: { (ActivationAnn, Maybe Activation) }
-- See Note [%shift: rule_activation -> {- empty -}]
: {- empty -} %shift { (noAnn, Nothing) }
@@ -1973,14 +1973,14 @@ rule_activation_marker :: { (Maybe (EpToken "~")) }
rule_explicit_activation :: { ( ActivationAnn
, Activation) } -- In brackets
- : '[' INTEGER ']' { ( ActivationAnn (epTok $1) (epTok $3) Nothing (Just (glR $2))
- , ActiveAfter (getINTEGERs $2) (fromInteger (il_value (getINTEGER $2)))) }
+ : '[' INTEGER ']' { ( ActivationAnn (epTok $1) (getINTEGERs $2) (epTok $3) Nothing (Just (glR $2))
+ , ActiveAfter (fromInteger (il_value (getINTEGER $2)))) }
| '[' rule_activation_marker INTEGER ']'
- { ( ActivationAnn (epTok $1) (epTok $4) $2 (Just (glR $3))
- , ActiveBefore (getINTEGERs $3) (fromInteger (il_value (getINTEGER $3)))) }
+ { ( ActivationAnn (epTok $1) (getINTEGERs $3) (epTok $4) $2 (Just (glR $3))
+ , ActiveBefore (fromInteger (il_value (getINTEGER $3)))) }
| '[' rule_activation_marker ']'
- { ( ActivationAnn (epTok $1) (epTok $3) $2 Nothing
- , NeverActive) }
+ { ( ActivationAnn (epTok $1) NoSourceText (epTok $3) $2 Nothing
+ , NeverActive ) }
rule_foralls :: { Maybe (RuleBndrs GhcPs) }
: 'forall' rule_vars '.' 'forall' rule_vars '.'
@@ -2825,11 +2825,11 @@ activation :: { (ActivationAnn,Maybe Activation) }
| explicit_activation { (fst $1,Just (snd $1)) }
explicit_activation :: { (ActivationAnn, Activation) } -- In brackets
- : '[' INTEGER ']' { (ActivationAnn (epTok $1) (epTok $3) Nothing (Just (glR $2))
- ,ActiveAfter (getINTEGERs $2) (fromInteger (il_value (getINTEGER $2)))) }
+ : '[' INTEGER ']' { (ActivationAnn (epTok $1) (getINTEGERs $2) (epTok $3) Nothing (Just (glR $2))
+ ,ActiveAfter (fromInteger (il_value (getINTEGER $2)))) }
| '[' rule_activation_marker INTEGER ']'
- { (ActivationAnn (epTok $1) (epTok $4) $2 (Just (glR $3))
- ,ActiveBefore (getINTEGERs $3) (fromInteger (il_value (getINTEGER $3)))) }
+ { (ActivationAnn (epTok $1) (getINTEGERs $3) (epTok $4) $2 (Just (glR $3))
+ ,ActiveBefore (fromInteger (il_value (getINTEGER $3)))) }
-----------------------------------------------------------------------------
-- Expressions
diff --git a/compiler/GHC/Platform/Ways.hs b/compiler/GHC/Platform/Ways.hs
index ca5bd7c9381f..56e36896b486 100644
--- a/compiler/GHC/Platform/Ways.hs
+++ b/compiler/GHC/Platform/Ways.hs
@@ -146,7 +146,7 @@ wayGeneralFlags :: Platform -> Way -> [GeneralFlag]
wayGeneralFlags _ (WayCustom {}) = []
wayGeneralFlags _ WayThreaded = []
wayGeneralFlags _ WayDebug = []
-wayGeneralFlags _ WayDyn = [Opt_PIC, Opt_ExternalDynamicRefs]
+wayGeneralFlags _ WayDyn = [Opt_PIC, Opt_ExternalDynamicRefs]
-- We could get away without adding -fPIC when compiling the
-- modules of a program that is to be linked with -dynamic; the
-- program itself does not need to be position-independent, only
@@ -154,6 +154,10 @@ wayGeneralFlags _ WayDyn = [Opt_PIC, Opt_ExternalDynamicRefs]
-- .so before loading the .so using the system linker. Since only
-- PIC objects can be linked into a .so, we have to compile even
-- modules of the main program with -fPIC when using -dynamic.
+ --
+ -- Note: For WASM, this is especially important as dyld.mjs can
+ -- only load PIC objects for GHCi/Template Haskell. WASM executables
+ -- handle GlobalRegs differently - see GHC.Linker.Executable.mkWasmGlobalRegsObj
wayGeneralFlags _ WayProf = []
-- | Turn these flags off when enabling this way
diff --git a/compiler/GHC/Runtime/Heap/Inspect.hs b/compiler/GHC/Runtime/Heap/Inspect.hs
index 5c38f20be8c5..885a21d22cc6 100644
--- a/compiler/GHC/Runtime/Heap/Inspect.hs
+++ b/compiler/GHC/Runtime/Heap/Inspect.hs
@@ -34,6 +34,7 @@ module GHC.Runtime.Heap.Inspect(
constrClosToName -- exported to use in test T4891
) where
+#ifndef BOOTSTRAPPING
import GHC.Prelude hiding (head, init, last, tail)
import GHC.Platform
@@ -1474,3 +1475,91 @@ quantifyType ty = ( filter isTyVar $
, ty)
where
(_tvs, _, rho) = tcSplitNestedSigmaTys ty
+
+#else
+import GHC.Prelude
+import GHC.Types.Name
+import GHC.Core.DataCon
+import GHC.Core.Type
+import GHC.Utils.Outputable
+import GHC.Types.Var.Set
+import GHC.Driver.Env
+import GHCi.RemoteTypes
+import GHC.InfoProv
+import GHC.Types.Basic (Boxity)
+import GHC.Utils.Panic
+
+-- Dummy types
+data ClosureType = DummyClosureType
+data GenClosure a = DummyGenClosure
+
+type RttiType = Type
+
+data Term = Term { ty :: RttiType
+ , dc :: Either String DataCon
+ , val :: ForeignHValue
+ , subTerms :: [Term] }
+ | Prim { ty :: RttiType
+ , valRaw :: [Word] }
+ | Suspension { ctype :: ClosureType
+ , ty :: RttiType
+ , val :: ForeignHValue
+ , bound_to :: Maybe Name
+ , infoprov :: Maybe InfoProv
+ }
+ | NewtypeWrap{ ty :: RttiType
+ , dc :: Either String DataCon
+ , wrapped_term :: Term }
+ | RefWrap { ty :: RttiType
+ , wrapped_term :: Term }
+
+-- Dummy functions
+cvObtainTerm :: HscEnv -> Int -> Bool -> RttiType -> ForeignHValue -> IO Term
+cvObtainTerm _ _ _ ty _ = return (Prim ty []) -- Dummy return
+
+cvReconstructType :: HscEnv -> Int -> RttiType -> ForeignHValue -> IO (Maybe RttiType)
+cvReconstructType _ _ _ _ = return Nothing
+
+improveRTTIType :: HscEnv -> RttiType -> RttiType -> Maybe Subst
+improveRTTIType _ _ _ = Nothing
+
+isFullyEvaluatedTerm :: Term -> Bool
+isFullyEvaluatedTerm _ = False
+
+termType :: Term -> RttiType
+termType t = ty t
+
+mapTermType :: (RttiType -> Type) -> Term -> Term
+mapTermType _ t = t
+
+termTyCoVars :: Term -> TyCoVarSet
+termTyCoVars _ = emptyVarSet
+
+type TermProcessor a b = RttiType -> Either String DataCon -> ForeignHValue -> [a] -> b
+
+data TermFold a = TermFold { fTerm :: TermProcessor a a
+ , fPrim :: RttiType -> [Word] -> a
+ , fSuspension :: ClosureType -> RttiType -> ForeignHValue
+ -> Maybe Name -> Maybe InfoProv -> a
+ , fNewtypeWrap :: RttiType -> Either String DataCon
+ -> a -> a
+ , fRefWrap :: RttiType -> a -> a
+ }
+
+foldTerm :: TermFold a -> Term -> a
+foldTerm _ _ = panic "foldTerm: bootstrapping"
+
+type Precedence = Int
+type TermPrinterM m = Precedence -> Term -> m SDoc
+type CustomTermPrinter m = TermPrinterM m -> [Precedence -> Term -> m (Maybe SDoc)]
+
+cPprTerm :: Monad m => CustomTermPrinter m -> Term -> m SDoc
+cPprTerm _ _ = return (text "Bootstrapping Term")
+
+cPprTermBase :: Monad m => CustomTermPrinter m
+cPprTermBase _ = []
+
+constrClosToName :: HscEnv -> GenClosure a -> IO (Either String Name)
+constrClosToName _ _ = return (Left "Bootstrapping")
+
+#endif
diff --git a/compiler/GHC/Runtime/Heap/Layout.hs b/compiler/GHC/Runtime/Heap/Layout.hs
index 73e2ff9e410a..e0956185a59a 100644
--- a/compiler/GHC/Runtime/Heap/Layout.hs
+++ b/compiler/GHC/Runtime/Heap/Layout.hs
@@ -438,8 +438,8 @@ cardTableSizeW platform elems =
-----------------------------------------------------------------------------
-- deriving the RTS closure type from an SMRep
-#include "ClosureTypes.h"
-#include "FunTypes.h"
+#include "rts/storage/ClosureTypes.h"
+#include "rts/storage/FunTypes.h"
-- Defines CONSTR, CONSTR_1_0 etc
-- | Derives the RTS closure type from an 'SMRep'
diff --git a/compiler/GHC/Runtime/Interpreter.hs b/compiler/GHC/Runtime/Interpreter.hs
index 5c43cdccde9a..f020cdaed512 100644
--- a/compiler/GHC/Runtime/Interpreter.hs
+++ b/compiler/GHC/Runtime/Interpreter.hs
@@ -24,7 +24,9 @@ module GHC.Runtime.Interpreter
, storeBreakpoint
, breakpointStatus
, getBreakpointVar
+#ifndef BOOTSTRAPPING
, getClosure
+#endif
, whereFrom
, getModBreaks
, readIModBreaks
@@ -107,7 +109,9 @@ import Control.Monad.Catch as MC (mask)
import Data.Binary
import Data.ByteString (ByteString)
import Foreign hiding (void)
+#ifndef BOOTSTRAPPING
import qualified GHC.Exts.Heap as Heap
+#endif
import GHC.Stack.CCS (CostCentre,CostCentreStack)
import System.Directory
import System.Process
@@ -390,11 +394,13 @@ getBreakpointVar interp ref ix =
mb <- interpCmd interp (GetBreakpointVar apStack ix)
mapM (mkFinalizedHValue interp) mb
+#ifndef BOOTSTRAPPING
getClosure :: Interp -> ForeignHValue -> IO (Heap.GenClosure ForeignHValue)
getClosure interp ref =
withForeignRef ref $ \hval -> do
mb <- interpCmd interp (GetClosure hval)
mapM (mkFinalizedHValue interp) mb
+#endif
whereFrom :: Interp -> ForeignHValue -> IO (Maybe InfoProv.InfoProv)
whereFrom interp ref =
diff --git a/compiler/GHC/Runtime/Interpreter/C.hs b/compiler/GHC/Runtime/Interpreter/C.hs
new file mode 100644
index 000000000000..ca18e4dbed90
--- /dev/null
+++ b/compiler/GHC/Runtime/Interpreter/C.hs
@@ -0,0 +1,93 @@
+{-# LANGUAGE MultiWayIf #-}
+
+-- | External interpreter program
+module GHC.Runtime.Interpreter.C
+ ( generateIservC
+ )
+where
+
+import GHC.Prelude
+import GHC.Platform
+import GHC.Data.FastString
+import GHC.Utils.Logger
+import GHC.Utils.TmpFs
+import GHC.Unit.Types
+import GHC.Unit.Env
+import GHC.Unit.Info
+import GHC.Unit.State
+import GHC.Utils.Panic.Plain
+import GHC.Linker.Executable
+import GHC.Linker.Config
+import GHC.Utils.CliOption
+
+-- | Generate iserv program for the target
+generateIservC :: Logger -> TmpFs -> ExecutableLinkOpts -> UnitEnv -> IO FilePath
+generateIservC logger tmpfs opts unit_env = do
+ -- get the unit-id of the ghci package. We need this to load the
+ -- interpreter code.
+ let unit_state = ue_homeUnitState unit_env
+ ghci_unit_id <- case lookupPackageName unit_state (PackageName (fsLit "ghci")) of
+ Nothing -> cmdLineErrorIO "C interpreter: couldn't find \"ghci\" package"
+ Just i -> pure i
+
+ -- generate a temporary name for the iserv program
+ let tmpdir = leTempDir opts
+ exe_file <- newTempName logger tmpfs tmpdir TFL_GhcSession "iserv"
+
+ let platform = ue_platform unit_env
+ let os = platformOS platform
+
+ -- we inherit ExecutableLinkOpts for the target code (i.e. derived from
+ -- DynFlags specified by the user and from settings). We need to adjust these
+ -- options to generate the iserv program we want. Some settings are to be
+ -- shared (e.g. ways, platform, etc.) but some other must be set specifically
+ -- for iserv.
+ let opts' = opts
+ { -- write iserv program in some temporary directory
+ leOutputFile = Just exe_file
+
+ -- we need GHC to generate a main entry point...
+ , leNoHsMain = False
+
+ -- ...however the main symbol must be the iserv server
+ , leMainSymbol = zString (zEncodeFS (unitIdFS ghci_unit_id)) ++ "_GHCiziServer_defaultServer"
+
+ -- we need to reset inputs, otherwise one of them may be defining
+ -- `main` too (with -no-hs-main).
+ , leInputs = []
+
+ -- we never know what symbols GHC will look up in the future, so we
+ -- must retain CAFs for running interpreted code.
+ , leKeepCafs = True
+
+ -- enable all rts options
+ , leRtsOptsEnabled = RtsOptsAll
+
+ -- Add -Wl,--export-dynamic enables GHCi to load dynamic objects that
+ -- refer to the RTS. This is harmless if you don't use it (adds a bit
+ -- of overhead to startup and increases the binary sizes) but if you
+ -- need it there's no alternative.
+ --
+ -- The Solaris linker does not support --export-dynamic option. It also
+ -- does not need it since it exports all dynamic symbols by default.
+ --
+ -- On Darwin, -flat_namespace is needed so that the iserv process can
+ -- resolve symbols from dynamically loaded objects against its own
+ -- symbol table.
+ , leLinkerConfig = if
+ | osElfTarget os
+ , os /= OSFreeBSD
+ , os /= OSSolaris2
+ -> (leLinkerConfig opts)
+ { linkerOptionsPost = linkerOptionsPost (leLinkerConfig opts) ++ [Option "-Wl,--export-dynamic"]
+ }
+ | os == OSDarwin
+ -> (leLinkerConfig opts)
+ { linkerOptionsPost = linkerOptionsPost (leLinkerConfig opts) ++ [Option "-Wl,-flat_namespace"]
+ }
+ | otherwise
+ -> leLinkerConfig opts
+ }
+ linkExecutable logger tmpfs opts' unit_env [] [ghci_unit_id]
+
+ pure exe_file
diff --git a/compiler/GHC/Runtime/Interpreter/Init.hs b/compiler/GHC/Runtime/Interpreter/Init.hs
new file mode 100644
index 000000000000..0333e167d3d4
--- /dev/null
+++ b/compiler/GHC/Runtime/Interpreter/Init.hs
@@ -0,0 +1,163 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE MultiWayIf #-}
+
+module GHC.Runtime.Interpreter.Init
+ ( initInterpreter
+ , InterpOpts (..)
+ )
+where
+
+
+import GHC.Prelude
+import GHC.Platform
+import GHC.Platform.Ways
+import GHC.Settings
+import GHC.Unit.Finder
+import GHC.Unit.Env
+import GHC.Utils.TmpFs
+import GHC.SysTools.Tasks
+
+import GHC.Linker.Executable
+import qualified GHC.Linker.Loader as Loader
+import GHC.Runtime.Interpreter
+import GHC.Runtime.Interpreter.C
+import GHC.StgToJS.Types (StgToJSConfig)
+
+import GHC.Utils.Monad
+import GHC.Utils.Outputable
+import GHC.Utils.Logger
+import GHC.Utils.Error
+import Control.Concurrent
+import System.Process
+
+data InterpOpts = InterpOpts
+ { interpExternal :: !Bool
+ , interpProg :: String
+ , interpOpts :: [String]
+ , interpWays :: Ways
+ , interpNameVer :: GhcNameVersion
+ , interpLdConfig :: LdConfig
+ , interpCcConfig :: CcConfig
+ , interpJsInterp :: FilePath
+ , interpTmpDir :: TempDir
+ , interpFinderOpts :: FinderOpts
+ , interpJsCodegenCfg :: StgToJSConfig
+ , interpVerbosity :: Int
+ , interpCreateProcess :: Maybe (CreateProcess -> IO ProcessHandle) -- create iserv process hook
+ , interpWasmDyld :: FilePath
+ , interpBrowser :: Bool
+ , interpBrowserHost :: String
+ , interpBrowserPort :: Int
+ , interpBrowserRedirectWasiConsole :: Bool
+ , interpBrowserPuppeteerLaunchOpts :: Maybe String
+ , interpBrowserPlaywrightBrowserType :: Maybe String
+ , interpBrowserPlaywrightLaunchOpts :: Maybe String
+ , interpExecutableLinkOpts :: ExecutableLinkOpts
+ }
+
+-- | Initialize code interpreter
+initInterpreter
+ :: TmpFs
+ -> Logger
+ -> Platform
+ -> FinderCache
+ -> UnitEnv
+ -> InterpOpts
+ -> IO (Maybe Interp)
+initInterpreter tmpfs logger platform finder_cache unit_env opts = do
+
+ lookup_cache <- liftIO $ mkInterpSymbolCache
+
+ -- see Note [Target code interpreter]
+ if
+#if !defined(wasm32_HOST_ARCH)
+ -- Wasm dynamic linker
+ | ArchWasm32 <- platformArch platform
+ -> do
+ s <- liftIO $ newMVar InterpPending
+ loader <- liftIO Loader.uninitializedLoader
+ libdir <- liftIO $ last <$> Loader.getGccSearchDirectory logger (interpLdConfig opts) "libraries"
+ let profiled = interpWays opts `hasWay` WayProf
+ way_tag = if profiled then "_p" else ""
+ let cfg =
+ WasmInterpConfig
+ { wasmInterpDyLD = interpWasmDyld opts
+ , wasmInterpLibDir = libdir
+ , wasmInterpOpts = interpOpts opts
+ , wasmInterpBrowser = interpBrowser opts
+ , wasmInterpBrowserHost = interpBrowserHost opts
+ , wasmInterpBrowserPort = interpBrowserPort opts
+ , wasmInterpBrowserRedirectWasiConsole = interpBrowserRedirectWasiConsole opts
+ , wasmInterpBrowserPuppeteerLaunchOpts = interpBrowserPuppeteerLaunchOpts opts
+ , wasmInterpBrowserPlaywrightBrowserType = interpBrowserPlaywrightBrowserType opts
+ , wasmInterpBrowserPlaywrightLaunchOpts = interpBrowserPlaywrightLaunchOpts opts
+ , wasmInterpTargetPlatform = platform
+ , wasmInterpProfiled = profiled
+ , wasmInterpHsSoSuffix = way_tag ++ dynLibSuffix (interpNameVer opts)
+ , wasmInterpUnitState = ue_homeUnitState unit_env
+ }
+ pure $ Just $ Interp (ExternalInterp $ ExtWasm $ ExtInterpState cfg s) loader lookup_cache
+#endif
+
+ -- JavaScript interpreter
+ | ArchJavaScript <- platformArch platform
+ -> do
+ s <- liftIO $ newMVar InterpPending
+ loader <- liftIO Loader.uninitializedLoader
+ let cfg = JSInterpConfig
+ { jsInterpNodeConfig = defaultNodeJsSettings
+ , jsInterpScript = interpJsInterp opts
+ , jsInterpTmpFs = tmpfs
+ , jsInterpTmpDir = interpTmpDir opts
+ , jsInterpLogger = logger
+ , jsInterpCodegenCfg = interpJsCodegenCfg opts
+ , jsInterpUnitEnv = unit_env
+ , jsInterpFinderOpts = interpFinderOpts opts
+ , jsInterpFinderCache = finder_cache
+ , jsInterpRtsWays = interpWays opts
+ }
+ return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader lookup_cache))
+
+ -- external interpreter
+ | interpExternal opts
+ -> do
+ let
+ profiled = interpWays opts `hasWay` WayProf
+ dynamic = interpWays opts `hasWay` WayDyn
+ prog <- case interpProg opts of
+ -- build iserv program if none specified
+ "" -> generateIservC logger tmpfs (interpExecutableLinkOpts opts) unit_env
+ _ -> pure (interpProg opts ++ flavour)
+ where
+ flavour
+ | profiled && dynamic = "-prof-dyn"
+ | profiled = "-prof"
+ | dynamic = "-dyn"
+ | otherwise = ""
+ let msg = text "Starting " <> text prog
+ tr <- if interpVerbosity opts >= 3
+ then return (logInfo logger $ withPprStyle defaultDumpStyle msg)
+ else return (pure ())
+ let
+ conf = IServConfig
+ { iservConfProgram = prog
+ , iservConfOpts = interpOpts opts
+ , iservConfProfiled = profiled
+ , iservConfDynamic = dynamic
+ , iservConfHook = interpCreateProcess opts
+ , iservConfTrace = tr
+ }
+ s <- liftIO $ newMVar InterpPending
+ loader <- liftIO Loader.uninitializedLoader
+ return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader lookup_cache))
+
+ -- Internal interpreter
+ | otherwise
+ ->
+#if defined(HAVE_INTERNAL_INTERPRETER)
+ do
+ loader <- liftIO Loader.uninitializedLoader
+ return (Just (Interp InternalInterp loader lookup_cache))
+#else
+ return Nothing
+#endif
diff --git a/compiler/GHC/Runtime/Interpreter/JS.hs b/compiler/GHC/Runtime/Interpreter/JS.hs
index 32827e23990e..12cbdc8301b9 100644
--- a/compiler/GHC/Runtime/Interpreter/JS.hs
+++ b/compiler/GHC/Runtime/Interpreter/JS.hs
@@ -20,12 +20,14 @@ module GHC.Runtime.Interpreter.JS
)
where
+import GHC.Platform.Ways
import GHC.Prelude
import GHC.Runtime.Interpreter.Types
import GHC.Runtime.Interpreter.Process
import GHC.Runtime.Utils
import GHCi.Message
+import GHC.Driver.DynFlags
import GHC.StgToJS.Linker.Types
import GHC.StgToJS.Linker.Linker
import GHC.StgToJS.Types
@@ -36,9 +38,9 @@ import GHC.Unit.Types
import GHC.Unit.State
import GHC.Utils.Logger
+import GHC.Utils.Error
import GHC.Utils.TmpFs
import GHC.Utils.Panic
-import GHC.Utils.Error (logInfo)
import GHC.Utils.Outputable (text)
import GHC.Data.FastString
@@ -155,6 +157,7 @@ spawnJSInterp cfg = do
unit_env = jsInterpUnitEnv cfg
finder_opts = jsInterpFinderOpts cfg
finder_cache = jsInterpFinderCache cfg
+ rts_ways = jsInterpRtsWays cfg
(std_in, proc) <- startTHRunnerProcess (jsInterpScript cfg) (jsInterpNodeConfig cfg)
@@ -197,7 +200,7 @@ spawnJSInterp cfg = do
-- cf https://emscripten.org/docs/compiling/Dynamic-Linking.html
-- link rts and its deps
- jsLinkRts logger tmpfs tmp_dir codegen_cfg unit_env inst
+ jsLinkRts logger tmpfs tmp_dir codegen_cfg unit_env inst rts_ways
-- link interpreter and its deps
jsLinkInterp logger tmpfs tmp_dir codegen_cfg unit_env inst
@@ -214,8 +217,8 @@ spawnJSInterp cfg = do
---------------------------------------------------------
-- | Link JS RTS
-jsLinkRts :: Logger -> TmpFs -> TempDir -> StgToJSConfig -> UnitEnv -> ExtInterpInstance JSInterpExtra -> IO ()
-jsLinkRts logger tmpfs tmp_dir cfg unit_env inst = do
+jsLinkRts :: Logger -> TmpFs -> TempDir -> StgToJSConfig -> UnitEnv -> ExtInterpInstance JSInterpExtra -> Ways -> IO ()
+jsLinkRts logger tmpfs tmp_dir cfg unit_env inst ways = do
let link_cfg = JSLinkConfig
{ lcNoStats = True -- we don't need the stats
, lcNoRts = False -- we need the RTS
@@ -228,8 +231,9 @@ jsLinkRts logger tmpfs tmp_dir cfg unit_env inst = do
}
-- link the RTS and its dependencies (things it uses from `ghc-internal`, etc.)
+ let rts_sublib_unit_id = rtsWayUnitId' ways
let link_spec = LinkSpec
- { lks_unit_ids = [rtsUnitId, ghcInternalUnitId]
+ { lks_unit_ids = [rtsUnitId, rts_sublib_unit_id, ghcInternalUnitId]
, lks_obj_root_filter = const False
, lks_extra_roots = mempty
, lks_objs_hs = mempty
diff --git a/compiler/GHC/Runtime/Interpreter/Types.hs b/compiler/GHC/Runtime/Interpreter/Types.hs
index 6c6f9ee9c424..108d6e7e0773 100644
--- a/compiler/GHC/Runtime/Interpreter/Types.hs
+++ b/compiler/GHC/Runtime/Interpreter/Types.hs
@@ -49,9 +49,7 @@ import GHCi.RemoteTypes
import GHCi.Message ( Pipe )
import GHC.Platform
-#if defined(HAVE_INTERNAL_INTERPRETER)
import GHC.Platform.Ways
-#endif
import GHC.Utils.TmpFs
import GHC.Utils.Logger
import GHC.Unit.Env
@@ -206,6 +204,7 @@ data JSInterpConfig = JSInterpConfig
, jsInterpUnitEnv :: !UnitEnv
, jsInterpFinderOpts :: !FinderOpts
, jsInterpFinderCache :: !FinderCache
+ , jsInterpRtsWays :: !Ways
}
------------------------
diff --git a/compiler/GHC/Runtime/Loader.hs b/compiler/GHC/Runtime/Loader.hs
index a6b236441e4d..5dc5a838efbb 100644
--- a/compiler/GHC/Runtime/Loader.hs
+++ b/compiler/GHC/Runtime/Loader.hs
@@ -219,7 +219,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/Settings.hs b/compiler/GHC/Settings.hs
index 160583e69ab2..b8ec884a94e4 100644
--- a/compiler/GHC/Settings.hs
+++ b/compiler/GHC/Settings.hs
@@ -101,6 +101,7 @@ data ToolSettings = ToolSettings
, toolSettings_ldSupportsSingleModule :: Bool
, toolSettings_mergeObjsSupportsResponseFiles :: Bool
, toolSettings_ldIsGnuLd :: Bool
+ , toolSettings_ldSupportsVerbatimNamespace :: Bool
, toolSettings_ccSupportsNoPie :: Bool
, toolSettings_useInplaceMinGW :: Bool
, toolSettings_arSupportsDashL :: Bool
diff --git a/compiler/GHC/Settings/IO.hs b/compiler/GHC/Settings/IO.hs
index 28934ee6025a..63964ff02ff8 100644
--- a/compiler/GHC/Settings/IO.hs
+++ b/compiler/GHC/Settings/IO.hs
@@ -132,6 +132,7 @@ initSettings top_dir = do
ldSupportsSingleModule <- getBooleanSetting "ld supports single module"
mergeObjsSupportsResponseFiles <- getBooleanSetting "Merge objects supports response files"
ldIsGnuLd <- getBooleanSetting "ld is GNU ld"
+ ldSupportsVerbatimNamespace <- getBooleanSetting "ld supports verbatim namespace"
arSupportsDashL <- getBooleanSetting "ar supports -L"
@@ -211,6 +212,7 @@ initSettings top_dir = do
, toolSettings_ldSupportsSingleModule = ldSupportsSingleModule
, toolSettings_mergeObjsSupportsResponseFiles = mergeObjsSupportsResponseFiles
, toolSettings_ldIsGnuLd = ldIsGnuLd
+ , toolSettings_ldSupportsVerbatimNamespace = ldSupportsVerbatimNamespace
, toolSettings_ccSupportsNoPie = gccSupportsNoPie
, toolSettings_useInplaceMinGW = useInplaceMinGW
, toolSettings_arSupportsDashL = arSupportsDashL
diff --git a/compiler/GHC/StgToCmm/Layout.hs b/compiler/GHC/StgToCmm/Layout.hs
index 2f81200a2891..b93dc1854084 100644
--- a/compiler/GHC/StgToCmm/Layout.hs
+++ b/compiler/GHC/StgToCmm/Layout.hs
@@ -549,7 +549,7 @@ mkVirtConstrSizes profile field_reps
-------------------------------------------------------------------------
-- bring in ARG_P, ARG_N, etc.
-#include "FunTypes.h"
+#include "rts/storage/FunTypes.h"
mkArgDescr :: Platform -> [Id] -> ArgDescr
mkArgDescr platform args
diff --git a/compiler/GHC/StgToCmm/TagCheck.hs b/compiler/GHC/StgToCmm/TagCheck.hs
index 5b3cf2e7e1e8..18fd617c0000 100644
--- a/compiler/GHC/StgToCmm/TagCheck.hs
+++ b/compiler/GHC/StgToCmm/TagCheck.hs
@@ -12,7 +12,7 @@ module GHC.StgToCmm.TagCheck
( emitTagAssertion, emitArgTagCheck, checkArg, whenCheckTags,
checkArgStatic, checkFunctionArgTags,checkConArgsStatic,checkConArgsDyn) where
-#include "ClosureTypes.h"
+#include "rts/storage/ClosureTypes.h"
import GHC.Prelude
diff --git a/compiler/GHC/StgToJS/Linker/Linker.hs b/compiler/GHC/StgToJS/Linker/Linker.hs
index b0856f508d71..574cff3f6ea8 100644
--- a/compiler/GHC/StgToJS/Linker/Linker.hs
+++ b/compiler/GHC/StgToJS/Linker/Linker.hs
@@ -340,7 +340,7 @@ jsLink lc_cfg cfg logger tmpfs ar_cache out link_plan = do
when link_c_sources $ do
- runLink logger tmpfs (csLinkerConfig cfg) $
+ runLink logger tmpfs (csLinkerConfig cfg) False $
[ Option "-o"
, FileOption "" (out "clibs.js")
-- Embed wasm files into a single .js file
diff --git a/compiler/GHC/StgToJS/Linker/Utils.hs b/compiler/GHC/StgToJS/Linker/Utils.hs
index f90d63b46958..3caafc0b0ae1 100644
--- a/compiler/GHC/StgToJS/Linker/Utils.hs
+++ b/compiler/GHC/StgToJS/Linker/Utils.hs
@@ -52,7 +52,7 @@ import GHC.Data.FastString
-- | Retrieve library directories provided by the @UnitId@ in @UnitState@
getInstalledPackageLibDirs :: UnitState -> UnitId -> [ShortText]
-getInstalledPackageLibDirs us = maybe mempty unitLibraryDirs . lookupUnitId us
+getInstalledPackageLibDirs us = maybe mempty unitLibraryDirsStatic . lookupUnitId us
-- | Retrieve the names of the libraries provided by @UnitId@
getInstalledPackageHsLibs :: UnitState -> UnitId -> [ShortText]
diff --git a/compiler/GHC/SysTools/BaseDir.hs b/compiler/GHC/SysTools/BaseDir.hs
index 384169188e3e..bbbe0913e438 100644
--- a/compiler/GHC/SysTools/BaseDir.hs
+++ b/compiler/GHC/SysTools/BaseDir.hs
@@ -125,13 +125,7 @@ expandToolDir
:: Bool -- ^ whether we use the ambient mingw toolchain
-> Maybe FilePath -- ^ tooldir
-> String -> String
-#if defined(mingw32_HOST_OS)
-expandToolDir False (Just tool_dir) s = expandPathVar "tooldir" tool_dir s
-expandToolDir False Nothing _ = panic "Could not determine $tooldir"
-expandToolDir True _ s = s
-#else
expandToolDir _ _ s = s
-#endif
-- | Returns a Unix-format path pointing to TopDir.
findTopDir :: Maybe String -- Maybe TopDir path (without the '-B' prefix).
@@ -169,21 +163,4 @@ findToolDir
:: Bool -- ^ whether we use the ambient mingw toolchain
-> FilePath -- ^ topdir
-> IO (Maybe FilePath)
-#if defined(mingw32_HOST_OS)
-findToolDir False top_dir = go 0 (top_dir "..") []
- where maxDepth = 3
- go :: Int -> FilePath -> [FilePath] -> IO (Maybe FilePath)
- go k path tried
- | k == maxDepth = throwGhcExceptionIO $
- InstallationError $ "could not detect mingw toolchain in the following paths: " ++ show tried
- | otherwise = do
- let try = path "mingw"
- let tried' = tried ++ [try]
- oneLevel <- doesDirectoryExist try
- if oneLevel
- then return (Just path)
- else go (k+1) (path "..") tried'
-findToolDir True _ = return Nothing
-#else
findToolDir _ _ = return Nothing
-#endif
diff --git a/compiler/GHC/SysTools/Process.hs b/compiler/GHC/SysTools/Process.hs
index cebd46aeb02c..226f14b460ec 100644
--- a/compiler/GHC/SysTools/Process.hs
+++ b/compiler/GHC/SysTools/Process.hs
@@ -217,7 +217,7 @@ handleProc pgm phase_name proc = do
does_not_exist =
throwGhcExceptionIO $
- InstallationError (phase_name ++ ": could not execute: " ++ pgm)
+ InstallationError (phase_name ++ ": could not execute: `" ++ pgm ++ "'")
withPipe :: ((Handle, Handle) -> IO a) -> IO a
withPipe = bracket createPipe $ \ (readEnd, writeEnd) -> do
diff --git a/compiler/GHC/SysTools/Tasks.hs b/compiler/GHC/SysTools/Tasks.hs
index 97c6ae9d584f..18f6e1b2c272 100644
--- a/compiler/GHC/SysTools/Tasks.hs
+++ b/compiler/GHC/SysTools/Tasks.hs
@@ -13,7 +13,11 @@ module GHC.SysTools.Tasks
, runSourceCodePreprocessor
, runPp
, runCc
+ , configureCc
+ , CcConfig (..)
+ , configureLd
, askLd
+ , LdConfig(..)
, runAs
, runLlvmOpt
, runLlvmLlc
@@ -22,10 +26,20 @@ module GHC.SysTools.Tasks
, figureLlvmVersion
, runMergeObjects
, runAr
+ , ArConfig (..)
+ , configureAr
, askOtool
+ , configureOtool
+ , OtoolConfig (..)
, runInstallNameTool
+ , InstallNameConfig (..)
+ , configureInstallName
, runRanlib
+ , RanlibConfig (..)
+ , configureRanlib
, runWindres
+ , WindresConfig (..)
+ , configureWindres
) where
import GHC.Prelude
@@ -207,15 +221,32 @@ runPp logger dflags args = traceSystoolCommand logger "pp" $ do
opts = map Option (getOpts dflags opt_F)
runSomething logger "Haskell pre-processor" prog (args ++ opts)
+data CcConfig = CcConfig
+ { ccProg :: String
+ , cxxProg :: String
+ , ccOpts :: [String]
+ , cxxOpts :: [String]
+ , ccPicOpts :: [String]
+ }
+
+configureCc :: DynFlags -> CcConfig
+configureCc dflags = CcConfig
+ { ccProg = pgm_c dflags
+ , cxxProg = pgm_cxx dflags
+ , ccOpts = getOpts dflags opt_c
+ , cxxOpts = getOpts dflags opt_cxx
+ , ccPicOpts = picCCOpts dflags
+ }
+
-- | Run compiler of C-like languages and raw objects (such as gcc or clang).
-runCc :: Maybe ForeignSrcLang -> Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
-runCc mLanguage logger tmpfs dflags args = traceSystoolCommand logger "cc" $ do
+runCc :: Maybe ForeignSrcLang -> Logger -> TmpFs -> TempDir -> CcConfig -> [Option] -> IO ()
+runCc mLanguage logger tmpfs tmpdir opts args = traceSystoolCommand logger "cc" $ do
let args1 = map Option userOpts
args2 = languageOptions ++ args ++ args1
-- We take care to pass -optc flags in args1 last to ensure that the
-- user can override flags passed by GHC. See #14452.
mb_env <- getGccEnv args2
- runSomethingResponseFile logger tmpfs (tmpDir dflags) cc_filter dbgstring prog args2
+ runSomethingResponseFile logger tmpfs tmpdir cc_filter dbgstring prog args2
mb_env
where
-- force the C compiler to interpret this file as C when
@@ -223,38 +254,51 @@ runCc mLanguage logger tmpfs dflags args = traceSystoolCommand logger "cc" $ do
-- Also useful for plain .c files, just in case GHC saw a
-- -x c option.
(languageOptions, userOpts, prog, dbgstring) = case mLanguage of
- Nothing -> ([], userOpts_c, pgm_c dflags, "C Compiler")
- Just language -> ([Option "-x", Option languageName], opts, prog, dbgstr)
+ Nothing -> ([], ccOpts opts, ccProg opts, "C Compiler")
+ Just language -> ([Option "-x", Option languageName], copts, prog, dbgstr)
where
- (languageName, opts, prog, dbgstr) = case language of
- LangC -> ("c", userOpts_c
- ,pgm_c dflags, "C Compiler")
- LangCxx -> ("c++", userOpts_cxx
- ,pgm_cxx dflags , "C++ Compiler")
- LangObjc -> ("objective-c", userOpts_c
- ,pgm_c dflags , "Objective C Compiler")
- LangObjcxx -> ("objective-c++", userOpts_cxx
- ,pgm_cxx dflags, "Objective C++ Compiler")
+ (languageName, copts, prog, dbgstr) = case language of
+ LangC -> ("c", ccOpts opts
+ ,ccProg opts, "C Compiler")
+ LangCxx -> ("c++", cxxOpts opts
+ ,cxxProg opts, "C++ Compiler")
+ LangObjc -> ("objective-c", ccOpts opts
+ ,ccProg opts, "Objective C Compiler")
+ LangObjcxx -> ("objective-c++", cxxOpts opts
+ ,cxxProg opts, "Objective C++ Compiler")
LangAsm -> ("assembler", []
- ,pgm_c dflags, "Asm Compiler")
+ ,ccProg opts, "Asm Compiler")
RawObject -> ("c", []
- ,pgm_c dflags, "C Compiler") -- claim C for lack of a better idea
+ ,ccProg opts, "C Compiler") -- claim C for lack of a better idea
--JS backend shouldn't reach here, so we just pass
-- strings to satisfy the totality checker
LangJs -> ("js", []
- ,pgm_c dflags, "JS Backend Compiler")
- userOpts_c = getOpts dflags opt_c
- userOpts_cxx = getOpts dflags opt_cxx
+ ,ccProg opts, "JS Backend Compiler")
isContainedIn :: String -> String -> Bool
xs `isContainedIn` ys = any (xs `isPrefixOf`) (tails ys)
--- | Run the linker with some arguments and return the output
-askLd :: Logger -> DynFlags -> [Option] -> IO String
-askLd logger dflags args = traceSystoolCommand logger "linker" $ do
+data LdConfig = LdConfig
+ { ldProg :: String -- ^ LD program path
+ , ldOpts :: [Option] -- ^ LD program arguments
+ , ldSupportsVerbatimNamespace :: Bool
+ }
+
+configureLd :: DynFlags -> LdConfig
+configureLd dflags =
let (p,args0) = pgm_l dflags
args1 = map Option (getOpts dflags opt_l)
- args2 = args0 ++ args1 ++ args
+ in LdConfig
+ { ldProg = p
+ , ldOpts = args0 ++ args1
+ , ldSupportsVerbatimNamespace = toolSettings_ldSupportsVerbatimNamespace (toolSettings dflags)
+ }
+
+-- | Run the linker with some arguments and return the output
+askLd :: Logger -> LdConfig -> [Option] -> IO String
+askLd logger ld_config args = traceSystoolCommand logger "linker" $ do
+ let p = ldProg ld_config
+ args2 = ldOpts ld_config ++ args
mb_env <- getGccEnv args2
runSomethingWith logger "gcc" p args2 $ \real_args ->
readCreateProcessWithExitCode' (proc p real_args){ env = mb_env }
@@ -373,31 +417,80 @@ runMergeObjects logger tmpfs dflags args =
else do
runSomething logger "Merge objects" p args2
-runAr :: Logger -> DynFlags -> Maybe FilePath -> [Option] -> IO ()
-runAr logger dflags cwd args = traceSystoolCommand logger "ar" $ do
- let ar = pgm_ar dflags
+newtype ArConfig = ArConfig
+ { arProg :: String
+ }
+
+configureAr :: DynFlags -> ArConfig
+configureAr dflags = ArConfig
+ { arProg = pgm_ar dflags
+ }
+
+runAr :: Logger -> ArConfig -> Maybe FilePath -> [Option] -> IO ()
+runAr logger opts cwd args = traceSystoolCommand logger "ar" $ do
+ let ar = arProg opts
runSomethingFiltered logger id "Ar" ar args cwd Nothing
-askOtool :: Logger -> ToolSettings -> Maybe FilePath -> [Option] -> IO String
-askOtool logger toolSettings mb_cwd args = do
- let otool = toolSettings_pgm_otool toolSettings
+newtype OtoolConfig = OtoolConfig
+ { otoolProg :: String
+ }
+
+configureOtool :: DynFlags -> OtoolConfig
+configureOtool dflags = OtoolConfig
+ { otoolProg = toolSettings_pgm_otool (toolSettings dflags)
+ }
+
+askOtool :: Logger -> OtoolConfig -> Maybe FilePath -> [Option] -> IO String
+askOtool logger opts mb_cwd args = do
+ let otool = otoolProg opts
runSomethingWith logger "otool" otool args $ \real_args ->
readCreateProcessWithExitCode' (proc otool real_args){ cwd = mb_cwd }
-runInstallNameTool :: Logger -> ToolSettings -> [Option] -> IO ()
-runInstallNameTool logger toolSettings args = do
- let tool = toolSettings_pgm_install_name_tool toolSettings
+newtype InstallNameConfig = InstallNameConfig
+ { installNameProg :: String
+ }
+
+configureInstallName :: DynFlags -> InstallNameConfig
+configureInstallName dflags = InstallNameConfig
+ { installNameProg = toolSettings_pgm_install_name_tool (toolSettings dflags)
+ }
+
+runInstallNameTool :: Logger -> InstallNameConfig -> [Option] -> IO ()
+runInstallNameTool logger opts args = do
+ let tool = installNameProg opts
runSomethingFiltered logger id "Install Name Tool" tool args Nothing Nothing
-runRanlib :: Logger -> DynFlags -> [Option] -> IO ()
-runRanlib logger dflags args = traceSystoolCommand logger "ranlib" $ do
- let ranlib = pgm_ranlib dflags
+newtype RanlibConfig = RanlibConfig
+ { ranlibProg :: String
+ }
+
+configureRanlib :: DynFlags -> RanlibConfig
+configureRanlib dflags = RanlibConfig
+ { ranlibProg = pgm_ranlib dflags
+ }
+
+runRanlib :: Logger -> RanlibConfig -> [Option] -> IO ()
+runRanlib logger opts args = traceSystoolCommand logger "ranlib" $ do
+ let ranlib = ranlibProg opts
runSomethingFiltered logger id "Ranlib" ranlib args Nothing Nothing
-runWindres :: Logger -> DynFlags -> [Option] -> IO ()
-runWindres logger dflags args = traceSystoolCommand logger "windres" $ do
- let cc_args = map Option (sOpt_c (settings dflags))
- windres = pgm_windres dflags
- opts = map Option (getOpts dflags opt_windres)
+data WindresConfig = WindresConfig
+ { windresProg :: String
+ , windresOpts :: [Option]
+ , windresCOpts :: [Option]
+ }
+
+configureWindres :: DynFlags -> WindresConfig
+configureWindres dflags = WindresConfig
+ { windresProg = pgm_windres dflags
+ , windresOpts = map Option (getOpts dflags opt_windres)
+ , windresCOpts = map Option (sOpt_c (settings dflags))
+ }
+
+runWindres :: Logger -> WindresConfig -> [Option] -> IO ()
+runWindres logger opts args = traceSystoolCommand logger "windres" $ do
+ let cc_args = windresCOpts opts
+ windres = windresProg opts
+ wopts = windresOpts opts
mb_env <- getGccEnv cc_args
- runSomethingFiltered logger id "Windres" windres (opts ++ args) Nothing mb_env
+ runSomethingFiltered logger id "Windres" windres (wopts ++ args) Nothing mb_env
diff --git a/compiler/GHC/Tc/Deriv/Generics.hs b/compiler/GHC/Tc/Deriv/Generics.hs
index 7163e903fbdf..04edd1831d2c 100644
--- a/compiler/GHC/Tc/Deriv/Generics.hs
+++ b/compiler/GHC/Tc/Deriv/Generics.hs
@@ -44,7 +44,6 @@ import GHC.Iface.Env ( newGlobalBinder )
import GHC.Types.Name hiding ( varName )
import GHC.Types.Name.Reader
-import GHC.Types.SourceText
import GHC.Types.Fixity
import GHC.Types.Basic
import GHC.Types.SrcLoc
@@ -379,7 +378,7 @@ mkBindsRep dflags gk loc dit@(DerivInstTys{dit_rep_tc = tycon}) = (binds, sigs)
max_fields = maximum $ 0 :| map dataConSourceArity datacons
inline1 f = L loc'' . InlineSig noAnn (L loc' f)
- $ alwaysInlinePragma { inl_act = ActiveAfter NoSourceText 1 }
+ $ alwaysInlinePragma { inl_act = ActiveAfter 1 }
-- The topmost M1 (the datatype metadata) has the exact same type
-- across all cases of a from/to definition, and can be factored out
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 9406bde05c55..c06ccf2e54f8 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -1657,7 +1657,7 @@ instance Diagnostic TcRnMessage where
TcRnRoleValidationFailed role reason -> mkSimpleDecorated $
vcat [text "Internal error in role inference:",
pprRoleValidationFailedReason role reason,
- text "Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug"]
+ text "Please report this as a GHC bug: https://github.com/stable-haskell/ghc/issues"]
TcRnCommonFieldResultTypeMismatch con1 con2 field_name -> mkSimpleDecorated $
vcat [sep [text "Constructors" <+> ppr con1 <+> text "and" <+> ppr con2,
text "have a common field" <+> quotes (ppr field_name) <> comma],
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index f4c33797620d..9b143dfb1130 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -586,7 +586,7 @@ tcRnSrcDecls explicit_mod_hdr export_ies decls
-- Zonk the final code. This must be done last.
-- Even simplifyTop may do some unification.
-- This pass also warns about missing type signatures
- ; (id_env, ev_binds', binds', fords', imp_specs', rules')
+ ; (id_env, ev_binds', binds', fords', imp_specs', rules', pat_syns')
<- zonkTcGblEnv new_ev_binds tcg_env
--------- Run finalizers --------------
@@ -604,6 +604,7 @@ tcRnSrcDecls explicit_mod_hdr export_ies decls
, tcg_imp_specs = []
, tcg_rules = []
, tcg_fords = []
+ , tcg_patsyns = []
, tcg_type_env = tcg_type_env tcg_env
`plusTypeEnv` id_env }
; (tcg_env, tcl_env) <- setGblEnv init_tcg_env
@@ -635,7 +636,7 @@ tcRnSrcDecls explicit_mod_hdr export_ies decls
-- Zonk the new bindings arising from running the finalisers,
-- and main. This won't give rise to any more finalisers as you
-- can't nest finalisers inside finalisers.
- ; (id_env_mf, ev_binds_mf, binds_mf, fords_mf, imp_specs_mf, rules_mf)
+ ; (id_env_mf, ev_binds_mf, binds_mf, fords_mf, imp_specs_mf, rules_mf, patsyns_mf)
<- zonkTcGblEnv main_ev_binds tcg_env
; let { !final_type_env = tcg_type_env tcg_env
@@ -649,24 +650,26 @@ tcRnSrcDecls explicit_mod_hdr export_ies decls
, tcg_ev_binds = ev_binds' `unionBags` ev_binds_mf
, tcg_imp_specs = imp_specs' ++ imp_specs_mf
, tcg_rules = rules' ++ rules_mf
- , tcg_fords = fords' ++ fords_mf } } ;
+ , tcg_fords = fords' ++ fords_mf
+ , tcg_patsyns = pat_syns' ++ patsyns_mf } } ;
; setGlobalTypeEnv tcg_env' final_type_env
}
zonkTcGblEnv :: Bag EvBind -> TcGblEnv
-> TcM (TypeEnv, Bag EvBind, LHsBinds GhcTc,
- [LForeignDecl GhcTc], [LTcSpecPrag], [LRuleDecl GhcTc])
+ [LForeignDecl GhcTc], [LTcSpecPrag], [LRuleDecl GhcTc], [PatSyn])
zonkTcGblEnv ev_binds tcg_env@(TcGblEnv { tcg_binds = binds
, tcg_ev_binds = cur_ev_binds
, tcg_imp_specs = imp_specs
, tcg_rules = rules
- , tcg_fords = fords })
+ , tcg_fords = fords
+ , tcg_patsyns = pat_syns })
= {-# SCC "zonkTopDecls" #-}
setGblEnv tcg_env $ -- This sets the GlobalRdrEnv which is used when rendering
-- error messages during zonking (notably levity errors)
do { let all_ev_binds = cur_ev_binds `unionBags` ev_binds
- ; zonkTopDecls all_ev_binds binds rules imp_specs fords }
+ ; zonkTopDecls all_ev_binds binds rules imp_specs fords pat_syns }
-- | Runs TH finalizers and renames and typechecks the top-level declarations
-- that they could introduce.
diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs
index 5167c55f6f02..606dfb799f25 100644
--- a/compiler/GHC/Tc/TyCl/PatSyn.hs
+++ b/compiler/GHC/Tc/TyCl/PatSyn.hs
@@ -23,7 +23,6 @@ import GHC.Hs
import GHC.Tc.Gen.Pat
import GHC.Tc.Utils.Env
import GHC.Tc.Utils.TcMType
-import GHC.Tc.Zonk.Type
import GHC.Tc.Errors.Types
import GHC.Tc.Utils.Monad
import GHC.Tc.Zonk.TcType
@@ -37,10 +36,10 @@ import GHC.Tc.Types.Origin
import GHC.Tc.TyCl.Build
import GHC.Core.Multiplicity
-import GHC.Core.Type ( typeKind, isManyTy, mkTYPEapp )
+import GHC.Core.Type ( typeKind, isManyTy, mkTYPEapp, definitelyLiftedType )
import GHC.Core.TyCo.Subst( extendTvSubstWithClone )
-import GHC.Core.TyCo.Tidy( tidyForAllTyBinders, tidyTypes, tidyType )
import GHC.Core.Predicate
+import GHC.Core.TyCo.Tidy
import GHC.Types.Name
import GHC.Types.Name.Reader
@@ -51,7 +50,7 @@ import GHC.Utils.Panic
import GHC.Utils.Outputable
import GHC.Data.FastString
import GHC.Types.Var
-import GHC.Types.Var.Env( emptyTidyEnv, mkInScopeSetList )
+import GHC.Types.Var.Env( mkInScopeSetList, emptyTidyEnv )
import GHC.Types.Id
import GHC.Types.Id.Info( RecSelParent(..) )
import GHC.Tc.Gen.Bind
@@ -672,27 +671,31 @@ tc_patsyn_finish lname dir is_infix lpat' prag_fn
(ex_tvs, ex_tys, prov_theta, prov_dicts)
(args, arg_tys)
pat_ty field_labels
- = do { -- Zonk everything. We are about to build a final PatSyn
- -- so there had better be no unification variables in there
-
- (univ_tvs, req_theta, ex_tvs, prov_theta, arg_tys, pat_ty) <-
- initZonkEnv NoFlexi $
- runZonkBndrT (zonkTyVarBindersX univ_tvs) $ \ univ_tvs' ->
- do { req_theta' <- zonkTcTypesToTypesX req_theta
- ; runZonkBndrT (zonkTyVarBindersX ex_tvs) $ \ ex_tvs' ->
- do { prov_theta' <- zonkTcTypesToTypesX prov_theta
- ; pat_ty' <- zonkTcTypeToTypeX pat_ty
- ; arg_tys' <- zonkTcTypesToTypesX arg_tys
+ = do { -- Don't do a final zonk-to-type yet, as the pattern synonym may still
+ -- contain unfilled metavariables.
+ -- See Note [Metavariables in pattern synonyms].
+
+ -- We still need to zonk, however, in order for instantiation to work
+ -- correctly. If we don't zonk, we are at risk of quantifying
+ -- 'alpha -> beta' to 'forall a. a -> beta' even though 'beta := alpha'.
+ ; (univ_tvs, req_theta, ex_tvs, prov_theta, arg_tys, pat_ty) <-
+ liftZonkM $
+ do { univ_tvs' <- traverse zonkInvisTVBinder univ_tvs
+ ; req_theta' <- zonkTcTypes req_theta
+ ; ex_tvs' <- traverse zonkInvisTVBinder ex_tvs
+ ; prov_theta' <- zonkTcTypes prov_theta
+ ; pat_ty' <- zonkTcType pat_ty
+ ; arg_tys' <- zonkTcTypes arg_tys
; let (env1, univ_tvs) = tidyForAllTyBinders emptyTidyEnv univ_tvs'
+ req_theta = tidyTypes env1 req_theta'
(env2, ex_tvs) = tidyForAllTyBinders env1 ex_tvs'
- req_theta = tidyTypes env2 req_theta'
prov_theta = tidyTypes env2 prov_theta'
arg_tys = tidyTypes env2 arg_tys'
pat_ty = tidyType env2 pat_ty'
; return (univ_tvs, req_theta,
- ex_tvs, prov_theta, arg_tys, pat_ty) } }
+ ex_tvs, prov_theta, arg_tys, pat_ty) }
; traceTc "tc_patsyn_finish {" $
ppr (unLoc lname) $$ ppr (unLoc lpat') $$
@@ -734,6 +737,48 @@ tc_patsyn_finish lname dir is_infix lpat' prag_fn
; traceTc "tc_patsyn_finish }" empty
; return (matcher_bind, tcg_env) }
+{- Note [Metavariables in pattern synonyms]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Unlike data constructors, the types of pattern synonyms are allowed to contain
+metavariables, because of view patterns. Example (from ticket #26465):
+
+ f :: Eq a => a -> Maybe a
+ f = ...
+
+ g = f
+ -- Due to the monomorphism restriction, we infer
+ -- g :: alpha -> Maybe alpha, with [W] Eq alpha
+
+ pattern P x <- (g -> Just x)
+ -- Infer: P :: alpha -> alpha
+
+Note that:
+
+ 1. 'g' is a top-level function binding whose inferred type contains metavariables
+ (due to type variable promotion, as described in Note [Deciding quantification] in GHC.Tc.Solver)
+ 2. 'P' is a pattern synonym without a type signature which uses 'g' in a view pattern.
+
+In this way, promoted metavariables of top-level functions can sneak their way
+into pattern synonym definitions.
+
+To account for this fact, we do not attempt a final zonk-to-type in
+'GHC.Tc.TyCl.PatSyn.tc_patsyn_finish'. Indeed, GHC may fill in the metavariables
+when typechecking the rest of the module. Following on from the above example,
+we might have a later binding:
+
+ y = g 'c'
+ -- fixes alpha := Char
+
+or
+
+ h (P b) = not b
+ -- fixes alpha := Bool
+
+We instead perform the final zonk-to-type at the very end, in the call
+to 'GHC.Tc.Zonk.Type.zonkPatSyn' in 'GHC.Tc.Zonk.Type.zonkTopDecls'. In this way,
+pattern synonyms are treated the same as top-level function bindings.
+-}
+
{-
************************************************************************
* *
@@ -870,9 +915,11 @@ mkPatSynBuilder dir (L _ name)
| otherwise
= do { builder_name <- newImplicitBinder name mkBuilderOcc
; let theta = req_theta ++ prov_theta
- need_dummy_arg = isUnliftedType pat_ty && null arg_tys && null theta
- -- NB: pattern arguments cannot be representation-polymorphic,
- -- as checked in 'tcPatSynSig'. So 'isUnliftedType' is OK here.
+ need_dummy_arg = null arg_tys && null theta && not (definitelyLiftedType pat_ty)
+ -- At this point, the representation of 'pat_ty' might still be unknown (see T26465c),
+ -- so use a conservative test that handles an unknown representation.
+ -- Ideally, we'd defer making the builder until the representation is settled,
+ -- but that would be a lot more work.
builder_sigma = add_void need_dummy_arg $
mkInvisForAllTys univ_bndrs $
mkInvisForAllTys ex_bndrs $
diff --git a/compiler/GHC/Tc/Utils/Unify.hs b/compiler/GHC/Tc/Utils/Unify.hs
index b68346970c3f..6ae0237e414a 100644
--- a/compiler/GHC/Tc/Utils/Unify.hs
+++ b/compiler/GHC/Tc/Utils/Unify.hs
@@ -1882,6 +1882,24 @@ the LHS vs the new RHS. And vice-versa (if it's the RHS that is a FunTy).
See T11305 and T26225 for examples of when this is important.
+Wrinkle [tc_sub_type_deep occurs check]
+
+ In #26823 we had
+
+ alpha <= a -> alpha
+
+ this is an occurs check failure, but if we naively follow the plan described
+ in this Note, we would do the following:
+
+ create fresh metavariables beta, gamma
+ unify alpha := beta -> gamma
+ decompose "beta -> gamma <= a -> (beta -> gamma)", obtaining
+ a <= beta and gamma <= beta -> gamma
+ recur with gamma <= beta -> gamma
+
+ This caused an infinite loop! So we insert a simple occurs check to prevent
+ the infinite loop.
+
Note [Deep subsumption and required foralls]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A required forall, (forall a -> ty) behaves like a "rho-type", one with no
@@ -2005,21 +2023,27 @@ tc_sub_type_deep pos unify inst_orig ctxt ty_actual ty_expected
af2 exp_mult exp_arg exp_res
-- See Note [FunTy vs non-FunTy case in tc_sub_type_deep]
- go1 (FunTy { ft_af = af1, ft_mult = act_mult, ft_arg = act_arg, ft_res = act_res }) ty_e
+ go1 ty_a@(FunTy { ft_af = af1, ft_mult = act_mult, ft_arg = act_arg, ft_res = act_res }) ty_e
| isVisibleFunArg af1
- = do { exp_mult <- newMultiplicityVar
+ = do { occurs <- occ_check ty_e ty_a
+ -- Wrinkle [tc_sub_type_deep occurs check]
+ ; if occurs then just_unify ty_a ty_e else
+ do { exp_mult <- newMultiplicityVar
; exp_arg <- newOpenFlexiTyVarTy -- NB: no FRR check needed; we might not need to eta-expand
; exp_res <- newOpenFlexiTyVarTy
; let exp_funTy = FunTy { ft_af = af1, ft_mult = exp_mult, ft_arg = exp_arg, ft_res = exp_res }
; unify_wrap <- just_unify exp_funTy ty_e
; fun_wrap <- go_fun af1 act_mult act_arg act_res af1 exp_mult exp_arg exp_res
; return $ unify_wrap <.> fun_wrap
- -- unify_wrap :: exp_funTy ~> ty_e
- -- fun_wrap :: ty_a ~> exp_funTy
- }
- go1 ty_a (FunTy { ft_af = af2, ft_mult = exp_mult, ft_arg = exp_arg, ft_res = exp_res })
+ -- unify_wrap :: exp_funTy ~~> ty_e
+ -- fun_wrap :: ty_a ~~> exp_funTy
+ } }
+ go1 ty_a ty_e@(FunTy { ft_af = af2, ft_mult = exp_mult, ft_arg = exp_arg, ft_res = exp_res })
| isVisibleFunArg af2
- = do { act_mult <- newMultiplicityVar
+ = do { occurs <- occ_check ty_a ty_e
+ -- Wrinkle [tc_sub_type_deep occurs check]
+ ; if occurs then just_unify ty_a ty_e else
+ do { act_mult <- newMultiplicityVar
; act_arg <- newOpenFlexiTyVarTy -- NB: no FRR check needed; we might not need to eta-expand
; act_res <- newOpenFlexiTyVarTy
; let act_funTy = FunTy { ft_af = af2, ft_mult = act_mult, ft_arg = act_arg, ft_res = act_res }
@@ -2027,9 +2051,9 @@ tc_sub_type_deep pos unify inst_orig ctxt ty_actual ty_expected
; unify_wrap <- just_unify ty_a act_funTy
; fun_wrap <- go_fun af2 act_mult act_arg act_res af2 exp_mult exp_arg exp_res
; return $ fun_wrap <.> unify_wrap
- -- unify_wrap :: ty_a ~> act_funTy
- -- fun_wrap :: act_funTy ~> ty_e
- }
+ -- unify_wrap :: ty_a ~~> act_funTy
+ -- fun_wrap :: act_funTy ~~> ty_e
+ }}
-- Otherwise, revert to unification.
go1 ty_a ty_e = just_unify ty_a ty_e
@@ -2037,6 +2061,16 @@ tc_sub_type_deep pos unify inst_orig ctxt ty_actual ty_expected
just_unify ty_a ty_e = do { cow <- unify ty_a ty_e
; return (mkWpCastN cow) }
+ -- See Wrinkle [tc_sub_type_deep occurs check]
+ occ_check :: TcType -> TcType -> TcM Bool
+ occ_check ty1 ty2
+ | Just tv1 <- getTyVar_maybe ty1
+ = do { z_ty2 <- liftZonkM $ zonkTcType ty2
+ ; return $ tv1 `elemVarSet` tyCoVarsOfType z_ty2
+ }
+ | otherwise
+ = return False
+
-- FunTy/FunTy case: this is where we insert any necessary eta-expansions.
go_fun :: FunTyFlag -> Mult -> TcType -> TcType -- actual FunTy
-> FunTyFlag -> Mult -> TcType -> TcType -- expected FunTy
diff --git a/compiler/GHC/Tc/Zonk/Type.hs b/compiler/GHC/Tc/Zonk/Type.hs
index 98a253e8f094..7050caff0012 100644
--- a/compiler/GHC/Tc/Zonk/Type.hs
+++ b/compiler/GHC/Tc/Zonk/Type.hs
@@ -37,9 +37,6 @@ module GHC.Tc.Zonk.Type (
import GHC.Prelude
import GHC.Builtin.Types
-
-import GHC.Core.TyCo.Ppr ( pprTyVar )
-
import GHC.Hs
import {-# SOURCE #-} GHC.Tc.Gen.Splice (runTopSplice)
@@ -60,8 +57,11 @@ import GHC.Tc.Zonk.TcType
, checkCoercionHole
, zonkCoVar )
-import GHC.Core.Type
import GHC.Core.Coercion
+import GHC.Core.ConLike
+import GHC.Core.PatSyn (PatSyn(..))
+import GHC.Core.TyCo.Ppr ( pprTyVar )
+import GHC.Core.Type
import GHC.Core.TyCon
import GHC.Utils.Outputable
@@ -93,6 +93,7 @@ import Control.Monad
import Control.Monad.Trans.Class ( lift )
import Data.List.NonEmpty ( NonEmpty )
import Data.Foldable ( toList )
+import Data.Traversable ( for )
{- Note [What is zonking?]
~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -470,7 +471,7 @@ commitFlexi DefaultFlexi tv zonked_kind
; return manyDataConTy }
| Just (ConcreteFRR origin) <- isConcreteTyVar_maybe tv
= do { addErr $ TcRnZonkerMessage (ZonkerCannotDefaultConcrete origin)
- ; return (anyTypeOfKind zonked_kind) }
+ ; newZonkAnyType zonked_kind }
| otherwise
= do { traceTc "Defaulting flexi tyvar to ZonkAny:" (pprTyVar tv)
-- See Note [Any types] in GHC.Builtin.Types, esp wrinkle (Any4)
@@ -647,23 +648,25 @@ zonkTopDecls :: Bag EvBind
-> LHsBinds GhcTc
-> [LRuleDecl GhcTc] -> [LTcSpecPrag]
-> [LForeignDecl GhcTc]
+ -> [PatSyn]
-> TcM (TypeEnv,
Bag EvBind,
LHsBinds GhcTc,
[LForeignDecl GhcTc],
[LTcSpecPrag],
- [LRuleDecl GhcTc])
-zonkTopDecls ev_binds binds rules imp_specs fords
+ [LRuleDecl GhcTc],
+ [PatSyn])
+zonkTopDecls ev_binds binds rules imp_specs fords pat_syns
= initZonkEnv DefaultFlexi $
runZonkBndrT (zonkEvBinds ev_binds) $ \ ev_binds' ->
runZonkBndrT (zonkRecMonoBinds binds) $ \ binds' ->
-- Top level is implicitly recursive
- do { rules' <- zonkRules rules
- ; specs' <- zonkLTcSpecPrags imp_specs
- ; fords' <- zonkForeignExports fords
- ; ty_env <- zonkEnvIds <$> getZonkEnv
- ; return (ty_env, ev_binds', binds', fords', specs', rules') }
-
+ do { rules' <- zonkRules rules
+ ; specs' <- zonkLTcSpecPrags imp_specs
+ ; fords' <- zonkForeignExports fords
+ ; pat_syns' <- traverse zonkPatSyn pat_syns
+ ; ty_env <- zonkEnvIds <$> getZonkEnv
+ ; return (ty_env, ev_binds', binds', fords', specs', rules', pat_syns') }
---------------------------------------------
zonkLocalBinds :: HsLocalBinds GhcTc
@@ -1549,7 +1552,8 @@ zonk_pat (SumPat tys pat alt arity )
; pat' <- zonkPat pat
; return (SumPat tys' pat' alt arity) }
-zonk_pat p@(ConPat { pat_args = args
+zonk_pat p@(ConPat { pat_con = L con_loc con
+ , pat_args = args
, pat_con_ext = p'@(ConPatTc
{ cpt_tvs = tyvars
, cpt_dicts = evs
@@ -1568,8 +1572,15 @@ zonk_pat p@(ConPat { pat_args = args
; new_binds <- zonkTcEvBinds binds
; new_wrapper <- zonkCoFn wrapper
; new_args <- zonkConStuff args
+ ; new_con <- case con of
+ RealDataCon {} -> return con
+ -- Data constructors never contain metavariables: they are
+ -- fully zonked before we look at any value bindings.
+ PatSynCon ps -> PatSynCon <$> noBinders (zonkPatSyn ps)
+ -- Pattern synonyms can contain metavariables, see e.g. T26465c.
; pure $ p
- { pat_args = new_args
+ { pat_con = L con_loc new_con
+ , pat_args = new_args
, pat_con_ext = p'
{ cpt_arg_tys = new_tys
, cpt_tvs = new_tyvars
@@ -1615,14 +1626,14 @@ zonk_pat (InvisPat ty tp)
; return (InvisPat ty' tp) }
zonk_pat (XPat ext) = case ext of
- { ExpansionPat orig pat->
+ { ExpansionPat orig pat ->
do { pat' <- zonk_pat pat
; return $ XPat $ ExpansionPat orig pat' }
; CoPat co_fn pat ty ->
- do { co_fn' <- zonkCoFn co_fn
- ; pat' <- zonkPat (noLocA pat)
- ; ty' <- noBinders $ zonkTcTypeToTypeX ty
- ; return (XPat $ CoPat co_fn' (unLoc pat') ty')
+ do { co_fn' <- zonkCoFn co_fn
+ ; pat' <- zonk_pat pat
+ ; ty' <- noBinders $ zonkTcTypeToTypeX ty
+ ; return (XPat $ CoPat co_fn' pat' ty')
} }
zonk_pat pat = pprPanic "zonk_pat" (ppr pat)
@@ -1653,6 +1664,45 @@ zonkPats = traverse zonkPat
{-# SPECIALISE zonkPats :: [LPat GhcTc] -> ZonkBndrTcM [LPat GhcTc] #-}
{-# SPECIALISE zonkPats :: NonEmpty (LPat GhcTc) -> ZonkBndrTcM (NonEmpty (LPat GhcTc)) #-}
+---------------------------
+
+-- | Perform a final zonk-to-type for a pattern synonym.
+--
+-- See Note [Metavariables in pattern synonyms] in GHC.Tc.TyCl.PatSyn.
+zonkPatSyn :: PatSyn -> ZonkTcM PatSyn
+zonkPatSyn
+ ps@( MkPatSyn
+ { psArgs = arg_tys
+ , psUnivTyVars = univ_tvs
+ , psReqTheta = req_theta
+ , psExTyVars = ex_tvs
+ , psProvTheta = prov_theta
+ , psResultTy = res_ty
+ , psMatcher = (matcherNm, matcherTy, matcherDummyArg)
+ , psBuilder = mbBuilder
+ }) =
+ runZonkBndrT (zonkTyVarBindersX univ_tvs) $ \ univ_tvs' ->
+ do { req_theta' <- zonkTcTypesToTypesX req_theta
+ ; res_ty' <- zonkTcTypeToTypeX res_ty
+ ; runZonkBndrT (zonkTyVarBindersX ex_tvs) $ \ ex_tvs' ->
+ do { prov_theta' <- zonkTcTypesToTypesX prov_theta
+ ; arg_tys' <- zonkTcTypesToTypesX arg_tys
+ ; matcherTy' <- zonkTcTypeToTypeX matcherTy
+ ; mbBuilder' <- for mbBuilder $ \ (builderNm, builderTy, builderDummyArg) ->
+ do { builderTy' <- zonkTcTypeToTypeX builderTy
+ ; return (builderNm, builderTy', builderDummyArg) }
+ ; return $
+ ps
+ { psArgs = arg_tys'
+ , psUnivTyVars = univ_tvs'
+ , psReqTheta = req_theta'
+ , psExTyVars = ex_tvs'
+ , psProvTheta = prov_theta'
+ , psResultTy = res_ty'
+ , psMatcher = (matcherNm, matcherTy', matcherDummyArg)
+ , psBuilder = mbBuilder'
+ } } }
+
{-
************************************************************************
* *
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index c482d24812f3..64b354c0ff23 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -998,8 +998,8 @@ cvtRuleMatch TH.FunLike = Hs.FunLike
cvtPhases :: TH.Phases -> Activation -> Activation
cvtPhases AllPhases dflt = dflt
-cvtPhases (FromPhase i) _ = ActiveAfter NoSourceText i
-cvtPhases (BeforePhase i) _ = ActiveBefore NoSourceText i
+cvtPhases (FromPhase i) _ = ActiveAfter i
+cvtPhases (BeforePhase i) _ = ActiveBefore i
cvtRuleBndr :: TH.RuleBndr -> CvtM (Hs.LRuleBndr GhcPs)
cvtRuleBndr (RuleVar n)
diff --git a/compiler/GHC/Types/Basic.hs b/compiler/GHC/Types/Basic.hs
index 18e82792822e..ff4e442dc2e2 100644
--- a/compiler/GHC/Types/Basic.hs
+++ b/compiler/GHC/Types/Basic.hs
@@ -84,11 +84,13 @@ module GHC.Types.Basic (
DefMethSpec(..),
SwapFlag(..), flipSwap, unSwap, notSwapped, isSwapped, pickSwap,
- CompilerPhase(..), PhaseNum, beginPhase, nextPhase, laterPhase,
+ CompilerPhase(..),
+ PhaseNum, nextPhase, laterPhase,
- Activation(..), isActive, competesWith,
+ Activation(..), isActiveInPhase, competesWith,
isNeverActive, isAlwaysActive, activeInFinalPhase, activeInInitialPhase,
activateAfterInitial, activateDuringFinal, activeAfter,
+ beginPhase, endPhase, laterThanPhase,
RuleMatchInfo(..), isConLike, isFunLike,
InlineSpec(..), noUserInlineSpec,
@@ -1464,52 +1466,76 @@ The CompilerPhase says which phase the simplifier is running in:
The phase sequencing is done by GHC.Opt.Simplify.Driver
-}
--- | Phase Number
-type PhaseNum = Int -- Compilation phase
- -- Phases decrease towards zero
- -- Zero is the last phase
+-- | Compilation phase number, as can be written by users in INLINE pragmas,
+-- SPECIALISE pragmas, and RULES.
+--
+-- - phases decrease towards zero
+-- - zero is the last phase
+--
+-- Does not include GHC internal "initial" and "final" phases; see 'CompilerPhase'.
+type PhaseNum = Int
+-- | Compilation phase number, including the user-specifiable 'PhaseNum'
+-- and the GHC internal "initial" and "final" phases.
data CompilerPhase
- = InitialPhase -- The first phase -- number = infinity!
- | Phase PhaseNum -- User-specificable phases
- | FinalPhase -- The last phase -- number = -infinity!
- deriving Eq
+ = InitialPhase -- ^ The first phase; number = infinity!
+ | Phase PhaseNum -- ^ User-specifiable phases
+ | FinalPhase -- ^ The last phase; number = -infinity!
+ deriving (Eq, Data)
instance Outputable CompilerPhase where
ppr (Phase n) = int n
- ppr InitialPhase = text "InitialPhase"
- ppr FinalPhase = text "FinalPhase"
+ ppr InitialPhase = text "initial"
+ ppr FinalPhase = text "final"
--- See Note [Pragma source text]
+-- | An activation is a range of phases throughout which something is active
+-- (like an INLINE pragma, SPECIALISE pragma, or RULE).
data Activation
= AlwaysActive
- | ActiveBefore SourceText PhaseNum -- Active only *strictly before* this phase
- | ActiveAfter SourceText PhaseNum -- Active in this phase and later
- | FinalActive -- Active in final phase only
+ -- | Active only *strictly before* this phase
+ | ActiveBefore PhaseNum
+ -- | Active in this phase and later phases
+ | ActiveAfter PhaseNum
+ -- | Active in the final phase only
+ | FinalActive
| NeverActive
deriving( Eq, Data )
-- Eq used in comparing rules in GHC.Hs.Decls
beginPhase :: Activation -> CompilerPhase
--- First phase in which the Activation is active
--- or FinalPhase if it is never active
+-- ^ First phase in which the 'Activation' is active,
+-- or 'FinalPhase' if it is never active
beginPhase AlwaysActive = InitialPhase
beginPhase (ActiveBefore {}) = InitialPhase
-beginPhase (ActiveAfter _ n) = Phase n
+beginPhase (ActiveAfter n) = Phase n
beginPhase FinalActive = FinalPhase
beginPhase NeverActive = FinalPhase
+endPhase :: Activation -> CompilerPhase
+-- ^ Last phase in which the 'Activation' is active,
+-- or 'InitialPhase' if it is never active
+endPhase AlwaysActive = FinalPhase
+endPhase (ActiveBefore n) =
+ if nextPhase InitialPhase == Phase n
+ then InitialPhase
+ else Phase $ n + 1
+endPhase (ActiveAfter {}) = FinalPhase
+endPhase FinalActive = FinalPhase
+endPhase NeverActive = InitialPhase
+
activeAfter :: CompilerPhase -> Activation
--- (activeAfter p) makes an Activation that is active in phase p and after
--- Invariant: beginPhase (activeAfter p) = p
+-- ^ @activeAfter p@ makes an 'Activation' that is active in phase @p@ and after
+--
+-- Invariant: @beginPhase (activeAfter p) = p@
activeAfter InitialPhase = AlwaysActive
-activeAfter (Phase n) = ActiveAfter NoSourceText n
+activeAfter (Phase n) = ActiveAfter n
activeAfter FinalPhase = FinalActive
nextPhase :: CompilerPhase -> CompilerPhase
--- Tells you the next phase after this one
--- Currently we have just phases [2,1,0,FinalPhase,FinalPhase,...]
--- Where FinalPhase means GHC's internal simplification steps
+-- ^ Tells you the next phase after this one
+--
+-- Currently we have just phases @[2,1,0,FinalPhase,FinalPhase,...]@,
+-- where FinalPhase means GHC's internal simplification steps
-- after all rules have run
nextPhase InitialPhase = Phase 2
nextPhase (Phase 0) = FinalPhase
@@ -1517,37 +1543,45 @@ nextPhase (Phase n) = Phase (n-1)
nextPhase FinalPhase = FinalPhase
laterPhase :: CompilerPhase -> CompilerPhase -> CompilerPhase
--- Returns the later of two phases
+-- ^ Returns the later of two phases
laterPhase (Phase n1) (Phase n2) = Phase (n1 `min` n2)
laterPhase InitialPhase p2 = p2
laterPhase FinalPhase _ = FinalPhase
laterPhase p1 InitialPhase = p1
laterPhase _ FinalPhase = FinalPhase
+-- | @p1 `laterThanOrEqualPhase` p2@ computes whether @p1@ happens (strictly)
+-- after @p2@.
+laterThanPhase :: CompilerPhase -> CompilerPhase -> Bool
+p1 `laterThanPhase` p2 = toNum p1 < toNum p2
+ where
+ toNum :: CompilerPhase -> Int
+ toNum InitialPhase = maxBound
+ toNum (Phase i) = i
+ toNum FinalPhase = minBound
+
activateAfterInitial :: Activation
--- Active in the first phase after the initial phase
+-- ^ Active in the first phase after the initial phase
activateAfterInitial = activeAfter (nextPhase InitialPhase)
activateDuringFinal :: Activation
--- Active in the final simplification phase (which is repeated)
+-- ^ Active in the final simplification phase (which is repeated)
activateDuringFinal = FinalActive
-isActive :: CompilerPhase -> Activation -> Bool
-isActive InitialPhase act = activeInInitialPhase act
-isActive (Phase p) act = activeInPhase p act
-isActive FinalPhase act = activeInFinalPhase act
+isActiveInPhase :: CompilerPhase -> Activation -> Bool
+isActiveInPhase InitialPhase act = activeInInitialPhase act
+isActiveInPhase (Phase p) act = activeInPhase p act
+isActiveInPhase FinalPhase act = activeInFinalPhase act
activeInInitialPhase :: Activation -> Bool
-activeInInitialPhase AlwaysActive = True
-activeInInitialPhase (ActiveBefore {}) = True
-activeInInitialPhase _ = False
+activeInInitialPhase act = beginPhase act == InitialPhase
activeInPhase :: PhaseNum -> Activation -> Bool
-activeInPhase _ AlwaysActive = True
-activeInPhase _ NeverActive = False
-activeInPhase _ FinalActive = False
-activeInPhase p (ActiveAfter _ n) = p <= n
-activeInPhase p (ActiveBefore _ n) = p > n
+activeInPhase _ AlwaysActive = True
+activeInPhase _ NeverActive = False
+activeInPhase _ FinalActive = False
+activeInPhase p (ActiveAfter n) = p <= n
+activeInPhase p (ActiveBefore n) = p > n
activeInFinalPhase :: Activation -> Bool
activeInFinalPhase AlwaysActive = True
@@ -1562,25 +1596,19 @@ isNeverActive _ = False
isAlwaysActive AlwaysActive = True
isAlwaysActive _ = False
-competesWith :: Activation -> Activation -> Bool
+-- | @act1 `competesWith` act2@ returns whether @act1@ is active in the phase
+-- when @act2@ __becomes__ active.
+--
+-- This answers the question: might @act1@ fire first?
+--
+-- NB: this is not the same as computing whether @act1@ and @act2@ are
+-- ever active at the same time.
+--
-- See Note [Competing activations]
-competesWith AlwaysActive _ = True
-
-competesWith NeverActive _ = False
-competesWith _ NeverActive = False
-
-competesWith FinalActive FinalActive = True
-competesWith FinalActive _ = False
-
-competesWith (ActiveBefore {}) AlwaysActive = True
-competesWith (ActiveBefore {}) FinalActive = False
-competesWith (ActiveBefore {}) (ActiveBefore {}) = True
-competesWith (ActiveBefore _ a) (ActiveAfter _ b) = a < b
-
-competesWith (ActiveAfter {}) AlwaysActive = False
-competesWith (ActiveAfter {}) FinalActive = True
-competesWith (ActiveAfter {}) (ActiveBefore {}) = False
-competesWith (ActiveAfter _ a) (ActiveAfter _ b) = a >= b
+competesWith :: Activation -> Activation -> Bool
+competesWith NeverActive _ = False
+competesWith _ NeverActive = False -- See Wrinkle [Never active rules]
+competesWith act1 act2 = isActiveInPhase (beginPhase act2) act1
{- Note [Competing activations]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1595,8 +1623,20 @@ It's too conservative to ensure that the two are never simultaneously
active. For example, a rule might be always active, and an inlining
might switch on in phase 2. We could switch off the rule, but it does
no harm.
--}
+ Wrinkle [Never active rules]
+
+ Rules can be declared as "never active" by users, using the syntax:
+
+ {-# RULE "blah" [~] ... #-}
+
+ (This feature exists solely for compiler plugins, by making it possible
+ to define a RULE that is never run by GHC, but is nevertheless parsed,
+ typechecked etc, so that it is available to the plugin.)
+
+ We should not warn about competing rules, so make sure that 'competesWith'
+ always returns 'False' when its second argument is 'NeverActive'.
+-}
{- *********************************************************************
* *
@@ -1855,26 +1895,36 @@ setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma
setInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info }
instance Outputable Activation where
- ppr AlwaysActive = empty
- ppr NeverActive = brackets (text "~")
- ppr (ActiveBefore _ n) = brackets (char '~' <> int n)
- ppr (ActiveAfter _ n) = brackets (int n)
- ppr FinalActive = text "[final]"
+ ppr AlwaysActive = empty
+ ppr NeverActive = brackets (text "~")
+ ppr (ActiveBefore n) = brackets (char '~' <> int n)
+ ppr (ActiveAfter n) = brackets (int n)
+ ppr FinalActive = text "[final]"
+
+instance Binary CompilerPhase where
+ put_ bh InitialPhase = putByte bh 0
+ put_ bh (Phase i) = do { putByte bh 1; put_ bh i }
+ put_ bh FinalPhase = putByte bh 2
+
+ get bh = do
+ h <- getByte bh
+ case h of
+ 0 -> return InitialPhase
+ 1 -> do { p <- get bh; return (Phase p) }
+ _ -> return FinalPhase
instance Binary Activation where
put_ bh NeverActive =
putByte bh 0
- put_ bh FinalActive =
+ put_ bh FinalActive = do
putByte bh 1
put_ bh AlwaysActive =
putByte bh 2
- put_ bh (ActiveBefore src aa) = do
+ put_ bh (ActiveBefore aa) = do
putByte bh 3
- put_ bh src
put_ bh aa
- put_ bh (ActiveAfter src ab) = do
+ put_ bh (ActiveAfter ab) = do
putByte bh 4
- put_ bh src
put_ bh ab
get bh = do
h <- getByte bh
@@ -1882,19 +1932,21 @@ instance Binary Activation where
0 -> return NeverActive
1 -> return FinalActive
2 -> return AlwaysActive
- 3 -> do src <- get bh
- aa <- get bh
- return (ActiveBefore src aa)
- _ -> do src <- get bh
- ab <- get bh
- return (ActiveAfter src ab)
-
+ 3 -> do aa <- get bh
+ return (ActiveBefore aa)
+ _ -> do ab <- get bh
+ return (ActiveAfter ab)
+instance NFData CompilerPhase where
+ rnf = \case
+ InitialPhase -> ()
+ FinalPhase -> ()
+ Phase i -> rnf i
instance NFData Activation where
rnf = \case
AlwaysActive -> ()
NeverActive -> ()
- ActiveBefore src aa -> rnf src `seq` rnf aa
- ActiveAfter src ab -> rnf src `seq` rnf ab
+ ActiveBefore aa -> rnf aa
+ ActiveAfter ab -> rnf ab
FinalActive -> ()
instance Outputable RuleMatchInfo where
diff --git a/compiler/GHC/Types/Id/Info.hs b/compiler/GHC/Types/Id/Info.hs
index 80158da6d487..f60f8865e0e5 100644
--- a/compiler/GHC/Types/Id/Info.hs
+++ b/compiler/GHC/Types/Id/Info.hs
@@ -583,7 +583,12 @@ hasInlineUnfolding :: IdInfo -> Bool
-- ^ True of a /non-loop-breaker/ Id that has a /stable/ unfolding that is
-- (a) always inlined; that is, with an `UnfWhen` guidance, or
-- (b) a DFunUnfolding which never needs to be inlined
-hasInlineUnfolding info = isInlineUnfolding (unfoldingInfo info)
+--
+-- Very important that this work with `realUnfoldingInfo` and so returns
+-- True even for a loop-breaker that has an INLINE pragma.
+-- See (CWW4) in Note [Cast worker/wrapper] in GHC.Core.Opt.Simplify.Iteration
+-- for discussion, and #26903 for the dire consequences of getting this wrong.
+hasInlineUnfolding info = isInlineUnfolding (realUnfoldingInfo info)
setArityInfo :: IdInfo -> ArityInfo -> IdInfo
setArityInfo info ar =
diff --git a/compiler/GHC/Types/Id/Make.hs b/compiler/GHC/Types/Id/Make.hs
index 70e9bbb555f0..cd442d2b6a81 100644
--- a/compiler/GHC/Types/Id/Make.hs
+++ b/compiler/GHC/Types/Id/Make.hs
@@ -67,7 +67,6 @@ import GHC.Core.Class
import GHC.Core.DataCon
import GHC.Types.Literal
-import GHC.Types.SourceText
import GHC.Types.RepType ( countFunRepArgs, typePrimRep )
import GHC.Types.Name.Set
import GHC.Types.Name
@@ -1926,8 +1925,7 @@ seqId = pcRepPolyId seqName ty concs info
`setArityInfo` arity
inline_prag
- = alwaysInlinePragma `setInlinePragmaActivation` ActiveAfter
- NoSourceText 0
+ = alwaysInlinePragma `setInlinePragmaActivation` ActiveAfter 0
-- Make 'seq' not inline-always, so that simpleOptExpr
-- (see GHC.Core.Subst.simple_app) won't inline 'seq' on the
-- LHS of rules. That way we can have rules for 'seq';
diff --git a/compiler/GHC/Types/Unique/FM.hs b/compiler/GHC/Types/Unique/FM.hs
index c9a15a32642a..926e2a105d5a 100644
--- a/compiler/GHC/Types/Unique/FM.hs
+++ b/compiler/GHC/Types/Unique/FM.hs
@@ -41,6 +41,7 @@ module GHC.Types.Unique.FM (
listToUFM_C,
listToIdentityUFM,
addToUFM,addToUFM_C,addToUFM_Acc,addToUFM_L,
+ strictAddToUFM_C,
addListToUFM,addListToUFM_C,
addToUFM_Directly,
addListToUFM_Directly,
@@ -52,6 +53,7 @@ module GHC.Types.Unique.FM (
delListFromUFM_Directly,
plusUFM,
plusUFM_C,
+ strictPlusUFM_C, strictPlusUFM_C_Directly,
plusUFM_CD,
plusUFM_CD2,
mergeUFM,
@@ -63,6 +65,7 @@ module GHC.Types.Unique.FM (
minusUFM_C,
intersectUFM,
intersectUFM_C,
+ strictIntersectUFM_C,
disjointUFM,
equalKeysUFM,
diffUFM,
@@ -179,6 +182,16 @@ addToUFM_C
addToUFM_C f (UFM m) k v =
UFM (M.insertWith (flip f) (getKey $ getUnique k) v m)
+strictAddToUFM_C
+ :: Uniquable key
+ => (elt -> elt -> elt) -- ^ old -> new -> result
+ -> UniqFM key elt -- ^ old
+ -> key -> elt -- ^ new
+ -> UniqFM key elt -- ^ result
+-- Arguments of combining function of MS.insertWith and strictAddToUFM_C are flipped.
+strictAddToUFM_C f (UFM m) k v =
+ UFM (MS.insertWith (flip f) (getKey $ getUnique k) v m)
+
addToUFM_Acc
:: Uniquable key
=> (elt -> elts -> elts) -- Add to existing
@@ -261,6 +274,12 @@ plusUFM (UFM x) (UFM y) = UFM (M.union y x)
plusUFM_C :: (elt -> elt -> elt) -> UniqFM key elt -> UniqFM key elt -> UniqFM key elt
plusUFM_C f (UFM x) (UFM y) = UFM (M.unionWith f x y)
+strictPlusUFM_C :: (elt -> elt -> elt) -> UniqFM key elt -> UniqFM key elt -> UniqFM key elt
+strictPlusUFM_C f (UFM x) (UFM y) = UFM (MS.unionWith f x y)
+
+strictPlusUFM_C_Directly :: (Unique -> elt -> elt -> elt) -> UniqFM key elt -> UniqFM key elt -> UniqFM key elt
+strictPlusUFM_C_Directly f (UFM x) (UFM y) = UFM (MS.unionWithKey (f . mkUniqueGrimily) x y)
+
-- | `plusUFM_CD f m1 d1 m2 d2` merges the maps using `f` as the
-- combinding function and `d1` resp. `d2` as the default value if
-- there is no entry in `m1` reps. `m2`. The domain is the union of
@@ -371,6 +390,13 @@ intersectUFM_C
-> UniqFM key elt3
intersectUFM_C f (UFM x) (UFM y) = UFM (M.intersectionWith f x y)
+strictIntersectUFM_C
+ :: (elt1 -> elt2 -> elt3)
+ -> UniqFM key elt1
+ -> UniqFM key elt2
+ -> UniqFM key elt3
+strictIntersectUFM_C f (UFM x) (UFM y) = UFM (MS.intersectionWith f x y)
+
disjointUFM :: UniqFM key elt1 -> UniqFM key elt2 -> Bool
disjointUFM (UFM x) (UFM y) = M.disjoint x y
diff --git a/compiler/GHC/Types/Unique/Set.hs b/compiler/GHC/Types/Unique/Set.hs
index 1fd82927d44c..e82039a18ff4 100644
--- a/compiler/GHC/Types/Unique/Set.hs
+++ b/compiler/GHC/Types/Unique/Set.hs
@@ -21,12 +21,14 @@ module GHC.Types.Unique.Set (
emptyUniqSet,
unitUniqSet,
mkUniqSet,
- addOneToUniqSet, addListToUniqSet,
+ addOneToUniqSet, addListToUniqSet, strictAddOneToUniqSet_C,
delOneFromUniqSet, delOneFromUniqSet_Directly, delListFromUniqSet,
delListFromUniqSet_Directly,
unionUniqSets, unionManyUniqSets,
- minusUniqSet, uniqSetMinusUFM, uniqSetMinusUDFM,
- intersectUniqSets,
+ strictUnionUniqSets_C, strictUnionManyUniqSets_C,
+ minusUniqSet, minusUniqSet_C,
+ uniqSetMinusUFM, uniqSetMinusUDFM,
+ intersectUniqSets, strictIntersectUniqSets_C,
disjointUniqSets,
restrictUniqSetToUFM,
uniqSetAny, uniqSetAll,
@@ -110,6 +112,10 @@ addListToUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a
addListToUniqSet = foldl' addOneToUniqSet
{-# INLINEABLE addListToUniqSet #-}
+strictAddOneToUniqSet_C :: Uniquable a => (a -> a -> a) -> UniqSet a -> a -> UniqSet a
+strictAddOneToUniqSet_C f (UniqSet set) x =
+ UniqSet (strictAddToUFM_C f set x x)
+
delOneFromUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a
delOneFromUniqSet (UniqSet s) a = UniqSet (delFromUFM s a)
@@ -128,15 +134,29 @@ delListFromUniqSet_Directly (UniqSet s) l =
unionUniqSets :: UniqSet a -> UniqSet a -> UniqSet a
unionUniqSets (UniqSet s) (UniqSet t) = UniqSet (plusUFM s t)
+strictUnionUniqSets_C :: (a -> a -> a) -> UniqSet a -> UniqSet a -> UniqSet a
+strictUnionUniqSets_C f (UniqSet s) (UniqSet t) =
+ UniqSet (strictPlusUFM_C f s t)
+
unionManyUniqSets :: [UniqSet a] -> UniqSet a
unionManyUniqSets = foldl' (flip unionUniqSets) emptyUniqSet
+strictUnionManyUniqSets_C :: (a -> a -> a) -> [UniqSet a] -> UniqSet a
+strictUnionManyUniqSets_C f = foldl' (flip (strictUnionUniqSets_C f)) emptyUniqSet
+
minusUniqSet :: UniqSet a -> UniqSet a -> UniqSet a
minusUniqSet (UniqSet s) (UniqSet t) = UniqSet (minusUFM s t)
+minusUniqSet_C :: (a -> a -> Maybe a) -> UniqSet a -> UniqSet a -> UniqSet a
+minusUniqSet_C f (UniqSet s) (UniqSet t) = UniqSet (minusUFM_C f s t)
+
intersectUniqSets :: UniqSet a -> UniqSet a -> UniqSet a
intersectUniqSets (UniqSet s) (UniqSet t) = UniqSet (intersectUFM s t)
+strictIntersectUniqSets_C :: (a -> a -> a) -> UniqSet a -> UniqSet a -> UniqSet a
+strictIntersectUniqSets_C f (UniqSet s) (UniqSet t) =
+ UniqSet (strictIntersectUFM_C f s t)
+
disjointUniqSets :: UniqSet a -> UniqSet a -> Bool
disjointUniqSets (UniqSet s) (UniqSet t) = disjointUFM s t
diff --git a/compiler/GHC/Unit/Info.hs b/compiler/GHC/Unit/Info.hs
index 04ac54b5d310..853d7b5b6c60 100644
--- a/compiler/GHC/Unit/Info.hs
+++ b/compiler/GHC/Unit/Info.hs
@@ -25,6 +25,8 @@ module GHC.Unit.Info
, collectLibraryDirs
, collectFrameworks
, collectFrameworksDirs
+ , libraryDirsForWay
+ , libraryDirsForWay'
, unitHsLibs
)
where
@@ -139,9 +141,11 @@ pprUnitInfo GenericUnitInfo {..} =
field "trusted" (ppr unitIsTrusted),
field "import-dirs" (fsep (map (text . ST.unpack) unitImportDirs)),
field "library-dirs" (fsep (map (text . ST.unpack) unitLibraryDirs)),
+ field "library-dirs-static" (fsep (map (text . ST.unpack) unitLibraryDirsStatic)),
field "dynamic-library-dirs" (fsep (map (text . ST.unpack) unitLibraryDynDirs)),
field "hs-libraries" (fsep (map (text . ST.unpack) unitLibraries)),
field "extra-libraries" (fsep (map (text . ST.unpack) unitExtDepLibsSys)),
+ field "extra-libraries-static" (fsep (map (text . ST.unpack) unitExtDepLibsStaticSys)),
field "extra-ghci-libraries" (fsep (map (text . ST.unpack) unitExtDepLibsGhc)),
field "include-dirs" (fsep (map (text . ST.unpack) unitIncludeDirs)),
field "includes" (fsep (map (text . ST.unpack) unitIncludes)),
@@ -200,19 +204,21 @@ collectFrameworksDirs ps = map ST.unpack (ordNub (filter (not . ST.null) (concat
-- | Either the 'unitLibraryDirs' or 'unitLibraryDynDirs' as appropriate for the way.
libraryDirsForWay :: Ways -> UnitInfo -> [String]
-libraryDirsForWay ws
- | hasWay ws WayDyn = map ST.unpack . unitLibraryDynDirs
- | otherwise = map ST.unpack . unitLibraryDirs
+libraryDirsForWay ws = libraryDirsForWay' (hasWay ws WayDyn)
+
+libraryDirsForWay' :: Bool -> UnitInfo -> [String]
+libraryDirsForWay' is_dyn
+ | is_dyn = map ST.unpack . unitLibraryDynDirs
+ | otherwise = map ST.unpack . unitLibraryDirsStatic
unitHsLibs :: GhcNameVersion -> Ways -> UnitInfo -> [String]
-unitHsLibs namever ways0 p = map (mkDynName . addSuffix . ST.unpack) (unitLibraries p)
+unitHsLibs namever ways0 p = map (mkDynName . ST.unpack) (unitLibraries p)
where
ways1 = removeWay WayDyn ways0
-- the name of a shared library is libHSfoo-ghc.so
-- we leave out the _dyn, because it is superfluous
tag = waysTag (fullWays ways1)
- rts_tag = waysTag ways1
mkDynName x
| not (ways0 `hasWay` WayDyn) = x
@@ -225,19 +231,3 @@ unitHsLibs namever ways0 p = map (mkDynName . addSuffix . ST.unpack) (unitLibrar
| otherwise
= panic ("Don't understand library name " ++ x)
- -- Add _thr and other rts suffixes to packages named
- -- `rts` or `rts-1.0`. Why both? Traditionally the rts
- -- package is called `rts` only. However the tooling
- -- usually expects a package name to have a version.
- -- As such we will gradually move towards the `rts-1.0`
- -- package name, at which point the `rts` package name
- -- will eventually be unused.
- --
- -- 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)
-
- expandTag t | null t = ""
- | otherwise = '_':t
diff --git a/compiler/GHC/Unit/Module/Graph.hs b/compiler/GHC/Unit/Module/Graph.hs
index e56ee33ca785..809adb1b7889 100644
--- a/compiler/GHC/Unit/Module/Graph.hs
+++ b/compiler/GHC/Unit/Module/Graph.hs
@@ -567,16 +567,26 @@ mgReachableLoop mg nk = map summaryNodeSummary modules_below where
allReachableMany td_map (mapMaybe lookup_node nk)
--- | @'mgQueryZero' g root b@ answers the question: can we reach @b@ from @root@
+-- | @'mgQueryZero' g root target@ answers the question: can we reach @target@ from @root@
-- in the module graph @g@, only using normal (level 0) imports?
+--
+-- If the @target@ key is not reachable, there is no path.
+-- The @root@ key not being in @g@ results in a panic.
mgQueryZero :: ModuleGraph
-> ZeroScopeKey
-> ZeroScopeKey
-> Bool
-mgQueryZero mg nka nkb = isReachable td_map na nb where
+mgQueryZero mg rootKey targetKey =
+ case lookup_node targetKey of
+ -- The module we are looking for may not be in the module graph at all,
+ -- e.g. if a reference to it did not arise from an explicit import
+ -- declaration (as in #26568).
+ Nothing -> False
+ Just ntarget -> isReachable td_map nroot ntarget
+ where
+ -- invariant: the root key has to exist in the graph
+ nroot = fromJust $ lookup_node rootKey
(td_map, lookup_node) = mg_zero_graph mg
- na = expectJust $ lookup_node nka
- nb = expectJust $ lookup_node nkb
-- | Reachability Query.
diff --git a/compiler/GHC/Unit/State.hs b/compiler/GHC/Unit/State.hs
index 436fd48dad5e..f8a978679ebc 100644
--- a/compiler/GHC/Unit/State.hs
+++ b/compiler/GHC/Unit/State.hs
@@ -113,6 +113,7 @@ import Data.Graph (stronglyConnComp, SCC(..))
import Data.Char ( toUpper )
import Data.List ( intersperse, partition, sortBy, isSuffixOf, sortOn )
import Data.Set (Set)
+import Data.String (fromString)
import Data.Monoid (First(..))
import qualified Data.Semigroup as Semigroup
import qualified Data.Set as Set
@@ -371,7 +372,7 @@ initUnitConfig dflags cached_dbs home_units =
-- Since "base" is not wired in, then the unit-id is discovered
-- from the settings file by default, but can be overriden by power-users
-- by specifying `-base-unit-id` flag.
- | otherwise = filter (hu_id /=) [baseUnitId dflags, ghcInternalUnitId, rtsUnitId]
+ | otherwise = filter (hu_id /=) (baseUnitId dflags:wiredInUnitIds)
-- if the home unit is indefinite, it means we are type-checking it only
-- (not producing any code). Hence we can use virtual units instantiated
@@ -645,7 +646,7 @@ initUnits logger dflags cached_dbs home_units = do
(unit_state,dbs) <- withTiming logger (text "initializing unit database")
forceUnitInfoMap
- $ mkUnitState logger (initUnitConfig dflags cached_dbs home_units)
+ $ mkUnitState logger dflags (initUnitConfig dflags cached_dbs home_units)
putDumpFileMaybe logger Opt_D_dump_mod_map "Module Map"
FormatText (updSDocContext (\ctx -> ctx {sdocLineLength = 200})
@@ -851,15 +852,18 @@ distrustAllUnits pkgs = map distrust pkgs
mungeUnitInfo :: FilePath -> FilePath
-> UnitInfo -> UnitInfo
mungeUnitInfo top_dir pkgroot =
- mungeDynLibFields
+ mungeLibDirFields
. mungeUnitInfoPaths (ST.pack top_dir) (ST.pack pkgroot)
-mungeDynLibFields :: UnitInfo -> UnitInfo
-mungeDynLibFields pkg =
+mungeLibDirFields :: UnitInfo -> UnitInfo
+mungeLibDirFields pkg =
pkg {
unitLibraryDynDirs = case unitLibraryDynDirs pkg of
[] -> unitLibraryDirs pkg
ds -> ds
+ , unitLibraryDirsStatic = case unitLibraryDirsStatic pkg of
+ [] -> unitLibraryDirs pkg
+ ds -> ds
}
-- -----------------------------------------------------------------------------
@@ -1094,6 +1098,7 @@ type WiringMap = UniqMap UnitId UnitId
findWiredInUnits
:: Logger
+ -> [UnitId] -- wired in unit ids
-> UnitPrecedenceMap
-> [UnitInfo] -- database
-> VisibilityMap -- info on what units are visible
@@ -1101,13 +1106,22 @@ findWiredInUnits
-> IO ([UnitInfo], -- unit database updated for wired in
WiringMap) -- map from unit id to wired identity
-findWiredInUnits logger prec_map pkgs vis_map = do
+findWiredInUnits logger unitIdsToFind prec_map pkgs vis_map = do
-- Now we must find our wired-in units, and rename them to
-- their canonical names (eg. base-1.0 ==> base), as described
-- in Note [Wired-in units] in GHC.Unit.Types
let
matches :: UnitInfo -> UnitId -> Bool
- pc `matches` pid = unitPackageName pc == PackageName (unitIdFS pid)
+ pc `matches` pid | (pkg, comp) <- break (==':') (unitIdString pid)
+ , not (null comp)
+ = unitPackageName pc == PackageName (fromString pkg)
+ -- note: GenericUnitInfo uses the same type for
+ -- unitPackageName and unitComponentName
+ && unitComponentName pc == Just (PackageName (fromString (drop 1 comp)))
+ pc `matches` pid
+ = unitPackageName pc == PackageName (unitIdFS pid)
+ && unitComponentName pc == Nothing
+
-- find which package corresponds to each wired-in package
-- delete any other packages with the same name
@@ -1127,7 +1141,8 @@ findWiredInUnits logger prec_map pkgs vis_map = do
-- available.
--
findWiredInUnit :: [UnitInfo] -> UnitId -> IO (Maybe (UnitId, UnitInfo))
- findWiredInUnit pkgs wired_pkg = firstJustsM [try all_exposed_ps, try all_ps, notfound]
+ findWiredInUnit pkgs wired_pkg = do
+ firstJustsM [try all_exposed_ps, try all_ps, notfound]
where
all_ps = [ p | p <- pkgs, p `matches` wired_pkg ]
all_exposed_ps = [ p | p <- all_ps, (mkUnit p) `elemUniqMap` vis_map ]
@@ -1152,7 +1167,7 @@ findWiredInUnits logger prec_map pkgs vis_map = do
return (wired_pkg, pkg)
- mb_wired_in_pkgs <- mapM (findWiredInUnit pkgs) wiredInUnitIds
+ mb_wired_in_pkgs <- mapM (findWiredInUnit pkgs) unitIdsToFind
let
wired_in_pkgs = catMaybes mb_wired_in_pkgs
@@ -1240,8 +1255,10 @@ instance Outputable UnusableUnitReason where
ppr IgnoredWithFlag = text "[ignored with flag]"
ppr (BrokenDependencies uids) = brackets (text "broken" <+> ppr uids)
ppr (CyclicDependencies uids) = brackets (text "cyclic" <+> ppr uids)
- ppr (IgnoredDependencies uids) = brackets (text "ignored" <+> ppr uids)
- ppr (ShadowedDependencies uids) = brackets (text "shadowed" <+> ppr uids)
+ ppr (IgnoredDependencies uids) = brackets (text $ "unusable because the -ignore-package flag was used to " ++
+ "ignore at least one of its dependencies:") $$
+ nest 2 (hsep (map ppr uids))
+ ppr (ShadowedDependencies uids) = brackets (text "unusable due to shadowed" <+> ppr uids)
type UnusableUnits = UniqMap UnitId (UnitInfo, UnusableUnitReason)
@@ -1465,9 +1482,10 @@ validateDatabase cfg pkg_map1 =
mkUnitState
:: Logger
+ -> DynFlags
-> UnitConfig
-> IO (UnitState,[UnitDatabase UnitId])
-mkUnitState logger cfg = do
+mkUnitState logger dflags cfg = do
{-
Plan.
@@ -1622,8 +1640,79 @@ mkUnitState logger cfg = do
-- it modifies the unit ids of wired in packages, but when we process
-- package arguments we need to key against the old versions.
--
- (pkgs2, wired_map) <- findWiredInUnits logger prec_map pkgs1 vis_map2
- let pkg_db = mkUnitInfoMap pkgs2
+ let wired_ids_all = rtsWayUnitId dflags : wiredInUnitIds
+ wired_ids
+ | gopt Opt_NoGhcInternal dflags = filter (/= ghcInternalUnitId) wired_ids_all
+ | otherwise = wired_ids_all
+ (pkgs2, wired_map) <- findWiredInUnits logger wired_ids prec_map pkgs1 vis_map2
+
+ --
+ -- Sanity check. If the rtsWayUnitId is not in the database, then we have a
+ -- problem. The RTS is effectively missing.
+ unless (null pkgs1 || gopt Opt_NoRts dflags || anyUniqMap (== rtsWayUnitId dflags) wired_map) $ do
+ pprPanic "mkUnitState" $
+ vcat
+ [ text "debug details:"
+ , nest 2 $ vcat
+ [ text "pkgs1_count =" <+> ppr (length pkgs1)
+ , text "Opt_NoRts =" <+> ppr (gopt Opt_NoRts dflags)
+ , text "Opt_NoGhcInternal =" <+> ppr (gopt Opt_NoGhcInternal dflags)
+ , text "ghcLink =" <+> text (show (ghcLink dflags))
+ , text "platform =" <+> text (show (targetPlatform dflags))
+ , text "rtsWayUnitId=" <+> ppr (rtsWayUnitId dflags)
+ , text "has_rts =" <+> ppr (anyUniqMap (== rtsWayUnitId dflags) wired_map)
+ , text "wired_map =" <+> ppr wired_map
+ , text "pkgs1 units (pre-wiring):" $$ nest 2 (pprWithCommas (\p -> ppr (unitId p) <+> parens (ppr (unitPackageName p))) pkgs1)
+ , text "pkgs2 units (post-wiring):" $$ nest 2 (pprWithCommas (\p -> ppr (unitId p) <+> parens (ppr (unitPackageName p))) pkgs2)
+ ]
+ ]
+ <> text "; The RTS for " <> ppr (rtsWayUnitId dflags)
+ <> text " is missing from the package database while building unit "
+ <> ppr (homeUnitId_ dflags)
+ <> text " (home units: " <> ppr (Set.toList (unitConfigHomeUnits cfg)) <> text ")."
+ <> text " Please check your installation."
+ <> text " If this target doesn't need the RTS (e.g. building a shared library), you can add -no-rts to the relevant package's ghc-options in cabal.project to bypass this check."
+
+ let pkgs3 = if gopt Opt_NoGhcInternal dflags
+ then pkgs2
+ else if gopt Opt_NoRts dflags && not (anyUniqMap (== ghcInternalUnitId) wired_map)
+ then pkgs2
+ else
+ -- At this point we should have `ghcInternalUnitId`, and the `rtsWiredUnitId dflags`.
+ -- The graph looks something like this:
+ -- ghc-internal
+ -- '- rtsWayUnitId dflags
+ -- '- rts ...
+ -- Notably the rtsWayUnitId is chosen by GHC _after_ the build plan by e.g. cabal
+ -- has been constructed. We still need to ensure that ordering when linking
+ -- is correct. As such we'll manually make rtsWayUnitId dflags a dependency
+ -- of ghcInternalUnitId.
+
+ -- pkgs2: [UnitInfo] = [GenUnitInfo UnitId] = [GenericUnitInfo PackageId PackageName UnitId ModuleName (GenModule (GenUnit UnitId))]
+ -- GenericUnitInfo { unitId: UnitId, ..., unitAbiHash: ShortText, unitDepends: [UnitId], unitAbiDepends: [(UnitId, ShortText)], ... }
+ -- ghcInternalUnitId: UnitId
+ -- rtsWayUnitId dflags: UnitId
+ let rtsWayUnitIdHash = case [ unitAbiHash pkg | pkg <- pkgs2
+ , unitId pkg == rtsWayUnitId dflags] of
+ [] -> panic "rtsWayUnitId not found in wired-in packages"
+ [x] -> x
+ _ -> panic "rtsWayUnitId found multiple times in wired-in packages"
+ ghcInternalUnit = case [ pkg | pkg <- pkgs2
+ , unitId pkg == ghcInternalUnitId ] of
+ [] -> panic "ghcInternalUnitId not found in wired-in packages"
+ [x] -> x
+ _ -> panic "ghcInternalUnitId found multiple times in wired-in packages"
+
+ -- update ghcInternalUnit to depend on rtsWayUnitId dflags
+ ghcInternalUnit' = ghcInternalUnit
+ { unitDepends = rtsWayUnitId dflags : unitDepends ghcInternalUnit
+ , unitAbiDepends = (rtsWayUnitId dflags, rtsWayUnitIdHash) : unitAbiDepends ghcInternalUnit
+ }
+ in map (\pkg -> if unitId pkg == ghcInternalUnitId
+ then ghcInternalUnit'
+ else pkg) pkgs2
+
+ let pkg_db = mkUnitInfoMap pkgs3
-- Update the visibility map, so we treat wired packages as visible.
let vis_map = updateVisibilityMap wired_map vis_map2
@@ -1657,7 +1746,7 @@ mkUnitState logger cfg = do
return (updateVisibilityMap wired_map plugin_vis_map2)
let pkgname_map = listToUFM [ (unitPackageName p, unitInstanceOf p)
- | p <- pkgs2
+ | p <- pkgs3
]
-- The explicitUnits accurately reflects the set of units we have turned
-- on; as such, it also is the only way one can come up with requirements.
diff --git a/compiler/GHC/Utils/Binary.hs b/compiler/GHC/Utils/Binary.hs
index 97a2b1d1f5df..94e51367267f 100644
--- a/compiler/GHC/Utils/Binary.hs
+++ b/compiler/GHC/Utils/Binary.hs
@@ -1869,172 +1869,6 @@ instance Binary ModuleName where
put_ bh (ModuleName fs) = put_ bh fs
get bh = do fs <- get bh; return (ModuleName fs)
--- instance Binary TupleSort where
--- put_ bh BoxedTuple = putByte bh 0
--- put_ bh UnboxedTuple = putByte bh 1
--- put_ bh ConstraintTuple = putByte bh 2
--- get bh = do
--- h <- getByte bh
--- case h of
--- 0 -> do return BoxedTuple
--- 1 -> do return UnboxedTuple
--- _ -> do return ConstraintTuple
-
--- instance Binary Activation where
--- put_ bh NeverActive = do
--- putByte bh 0
--- put_ bh FinalActive = do
--- putByte bh 1
--- put_ bh AlwaysActive = do
--- putByte bh 2
--- put_ bh (ActiveBefore src aa) = do
--- putByte bh 3
--- put_ bh src
--- put_ bh aa
--- put_ bh (ActiveAfter src ab) = do
--- putByte bh 4
--- put_ bh src
--- put_ bh ab
--- get bh = do
--- h <- getByte bh
--- case h of
--- 0 -> do return NeverActive
--- 1 -> do return FinalActive
--- 2 -> do return AlwaysActive
--- 3 -> do src <- get bh
--- aa <- get bh
--- return (ActiveBefore src aa)
--- _ -> do src <- get bh
--- ab <- get bh
--- return (ActiveAfter src ab)
-
--- instance Binary InlinePragma where
--- put_ bh (InlinePragma s a b c d) = do
--- put_ bh s
--- put_ bh a
--- put_ bh b
--- put_ bh c
--- put_ bh d
-
--- get bh = do
--- s <- get bh
--- a <- get bh
--- b <- get bh
--- c <- get bh
--- d <- get bh
--- return (InlinePragma s a b c d)
-
--- instance Binary RuleMatchInfo where
--- put_ bh FunLike = putByte bh 0
--- put_ bh ConLike = putByte bh 1
--- get bh = do
--- h <- getByte bh
--- if h == 1 then return ConLike
--- else return FunLike
-
--- instance Binary InlineSpec where
--- put_ bh NoUserInlinePrag = putByte bh 0
--- put_ bh Inline = putByte bh 1
--- put_ bh Inlinable = putByte bh 2
--- put_ bh NoInline = putByte bh 3
-
--- get bh = do h <- getByte bh
--- case h of
--- 0 -> return NoUserInlinePrag
--- 1 -> return Inline
--- 2 -> return Inlinable
--- _ -> return NoInline
-
--- instance Binary RecFlag where
--- put_ bh Recursive = do
--- putByte bh 0
--- put_ bh NonRecursive = do
--- putByte bh 1
--- get bh = do
--- h <- getByte bh
--- case h of
--- 0 -> do return Recursive
--- _ -> do return NonRecursive
-
--- instance Binary OverlapMode where
--- put_ bh (NoOverlap s) = putByte bh 0 >> put_ bh s
--- put_ bh (Overlaps s) = putByte bh 1 >> put_ bh s
--- put_ bh (Incoherent s) = putByte bh 2 >> put_ bh s
--- put_ bh (Overlapping s) = putByte bh 3 >> put_ bh s
--- put_ bh (Overlappable s) = putByte bh 4 >> put_ bh s
--- get bh = do
--- h <- getByte bh
--- case h of
--- 0 -> (get bh) >>= \s -> return $ NoOverlap s
--- 1 -> (get bh) >>= \s -> return $ Overlaps s
--- 2 -> (get bh) >>= \s -> return $ Incoherent s
--- 3 -> (get bh) >>= \s -> return $ Overlapping s
--- 4 -> (get bh) >>= \s -> return $ Overlappable s
--- _ -> panic ("get OverlapMode" ++ show h)
-
-
--- instance Binary OverlapFlag where
--- put_ bh flag = do put_ bh (overlapMode flag)
--- put_ bh (isSafeOverlap flag)
--- get bh = do
--- h <- get bh
--- b <- get bh
--- return OverlapFlag { overlapMode = h, isSafeOverlap = b }
-
--- instance Binary FixityDirection where
--- put_ bh InfixL = do
--- putByte bh 0
--- put_ bh InfixR = do
--- putByte bh 1
--- put_ bh InfixN = do
--- putByte bh 2
--- get bh = do
--- h <- getByte bh
--- case h of
--- 0 -> do return InfixL
--- 1 -> do return InfixR
--- _ -> do return InfixN
-
--- instance Binary Fixity where
--- put_ bh (Fixity src aa ab) = do
--- put_ bh src
--- put_ bh aa
--- put_ bh ab
--- get bh = do
--- src <- get bh
--- aa <- get bh
--- ab <- get bh
--- return (Fixity src aa ab)
-
--- instance Binary WarningTxt where
--- put_ bh (WarningTxt s w) = do
--- putByte bh 0
--- put_ bh s
--- put_ bh w
--- put_ bh (DeprecatedTxt s d) = do
--- putByte bh 1
--- put_ bh s
--- put_ bh d
-
--- get bh = do
--- h <- getByte bh
--- case h of
--- 0 -> do s <- get bh
--- w <- get bh
--- return (WarningTxt s w)
--- _ -> do s <- get bh
--- d <- get bh
--- return (DeprecatedTxt s d)
-
--- instance Binary StringLiteral where
--- put_ bh (StringLiteral st fs _) = do
--- put_ bh st
--- put_ bh fs
--- get bh = do
--- st <- get bh
--- fs <- get bh
--- return (StringLiteral st fs Nothing)
-
newtype BinLocated a = BinLocated { unBinLocated :: Located a }
instance Binary a => Binary (BinLocated a) where
diff --git a/compiler/GHC/Utils/Panic/Plain.hs b/compiler/GHC/Utils/Panic/Plain.hs
index 04281ff6d298..85acb1180152 100644
--- a/compiler/GHC/Utils/Panic/Plain.hs
+++ b/compiler/GHC/Utils/Panic/Plain.hs
@@ -92,7 +92,7 @@ showPlainGhcException =
showString "panic! (the 'impossible' happened)\n"
. showString (" GHC version " ++ cProjectVersion ++ ":\n\t")
. s . showString "\n\n"
- . showString "Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug\n"
+ . showString "Please report this as a GHC bug: https://github.com/stable-haskell/ghc/issues\n"
throwPlainGhcException :: PlainGhcException -> a
throwPlainGhcException = Exception.throw
diff --git a/compiler/Language/Haskell/Syntax/Binds.hs b/compiler/Language/Haskell/Syntax/Binds.hs
index 197052624b48..73698cb2fbd6 100644
--- a/compiler/Language/Haskell/Syntax/Binds.hs
+++ b/compiler/Language/Haskell/Syntax/Binds.hs
@@ -233,7 +233,7 @@ data HsBindLR idL idR
var_rhs :: LHsExpr idR -- ^ Located only for consistency
}
- -- | Patterns Synonym Binding
+ -- | Pattern Synonym Binding
| PatSynBind
(XPatSynBind idL idR)
(PatSynBind idL idR)
diff --git a/compiler/Setup.hs b/compiler/Setup.hs
index c112aaba549d..48bacb99c61f 100644
--- a/compiler/Setup.hs
+++ b/compiler/Setup.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE CPP #-}
module Main where
import Distribution.Simple
@@ -12,6 +13,9 @@ import Distribution.Simple.Program
import Distribution.Simple.Utils
import Distribution.Simple.Setup
import Distribution.Simple.PackageIndex
+#if MIN_VERSION_Cabal(3,14,0)
+import Distribution.Simple.LocalBuildInfo (interpretSymbolicPathLBI)
+#endif
import System.IO
import System.Process
@@ -23,12 +27,26 @@ import qualified Data.Map as Map
import GHC.ResponseFile
import System.Environment
+-- | Extract the 'Verbosity' from the configure flags.
+--
+-- Cabal 3.17 (commit edb808a0b8b) split the old @Verbosity@ type into
+-- 'VerbosityFlags' (the CLI-passable part) and 'VerbosityHandles', so
+-- 'configVerbosity' now yields a 'VerbosityFlags' which must be wrapped
+-- back into a 'Verbosity' before passing it to the Cabal library functions.
+configVerbosity' :: ConfigFlags -> Verbosity
+#if MIN_VERSION_Cabal(3,17,0)
+configVerbosity' cfg =
+ mkVerbosity defaultVerbosityHandles (fromFlagOrDefault silent (configVerbosity cfg))
+#else
+configVerbosity' cfg = fromFlagOrDefault minBound (configVerbosity cfg)
+#endif
+
main :: IO ()
main = defaultMainWithHooks ghcHooks
where
ghcHooks = simpleUserHooks
{ postConf = \args cfg pd lbi -> do
- let verbosity = fromFlagOrDefault minBound (configVerbosity cfg)
+ let verbosity = configVerbosity' cfg
ghcAutogen verbosity lbi
postConf simpleUserHooks args cfg pd lbi
}
@@ -54,19 +72,28 @@ primopIncls =
, ("primop-vector-tycons.hs-incl" , "--primop-vector-tycons")
, ("primop-docs.hs-incl" , "--wired-in-docs")
, ("primop-deprecations.hs-incl" , "--wired-in-deprecations")
+ , ("primop-prim-module.hs-incl" , "--prim-module")
+ , ("primop-wrappers-module.hs-incl" , "--wrappers-module")
]
ghcAutogen :: Verbosity -> LocalBuildInfo -> IO ()
ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameMap,installedPkgs}
= 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
- (ghc ,withPrograms) <- requireProgram normal ghcProgram withPrograms
+ (gcc ,withPrograms) <- requireProgram verbosity gccProgram withPrograms
+ (ghc ,withPrograms) <- requireProgram verbosity ghcProgram withPrograms
- settings <- read <$> getProgramOutput normal ghc ["--info"]
+ settings <- read <$> getProgramOutput verbosity ghc ["--info"]
-- We are reinstalling GHC
-- Write primop-*.hs-incl
let hsCppOpts = case lookup "Haskell CPP flags" settings of
@@ -76,34 +103,44 @@ ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameM
cppOpts = hsCppOpts ++ ["-P","-x","c"]
cppIncludes = map ("-I"++) [compilerRoot]
-- Preprocess primops.txt.pp
- primopsStr <- getProgramOutput normal gcc (cppOpts ++ cppIncludes ++ [primopsTxtPP])
+ primopsStr <- getProgramOutput verbosity gcc (cppOpts ++ cppIncludes ++ [primopsTxtPP])
-- 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"
let cGhcInternalUnitId = case lookupPackageName installedPkgs (mkPackageName "ghc-internal") of
- -- We assume there is exactly one copy of `ghc-internal` in our dependency closure
+ -- We assume there is exactly one copy of `ghc-internal` in our dependency closure for
+ -- ghc >= 9.10 that have the ghc-internal library.
[(_,[packageInfo])] -> unUnitId $ installedUnitId packageInfo
+ -- for ghc < 9.10 we expect to find none.
+ [] -> ""
+ -- for anything else this is an issue.
_ -> error "Couldn't find unique ghc-internal 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 cGhcInternalUnitId settings
createDirectoryIfMissingVerbose verbosity True (takeDirectory configHsPath)
rewriteFileEx verbosity configHsPath configHs
@@ -119,6 +156,8 @@ generateConfigHs :: String -- ^ ghc's cabal-generated unit-id, which matches its
-> String -- ^ ghc-internal's cabal-generated unit-id, which matches its package-id/key
-> [(String,String)] -> String
generateConfigHs cProjectUnitId cGhcInternalUnitId settings = either error id $ do
+ -- cStage = 2 is clearly wrong. As we compile the stage 1 compiler with this
+ -- file as well!
let getSetting' = getSetting $ (("cStage","2"):) settings
buildPlatform <- getSetting' "cBuildPlatformString" "Host platform"
hostPlatform <- getSetting' "cHostPlatformString" "Target platform"
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index d5e60a8d94c1..26fd609c8a55 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -32,25 +32,9 @@ extra-source-files:
GHC/Builtin/primops.txt.pp
Unique.h
CodeGen.Platform.h
- -- Shared with rts via hard-link at configure time. This is safer
- -- for Windows, where symlinks don't work out of the box, so we
- -- can't just commit some in git.
- Bytecodes.h
- ClosureTypes.h
- FunTypes.h
- MachRegs.h
- MachRegs/arm32.h
- MachRegs/arm64.h
- MachRegs/loongarch64.h
- MachRegs/ppc.h
- MachRegs/riscv64.h
- MachRegs/s390x.h
- MachRegs/wasm32.h
- MachRegs/x86.h
-
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.18, directory, process, filepath, containers
Flag internal-interpreter
Description: Build with internal interpreter support.
@@ -67,6 +51,7 @@ Flag dynamic-system-linker
Flag build-tool-depends
Description: Use build-tool-depends
Default: True
+ Manual: True
Flag with-libzstd
Default: False
@@ -95,11 +80,6 @@ Library
Default-Language: GHC2021
Exposed: False
Includes: Unique.h
- -- CodeGen.Platform.h -- invalid as C, skip
- -- shared with rts via symlink
- Bytecodes.h
- ClosureTypes.h
- FunTypes.h
if flag(build-tool-depends)
build-tool-depends: alex:alex >= 3.2.6, happy:happy >= 1.20.0, genprimopcode:genprimopcode, deriveConstants:deriveConstants
@@ -131,17 +111,19 @@ Library
semaphore-compat,
stm,
rts,
+ rts-headers,
ghc-boot == @ProjectVersionMunged@,
- ghc-heap >=9.10.1 && <=@ProjectVersionMunged@,
ghci == @ProjectVersionMunged@
if flag(bootstrap)
+ CPP-Options: -DBOOTSTRAPPING
Build-Depends:
ghc-boot-th-next == @ProjectVersionMunged@
else
Build-Depends:
ghc-boot-th == @ProjectVersionMunged@,
ghc-internal == @ProjectVersionForLib@.0,
+ ghc-heap >= 9.10.1 && <=@ProjectVersionMunged@,
if os(windows)
Build-Depends: Win32 >= 2.3 && < 2.15
@@ -271,6 +253,7 @@ Library
GHC.CmmToAsm.AArch64.CodeGen
GHC.CmmToAsm.AArch64.Cond
GHC.CmmToAsm.AArch64.Instr
+ GHC.CmmToAsm.AArch64.Peephole
GHC.CmmToAsm.AArch64.Ppr
GHC.CmmToAsm.AArch64.RegInfo
GHC.CmmToAsm.AArch64.Regs
@@ -325,6 +308,7 @@ Library
GHC.CmmToAsm.Reg.Linear.X86
GHC.CmmToAsm.Reg.Linear.X86_64
GHC.CmmToAsm.Reg.Liveness
+ GHC.CmmToAsm.Reg.Regs
GHC.CmmToAsm.Reg.Target
GHC.CmmToAsm.Reg.Utils
GHC.CmmToAsm.RV64
@@ -511,6 +495,7 @@ Library
GHC.Driver.Config.HsToCore
GHC.Driver.Config.HsToCore.Ticks
GHC.Driver.Config.HsToCore.Usage
+ GHC.Driver.Config.Interpreter
GHC.Driver.Config.Linker
GHC.Driver.Config.Logger
GHC.Driver.Config.Parser
@@ -642,11 +627,12 @@ Library
GHC.JS.JStg.Syntax
GHC.JS.JStg.Monad
GHC.JS.Transform
+ GHC.Linker.ArchivePrelink
GHC.Linker.Config
GHC.Linker.Deps
GHC.Linker.Dynamic
GHC.Linker.External
- GHC.Linker.ExtraObj
+ GHC.Linker.Executable
GHC.Linker.Loader
GHC.Linker.MacOS
GHC.Linker.Static
@@ -719,6 +705,8 @@ Library
GHC.Runtime.Heap.Inspect
GHC.Runtime.Heap.Layout
GHC.Runtime.Interpreter
+ GHC.Runtime.Interpreter.C
+ GHC.Runtime.Interpreter.Init
GHC.Runtime.Interpreter.JS
GHC.Runtime.Interpreter.Process
GHC.Runtime.Interpreter.Types
diff --git a/configure.ac b/configure.ac
index 3018197a7d77..2db92fda4159 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,1125 +1,73 @@
-dnl == autoconf source for the Glasgow FP tools ==
-dnl (run "grep '^dnl \*' configure.ac | sed -e 's/dnl / /g; s/\*\*/ +/g;'"
-dnl (or some such) to see the outline of this file)
-dnl
-#
-# (c) The University of Glasgow 1994-2012
-#
-# Configure script template for GHC
-#
-# Process with 'autoreconf' to get a working configure script.
-#
-# For the generated configure script, do "./configure --help" to
-# see what flags are available. (Better yet, read the documentation!)
-#
-
-AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.14.1], [glasgow-haskell-bugs@haskell.org], [ghc-AC_PACKAGE_VERSION])
- # Version on master must be X.Y (not X.Y.Z) for ProjectVersionMunged variable
- # to be useful (cf #19058). However, the version must have three components
- # (X.Y.Z) on stable branches (e.g. ghc-9.2) to ensure that pre-releases are
- # versioned correctly.
-
-AC_CONFIG_MACRO_DIRS([m4])
-
-# Set this to YES for a released version, otherwise NO
-: ${RELEASE=YES}
-
-# The primary version (e.g. 7.5, 7.4.1) is set in the AC_INIT line
-# above. If this is not a released version, then we will append the
-# date to the version number (e.g. 7.4.20111220). The date is
-# constructed by finding the date of the most recent patch in the
-# git repository. If this is a source distribution (not a git
-# checkout), then we ship a file 'VERSION' containing the full version
-# when the source distribution was created.
-
-if test ! -f rts/ghcautoconf.h.autoconf.in; then
- echo "rts/ghcautoconf.h.autoconf.in doesn't exist: perhaps you haven't run 'python3 boot'?"
- exit 1
-fi
-
-dnl this makes sure `./configure --target=`
-dnl works as expected, since we're slightly modifying how Autoconf
-dnl interprets build/host/target and how this interacts with $CC tests
-test -n "$target_alias" && ac_tool_prefix=$target_alias-
-
-dnl ----------------------------------------------------------
-dnl ** Store USER specified environment variables to pass them on to
-dnl ** ghc-toolchain (in m4/ghc-toolchain.m4)
-USER_CFLAGS="$CFLAGS"
-USER_LDFLAGS="$LDFLAGS"
-USER_LIBS="$LIBS"
-USER_CXXFLAGS="$CXXFLAGS"
-dnl The lower-level/not user-facing environment variables that may still be set
-dnl by developers such as in ghc-wasm-meta
-USER_CONF_CC_OPTS_STAGE2="$CONF_CC_OPTS_STAGE2"
-USER_CONF_CXX_OPTS_STAGE2="$CONF_CXX_OPTS_STAGE2"
-USER_CONF_GCC_LINKER_OPTS_STAGE2="$CONF_GCC_LINKER_OPTS_STAGE2"
-
-USER_LD="$LD"
-
-dnl ----------------------------------------------------------
-dnl ** Find unixy sort and find commands,
-dnl ** which are needed by FP_SETUP_PROJECT_VERSION
-
-dnl ** Find find command (for Win32's benefit)
-FP_PROG_FIND
-FP_PROG_SORT
-
-dnl ----------------------------------------------------------
-FP_SETUP_PROJECT_VERSION
-
-# Hmmm, we fix the RPM release number to 1 here... Is this convenient?
-AC_SUBST([release], [1])
-
-dnl * We require autoconf version 2.69 due to
-dnl https://bugs.ruby-lang.org/issues/8179. Also see #14910.
-dnl * We need 2.50 due to the use of AC_SYS_LARGEFILE and AC_MSG_NOTICE.
-dnl * We need 2.52 due to the use of AS_TR_CPP and AS_TR_SH.
-dnl * Using autoconf 2.59 started to give nonsense like this
-dnl #define SIZEOF_CHAR 0
-dnl recently.
+# configure.ac
AC_PREREQ([2.69])
-
-# No, semi-sadly, we don't do `--srcdir'...
-if test x"$srcdir" != 'x.' ; then
- echo "This configuration does not support the \`--srcdir' option.."
- exit 1
-fi
-
-dnl --------------------------------------------------------------
-dnl * Project specific configuration options
-dnl --------------------------------------------------------------
-dnl What follows is a bunch of options that can either be configured
-dnl through command line options to the configure script or by
-dnl supplying defns in the build tree's mk/build.mk. Having the option to
-dnl use either is considered a Feature.
-
-dnl ** What command to use to compile compiler sources ?
-dnl --------------------------------------------------------------
-
-AC_ARG_VAR(GHC,[Use as the full path to GHC. [default=autodetect]])
-AC_PATH_PROG([GHC], [ghc])
-AC_ARG_WITH([ghc],
- AS_HELP_STRING([--with-ghc=PATH], [Use PATH as the full path to ghc (obsolete, use GHC=PATH instead) [default=autodetect]]),
- AC_MSG_ERROR([--with-ghc=$withval is obsolete (use './configure GHC=$withval' or 'GHC=$withval ./configure' instead)]))
-AC_SUBST(WithGhc,$GHC)
-
-AC_ARG_ENABLE(bootstrap-with-devel-snapshot,
-[AS_HELP_STRING([--enable-bootstrap-with-devel-snapshot],
- [Allow bootstrapping using a development snapshot of GHC. This is not guaranteed to work.])],
- [FP_CAPITALIZE_YES_NO(["$enableval"], [EnableBootstrapWithDevelSnaphost])],
- [EnableBootstrapWithDevelSnaphost=NO]
-)
-
-AC_ARG_ENABLE(ignore-build-platform-mismatch,
-[AS_HELP_STRING([--ignore-build-platform-mismatch],
- [Ignore when the target platform reported by the bootstrap compiler doesn''t match the configured build platform. This flag is used to correct mistakes when the target platform is incorrectly reported by the bootstrap (#25200). ])],
- [FP_CAPITALIZE_YES_NO(["$enableval"], [IgnoreBuildPlatformMismatch])],
- [IgnoreBuildPlatformMismatch=NO]
-)
-
-
-AC_ARG_ENABLE(tarballs-autodownload,
-[AS_HELP_STRING([--enable-tarballs-autodownload],
- [Automatically download Windows distribution binaries if needed.])],
- [FP_CAPITALIZE_YES_NO(["$enableval"], [TarballsAutodownload])],
- [TarballsAutodownload=NO]
-)
-
-AC_ARG_ENABLE(distro-toolchain,
-[AS_HELP_STRING([--enable-distro-toolchain],
- [Do not use bundled Windows toolchain binaries.])],
- [FP_CAPITALIZE_YES_NO(["$enableval"], [EnableDistroToolchain])],
- [EnableDistroToolchain=NO]
-)
-
-if test "$EnableDistroToolchain" = "YES"; then
- TarballsAutodownload=NO
-fi
-
-AC_ARG_ENABLE(ghc-toolchain,
-[AS_HELP_STRING([--enable-ghc-toolchain],
- [Whether to use the newer ghc-toolchain tool to configure ghc targets])],
- [FP_CAPITALIZE_YES_NO(["$enableval"], [EnableGhcToolchain])],
- [EnableGhcToolchain=NO]
-)
-AC_SUBST([EnableGhcToolchain])
-
-AC_ARG_ENABLE(strict-ghc-toolchain-check,
-[AS_HELP_STRING([--enable-strict-ghc-toolchain-check],
- [Whether to raise an error if the output of ghc-toolchain differs from configure])],
- [FP_CAPITALIZE_YES_NO(["$enableval"], [EnableStrictGhcToolchainCheck])],
- [EnableStrictGhcToolchainCheck=NO]
-)
-AC_SUBST([EnableStrictGhcToolchainCheck])
-
-dnl CC_STAGE0, LD_STAGE0, AR_STAGE0 are like the "previous" variable
-dnl CC, LD, AR (inherited by CC_STAGE[123], etc.)
-dnl but instead used by stage0 for bootstrapping stage1
-AC_ARG_VAR(CC_STAGE0, [C compiler command (bootstrap)])
-AC_ARG_VAR(LD_STAGE0, [Linker command (bootstrap)])
-AC_ARG_VAR(AR_STAGE0, [Archive command (bootstrap)])
-
-dnl RTS ways supplied by the bootstrapping compiler.
-AC_ARG_VAR(RTS_WAYS_STAGE0, [RTS ways])
-
-if test "$WithGhc" != ""; then
- FPTOOLS_GHC_VERSION([GhcVersion], [GhcMajVersion], [GhcMinVersion], [GhcPatchLevel])dnl
-
- if test "$GhcMajVersion" = "unknown" || test "$GhcMinVersion" = "unknown"; then
- AC_MSG_ERROR([Cannot determine the version of $WithGhc. Is it really GHC?])
- fi
-
- AC_SUBST(GhcVersion)dnl
- AC_SUBST(GhcMajVersion)dnl
- AC_SUBST(GhcMinVersion)dnl
- AC_SUBST(GhcPatchLevel)dnl
- GhcMinVersion2=`echo "$GhcMinVersion" | sed 's/^\\(.\\)$/0\\1/'`
- GhcCanonVersion="$GhcMajVersion$GhcMinVersion2"
-
- dnl infer {CC,LD,AR}_STAGE0 from `ghc --info` unless explicitly set by user
- if test -z "$CC_STAGE0"; then
- BOOTSTRAPPING_GHC_INFO_FIELD([CC_STAGE0],[C compiler command])
- fi
-
- if test -z "$LD_STAGE0"; then
- BOOTSTRAPPING_GHC_INFO_FIELD([LD_STAGE0],[ld command])
- # ld command is removed in 9.10.1 as a boot compiler and supplies "Merge objects
- # command" instead
- if test -z "$LD_STAGE0"; then
- BOOTSTRAPPING_GHC_INFO_FIELD([LD_STAGE0],[Merge objects command])
- fi
-
- fi
- if test -z "$AR_STAGE0"; then
- BOOTSTRAPPING_GHC_INFO_FIELD([AR_STAGE0],[ar command])
- fi
- BOOTSTRAPPING_GHC_INFO_FIELD([AR_OPTS_STAGE0],[ar flags])
- BOOTSTRAPPING_GHC_INFO_FIELD([ArSupportsAtFile_STAGE0],[ar supports at file])
- BOOTSTRAPPING_GHC_INFO_FIELD([ArSupportsDashL_STAGE0],[ar supports -L])
- BOOTSTRAPPING_GHC_INFO_FIELD([SUPPORT_SMP_STAGE0],[Support SMP])
- BOOTSTRAPPING_GHC_INFO_FIELD([RTS_WAYS_STAGE0],[RTS ways])
-
- dnl Check whether or not the bootstrapping GHC has a threaded RTS. This
- dnl determines whether or not we can have a threaded stage 1.
- dnl See Note [Linking ghc-bin against threaded stage0 RTS] in
- dnl hadrian/src/Settings/Packages.hs for details.
- dnl SMP support which implies a registerised stage0 is also required (see issue 18266)
- if echo ${RTS_WAYS_STAGE0} | tr ' ' '\n' | grep '^thr$' 2>&1 >/dev/null && \
- test "$SUPPORT_SMP_STAGE0" = "YES"
- then
- AC_SUBST(GhcThreadedRts, YES)
- else
- AC_SUBST(GhcThreadedRts, NO)
- fi
-fi
-
-dnl ** Must have GHC to build GHC
-if test "$WithGhc" = ""
-then
- AC_MSG_ERROR([GHC is required.])
-fi
-MinBootGhcVersion="9.6"
-FP_COMPARE_VERSIONS([$GhcVersion],[-lt],[$MinBootGhcVersion],
- [AC_MSG_ERROR([GHC version $MinBootGhcVersion or later is required to compile GHC.])])
-
-if test `expr $GhcMinVersion % 2` = "1"
-then
- if test "$EnableBootstrapWithDevelSnaphost" = "NO"
- then
- AC_MSG_ERROR([
- $WithGhc is a development snapshot of GHC, version $GhcVersion.
- Bootstrapping using this version of GHC is not supported, and may not
- work. Use --enable-bootstrap-with-devel-snapshot to try it anyway,
- or 'GHC=' to specify a different GHC to use.])
- fi
-fi
-
-# GHC is passed to Cabal, so we need a native path
-if test "${WithGhc}" != ""
-then
- ghc_host_os=`"${WithGhc}" +RTS --info | grep 'Host OS' | sed -e 's/.*, "//' -e 's/")//'`
-
- if test "$ghc_host_os" = "mingw32"
- then
- if test "${OSTYPE}" = "msys"
- then
- WithGhc=`echo "${WithGhc}" | sed "s#^/\([a-zA-Z]\)/#\1:/#"`
- else
- # Canonicalise to :/path/to/ghc
- WithGhc=`cygpath -m "${WithGhc}"`
- fi
- echo "GHC path canonicalised to: ${WithGhc}"
- fi
-fi
-AC_SUBST([WithGhc])
-
-dnl ** Without optimization some INLINE trickery fails for GHCi
-SRC_CC_OPTS="-O"
-
-dnl--------------------------------------------------------------------
-dnl * Choose host(/target/build) platform
-dnl--------------------------------------------------------------------
-dnl If we aren't explicitly told what values to use with configure flags,
-dnl we ask the bootstrapping compiler what platform it is for
-
-if test "${WithGhc}" != ""
-then
- bootstrap_host=`"${WithGhc}" --info | grep '^ ,("Host platform"' | sed -e 's/.*,"//' -e 's/")//' | tr -d '\r'`
- bootstrap_target=`"${WithGhc}" --info | grep '^ ,("Target platform"' | sed -e 's/.*,"//' -e 's/")//' | tr -d '\r'`
- if test "$bootstrap_host" != "$bootstrap_target"
- then
- echo "Bootstrapping GHC is a cross compiler. This probably isn't going to work"
- fi
-fi
-
-# We have to run these unconditionally, but we may discard their
-# results in the following code
-AC_CANONICAL_BUILD
-AC_CANONICAL_HOST
-AC_CANONICAL_TARGET
-
-FPTOOLS_SET_PLATFORMS_VARS
-
-FP_PROG_SH
-
-# Verify that the installed (bootstrap) GHC is capable of generating
-# code for the requested build platform.
-if test "$BuildPlatform" != "$bootstrap_target"
-then
- if test "$IgnoreBuildPlatformMismatch" = "NO"
- then
- echo "This GHC (${WithGhc}) does not generate code for the build platform"
- echo " GHC target platform : $bootstrap_target"
- echo " Desired build platform : $BuildPlatform"
- exit 1
- fi
-fi
-
-dnl ** Do an unregisterised build?
-dnl --------------------------------------------------------------
-
-GHC_UNREGISTERISED
-AC_SUBST(Unregisterised)
-
-dnl ** Do a build with tables next to code?
-dnl --------------------------------------------------------------
-
-GHC_TABLES_NEXT_TO_CODE
-AC_SUBST(TablesNextToCode)
-
-# Requires FPTOOLS_SET_PLATFORMS_VARS to be run first.
-FP_FIND_ROOT
-
-# Extract and configure the Windows toolchain
-if test "$HostOS" = "mingw32" -a "$EnableDistroToolchain" = "NO"; then
- FP_INSTALL_WINDOWS_TOOLCHAIN
- FP_SETUP_WINDOWS_TOOLCHAIN([$hardtop/inplace/mingw], [$hardtop/inplace/mingw])
-else
- AC_CHECK_TOOL([CC],[gcc], [clang])
- AC_CHECK_TOOL([CXX],[g++], [clang++])
- AC_CHECK_TOOL([NM],[nm])
- # N.B. we don't probe for LD here but instead
- # do so in FIND_LD to avoid #21778.
- AC_CHECK_TOOL([AR],[ar])
- AC_CHECK_TOOL([RANLIB],[ranlib])
- AC_CHECK_TOOL([OBJDUMP],[objdump])
- AC_CHECK_TOOL([WindresCmd],[windres])
- AC_CHECK_TOOL([Genlib],[genlib])
-
- if test "$HostOS" = "mingw32"; then
- AC_CHECK_TARGET_TOOL([WindresCmd],[windres])
- AC_CHECK_TARGET_TOOL([OBJDUMP],[objdump])
-
- WindresCmd="$(cygpath -m $WindresCmd)"
-
- if test "$Genlib" != ""; then
- GenlibCmd="$(cygpath -m $Genlib)"
- fi
- fi
-fi
-
-FP_ICONV
-FP_GMP
-FP_CURSES
-
-dnl On Windows we force in-tree GMP build until we support dynamic linking
-if test "$HostOS" = "mingw32"
-then
- GMP_FORCE_INTREE="YES"
-fi
-
-dnl ** Building a cross compiler?
-dnl --------------------------------------------------------------
-dnl We allow the user to override this since the target/host check
-dnl can get this wrong in some particular cases. See #26236.
-if test -z "$CrossCompiling" ; then
- CrossCompiling=NO
- # If 'host' and 'target' differ, then this means we are building a cross-compiler.
- if test "$target" != "$host" ; then
- CrossCompiling=YES
- fi
-fi
-if test "$CrossCompiling" = "YES"; then
- # This tells configure that it can accept just 'target',
- # otherwise you get
- # configure: error: cannot run C compiled programs.
- # If you meant to cross compile, use `--host'.
- cross_compiling=yes
-fi
-
-if test "$BuildPlatform" != "$HostPlatform" ; then
- AC_MSG_ERROR([
-You've selected:
-
- BUILD: $BuildPlatform (the architecture we're building on)
- HOST: $HostPlatform (the architecture the compiler we're building will execute on)
- TARGET: $TargetPlatform (the architecture the compiler we're building will produce code for)
-
-BUILD must equal HOST; that is, we do not support building GHC itself
-with a cross-compiler. To cross-compile GHC itself, set TARGET: stage
-1 will be a cross-compiler, and stage 2 will be the cross-compiled
-GHC.
-])
-fi
-# Despite its similarity in name to TargetPlatform, TargetPlatformFull is used
-# in calls to subproject configure scripts and thus must be set to the autoconf
-# triple, not the normalized GHC triple that TargetPlatform is set to.
-#
-# We use the non-canonicalized triple, target_alias, here since the subproject
-# configure scripts will use this triple to construct the names of the toolchain
-# executables. If we instead passed down the triple produced by
-# AC_CANONICAL_TARGET then it may look for the target toolchain under the wrong
-# name (this is a known problem in the case of the Android NDK, which has
-# slightly odd triples).
-#
-# It may be better to just do away with the GHC triples altogether. This would
-# all be taken care of for us if we configured the subprojects using
-# AC_CONFIG_DIR, but unfortunately Cabal needs to be the one to do the
-# configuration.
-#
-# We also use non-canonicalized triple when install stage1 crosscompiler
-if test -z "${target_alias}"
-then
- # --target wasn't given; use result from AC_CANONICAL_TARGET
- TargetPlatformFull="${target}"
-else
- TargetPlatformFull="${target_alias}"
-fi
-AC_SUBST(CrossCompiling)
-AC_SUBST(TargetPlatformFull)
-
-dnl ** Which gcc to use?
-dnl --------------------------------------------------------------
-
-AC_ARG_WITH([gcc],
- AS_HELP_STRING([--with-gcc=ARG], [Use ARG as the path to gcc (obsolete, use CC=ARG instead) [default=autodetect]]),
- AC_MSG_ERROR([--with-gcc=$withval is obsolete (use './configure CC=$withval' or 'CC=$withval ./configure' instead)]))
-
-AC_ARG_WITH([clang],
- AS_HELP_STRING([--with-clang=ARG], [Use ARG as the path to clang (obsolete, use CC=ARG instead) [default=autodetect]]),
- AC_MSG_ERROR([--with-clang=$withval is obsolete (use './configure CC=$withval' or 'CC=$withval ./configure' instead)]))
-
-dnl detect compiler (prefer gcc over clang) and set $CC (unless CC already set),
-dnl later CC is copied to CC_STAGE{1,2,3}
-AC_PROG_CC([cc gcc clang])
-AC_PROG_CXX([g++ clang++ c++])
-# Work around #24324
-MOVE_TO_FLAGS([CC],[CFLAGS])
-MOVE_TO_FLAGS([CXX],[CXXFLAGS])
-
-MAYBE_OVERRIDE_STAGE0([ar],[AR_STAGE0])
-
-dnl make extensions visible to allow feature-tests to detect them lateron
-AC_USE_SYSTEM_EXTENSIONS
-
-# --with-hs-cpp/--with-hs-cpp-flags
-FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs)
-AC_SUBST([HaskellCPPCmd])
-AC_SUBST([HaskellCPPArgs])
-
-# --with-js-cpp/--with-js-cpp-flags
-FP_JSCPP_CMD_WITH_ARGS(JavaScriptCPPCmd, JavaScriptCPPArgs)
-AC_SUBST([JavaScriptCPPCmd])
-AC_SUBST([JavaScriptCPPArgs])
-
-# --with-cmm-cpp/--with-cmm-cpp-flags
-FP_CMM_CPP_CMD_WITH_ARGS([$CC_STAGE0], [CmmCPPCmd_STAGE0], [CmmCPPArgs_STAGE0], [CmmCPPSupportsG0_STAGE0])
-AC_SUBST([CmmCPPCmd_STAGE0])
-AC_SUBST([CmmCPPArgs_STAGE0])
-AC_SUBST([CmmCPPSupportsG0_STAGE0])
-FP_CMM_CPP_CMD_WITH_ARGS([$CC], [CmmCPPCmd], [CmmCPPArgs], [CmmCPPSupportsG0])
-AC_SUBST([CmmCPPCmd])
-AC_SUBST([CmmCPPArgs])
-AC_SUBST([CmmCPPSupportsG0])
-
-FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS])
-FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0])
-FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1])
-FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2])
-
-dnl ** Do we have a compatible emsdk version?
-dnl --------------------------------------------------------------
-EMSDK_VERSION("3.1.20", "", "")
-
-dnl ** Which ld to use
-dnl --------------------------------------------------------------
-AC_ARG_VAR(LD,[Use as the path to ld. See also --disable-ld-override.])
-FIND_LD([$target],[GccUseLdOpt])
-FIND_MERGE_OBJECTS()
-CONF_GCC_LINKER_OPTS_STAGE1="$CONF_GCC_LINKER_OPTS_STAGE1 $GccUseLdOpt"
-CONF_GCC_LINKER_OPTS_STAGE2="$CONF_GCC_LINKER_OPTS_STAGE2 $GccUseLdOpt"
-CFLAGS="$CFLAGS $GccUseLdOpt"
-
-FP_PROG_LD_IS_GNU
-FP_PROG_LD_NO_COMPACT_UNWIND
-FP_PROG_LD_FILELIST
-FP_PROG_LD_SINGLE_MODULE
-
-
-dnl ** Which nm to use?
-dnl --------------------------------------------------------------
-FP_FIND_NM
-
-dnl ** Which objdump to use?
-dnl --------------------------------------------------------------
-dnl Note: we may not have objdump on OS X, and we only need it on
-dnl Windows (for DLL checks), OpenBSD, and AIX
-case $HostOS_CPP in
- cygwin32|mingw32|openbsd|aix)
- AC_CHECK_TARGET_TOOL([OBJDUMP], [objdump])
- ;;
-esac
-
-if test "$HostOS" = "mingw32"
-then
- ObjdumpCmd=$(cygpath -m "$OBJDUMP")
-else
- ObjdumpCmd="$OBJDUMP"
-fi
-AC_SUBST([ObjdumpCmd])
-
-dnl ** Which ranlib to use?
-dnl --------------------------------------------------------------
-AC_PROG_RANLIB
-if test "$RANLIB" = ":"; then
- AC_MSG_ERROR([cannot find ranlib in your PATH])
-fi
-if test "$HostOS" = "mingw32"
-then
- RanlibCmd=$(cygpath -m "$RANLIB")
-else
- RanlibCmd="$RANLIB"
-fi
-AC_SUBST([RanlibCmd])
-
-dnl ** which strip to use?
-dnl --------------------------------------------------------------
-AC_CHECK_TARGET_TOOL([STRIP], [strip])
-StripCmd="$STRIP"
-AC_SUBST([StripCmd])
-
-dnl ** Which otool to use on macOS
-dnl --------------------------------------------------------------
-AC_CHECK_TARGET_TOOL([OTOOL], [otool])
-OtoolCmd="$OTOOL"
-AC_SUBST(OtoolCmd)
-
-dnl ** Which install_name_tool to use on macOS
-dnl --------------------------------------------------------------
-AC_CHECK_TARGET_TOOL([INSTALL_NAME_TOOL], [install_name_tool])
-InstallNameToolCmd="$INSTALL_NAME_TOOL"
-AC_SUBST(InstallNameToolCmd)
-
-# Here is where we re-target which specific version of the LLVM
-# tools we are looking for. In the past, GHC supported a number of
-# versions of LLVM simultaneously, but that stopped working around
-# 3.5/3.6 release of LLVM.
-LlvmMinVersion=13 # inclusive
-LlvmMaxVersion=21 # not inclusive
+AC_INIT([ghc-builder], [0.1.0], [your-email@example.com])
+AC_CONFIG_SRCDIR([.]) # A representative .in file
+AC_CONFIG_MACRO_DIR([m4]) # For any custom m4 macros
+
+# --- Define GHC Build Options ---
+# Usage: ./configure ProjectVersion=X.Y ...
+AC_ARG_WITH([project-version], [AS_HELP_STRING([--with-project-version=VER], [GHC version (default: 9.14)])], [ProjectVersion="$withval"], [ProjectVersion="9.14"])
+AC_ARG_WITH([project-version-int], [AS_HELP_STRING([--with-project-version-int=VER], [GHC version as int (default: 914)])], [ProjectVersionInt="$withval"], [ProjectVersionInt="914"])
+AC_ARG_WITH([project-version-munged], [AS_HELP_STRING([--with-project-version-munged=VER], [GHC version "munged" (default: 9.14)])], [ProjectVersionMunged="$withval"], [ProjectVersionMunged="9.14"])
+AC_ARG_WITH([project-version-for-lib], [AS_HELP_STRING([--with-project-version-for-lib=VER], [GHC version for libraries (default: 9.1400)])], [ProjectVersionForLib="$withval"], [ProjectVersionForLib="9.1400"])
+AC_ARG_WITH([project-patch-level], [AS_HELP_STRING([--with-project-patch-level=VER], [GHC patchlevel version (default: 0)])], [ProjectPatchLevel="$withval"], [ProjectPatchLevel="0"])
+AC_ARG_WITH([project-patch-level1], [AS_HELP_STRING([--with-project-patch-level1=VER], [GHC patchlevel1 version (default: 0)])], [ProjectPatchLevel1="$withval"], [ProjectPatchLevel1="0"])
+AC_ARG_WITH([project-patch-level2], [AS_HELP_STRING([--with-project-patch-level2=VER], [GHC patchlevel2 version (default: 0)])], [ProjectPatchLevel2="$withval"], [ProjectPatchLevel2="0"])
+
+# Export these variables for substitution by AC_SUBST
+AC_SUBST([ProjectVersion])
+AC_SUBST([ProjectVersionInt])
+AC_SUBST([ProjectVersionMunged])
+AC_SUBST([ProjectVersionForLib])
+AC_SUBST([ProjectPatchLevel])
+AC_SUBST([ProjectPatchLevel1])
+AC_SUBST([ProjectPatchLevel2])
+
+# For ghc-boot-th.cabal.in
+AC_SUBST([Suffix],[""])
+AC_SUBST([SourceRoot],["."])
+
+# Static vs dynamic stage2 builds are selected by the Makefile choosing between
+# cabal.project.stage2.static and cabal.project.stage2.dynamic (DYNAMIC=1), not
+# by configure. See cabal.project.stage2.common and its variants.
+
+# --- Define Programs ---
+# We don't need to check for CC, MAKE_SET, and others for now, we only want substitution.
+# AC_PROG_CC
+# AC_PROG_MAKE_SET # To ensure 'set' works in Makefiles for undefined variables
+AC_CHECK_PROGS([PYTHON], [python3 python python2])
+AS_IF([test "x$PYTHON" = x], [AC_MSG_ERROR([Python interpreter not found. Please install Python or set PYTHON environment variable.])])
+AC_SUBST([PYTHON])
+
+# FIXME: For now we keep this check, but just widen it aggressively.
+# At some point we should just outright remove this.
+LlvmMinVersion=10 # inclusive
+LlvmMaxVersion=100 # not inclusive
AC_SUBST([LlvmMinVersion])
AC_SUBST([LlvmMaxVersion])
-ConfiguredEmsdkVersion="${EmsdkVersion}"
-AC_SUBST([ConfiguredEmsdkVersion])
-
-dnl ** Which LLVM llc to use?
-dnl --------------------------------------------------------------
-AC_ARG_VAR(LLC,[Use as the path to LLVM's llc [default=autodetect]])
-FIND_LLVM_PROG([LLC], [llc], [$LlvmMinVersion], [$LlvmMaxVersion])
-LlcCmd="$LLC"
-AC_SUBST([LlcCmd])
-
-dnl ** Which LLVM opt to use?
-dnl --------------------------------------------------------------
-AC_ARG_VAR(OPT,[Use as the path to LLVM's opt [default=autodetect]])
-FIND_LLVM_PROG([OPT], [opt], [$LlvmMinVersion], [$LlvmMaxVersion])
-OptCmd="$OPT"
-AC_SUBST([OptCmd])
-
-dnl ** Which LLVM assembler to use?
-dnl --------------------------------------------------------------
-AC_ARG_VAR(LLVMAS,[Use as the path to LLVM's assembler (typically clang) [default=autodetect]])
-FIND_LLVM_PROG([LLVMAS], [clang], [$LlvmMinVersion], [$LlvmMaxVersion])
-LlvmAsCmd="$LLVMAS"
-AC_SUBST([LlvmAsCmd])
-
-dnl --------------------------------------------------------------
-dnl End of configure script option section
-dnl --------------------------------------------------------------
-
-dnl ** Copy headers shared by the RTS and compiler
-dnl --------------------------------------------------------------
-dnl We can't commit symlinks without breaking Windows in the default
-dnl configuration.
-AC_MSG_NOTICE([Creating links for headers shared by the RTS and compiler])
-ln -f rts/include/rts/Bytecodes.h compiler/
-ln -f rts/include/rts/storage/ClosureTypes.h compiler/
-ln -f rts/include/rts/storage/FunTypes.h compiler/
-ln -f rts/include/stg/MachRegs.h compiler/
-mkdir -p compiler/MachRegs
-ln -f rts/include/stg/MachRegs/arm32.h compiler/MachRegs/arm32.h
-ln -f rts/include/stg/MachRegs/arm64.h compiler/MachRegs/arm64.h
-ln -f rts/include/stg/MachRegs/loongarch64.h compiler/MachRegs/loongarch64.h
-ln -f rts/include/stg/MachRegs/ppc.h compiler/MachRegs/ppc.h
-ln -f rts/include/stg/MachRegs/riscv64.h compiler/MachRegs/riscv64.h
-ln -f rts/include/stg/MachRegs/s390x.h compiler/MachRegs/s390x.h
-ln -f rts/include/stg/MachRegs/wasm32.h compiler/MachRegs/wasm32.h
-ln -f rts/include/stg/MachRegs/x86.h compiler/MachRegs/x86.h
-AC_MSG_NOTICE([done.])
-
-dnl ** Copy the files from the "fs" utility into the right folders.
-dnl --------------------------------------------------------------
-AC_MSG_NOTICE([Creating links for in-tree file handling routines])
-ln -f utils/fs/fs.* utils/unlit/
-ln -f utils/fs/fs.* rts/
-ln -f utils/fs/fs.h libraries/ghc-internal/include/
-ln -f utils/fs/fs.c libraries/ghc-internal/cbits/
-AC_MSG_NOTICE([Routines in place. Packages can now be build normally.])
-
-dnl ** Copy files for ghci wrapper C utilities.
-dnl --------------------------------------------------------------
-dnl See Note [Hadrian's ghci-wrapper package] in hadrian/src/Packages.hs
-AC_MSG_NOTICE([Creating links for ghci wrapper])
-ln -f driver/utils/getLocation.c driver/ghci/
-ln -f driver/utils/getLocation.h driver/ghci/
-ln -f driver/utils/isMinTTY.c driver/ghci/
-ln -f driver/utils/isMinTTY.h driver/ghci/
-ln -f driver/utils/cwrapper.c driver/ghci/
-ln -f driver/utils/cwrapper.h driver/ghci/
-AC_MSG_NOTICE([done.])
-
-dnl --------------------------------------------------------------
-dnl ** Can the unix package be built?
-dnl --------------------------------------------------------------
-
-dnl ** does #! work?
-AC_SYS_INTERPRETER()
-
-dnl ** look for GCC and find out which version
-dnl Figure out which C compiler to use. Gcc is preferred.
-dnl If gcc, make sure it's at least 4.7
-dnl
-FP_GCC_VERSION
-
-
-dnl ** Check support for the extra flags passed by GHC when compiling via C
-FP_GCC_SUPPORTS_VIA_C_FLAGS
-
-dnl ** Used to determine how to compile ghc-prim's atomics.c, used by
-dnl unregisterised, Sparc, and PPC backends. Also determines whether
-dnl linking to libatomic is required for atomic operations, e.g. on
-dnl RISCV64 GCC.
-FP_CC_SUPPORTS__ATOMICS
-if test "$need_latomic" = 1; then
- AC_SUBST([NeedLibatomic],[YES])
-else
- AC_SUBST([NeedLibatomic],[NO])
-fi
-
-dnl ** look to see if we have a C compiler using an llvm back end.
-dnl
-FP_CC_LLVM_BACKEND
-AC_SUBST(CcLlvmBackend)
-
-FPTOOLS_SET_C_LD_FLAGS([target],[CFLAGS],[LDFLAGS],[IGNORE_LINKER_LD_FLAGS],[CPPFLAGS])
-FPTOOLS_SET_C_LD_FLAGS([build],[CONF_CC_OPTS_STAGE0],[CONF_GCC_LINKER_OPTS_STAGE0],[CONF_LD_LINKER_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0])
-FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE1],[CONF_GCC_LINKER_OPTS_STAGE1],[CONF_LD_LINKER_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1])
-FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE2],[CONF_GCC_LINKER_OPTS_STAGE2],[CONF_LD_LINKER_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2])
-# Stage 3 won't be supported by cross-compilation
-
-#-no_fixup_chains
-FP_LD_NO_FIXUP_CHAINS([target], [LDFLAGS])
-FP_LD_NO_FIXUP_CHAINS([build], [CONF_GCC_LINKER_OPTS_STAGE0])
-FP_LD_NO_FIXUP_CHAINS([target], [CONF_GCC_LINKER_OPTS_STAGE1])
-FP_LD_NO_FIXUP_CHAINS([target], [CONF_GCC_LINKER_OPTS_STAGE2])
-
-#-no_warn_duplicate_libraries
-FP_LD_NO_WARN_DUPLICATE_LIBRARIES([build], [CONF_GCC_LINKER_OPTS_STAGE0])
-FP_LD_NO_WARN_DUPLICATE_LIBRARIES([target], [CONF_GCC_LINKER_OPTS_STAGE1])
-FP_LD_NO_WARN_DUPLICATE_LIBRARIES([target], [CONF_GCC_LINKER_OPTS_STAGE2])
-
-FP_MERGE_OBJECTS_SUPPORTS_RESPONSE_FILES
-
-GHC_LLVM_TARGET_SET_VAR
-# The target is substituted into the distrib/configure.ac file
-AC_SUBST(LlvmTarget)
-
-dnl ** See whether cc supports --target= and set
-dnl CONF_CC_OPTS_STAGE[012] accordingly.
-FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0])
-FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1])
-FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2])
-
-FP_PROG_CC_LINKER_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_GCC_LINKER_OPTS_STAGE0])
-FP_PROG_CC_LINKER_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1])
-FP_PROG_CC_LINKER_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2])
-
-dnl ** See whether cc used as a linker supports -no-pie
-FP_GCC_SUPPORTS_NO_PIE
-
-dnl Pass -Qunused-arguments or otherwise GHC will have very noisy invocations of Clang
-dnl TODO: Do we need -Qunused-arguments in CXX and GCC linker too?
-FP_CC_IGNORE_UNUSED_ARGS([$CC_STAGE0], [CONF_CC_OPTS_STAGE0])
-FP_CC_IGNORE_UNUSED_ARGS([$CC], [CONF_CC_OPTS_STAGE1])
-FP_CC_IGNORE_UNUSED_ARGS([$CC], [CONF_CC_OPTS_STAGE2])
-
-# CPP, CPPFLAGS
-# --with-cpp/-with-cpp-flags
-dnl Note that we must do this after setting and using the C99 CPPFLAGS, or
-dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG
-FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0])
-FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1])
-FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2])
-AC_SUBST([CPPCmd_STAGE0])
-AC_SUBST([CPPCmd])
-
-# See rules/distdir-way-opts.mk for details.
-# Flags passed to the C compiler
-AC_SUBST(CONF_CC_OPTS_STAGE0)
-AC_SUBST(CONF_CC_OPTS_STAGE1)
-AC_SUBST(CONF_CC_OPTS_STAGE2)
-# Flags passed to the C compiler when we ask it to link
-AC_SUBST(CONF_GCC_LINKER_OPTS_STAGE0)
-AC_SUBST(CONF_GCC_LINKER_OPTS_STAGE1)
-AC_SUBST(CONF_GCC_LINKER_OPTS_STAGE2)
-# Flags passed to the linker when we ask it to link
-AC_SUBST(CONF_LD_LINKER_OPTS_STAGE0)
-AC_SUBST(CONF_LD_LINKER_OPTS_STAGE1)
-AC_SUBST(CONF_LD_LINKER_OPTS_STAGE2)
-# Flags passed to the C preprocessor
-AC_SUBST(CONF_CPP_OPTS_STAGE0)
-AC_SUBST(CONF_CPP_OPTS_STAGE1)
-AC_SUBST(CONF_CPP_OPTS_STAGE2)
-# Flags passed to the Haskell compiler
-AC_SUBST(CONF_HC_OPTS_STAGE0)
-AC_SUBST(CONF_HC_OPTS_STAGE1)
-AC_SUBST(CONF_HC_OPTS_STAGE2)
-
-dnl Identify C++ standard library flavour and location only when _not_ compiling
-dnl the JS backend. The JS backend uses emscripten to wrap c++ utilities which
-dnl fails this check, so we avoid it when compiling to JS.
-if test "$TargetOS" != "ghcjs"; then
- FP_FIND_CXX_STD_LIB
-fi
-AC_CONFIG_FILES([mk/system-cxx-std-lib-1.0.conf])
-
-dnl ** Set up the variables for the platform in the settings file.
-dnl May need to use gcc to find platform details.
-dnl --------------------------------------------------------------
-FPTOOLS_SET_HASKELL_PLATFORM_VARS([Build])
-
-FPTOOLS_SET_HASKELL_PLATFORM_VARS([Host])
-AC_SUBST(HaskellHostArch)
-AC_SUBST(HaskellHostOs)
-
-FPTOOLS_SET_HASKELL_PLATFORM_VARS([Target])
-AC_SUBST(HaskellTargetArch)
-AC_SUBST(HaskellTargetOs)
-
-GHC_SUBSECTIONS_VIA_SYMBOLS
-AC_SUBST(TargetHasSubsectionsViaSymbols)
-
-GHC_IDENT_DIRECTIVE
-AC_SUBST(TargetHasIdentDirective)
-
-GHC_GNU_NONEXEC_STACK
-AC_SUBST(TargetHasGnuNonexecStack)
-
-dnl Let's make sure install-sh is executable here. If we got it from
-dnl a darcs repo, it might not be (see bug #978).
-chmod +x install-sh
-dnl ** figure out how to do a BSD-ish install
-AC_PROG_INSTALL
-
-dnl ** how to invoke `ar' and `ranlib'
-FP_PROG_AR_SUPPORTS_ATFILE
-FP_PROG_AR_SUPPORTS_DASH_L
-FP_PROG_AR_NEEDS_RANLIB
-
-dnl ** Check to see whether ln -s works
-AC_PROG_LN_S
-
-FP_SETTINGS
-
-dnl ** Find the path to sed
-AC_PATH_PROGS(SedCmd,gsed sed,sed)
-
-
-dnl ** check for time command
-AC_PATH_PROG(TimeCmd,time)
-
-dnl ** check for tar
-dnl if GNU tar is named gtar, look for it first.
-AC_PATH_PROGS(TarCmd,gnutar gtar tar,tar)
-
-dnl ** check for autoreconf
-AC_PATH_PROG(AutoreconfCmd, autoreconf, autoreconf)
-
-dnl ** check for dtrace (currently only implemented for Mac OS X)
-AC_ARG_ENABLE(dtrace,
- [AS_HELP_STRING([--enable-dtrace],
- [Enable DTrace])],
- EnableDtrace=$enableval,
- EnableDtrace=yes
-)
-
-HaveDtrace=NO
-
-AC_PATH_PROG(DtraceCmd,dtrace)
-if test "x$EnableDtrace" = "xyes"; then
- if test -n "$DtraceCmd"; then
- if test "x$TargetOS_CPP-$TargetVendor_CPP" = "xdarwin-apple" \
- -o "x$TargetOS_CPP-$TargetVendor_CPP" = "xfreebsd-portbld" \
- -o "x$TargetOS_CPP-$TargetVendor_CPP" = "xsolaris2-unknown"; then
- HaveDtrace=YES
- fi
- fi
-fi
-AC_SUBST(HaveDtrace)
-
-AC_PATH_PROG(HSCOLOUR,HsColour)
-# HsColour is passed to Cabal, so we need a native path
-if test "$HostOS" = "mingw32" && \
- test "${OSTYPE}" != "msys" && \
- test "${HSCOLOUR}" != ""
-then
- # Canonicalise to :/path/to/gcc
- HSCOLOUR=`cygpath -m ${HSCOLOUR}`
-fi
-
-dnl ** check for Sphinx toolchain
-AC_PATH_PROG(SPHINXBUILD,sphinx-build)
-AC_CACHE_CHECK([for version of sphinx-build], fp_cv_sphinx_version,
-changequote(, )dnl
-[if test -n "$SPHINXBUILD"; then
- fp_cv_sphinx_version=`"$SPHINXBUILD" --version 2>&1 | sed -re 's/.* v?([0-9]\.[0-9]\.[0-9])/\1/' | head -n1`;
-fi;
-changequote([, ])dnl
+# --- Files to generate ---
+# config.status will create these files by substituting @VAR@ placeholders.
+AC_CONFIG_FILES([
+ ghc/ghc-bin.cabal
+ compiler/ghc.cabal
+ compiler/GHC/CmmToLlvm/Version/Bounds.hs
+ libraries/ghc-boot/ghc-boot.cabal
+ libraries/ghc-boot-th/ghc-boot-th.cabal
+ libraries/ghc-boot-th-next/ghc-boot-th-next.cabal
+ libraries/ghc-heap/ghc-heap.cabal
+ libraries/template-haskell/template-haskell.cabal
+ libraries/ghci/ghci.cabal
+ utils/ghc-pkg/ghc-pkg.cabal
+ utils/ghc-iserv/ghc-iserv.cabal
+ utils/runghc/runghc.cabal
+ libraries/ghc-internal/ghc-internal.cabal
+ libraries/ghc-experimental/ghc-experimental.cabal
+ libraries/base/base.cabal
+ rts/include/ghcversion.h
])
-FP_COMPARE_VERSIONS([$fp_cv_sphinx_version],-lt,1.0.0,
- [AC_MSG_WARN([Sphinx version 1.0.0 or later is required to build documentation]); SPHINXBUILD=;])
-if test -n "$SPHINXBUILD"; then
- if "$SPHINXBUILD" -b text utils/check-sphinx utils/check-sphinx/dist > /dev/null 2>&1; then true; else
- AC_MSG_WARN([Sphinx for python3 is required to build documentation.])
- SPHINXBUILD=;
- fi
-fi
-
-dnl ** check for xelatex
-AC_PATH_PROG(XELATEX,xelatex)
-AC_PATH_PROG(MAKEINDEX,makeindex)
-AC_PATH_PROG(GIT,git)
-
-dnl ** check for makeinfo
-AC_PATH_PROG(MAKEINFO,makeinfo)
-
-dnl ** check for cabal
-AC_PATH_PROG(CABAL,cabal)
-
-
-dnl ** check for Python for testsuite driver
-FIND_PYTHON
-
-dnl ** check for ghc-pkg command
-FP_PROG_GHC_PKG
-
-dnl ** check for installed happy binary + version
-
-AC_ARG_VAR(HAPPY,[Use as the path to happy [default=autodetect]])
-FPTOOLS_HAPPY
-
-dnl ** check for installed alex binary + version
-
-AC_ARG_VAR(ALEX,[Use as the path to alex [default=autodetect]])
-FPTOOLS_ALEX
-
-dnl --------------------------------------------------
-dnl ### program checking section ends here ###
-dnl --------------------------------------------------
-
-dnl for use in settings file
-AC_CHECK_SIZEOF([void *])
-TargetWordSize=$ac_cv_sizeof_void_p
-AC_SUBST(TargetWordSize)
-
-AC_C_BIGENDIAN([TargetWordBigEndian=YES],[TargetWordBigEndian=NO])
-AC_SUBST(TargetWordBigEndian)
-
-dnl ** check for math library
-dnl Keep that check as early as possible.
-dnl as we need to know whether we need libm
-dnl for math functions or not
-dnl (see https://gitlab.haskell.org/ghc/ghc/issues/3730)
-AC_CHECK_LIB(m, atan, UseLibm=YES, UseLibm=NO)
-AC_SUBST([UseLibm])
-TargetHasLibm=$UseLibm
-AC_SUBST(TargetHasLibm)
-
-FP_BFD_FLAG
-AC_SUBST([UseLibbfd])
-
-dnl ################################################################
-dnl Check for libraries
-dnl ################################################################
-
-FP_FIND_LIBFFI
-AC_SUBST(UseSystemLibFFI)
-AC_SUBST(FFILibDir)
-AC_SUBST(FFIIncludeDir)
-
-dnl ** check whether we need -ldl to get dlopen()
-AC_CHECK_LIB([dl], [dlopen], UseLibdl=YES, UseLibdl=NO)
-AC_SUBST([UseLibdl])
-
-dnl ** check for leading underscores in symbol names
-FP_LEADING_UNDERSCORE
-AC_SUBST([LeadingUnderscore], [`echo $fptools_cv_leading_underscore | sed 'y/yesno/YESNO/'`])
-
-dnl ** check for librt
-AC_CHECK_LIB([rt], [clock_gettime], UseLibrt=YES, UseLibrt=NO)
-AC_SUBST([UseLibrt])
-
-FP_CHECK_PTHREAD_LIB
-AC_SUBST([UseLibpthread])
-
-GHC_ADJUSTORS_METHOD([Target])
-AC_SUBST([UseLibffiForAdjustors])
-
-dnl ** IPE data compression
-dnl --------------------------------------------------------------
-FP_FIND_LIBZSTD
-AC_SUBST(UseLibZstd)
-AC_SUBST(UseStaticLibZstd)
-AC_SUBST(LibZstdLibDir)
-AC_SUBST(LibZstdIncludeDir)
-
-dnl ** Other RTS features
-dnl --------------------------------------------------------------
-FP_FIND_LIBDW
-AC_SUBST(UseLibdw)
-AC_SUBST(LibdwLibDir)
-AC_SUBST(LibdwIncludeDir)
-
-FP_FIND_LIBNUMA
-AC_SUBST(UseLibNuma)
-AC_SUBST(LibNumaLibDir)
-AC_SUBST(LibNumaIncludeDir)
-
-dnl ** Documentation
-dnl --------------------------------------------------------------
-if test -n "$SPHINXBUILD"; then
- BUILD_MAN=YES
- BUILD_SPHINX_HTML=YES
- if test -n "$XELATEX" -a -n "$MAKEINDEX"; then
- BUILD_SPHINX_PDF=YES
- else
- BUILD_SPHINX_PDF=NO
- fi
- if test -n "$MAKEINFO"; then
- BUILD_SPHINX_INFO=YES
- else
- BUILD_SPHINX_INFO=NO
- fi
-else
- BUILD_MAN=NO
- BUILD_SPHINX_HTML=NO
- BUILD_SPHINX_PDF=NO
- BUILD_SPHINX_INFO=NO
-fi
-AC_SUBST(BUILD_MAN)
-AC_SUBST(BUILD_SPHINX_HTML)
-AC_SUBST(BUILD_SPHINX_PDF)
-
-if grep ' ' compiler/ghc.cabal.in 2>&1 >/dev/null; then
- AC_MSG_ERROR([compiler/ghc.cabal.in contains tab characters; please remove them])
-fi
-
-# We got caught by
-# http://savannah.gnu.org/bugs/index.php?1516
-# $(eval ...) inside conditionals causes errors
-# with make 3.80, so warn the user if it looks like they're about to
-# try to use it.
-# We would use "grep -q" here, but Solaris's grep doesn't support it.
-print_make_warning=""
-checkMake380() {
- make_ver=`$1 --version 2>&1 | head -1`
- if echo "$make_ver" | grep 'GNU Make 3\.80' > /dev/null
- then
- print_make_warning="true"
- fi
- if echo "$make_ver" | grep 'GNU Make' > /dev/null
- then
- MakeCmd=$1
- AC_SUBST(MakeCmd)
- fi
-}
-
-checkMake380 make
-checkMake380 gmake
-
-# Toolchain target files
-FIND_GHC_TOOLCHAIN_BIN([NO])
-PREP_TARGET_FILE
-FIND_GHC_TOOLCHAIN([hadrian/cfg])
-
-AC_CONFIG_FILES(
-[ hadrian/cfg/system.config
- hadrian/ghci-cabal
- hadrian/ghci-multi-cabal
- hadrian/ghci-stack
- hadrian/cfg/default.host.target
- hadrian/cfg/default.target
-])
-
-dnl Create the VERSION file, satisfying #22322.
-printf "$ProjectVersion" > VERSION
AC_OUTPUT
-[
-if test "$print_make_warning" = "true"; then
- echo
- echo "WARNING: It looks like \"$MakeCmd\" is GNU make 3.80."
- echo "This version cannot be used to build GHC."
- echo "Please use GNU make >= 3.81."
-fi
-
-echo "
-----------------------------------------------------------------------
-Configure completed successfully.
-
- Building GHC version : $ProjectVersion
- Git commit id : $ProjectGitCommitId
-
- Build platform : $BuildPlatform
- Host platform : $HostPlatform
- Target platform : $TargetPlatform
-"
-
-echo "\
- Bootstrapping using : $WithGhc
- which is version : $GhcVersion
- with threaded RTS? : $GhcThreadedRts
-"
-
-if test "x$CcLlvmBackend" = "xYES"; then
- CompilerName="clang "
-else
- CompilerName="gcc "
-fi
-
-echo "\
- Using (for bootstrapping) : $CC_STAGE0
- Using $CompilerName : $CC
- which is version : $GccVersion
- linker options : $GccUseLdOpt
- Building a cross compiler : $CrossCompiling
- Unregisterised : $Unregisterised
- TablesNextToCode : $TablesNextToCode
- Build GMP in tree : $GMP_FORCE_INTREE
- cpp : $CPPCmd
- cpp-flags : $CONF_CPP_OPTS_STAGE2
- hs-cpp : $HaskellCPPCmd
- hs-cpp-flags : $HaskellCPPArgs
- js-cpp : $JavaScriptCPPCmd
- js-cpp-flags : $JavaScriptCPPArgs
- cmmcpp : $CmmCPPCmd
- cmmcpp-flags : $CmmCPPArgs
- cmmcpp-g0 : $CmmCPPSupportsG0
- c++ : $CXX
- ar : $ArCmd
- nm : $NmCmd
- objdump : $ObjdumpCmd
- ranlib : $RanlibCmd
- otool : $OtoolCmd
- install_name_tool : $InstallNameToolCmd
- windres : $WindresCmd
- genlib : $GenlibCmd
- Happy : $HappyCmd ($HappyVersion)
- Alex : $AlexCmd ($AlexVersion)
- sphinx-build : $SPHINXBUILD
- xelatex : $XELATEX
- makeinfo : $MAKEINFO
- git : $GIT
- cabal-install : $CABAL
-"
-
-echo "\
- Using optional dependencies:
- libnuma : $UseLibNuma
- libzstd : $UseLibZstd
- statically linked? : ${UseStaticLibZstd:-N/A}
- libdw : $UseLibdw
-
- Using LLVM tools
- llc : $LlcCmd
- opt : $OptCmd
- llvm-as : $LlvmAsCmd"
-
-if test "$HSCOLOUR" = ""; then
-echo "
- HsColour was not found; documentation will not contain source links
-"
-else
-echo "\
- HsColour : $HSCOLOUR
-"
-fi
-
-echo "\
- Tools to build Sphinx HTML documentation available: $BUILD_SPHINX_HTML
- Tools to build Sphinx PDF documentation available: $BUILD_SPHINX_PDF
- Tools to build Sphinx INFO documentation available: $BUILD_SPHINX_INFO"
-
-echo "----------------------------------------------------------------------
-"
-
-echo "\
-For a standard build of GHC (fully optimised with profiling), type
- ./hadrian/build
-
-You can customise the build with flags such as
- ./hadrian/build -j --flavour=devel2 [--freeze1]
-
-To make changes to the default build configuration, see the file
- hadrian/src/UserSettings.hs
-
-For more information on how to configure your GHC build, see
- https://gitlab.haskell.org/ghc/ghc/-/wikis/building/hadrian
-"]
-
-# Currently we don't validate the /host/ GHC toolchain because configure
-# doesn't configure flags and properties for most of the host toolchain
-#
-# In fact, most values in default.host.target are dummy values since they are
-# never used (see default.host.target.in)
-#
-# When we move to configure toolchains by means of ghc-toolchain only, we'll
-# have a correct complete /host/ toolchain rather than an incomplete one, which
-# might further unlock things like canadian cross-compilation
-#
-# VALIDATE_GHC_TOOLCHAIN([default.host.target],[default.host.target.ghc-toolchain])
-
-VALIDATE_GHC_TOOLCHAIN([hadrian/cfg/default.target],[hadrian/cfg/default.target.ghc-toolchain])
-rm -Rf acargs acghc-toolchain actmp-ghc-toolchain
+# After running ./configure, the following command can be used to see configured values:
+# ./config.status --config
diff --git a/distrib/configure.ac.in b/distrib/configure.ac.in
index 65d92806ec10..3cdaa782e0fd 100644
--- a/distrib/configure.ac.in
+++ b/distrib/configure.ac.in
@@ -360,6 +360,8 @@ FP_PROG_AR_NEEDS_RANLIB
RanlibCmd="$RANLIB"
AC_SUBST([RanlibCmd])
+LINKER_SUPPORTS_VERBATIM_LINKING
+
dnl ** Have libdw?
dnl --------------------------------------------------------------
dnl Check for a usable version of libdw/elfutils
diff --git a/docs/users_guide/ghci.rst b/docs/users_guide/ghci.rst
index f23939c44cec..da73e94b47e0 100644
--- a/docs/users_guide/ghci.rst
+++ b/docs/users_guide/ghci.rst
@@ -2100,6 +2100,19 @@ mostly obvious.
By disabling this flag you can speed up the initial start time of GHCi.
When targets are needed, they can be loaded by using the :ghci-cmd:`:reload`.
+.. ghc-flag:: -fimport-loaded-targets
+ :shortdesc: Add loaded modules to interactive context.
+ :type: dynamic
+ :reverse: -fno-import-loaded-targets
+ :category:
+
+ :default: off
+ :since: 9.14.2
+
+ Import all modules into the GHCi session after loading targets.
+ Importing all modules increases memory usage.
+ If disabled, only a single module will be automatically imported in the GHCi session.
+
Packages
~~~~~~~~
diff --git a/docs/users_guide/phases.rst b/docs/users_guide/phases.rst
index 468d317cb3d8..8eb56f99abf4 100644
--- a/docs/users_guide/phases.rst
+++ b/docs/users_guide/phases.rst
@@ -770,10 +770,9 @@ Options affecting code generation
:type: dynamic
:category: codegen
- Generate position-independent code (code that can be put into shared
- libraries). This currently works on Linux x86 and x86-64. On
- Windows, position-independent code is never used so the flag is a
- no-op on that platform.
+ Generate position-independent code (PIC). This code can be put into shared
+ libraries and is sometimes required by operating systems, e.g. systems using
+ Address Space Layout Randomization (ASLR).
.. ghc-flag:: -fexternal-dynamic-refs
:shortdesc: Generate code for linking against dynamic libraries
@@ -790,9 +789,7 @@ Options affecting code generation
:category: codegen
Generate code in such a way to be linkable into a position-independent
- executable This currently works on Linux x86 and x86-64. On Windows,
- position-independent code is never used so the flag is a no-op on that
- platform. To link the final executable use :ghc-flag:`-pie`.
+ executable. To link the final executable use :ghc-flag:`-pie`.
.. ghc-flag:: -dynamic
:shortdesc: Build dynamically-linked object files and executables
@@ -943,6 +940,53 @@ for example).
To control the name, use the :ghc-flag:`-o ⟨file⟩` option
as usual. The default name is ``liba.a``.
+.. ghc-flag:: -static-external
+ :shortdesc: Link external C dependencies statically when
+ building an executable.
+ :type: dynamic
+ :category: linking
+
+ Link external system libraries statically when building an executable.
+ By default, this excludes the following libraries: ``c``, ``m``, ``rt``, ``dl``, ``pthread``.
+ Also see :ghc-flag:`-exclude-static-external ⟨lib1,lib2,...⟩` for more control.
+ It is required that all system dependencies and their
+ static libraries are installed. This does not affect how Haskell libraries
+ are linked. You can combine this with ghc-flag:`-static` to produce binaries
+ that are only dynamically linked against e.g. libc.
+
+ Also note that this option is not terribly portable. It relies on the "verbatim namespace"
+ convention that some linkers support (``-l:foo.a``). On systems where
+ this isn't supported, GHC falls back to trying to look up the absolute path
+ of the static archives, which may not always work.
+
+ To control how Haskell libraries are linked, see :ghc-flag:`-static` and
+ :ghc-flag:`-dynamic`.
+
+.. ghc-flag:: -exclude-static-external ⟨lib1,lib2,...⟩
+ :shortdesc: Don't link the following libraries statically
+ :type: dynamic
+ :category: linking
+
+ When linking system libraries statically, allow to specify a comma separated list
+ of libraries to not link statically (as in: dynamic). Since :ghc-flag:`-static-external`
+ is not meant for fully static linking and gives more control than :ghc-flag:`-fully-static`,
+ this option allows to exclude certain libraries. By default, these are: ``c``, ``m``, ``rt``, ``dl``, ``pthread``, ``stdc++``, ``c++``, ``c++abi``, ``atomic``.
+
+ When this option is specified without arguments, no libraries are excluded.
+
+.. ghc-flag:: -fully-static
+ :shortdesc: Link everything statically when
+ building an executable.
+ :type: dynamic
+ :category: linking
+
+ Link all libraries statically when building an executable. This includes
+ external libraries, Haskell libraries, as well as libc.
+ This requires that all dependencies and their static libraries are installed.
+ Musl is commonly used to provide a static libc.
+
+ This flag is incompatible with :ghc-flag:`-dynamic`.
+
.. ghc-flag:: -L ⟨dir⟩
:shortdesc: Add ⟨dir⟩ to the list of directories searched for libraries
:type: dynamic
@@ -998,6 +1042,9 @@ for example).
Tell the linker to avoid shared Haskell libraries, if possible. This
is the default.
+ To further control linking behavior, also see :ghc-flag:`-fully-static`
+ and :ghc-flag:`-static-external`.
+
.. ghc-flag:: -dynamic
:shortdesc: Build dynamically-linked object files and executables
:type: dynamic
diff --git a/ghc/GHC/Driver/Session/Mode.hs b/ghc/GHC/Driver/Session/Mode.hs
index e2d9c28e935b..33850aab89f9 100644
--- a/ghc/GHC/Driver/Session/Mode.hs
+++ b/ghc/GHC/Driver/Session/Mode.hs
@@ -32,12 +32,16 @@ data PreStartupMode
| ShowNumVersion -- ghc --numeric-version
| ShowSupportedExtensions -- ghc --supported-extensions
| ShowOptions Bool {- isInteractive -} -- ghc --show-options
+ | PrintPrimModule -- ghc --print-prim-module
+ | PrintPrimWrappersModule -- ghc --print-prim-wrappers-module
-showVersionMode, showNumVersionMode, showSupportedExtensionsMode, showOptionsMode :: Mode
+showVersionMode, showNumVersionMode, showSupportedExtensionsMode, showOptionsMode, printPrimModule, printPrimWrappersModule :: Mode
showVersionMode = mkPreStartupMode ShowVersion
showNumVersionMode = mkPreStartupMode ShowNumVersion
showSupportedExtensionsMode = mkPreStartupMode ShowSupportedExtensions
showOptionsMode = mkPreStartupMode (ShowOptions False)
+printPrimModule = mkPreStartupMode PrintPrimModule
+printPrimWrappersModule = mkPreStartupMode PrintPrimWrappersModule
mkPreStartupMode :: PreStartupMode -> Mode
mkPreStartupMode = Left
@@ -203,6 +207,8 @@ mode_flags =
, defFlag "-numeric-version" (PassFlag (setMode showNumVersionMode))
, defFlag "-info" (PassFlag (setMode showInfoMode))
, defFlag "-show-options" (PassFlag (setMode showOptionsMode))
+ , defFlag "-print-prim-module" (PassFlag (setMode printPrimModule))
+ , defFlag "-print-prim-wrappers-module" (PassFlag (setMode printPrimWrappersModule))
, defFlag "-supported-languages" (PassFlag (setMode showSupportedExtensionsMode))
, defFlag "-supported-extensions" (PassFlag (setMode showSupportedExtensionsMode))
, defFlag "-show-packages" (PassFlag (setMode showUnitsMode))
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 0243b5767df3..a41c81c86fbd 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -199,8 +199,8 @@ defaultGhciSettings =
}
ghciWelcomeMsg :: String
-ghciWelcomeMsg = "GHCi, version " ++ cProjectVersion ++
- ": https://www.haskell.org/ghc/ :? for help"
+ghciWelcomeMsg = "GHCi, version " ++ cProjectVersion ++ " (Stable Haskell Edition)" ++
+ ": https://github.com/stable-haskell/ghc :? for help"
ghciCommands :: [Command]
ghciCommands = map mkCmd [
@@ -2404,36 +2404,44 @@ setContextAfterLoad keep_ctxt (Just graph) = do
GHC.topSortModuleGraph True (GHC.mkModuleGraph loaded_graph) Nothing
in case graph' of
[] -> setContextKeepingPackageModules keep_ctxt []
- xs -> load_this (last xs)
- (m:_) ->
- load_this m
+ xs -> load_these [last xs]
+ m:ms -> do
+ flags <- GHC.getInteractiveDynFlags
+ let xs = if gopt Opt_GhciImportLoadedTargets flags
+ then m:ms
+ else [m]
+ load_these xs
where
- is_loaded (GHC.ModuleNode _ ms) = isLoadedModuleNode ms
- is_loaded _ = return False
+ is_loaded (GHC.ModuleNode _ ms) = isLoadedModuleNode ms
+ is_loaded _ = return False
- findTarget mds t
+ findTarget mds t
= case mapMaybe (`matches` t) mds of
[] -> Nothing
(m:_) -> Just m
- (GHC.ModuleNode _ summary) `matches` Target { targetId = TargetModule m }
- = if GHC.moduleNodeInfoModuleName summary == m then Just summary else Nothing
- (GHC.ModuleNode _ summary) `matches` Target { targetId = TargetFile f _ }
- | Just f' <- GHC.ml_hs_file (GHC.moduleNodeInfoLocation summary) =
- if f == f' then Just summary else Nothing
- _ `matches` _ = Nothing
-
- load_this summary | m <- GHC.moduleNodeInfoModule summary = do
- is_interp <- GHC.moduleIsInterpreted m
- dflags <- getDynFlags
- let star_ok = is_interp && not (safeLanguageOn dflags)
- -- We import the module with a * iff
- -- - it is interpreted, and
- -- - -XSafe is off (it doesn't allow *-imports)
- let new_ctx | star_ok = [mkIIModule m]
- | otherwise = [mkIIDecl (GHC.moduleName m)]
- setContextKeepingPackageModules keep_ctxt new_ctx
-
+ (GHC.ModuleNode _ summary) `matches` Target { targetId = TargetModule m }
+ = if GHC.moduleNodeInfoModuleName summary == m then Just summary else Nothing
+ (GHC.ModuleNode _ summary) `matches` Target { targetId = TargetFile f _ }
+ | Just f' <- GHC.ml_hs_file (GHC.moduleNodeInfoLocation summary) =
+ if f == f' then Just summary else Nothing
+ _ `matches` _ = Nothing
+
+ load_these summaries = do
+ new_ctx <- traverse target_to_interactive_import summaries
+ setContextKeepingPackageModules keep_ctxt new_ctx
+
+ target_to_interactive_import summary
+ | m <- GHC.moduleNodeInfoModule summary = do
+ is_interp <- GHC.moduleIsInterpreted m
+ dflags <- getDynFlags
+ let star_ok = is_interp && not (safeLanguageOn dflags)
+ -- We import the module with a * iff
+ -- - it is interpreted, and
+ -- - -XSafe is off (it doesn't allow *-imports)
+ let new_ctx | star_ok = mkIIModule m
+ | otherwise = mkIIDecl (GHC.moduleName m)
+ pure new_ctx
-- | Keep any package modules (except Prelude) when changing the context.
setContextKeepingPackageModules
diff --git a/ghc/Main.hs b/ghc/Main.hs
index 259678550f7b..4ea44bc05ded 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -21,6 +21,7 @@ import GHC (parseTargetFiles, Ghc, GhcMonad(..),
import GHC.Driver.Backend
import GHC.Driver.CmdLine
+import GHC.Driver.DynFlags (ExecutableLinkMode(..))
import GHC.Driver.Env
import GHC.Driver.Errors
import GHC.Driver.Errors.Types
@@ -37,6 +38,8 @@ import GHC.Driver.Config.Diagnostic
import GHC.Platform
import GHC.Platform.Host
+import GHC.Builtin.PrimOps (primOpPrimModule, primOpWrappersModule)
+
#if defined(HAVE_INTERNAL_INTERPRETER)
import GHCi.UI ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings )
#endif
@@ -58,6 +61,7 @@ import GHC.Types.PkgQual
import GHC.Utils.Error
import GHC.Utils.Panic
import GHC.Utils.Outputable as Outputable
+import GHC.Utils.Misc ( split )
import GHC.Utils.Monad ( liftIO )
import GHC.Utils.Binary ( openBinMem, put_ )
import GHC.Utils.Logger
@@ -83,12 +87,14 @@ import GHC.Driver.Session.Units
-- Standard Haskell libraries
import System.IO
+import System.FilePath
+import System.Directory
import System.Environment
import System.Exit
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except (throwE, runExceptT)
-import Data.List ( isPrefixOf, partition, intercalate )
+import Data.List ( isPrefixOf, isSuffixOf, partition, intercalate )
import Prelude
import qualified Data.List.NonEmpty as NE
@@ -112,13 +118,50 @@ main = do
configureHandleEncoding
GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $ do
-- 1. extract the -B flag from the args
+ prog0 <- getProgName
argv0 <- getArgs
- let (minusB_args, argv1) = partition ("-B" `isPrefixOf`) argv0
+ -- either pass @--target=...@ to select the target, or use a symbolic
+ -- or (copy of the executable) name that ends with @-ghc@. E.g.
+ -- x86_64-unknown-linux-ghc would select the x86_64-unknown-linux target.
+ let (target_args, argv1) = partition ("-target=" `isPrefixOf`) argv0
+ mbTarget | not (null target_args) = Just (drop 8 (last target_args))
+ | "-ghc" `isSuffixOf` prog0
+ , parts <- split '-' prog0
+ , length parts > 2 = Just (take (length prog0 - 4) prog0)
+ | otherwise = Nothing
+
+
+ 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 targets (in " ++ targets_dir ++ "):"
+ 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
@@ -134,13 +177,15 @@ 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
+ PrintPrimModule -> liftIO $ putStrLn primOpPrimModule
+ PrintPrimWrappersModule -> liftIO $ putStrLn primOpWrappersModule
Right postStartupMode ->
-- start our GHC session
- GHC.runGhc mbMinusB $ do
+ GHC.runGhc targettopdir $ do
dflags <- GHC.getSessionDynFlags
@@ -172,11 +217,11 @@ main' postLoadMode units dflags0 args flagWarnings = do
DoInteractive -> (CompManager, interpreterBackend, LinkInMemory)
DoEval _ -> (CompManager, interpreterBackend, LinkInMemory)
DoRun -> (CompManager, interpreterBackend, LinkInMemory)
- DoMake -> (CompManager, dflt_backend, LinkBinary)
- DoBackpack -> (CompManager, dflt_backend, LinkBinary)
- DoMkDependHS -> (MkDepend, dflt_backend, LinkBinary)
- DoAbiHash -> (OneShot, dflt_backend, LinkBinary)
- _ -> (OneShot, dflt_backend, LinkBinary)
+ DoMake -> (CompManager, dflt_backend, LinkExecutable Dynamic)
+ DoBackpack -> (CompManager, dflt_backend, LinkExecutable Dynamic)
+ DoMkDependHS -> (MkDepend, dflt_backend, LinkExecutable Dynamic)
+ DoAbiHash -> (OneShot, dflt_backend, LinkExecutable Dynamic)
+ _ -> (OneShot, dflt_backend, LinkExecutable Dynamic)
let dflags1 = dflags0{ ghcMode = mode,
backend = bcknd,
@@ -340,7 +385,7 @@ showBanner _postLoadMode dflags = do
-- Display details of the configuration in verbose mode
when (verb >= 2) $
- do hPutStr stderr "Glasgow Haskell Compiler, Version "
+ do hPutStr stderr "Glasgow Haskell Compiler (Stable Haskell Edition), Version "
hPutStr stderr cProjectVersion
hPutStr stderr ", stage "
hPutStr stderr cStage
@@ -374,7 +419,7 @@ showSupportedExtensions m_top_dir = do
mapM_ putStrLn $ supportedLanguagesAndExtensions arch_os
showVersion :: IO ()
-showVersion = putStrLn (cProjectName ++ ", version " ++ cProjectVersion)
+showVersion = putStrLn (cProjectName ++ ", version " ++ cProjectVersion ++ " (Stable Haskell Edition)")
showOptions :: Bool -> IO ()
showOptions isInteractive = putStr (unlines availableOptions)
diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in
index e29b0f430a9f..76eb0fbc879f 100644
--- a/ghc/ghc-bin.cabal.in
+++ b/ghc/ghc-bin.cabal.in
@@ -1,3 +1,4 @@
+Cabal-Version: 3.0
-- WARNING: ghc-bin.cabal is automatically generated from ghc-bin.cabal.in by
-- ./configure. Make sure you are editing ghc-bin.cabal.in, not ghc-bin.cabal.
@@ -15,7 +16,6 @@ Description:
to the Glasgow Haskell Compiler.
Category: Development
Build-Type: Simple
-Cabal-Version: >=1.10
Flag internal-interpreter
Description: Build with internal interpreter support.
@@ -27,6 +27,11 @@ Flag threaded
Default: True
Manual: True
+Flag debug
+ Description: Link the ghc executable against the debug RTS
+ Default: True
+ Manual: True
+
Executable ghc
Default-Language: GHC2021
@@ -45,6 +50,21 @@ Executable ghc
ghc-boot == @ProjectVersionMunged@,
ghc == @ProjectVersionMunged@
+ if impl(ghc > 9.12)
+ -- we need to depend on the specific rts we want to link our
+ -- final GHC against.
+ -- TODO: add debug flag and extend those extra cases.
+ if flag(threaded)
+ if flag(debug)
+ Build-Depends: rts:threaded-debug
+ else
+ Build-Depends: rts:threaded-nodebug
+ else
+ if flag(debug)
+ Build-Depends: rts:nonthreaded-debug
+ else
+ Build-Depends: rts:nonthreaded-nodebug
+
if os(windows)
Build-Depends: Win32 >= 2.3 && < 2.15
else
@@ -56,6 +76,18 @@ Executable ghc
-rtsopts=all
"-with-rtsopts=-K512M -H -I5 -T"
+ -- Export RTS symbols to dynamically loaded libraries
+ -- See Note [ghc-iserv and dynamic symbol export] in utils/ghc-iserv/ghc-iserv.cabal.in
+ -- GHC loads Haskell shared libraries dynamically for TH/GHCi and these
+ -- libraries need access to RTS symbols. Without these flags, symbols
+ -- from the linked RTS are not visible to dlopen'd libraries.
+ if os(linux) || os(freebsd)
+ ghc-options: -rdynamic
+ if os(osx) || os(darwin)
+ ghc-options: -optl -Wl,-flat_namespace
+ -- Note: Windows has a hard limit of 65535 symbol exports (16-bit index).
+ -- We cannot use --export-all-symbols here as we exceed that limit.
+
if flag(internal-interpreter)
-- NB: this is never built by the bootstrapping GHC+libraries
Build-depends:
diff --git a/hadrian/cfg/default.host.target.in b/hadrian/cfg/default.host.target.in
index 30282ec82b7a..51b0f9026ab5 100644
--- a/hadrian/cfg/default.host.target.in
+++ b/hadrian/cfg/default.host.target.in
@@ -25,6 +25,7 @@ Target
, ccLinkSupportsFilelist = False
, ccLinkSupportsSingleModule = True
, ccLinkIsGnu = False
+, ccLinkSupportsVerbatimNamespace = False
}
, tgtAr = Ar
diff --git a/hadrian/cfg/default.target.in b/hadrian/cfg/default.target.in
index 20d5111e2629..e201390b8803 100644
--- a/hadrian/cfg/default.target.in
+++ b/hadrian/cfg/default.target.in
@@ -25,6 +25,7 @@ Target
, ccLinkSupportsFilelist = @LdHasFilelistBool@
, ccLinkSupportsSingleModule = @LdHasSingleModuleBool@
, ccLinkIsGnu = @LdIsGNULdBool@
+, ccLinkSupportsVerbatimNamespace = @LdSupportsVerbatimNamespaceBool@
}
, tgtAr = Ar
diff --git a/hadrian/hadrian.cabal b/hadrian/hadrian.cabal
index 5c042a37ad51..03eecc63f619 100644
--- a/hadrian/hadrian.cabal
+++ b/hadrian/hadrian.cabal
@@ -86,7 +86,6 @@ executable hadrian
, Rules.Documentation
, Rules.Generate
, Rules.Gmp
- , Rules.Libffi
, Rules.Library
, Rules.Lint
, Rules.Nofib
diff --git a/hadrian/src/Builder.hs b/hadrian/src/Builder.hs
index f566f57e3fcc..0b0b7d0ece7c 100644
--- a/hadrian/src/Builder.hs
+++ b/hadrian/src/Builder.hs
@@ -236,25 +236,16 @@ instance H.Builder Builder where
-- changes (#18001).
_bootGhcVersion <- setting GhcVersion
pure []
- Ghc _ st -> do
+ Ghc _ _ -> do
root <- buildRoot
unlitPath <- builderPath Unlit
distro_mingw <- lookupSystemConfig "settings-use-distro-mingw"
- libffi_adjustors <- useLibffiForAdjustors
- use_system_ffi <- flag UseSystemFfi
return $ [ unlitPath ]
++ [ root -/- mingwStamp | windowsHost, distro_mingw == "NO" ]
-- proxy for the entire mingw toolchain that
-- we have in inplace/mingw initially, and then at
-- root -/- mingw.
- -- ffi.h needed by the compiler when using libffi_adjustors (#24864)
- -- It would be nicer to not duplicate this logic between here
- -- and needRtsLibffiTargets and libffiHeaderFiles but this doesn't change
- -- very often.
- ++ [ root -/- buildDir (rtsContext st) -/- "include" -/- header
- | header <- ["ffi.h", "ffitarget.h"]
- , libffi_adjustors && not use_system_ffi ]
Hsc2Hs stage -> (\p -> [p]) <$> templateHscPath stage
Make dir -> return [dir -/- "Makefile"]
diff --git a/hadrian/src/Packages.hs b/hadrian/src/Packages.hs
index aef68a8d771f..77a85af0e65c 100644
--- a/hadrian/src/Packages.hs
+++ b/hadrian/src/Packages.hs
@@ -111,7 +111,7 @@ hpcBin = util "hpc-bin" `setPath` "utils/hpc"
integerGmp = lib "integer-gmp"
iserv = util "iserv"
iservProxy = util "iserv-proxy"
-libffi = top "libffi"
+libffi = lib "libffi-clib"
mtl = lib "mtl"
osString = lib "os-string"
parsec = lib "parsec"
diff --git a/hadrian/src/Rules.hs b/hadrian/src/Rules.hs
index 55de341f8e00..6c6f5feeeaba 100644
--- a/hadrian/src/Rules.hs
+++ b/hadrian/src/Rules.hs
@@ -21,7 +21,6 @@ import qualified Rules.Dependencies
import qualified Rules.Documentation
import qualified Rules.Generate
import qualified Rules.Gmp
-import qualified Rules.Libffi
import qualified Rules.Library
import qualified Rules.Program
import qualified Rules.Register
@@ -87,7 +86,7 @@ packageTargets includeGhciLib stage pkg = do
then return [] -- Skip inactive packages.
else if isLibrary pkg
then do -- Collect all targets of a library package.
- let pkgWays = if pkg == rts then getRtsWays else getLibraryWays
+ let pkgWays = if pkg `elem` [rts, libffi] then getRtsWays else getLibraryWays
ways <- interpretInContext context pkgWays
libs <- mapM (\w -> pkgLibraryFile (Context stage pkg w (error "unused"))) (Set.toList ways)
more <- Rules.Library.libraryTargets includeGhciLib context
@@ -133,7 +132,6 @@ buildRules = do
Rules.Generate.generateRules
Rules.Generate.templateRules
Rules.Gmp.gmpRules
- Rules.Libffi.libffiRules
Rules.Library.libraryRules
Rules.Rts.rtsRules
packageRules
diff --git a/hadrian/src/Rules/Generate.hs b/hadrian/src/Rules/Generate.hs
index b7d73ecfa173..5880218c899f 100644
--- a/hadrian/src/Rules/Generate.hs
+++ b/hadrian/src/Rules/Generate.hs
@@ -18,7 +18,6 @@ import Hadrian.Haskell.Cabal.Type (PackageData(version))
import Hadrian.Haskell.Cabal
import Hadrian.Oracles.Cabal (readPackageData)
import Packages
-import Rules.Libffi
import Settings
import Target
import Utilities
@@ -58,7 +57,6 @@ rtsDependencies = do
stage <- getStage
rtsPath <- expr (rtsBuildPath stage)
jsTarget <- expr isJsTarget
- useSystemFfi <- expr (flag UseSystemFfi)
let -- headers common to native and JS RTS
common_headers =
@@ -70,7 +68,6 @@ rtsDependencies = do
[ "rts" -/- "EventTypes.h"
, "rts" -/- "EventLogConstants.h"
]
- ++ (if useSystemFfi then [] else libffiHeaderFiles)
headers
| jsTarget = common_headers
| otherwise = common_headers ++ native_headers
@@ -102,6 +99,8 @@ compilerDependencies = do
, "primop-vector-uniques.hs-incl"
, "primop-docs.hs-incl"
, "primop-deprecations.hs-incl"
+ , "primop-prim-module.hs-incl"
+ , "primop-wrappers-module.hs-incl"
, "GHC/Platform/Constants.hs"
, "GHC/Settings/Config.hs"
]
diff --git a/hadrian/src/Rules/Libffi.hs b/hadrian/src/Rules/Libffi.hs
deleted file mode 100644
index edb330c90347..000000000000
--- a/hadrian/src/Rules/Libffi.hs
+++ /dev/null
@@ -1,246 +0,0 @@
-{-# LANGUAGE TypeFamilies #-}
-
-module Rules.Libffi (
- LibffiDynLibs(..),
- needLibffi, askLibffilDynLibs, libffiRules, libffiLibrary, libffiHeaderFiles,
- libffiHeaderDir, libffiSystemHeaderDir, libffiName
- ) where
-
-import Hadrian.Utilities
-
-import Packages
-import Settings.Builders.Common
-import Target
-import Utilities
-import GHC.Toolchain (targetPlatformTriple)
-
-{- Note [Libffi indicating inputs]
- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-First see https://gitlab.haskell.org/ghc/ghc/wikis/Developing-Hadrian for an
-explanation of "indicating input". Part of the definition is copied here for
-your convenience:
-
- change in the vital output -> change in the indicating inputs
-
-In the case of building libffi `vital output = built libffi library files` and
-we can consider the libffi archive file (i.e. the "libffi-tarballs/libffi*.tar.gz"
-file) to be the only indicating input besides the build tools (e.g. make).
-Note building libffi is split into a few rules, but we also expect that:
-
- no change in the archive file -> no change in the intermediate build artifacts
-
-and so the archive file is still a valid choice of indicating input for
-all libffi rules. Hence we can get away with `need`ing only the archive file and
-don't have to `need` intermediate build artifacts (besides those to trigger
-dependant libffi rules i.e. to generate vital inputs as is noted on the wiki).
-It is then safe to `trackAllow` the libffi build directory as is done in
-`needLibfffiArchive`.
-
-A disadvantage to this approach is that changing the archive file forces a clean
-build of libffi i.e. we cannot incrementally build libffi. This seems like a
-performance issue, but is justified as building libffi is fast and the archive
-file is rarely changed.
-
--}
-
--- | Oracle question type. The oracle returns the list of dynamic
--- libffi library file paths (all but one of which should be symlinks).
-newtype LibffiDynLibs = LibffiDynLibs Stage
- deriving (Eq, Show, Hashable, Binary, NFData)
-type instance RuleResult LibffiDynLibs = [FilePath]
-
-askLibffilDynLibs :: Stage -> Action [FilePath]
-askLibffilDynLibs stage = askOracle (LibffiDynLibs stage)
-
--- | The path to the dynamic library manifest file. The file contains all file
--- paths to libffi dynamic library file paths.
--- The path is calculated but not `need`ed.
-dynLibManifest' :: Monad m => m FilePath -> Stage -> m FilePath
-dynLibManifest' getRoot stage = do
- root <- getRoot
- return $ root -/- stageString stage -/- pkgName libffi -/- ".dynamiclibs"
-
-dynLibManifestRules :: Stage -> Rules FilePath
-dynLibManifestRules = dynLibManifest' buildRootRules
-
-dynLibManifest :: Stage -> Action FilePath
-dynLibManifest = dynLibManifest' buildRoot
-
--- | Need the (locally built) libffi library.
-needLibffi :: Stage -> Action ()
-needLibffi stage = do
- jsTarget <- isJsTarget
- unless jsTarget $ do
- manifest <- dynLibManifest stage
- need [manifest]
-
--- | Context for @libffi@.
-libffiContext :: Stage -> Action Context
-libffiContext stage = do
- ways <- interpretInContext
- (Context stage libffi (error "libffiContext: way not set") (error "libffiContext: iplace not set"))
- getLibraryWays
- return $ (\w -> Context stage libffi w Final) (if any (wayUnit Dynamic) ways
- then dynamic
- else vanilla)
-
--- | The name of the library
-libffiName :: Expr String
-libffiName = do
- useSystemFfi <- expr (flag UseSystemFfi)
- if useSystemFfi
- then pure "ffi"
- else libffiLocalName Nothing
-
--- | The name of the (locally built) library
-libffiLocalName :: Maybe Bool -> Expr String
-libffiLocalName force_dynamic = do
- way <- getWay
- winTarget <- expr isWinTarget
- let dynamic = fromMaybe (Dynamic `wayUnit` way) force_dynamic
- pure $ mconcat
- [ if dynamic then "" else "C"
- , if winTarget then "ffi-6" else "ffi"
- ]
-
-libffiLibrary :: FilePath
-libffiLibrary = "inst/lib/libffi.a"
-
--- | These are the headers that we must package with GHC since foreign export
--- adjustor code produced by GHC depends upon them.
--- See Note [Packaging libffi headers] in GHC.Driver.CodeOutput.
-libffiHeaderFiles :: [FilePath]
-libffiHeaderFiles = ["ffi.h", "ffitarget.h"]
-
-libffiHeaderDir :: Stage -> Action FilePath
-libffiHeaderDir stage = do
- path <- libffiBuildPath stage
- return $ path -/- "inst/include"
-
-libffiSystemHeaderDir :: Action FilePath
-libffiSystemHeaderDir = setting FfiIncludeDir
-
-fixLibffiMakefile :: FilePath -> String -> String
-fixLibffiMakefile top =
- replace "-MD" "-MMD"
- . replace "@toolexeclibdir@" "$(libdir)"
- . replace "@INSTALL@" ("$(subst ../install-sh," ++ top ++ "/install-sh,@INSTALL@)")
-
--- TODO: check code duplication w.r.t. ConfCcArgs
-configureEnvironment :: Stage -> Action [CmdOption]
-configureEnvironment stage = do
- context <- libffiContext stage
- cFlags <- interpretInContext context $ mconcat
- [ cArgs
- , getStagedCCFlags ]
- ldFlags <- interpretInContext context ldArgs
- sequence [ builderEnvironment "CC" $ Cc CompileC stage
- , builderEnvironment "CXX" $ Cc CompileC stage
- , builderEnvironment "AR" (Ar Unpack stage)
- , builderEnvironment "NM" Nm
- , builderEnvironment "RANLIB" Ranlib
- , return . AddEnv "CFLAGS" $ unwords cFlags ++ " -w"
- , return . AddEnv "LDFLAGS" $ unwords ldFlags ++ " -w" ]
-
--- Need the libffi archive and `trackAllow` all files in the build directory.
--- See [Libffi indicating inputs].
-needLibfffiArchive :: FilePath -> Action FilePath
-needLibfffiArchive buildPath = do
- top <- topDirectory
- tarball <- unifyPath
- . fromSingleton "Exactly one LibFFI tarball is expected"
- <$> getDirectoryFiles top ["libffi-tarballs/libffi*.tar.gz"]
- need [top -/- tarball]
- trackAllow [buildPath -/- "**"]
- return tarball
-
-libffiRules :: Rules ()
-libffiRules = do
- _ <- addOracleCache $ \ (LibffiDynLibs stage)
- -> do
- jsTarget <- isJsTarget
- if jsTarget
- then return []
- else readFileLines =<< dynLibManifest stage
- forM_ [Stage1, Stage2, Stage3] $ \stage -> do
- root <- buildRootRules
- let path = root -/- stageString stage
- libffiPath = path -/- pkgName libffi -/- "build"
-
- -- We set a higher priority because this rule overlaps with the build rule
- -- for static libraries 'Rules.Library.libraryRules'.
- dynLibMan <- dynLibManifestRules stage
- let topLevelTargets = [ libffiPath -/- libffiLibrary
- , dynLibMan
- ]
- priority 2 $ topLevelTargets &%> \_ -> do
- _ <- needLibfffiArchive libffiPath
- context <- libffiContext stage
-
- -- Note this build needs the Makefile, triggering the rules bellow.
- build $ target context (Make libffiPath) [] []
- libffiName' <- interpretInContext context (libffiLocalName (Just True))
-
- -- Produces all install files.
- produces =<< (\\ topLevelTargets)
- <$> liftIO (getDirectoryFilesIO "." [libffiPath -/- "inst//*"])
-
- -- Find dynamic libraries.
- osxTarget <- isOsxTarget
- winTarget <- isWinTarget
-
- dynLibFiles <- do
- let libfilesDir = libffiPath -/-
- (if winTarget then "inst" -/- "bin" else "inst" -/- "lib")
- dynlibext
- | winTarget = "dll"
- | osxTarget = "dylib"
- | otherwise = "so"
- filepat = "lib" ++ libffiName' ++ "." ++ dynlibext ++ "*"
- liftIO $ getDirectoryFilesIO "." [libfilesDir -/- filepat]
-
- writeFileLines dynLibMan dynLibFiles
- putSuccess "| Successfully build libffi."
-
- fmap (libffiPath -/-) ( "Makefile.in" :& "configure" :& Nil ) &%>
- \ ( mkIn :& _ ) -> do
- -- Extract libffi tar file
- context <- libffiContext stage
- removeDirectory libffiPath
- tarball <- needLibfffiArchive libffiPath
- -- Go from 'libffi-3.99999+git20171002+77e130c.tar.gz' to 'libffi-3.99999'
- let libname = takeWhile (/= '+') $ fromJust $ stripExtension "tar.gz" $ takeFileName tarball
-
- -- Move extracted directory to libffiPath.
- root <- buildRoot
- removeDirectory (root -/- libname)
- actionFinally (do
- build $ target context (Tar Extract) [tarball] [path]
- moveDirectory (path -/- libname) libffiPath) $
- -- And finally:
- removeFiles (path) [libname -/- "**"]
-
- top <- topDirectory
- fixFile mkIn (fixLibffiMakefile top)
-
- files <- liftIO $ getDirectoryFilesIO "." [libffiPath -/- "**"]
- produces files
-
- fmap (libffiPath -/-) ("Makefile" :& "config.guess" :& "config.sub" :& Nil)
- &%> \( mk :& _ ) -> do
- _ <- needLibfffiArchive libffiPath
- context <- libffiContext stage
-
- -- This need rule extracts the libffi tar file to libffiPath.
- need [mk <.> "in"]
-
- -- Configure.
- forM_ ["config.guess", "config.sub"] $ \file -> do
- copyFile file (libffiPath -/- file)
- env <- configureEnvironment stage
- buildWithCmdOptions env $
- target context (Configure libffiPath) [mk <.> "in"] [mk]
-
- dir <- queryBuildTarget targetPlatformTriple
- files <- liftIO $ getDirectoryFilesIO "." [libffiPath -/- dir -/- "**"]
- produces files
diff --git a/hadrian/src/Rules/Library.hs b/hadrian/src/Rules/Library.hs
index 1aa19fc2fd28..946178659b0f 100644
--- a/hadrian/src/Rules/Library.hs
+++ b/hadrian/src/Rules/Library.hs
@@ -1,4 +1,4 @@
-module Rules.Library (libraryRules, needLibrary, libraryTargets) where
+module Rules.Library (libraryRules, needLibrary, libraryTargets, LibDyn(..), parseGhcPkgLibDyn) where
import Hadrian.BuildPath
import Hadrian.Haskell.Cabal
@@ -36,7 +36,7 @@ libraryRules = do
root -/- "stage*/lib/**/libHS*-*.dll" %> registerDynamicLib root "dll"
root -/- "stage*/lib/**/*.a" %> registerStaticLib root
root -/- "**/HS*-*.o" %> buildGhciLibO root
- root -/- "**/HS*-*.p_o" %> buildGhciLibO root
+ root -/- "**/HS*-*.*_o" %> buildGhciLibO root
-- * 'Action's for building libraries
diff --git a/hadrian/src/Rules/Register.hs b/hadrian/src/Rules/Register.hs
index f9150db49cb3..1608a88239e8 100644
--- a/hadrian/src/Rules/Register.hs
+++ b/hadrian/src/Rules/Register.hs
@@ -139,7 +139,7 @@ buildConfFinal :: [(Resource, Int)] -> Context -> FilePath -> Action ()
buildConfFinal rs context@Context {..} _conf = do
depPkgIds <- cabalDependencies context
ensureConfigured context
- ways <- interpretInContext context (getLibraryWays <> if package == rts then getRtsWays else mempty)
+ ways <- interpretInContext context (getLibraryWays <> if package `elem` [rts, libffi] then getRtsWays else mempty)
stamps <- mapM pkgStampFile [ context { way = w } | w <- Set.toList ways ]
confs <- mapM (\pkgId -> packageDbPath (PackageDbLoc stage Final) <&> (-/- pkgId <.> "conf")) depPkgIds
-- Important to need these together to avoid introducing a linearisation. This is not the most critical place
@@ -287,14 +287,6 @@ parseCabalName s = bimap show id (Cabal.runParsecParser parser "
where
component = CabalCharParsing.munch1 (\c -> Char.isAlphaNum c || c == '.')
-
-
--- | Return extra library targets.
-extraTargets :: Context -> Action [FilePath]
-extraTargets context
- | package context == rts = needRtsLibffiTargets (Context.stage context)
- | otherwise = return []
-
-- | Given a library 'Package' this action computes all of its targets. Needing
-- all the targets should build the library such that it is ready to be
-- registered into the package database.
@@ -308,7 +300,5 @@ libraryTargets includeGhciLib context@Context {..} = do
ghci <- if ghciObjsSupported && includeGhciLib && not (wayUnit Dynamic way)
then interpretInContext context $ getContextData buildGhciLib
else return False
- extra <- extraTargets context
return $ [ libFile ]
++ [ ghciLib | ghci ]
- ++ extra
diff --git a/hadrian/src/Rules/Rts.hs b/hadrian/src/Rules/Rts.hs
index a71dd94c1307..d3bc3d9056be 100644
--- a/hadrian/src/Rules/Rts.hs
+++ b/hadrian/src/Rules/Rts.hs
@@ -1,14 +1,12 @@
{-# LANGUAGE MultiWayIf #-}
-module Rules.Rts (rtsRules, needRtsLibffiTargets, needRtsSymLinks) where
+module Rules.Rts (rtsRules, needRtsSymLinks) where
import qualified Data.Set as Set
import Packages (rts)
-import Rules.Libffi
import Hadrian.Utilities
import Settings.Builders.Common
-import Context.Type
-- | This rule has priority 3 to override the general rule for generating shared
-- library files (see Rules.Library.libraryRules).
@@ -26,134 +24,6 @@ rtsRules = priority 3 $ do
(addRtsDummyVersion $ takeFileName rtsLibFilePath')
rtsLibFilePath'
- -- Libffi
- forM_ [Stage1, Stage2, Stage3 ] $ \ stage -> do
- let buildPath = root -/- buildDir (rtsContext stage)
-
- -- Header files
- -- See Note [Packaging libffi headers] in GHC.Driver.CodeOutput.
- forM_ libffiHeaderFiles $ \header ->
- buildPath -/- "include" -/- header %> copyLibffiHeader stage
-
- -- Static libraries.
- buildPath -/- "libCffi*.a" %> copyLibffiStatic stage
-
- -- Dynamic libraries
- buildPath -/- "libffi*.dylib*" %> copyLibffiDynamicUnix stage ".dylib"
- buildPath -/- "libffi*.so*" %> copyLibffiDynamicUnix stage ".so"
- buildPath -/- "libffi*.dll*" %> copyLibffiDynamicWin stage
-
-withLibffi :: Stage -> (FilePath -> FilePath -> Action a) -> Action a
-withLibffi stage action = needLibffi stage
- >> (join $ action <$> libffiBuildPath stage
- <*> rtsBuildPath stage)
-
--- | Copy a header files wither from the system libffi or from the libffi
--- build dir to the rts build dir.
---
--- See Note [Packaging libffi headers] in GHC.Driver.CodeOutput.
-copyLibffiHeader :: Stage -> FilePath -> Action ()
-copyLibffiHeader stage header = do
- useSystemFfi <- flag UseSystemFfi
- (fromStr, headerDir) <- if useSystemFfi
- then ("system",) <$> libffiSystemHeaderDir
- else needLibffi stage
- >> ("custom",) <$> libffiHeaderDir stage
- copyFile
- (headerDir -/- takeFileName header)
- header
- putSuccess $ "| Successfully copied " ++ fromStr ++ " FFI library header "
- ++ "files to RTS build directory."
-
--- | Copy a static library file from the libffi build dir to the rts build dir.
-copyLibffiStatic :: Stage -> FilePath -> Action ()
-copyLibffiStatic stage target = withLibffi stage $ \ libffiPath _ -> do
- -- Copy the vanilla library, and symlink the rest to it.
- vanillaLibFile <- rtsLibffiLibrary stage vanilla
- if target == vanillaLibFile
- then copyFile' (libffiPath -/- libffiLibrary) target
- else createFileLink (takeFileName vanillaLibFile) target
-
-
--- | Copy a dynamic library file from the libffi build dir to the rts build dir.
-copyLibffiDynamicUnix :: Stage -> String -> FilePath -> Action ()
-copyLibffiDynamicUnix stage libSuf target = do
- needLibffi stage
- dynLibs <- askLibffilDynLibs stage
-
- -- If no version number suffix, then copy else just symlink.
- let versionlessSourceFilePath = fromMaybe
- (error $ "Needed " ++ show target ++ " which is not any of " ++
- "libffi's built shared libraries: " ++ show dynLibs)
- (find (libSuf `isSuffixOf`) dynLibs)
- let versionlessSourceFileName = takeFileName versionlessSourceFilePath
- if versionlessSourceFileName == takeFileName target
- then do
- copyFile' versionlessSourceFilePath target
-
- -- On OSX the dylib's id must be updated to a relative path.
- when osxHost $ cmd
- [ "install_name_tool"
- , "-id", "@rpath/" ++ takeFileName target
- , target
- ]
- else createFileLink versionlessSourceFileName target
-
--- | Copy a dynamic library file from the libffi build dir to the rts build dir.
-copyLibffiDynamicWin :: Stage -> FilePath -> Action ()
-copyLibffiDynamicWin stage target = do
- needLibffi stage
- dynLibs <- askLibffilDynLibs stage
- let source = fromMaybe
- (error $ "Needed " ++ show target ++ " which is not any of " ++
- "libffi's built shared libraries: " ++ show dynLibs)
- (find (\ lib -> takeFileName target == takeFileName lib) dynLibs)
- copyFile' source target
-
-rtsLibffiLibrary :: Stage -> Way -> Action FilePath
-rtsLibffiLibrary stage way = do
- name <- interpretInContext ((rtsContext stage) { way = way }) libffiName
- suf <- if wayUnit Dynamic way
- then do
- extension <- setting DynamicExtension -- e.g., .dll or .so
- let suffix = waySuffix (removeWayUnit Dynamic way)
- return (suffix ++ extension)
- -- Static suffix
- else return (waySuffix way ++ ".a") -- e.g., _p.a
- rtsPath <- rtsBuildPath stage
- return $ rtsPath -/- "lib" ++ name ++ suf
-
--- | Get the libffi files bundled with the rts (header and library files).
--- Unless using the system libffi, this needs the libffi library. It must be
--- built before the targets can be calculated.
-needRtsLibffiTargets :: Stage -> Action [FilePath]
-needRtsLibffiTargets stage = do
- rtsPath <- rtsBuildPath stage
- useSystemFfi <- flag UseSystemFfi
- jsTarget <- isJsTarget
-
- -- Header files (in the rts build dir).
- let headers = fmap ((rtsPath -/- "include") -/-) libffiHeaderFiles
-
- if | jsTarget -> return []
- | useSystemFfi -> return []
- | otherwise -> do
- -- Need Libffi
- -- This returns the dynamic library files (in the Libffi build dir).
- needLibffi stage
- dynLibffSource <- askLibffilDynLibs stage
-
- -- Dynamic library files (in the rts build dir).
- let dynLibffis = fmap (\ lib -> rtsPath -/- takeFileName lib)
- dynLibffSource
-
- -- Libffi files (in the rts build dir).
- libffis_libs <- do
- ways <- interpretInContext (stageContext stage)
- (getLibraryWays <> getRtsWays)
- mapM (rtsLibffiLibrary stage) (Set.toList ways)
- return $ concat [ headers, dynLibffis, libffis_libs ]
-
-- Need symlinks generated by rtsRules.
needRtsSymLinks :: Stage -> Set.Set Way -> Action ()
needRtsSymLinks stage rtsWays
diff --git a/hadrian/src/Settings/Builders/DeriveConstants.hs b/hadrian/src/Settings/Builders/DeriveConstants.hs
index 9fb264f005be..7aa858e7628f 100644
--- a/hadrian/src/Settings/Builders/DeriveConstants.hs
+++ b/hadrian/src/Settings/Builders/DeriveConstants.hs
@@ -48,4 +48,4 @@ includeCcArgs = do
, arg "-Irts/include"
, arg $ "-I" ++ rtsPath "include"
, notM targetSupportsSMP ? arg "-DNOSMP"
- , arg "-fcommon" ]
+ ]
diff --git a/hadrian/src/Settings/Builders/GenPrimopCode.hs b/hadrian/src/Settings/Builders/GenPrimopCode.hs
index d38dcf303853..625fadeba5b6 100644
--- a/hadrian/src/Settings/Builders/GenPrimopCode.hs
+++ b/hadrian/src/Settings/Builders/GenPrimopCode.hs
@@ -24,4 +24,6 @@ genPrimopCodeBuilderArgs = builder GenPrimopCode ? mconcat
, output "//primop-vector-tycons.hs-incl" ? arg "--primop-vector-tycons"
, output "//primop-docs.hs-incl" ? arg "--wired-in-docs"
, output "//primop-deprecations.hs-incl" ? arg "--wired-in-deprecations"
+ , output "//primop-prim-module.hs-incl" ? arg "--prim-module"
+ , output "//primop-wrappers-module.hs-incl" ? arg "--wrappers-module"
, output "//primop-usage.hs-incl" ? arg "--usage" ]
diff --git a/hadrian/src/Settings/Builders/Ghc.hs b/hadrian/src/Settings/Builders/Ghc.hs
index 4c274724b46b..ea85bcb8de08 100644
--- a/hadrian/src/Settings/Builders/Ghc.hs
+++ b/hadrian/src/Settings/Builders/Ghc.hs
@@ -10,7 +10,6 @@ import Packages
import Settings.Builders.Common
import Settings.Warnings
import qualified Context as Context
-import Rules.Libffi (libffiName)
import qualified Data.Set as Set
import Data.Version.Extra
@@ -106,9 +105,6 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do
context <- getContext
distPath <- expr (Context.distDynDir context)
- useSystemFfi <- expr (flag UseSystemFfi)
- buildPath <- getBuildPath
- libffiName' <- libffiName
debugged <- buildingCompilerStage' . ghcDebugged =<< expr flavour
osxTarget <- expr isOsxTarget
@@ -127,17 +123,6 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do
metaOrigin | osxTarget = "@loader_path"
| otherwise = "$ORIGIN"
- -- TODO: an alternative would be to generalize by linking with extra
- -- bundled libraries, but currently the rts is the only use case. It is
- -- a special case when `useSystemFfi == True`: the ffi library files
- -- are not actually bundled with the rts. Perhaps ffi should be part of
- -- rts's extra libraries instead of extra bundled libraries in that
- -- case. Care should be take as to not break the make build.
- rtsFfiArg = package rts ? not useSystemFfi ? mconcat
- [ arg ("-L" ++ buildPath)
- , arg ("-l" ++ libffiName')
- ]
-
-- This is the -rpath argument that is required for the bindist scenario
-- to work. Indeed, when you install a bindist, the actual executables
-- end up nested somewhere under $libdir, with the wrapper scripts
@@ -166,7 +151,6 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do
, (not (nonHsMainPackage pkg) && not (isLibrary pkg)) ? arg "-rtsopts"
, pure [ "-l" ++ lib | lib <- libs ]
, pure [ "-L" ++ libDir | libDir <- libDirs ]
- , rtsFfiArg
, osxTarget ? pure (concat [ ["-framework", fmwk] | fmwk <- fmwks ])
, debugged ? packageOneOf [ghc, iservProxy, iserv, remoteIserv] ?
arg "-debug"
diff --git a/hadrian/src/Settings/Default.hs b/hadrian/src/Settings/Default.hs
index 131de6d55133..d26a234015d0 100644
--- a/hadrian/src/Settings/Default.hs
+++ b/hadrian/src/Settings/Default.hs
@@ -137,6 +137,7 @@ stage1Packages = do
libraries0 <- filter good_stage0_package <$> stage0Packages
cross <- flag CrossCompiling
winTarget <- isWinTarget
+ useSystemFfi <- flag UseSystemFfi
let when c xs = if c then xs else mempty
@@ -186,6 +187,10 @@ stage1Packages = do
[ -- See Note [Hadrian's ghci-wrapper package]
ghciWrapper
]
+ , when (not useSystemFfi)
+ [
+ libffi
+ ]
]
-- | Packages built in 'Stage2' by default. You can change this in "UserSettings".
diff --git a/hie.yaml b/hie.yaml
index 34dde0452ad1..b52d2944acad 100644
--- a/hie.yaml
+++ b/hie.yaml
@@ -1,8 +1,4 @@
-# This is a IDE configuration file which tells IDEs such as `ghcide` how
-# to set up a GHC API session for this project.
-#
-# To use it in windows systems replace the config with
-# cradle: {bios: {program: "./hadrian/hie-bios.bat"}}
-#
-# The format is documented here - https://github.com/mpickering/hie-bios
-cradle: {bios: {program: "./hadrian/hie-bios"}}
+# This is not perfect but it works ok
+cradle:
+ cabal:
+ cabalProject: cabal.project.stage1
diff --git a/libffi-tarballs b/libffi-tarballs
deleted file mode 160000
index 7c51059557b6..000000000000
--- a/libffi-tarballs
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit 7c51059557b68d29820a0a87cebfa6fe73c8adf5
diff --git a/libraries/Cabal b/libraries/Cabal
deleted file mode 160000
index d9b0904b49dc..000000000000
--- a/libraries/Cabal
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit d9b0904b49dc84e0bfc79062daf2bbdf9d22a422
diff --git a/libraries/Win32 b/libraries/Win32
deleted file mode 160000
index 7d0772bb265a..000000000000
--- a/libraries/Win32
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit 7d0772bb265a6c59eb14c441cf65c778895528df
diff --git a/libraries/array b/libraries/array
deleted file mode 160000
index 6d59d5deb4f2..000000000000
--- a/libraries/array
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit 6d59d5deb4f2a12656ab4c4371c0d12dac4875ef
diff --git a/libraries/base/src/System/CPUTime/Posix/ClockGetTime.hsc b/libraries/base/src/System/CPUTime/Posix/ClockGetTime.hsc
index cc1e0850835a..7279215943a9 100644
--- a/libraries/base/src/System/CPUTime/Posix/ClockGetTime.hsc
+++ b/libraries/base/src/System/CPUTime/Posix/ClockGetTime.hsc
@@ -40,6 +40,23 @@ withTimespec action =
u_nsec <- (#peek struct timespec,tv_nsec) p_ts :: IO CLong
return (r, cTimeToInteger u_sec * 1e12 + fromIntegral u_nsec * 1e3)
+#if defined(__wasi__)
+-- WASI defines clockid_t as 'const struct __clockid *' (a pointer type),
+-- unlike the integer clockid_t on POSIX platforms (Linux, macOS, etc.).
+-- We use 'Ptr ()' (void pointer) to match the WASI ABI; C allows implicit
+-- conversion between void* and any other pointer type.
+foreign import capi unsafe "time.h clock_getres" clock_getres :: Ptr () -> Ptr Timespec -> IO CInt
+foreign import capi unsafe "time.h clock_gettime" clock_gettime :: Ptr () -> Ptr Timespec -> IO CInt
+
+#if HAVE_DECL_CLOCK_PROCESS_CPUTIME_ID
+foreign import capi unsafe "time.h value CLOCK_PROCESS_CPUTIME_ID" cLOCK_PROCESS_CPUTIME_ID :: Ptr ()
+#else
+foreign import capi unsafe "time.h value CLOCK_MONOTONIC" cLOCK_PROCESS_CPUTIME_ID :: Ptr ()
+#endif // HAVE_DECL_CLOCK_PROCESS_CPUTIME_ID
+
+#else
+-- Standard POSIX platforms (Linux, macOS, FreeBSD, …) use clockid_t as an
+-- integer type (typically 'int' or 'long').
foreign import capi unsafe "time.h clock_getres" clock_getres :: CUIntPtr -> Ptr Timespec -> IO CInt
foreign import capi unsafe "time.h clock_gettime" clock_gettime :: CUIntPtr -> Ptr Timespec -> IO CInt
@@ -49,6 +66,8 @@ foreign import capi unsafe "time.h value CLOCK_PROCESS_CPUTIME_ID" cLOCK_PROCESS
foreign import capi unsafe "time.h value CLOCK_MONOTONIC" cLOCK_PROCESS_CPUTIME_ID :: CUIntPtr
#endif // HAVE_DECL_CLOCK_PROCESS_CPUTIME_ID
+#endif // __wasi__
+
#else
-- This should never happen
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/binary b/libraries/binary
deleted file mode 160000
index a625eee2eb9d..000000000000
--- a/libraries/binary
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit a625eee2eb9dfb4019c051b59d6007c9dded88aa
diff --git a/libraries/bytestring b/libraries/bytestring
deleted file mode 160000
index d984ad00644c..000000000000
--- a/libraries/bytestring
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit d984ad00644c0157bad04900434b9d36f23633c5
diff --git a/libraries/containers b/libraries/containers
deleted file mode 160000
index 801b06e5d439..000000000000
--- a/libraries/containers
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit 801b06e5d4392b028e519d5ca116a2881d559721
diff --git a/libraries/deepseq b/libraries/deepseq
deleted file mode 160000
index ae2762ac241a..000000000000
--- a/libraries/deepseq
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit ae2762ac241a61852c9ff4c287af234fb1ad931f
diff --git a/libraries/directory b/libraries/directory
deleted file mode 160000
index 6442a3cf04f7..000000000000
--- a/libraries/directory
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit 6442a3cf04f74d82cdf8c9213324313d52b23d28
diff --git a/libraries/exceptions b/libraries/exceptions
deleted file mode 160000
index 81bfd6e0ca63..000000000000
--- a/libraries/exceptions
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit 81bfd6e0ca631f315658201ae02e30046678f056
diff --git a/libraries/file-io b/libraries/file-io
deleted file mode 160000
index 21303160b5dd..000000000000
--- a/libraries/file-io
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit 21303160b5dd91d6197bd1d20a8796ba2a819d4e
diff --git a/libraries/filepath b/libraries/filepath
deleted file mode 160000
index cbcd0ccf92f4..000000000000
--- a/libraries/filepath
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit cbcd0ccf92f47e6c10fb9cc513a7b26facfc19fe
diff --git a/libraries/ghc-boot-th/ghc-boot-th.cabal.in b/libraries/ghc-boot-th/ghc-boot-th.cabal.in
index a1ce2dc2dafc..2c299ad6c06c 100644
--- a/libraries/ghc-boot-th/ghc-boot-th.cabal.in
+++ b/libraries/ghc-boot-th/ghc-boot-th.cabal.in
@@ -56,7 +56,7 @@ Library
cpp-options: -DBOOTSTRAP_TH
build-depends:
ghc-prim
- hs-source-dirs: @SourceRoot@ ../ghc-internal/src
+ hs-source-dirs: ../ghc-boot-th ../ghc-internal/src
exposed-modules:
GHC.Boot.TH.Lib
GHC.Boot.TH.Syntax
diff --git a/libraries/ghc-boot/GHC/Unit/Database.hs b/libraries/ghc-boot/GHC/Unit/Database.hs
index ac6847615604..4d3347bdff31 100644
--- a/libraries/ghc-boot/GHC/Unit/Database.hs
+++ b/libraries/ghc-boot/GHC/Unit/Database.hs
@@ -170,6 +170,10 @@ data GenericUnitInfo srcpkgid srcpkgname uid modulename mod = GenericUnitInfo
, unitExtDepLibsSys :: [ST.ShortText]
-- ^ Names of the external system libraries that this unit depends on. See
-- also `unitExtDepLibsGhc` field.
+ --
+ , unitExtDepLibsStaticSys :: [ST.ShortText]
+ -- ^ Names of the external static system libraries that this unit depends on. See
+ -- also `unitExtDepLibsGhc` field.
, unitExtDepLibsGhc :: [ST.ShortText]
-- ^ Because of slight differences between the GHC dynamic linker (in
@@ -188,6 +192,13 @@ data GenericUnitInfo srcpkgid srcpkgname uid modulename mod = GenericUnitInfo
--
-- It seems to be used to store paths to external library dependencies
-- too.
+ --
+ , unitLibraryDirsStatic :: [FilePathST]
+ -- ^ Directories containing static libraries provided by this unit. See also
+ -- `unitLibraryDynDirs`.
+ --
+ -- It seems to be used to store paths to external library dependencies
+ -- too.
, unitLibraryDynDirs :: [FilePathST]
-- ^ Directories containing the dynamic libraries provided by this unit.
@@ -224,6 +235,10 @@ data GenericUnitInfo srcpkgid srcpkgname uid modulename mod = GenericUnitInfo
, unitHaddockHTMLs :: [FilePathST]
-- ^ Paths to Haddock directories containing HTML files
+ , unitDataDir :: Maybe FilePathST
+ -- ^ Data directory for package data files (e.g., templates, resources)
+ -- Exposed to the compiler for packages that need data files during compilation/linking
+
, unitExposedModules :: [(modulename, Maybe mod)]
-- ^ Modules exposed by the unit.
--
@@ -538,12 +553,13 @@ instance Binary DbUnitInfo where
unitPackageName unitPackageVersion
unitComponentName
unitAbiHash unitDepends unitAbiDepends unitImportDirs
- unitLibraries unitExtDepLibsSys unitExtDepLibsGhc
- unitLibraryDirs unitLibraryDynDirs
+ unitLibraries unitExtDepLibsSys unitExtDepLibsStaticSys unitExtDepLibsGhc
+ unitLibraryDirs unitLibraryDirsStatic unitLibraryDynDirs
unitExtDepFrameworks unitExtDepFrameworkDirs
unitLinkerOptions unitCcOptions
unitIncludes unitIncludeDirs
unitHaddockInterfaces unitHaddockHTMLs
+ unitDataDir
unitExposedModules unitHiddenModules
unitIsIndefinite unitIsExposed unitIsTrusted) = do
put unitPackageId
@@ -559,8 +575,10 @@ instance Binary DbUnitInfo where
put unitImportDirs
put unitLibraries
put unitExtDepLibsSys
+ put unitExtDepLibsStaticSys
put unitExtDepLibsGhc
put unitLibraryDirs
+ put unitLibraryDirsStatic
put unitLibraryDynDirs
put unitExtDepFrameworks
put unitExtDepFrameworkDirs
@@ -570,6 +588,7 @@ instance Binary DbUnitInfo where
put unitIncludeDirs
put unitHaddockInterfaces
put unitHaddockHTMLs
+ put unitDataDir
put unitExposedModules
put unitHiddenModules
put unitIsIndefinite
@@ -590,8 +609,10 @@ instance Binary DbUnitInfo where
unitImportDirs <- get
unitLibraries <- get
unitExtDepLibsSys <- get
+ unitExtDepLibsStaticSys <- get
unitExtDepLibsGhc <- get
libraryDirs <- get
+ libraryDirsStatic <- get
libraryDynDirs <- get
frameworks <- get
frameworkDirs <- get
@@ -601,6 +622,7 @@ instance Binary DbUnitInfo where
unitIncludeDirs <- get
unitHaddockInterfaces <- get
unitHaddockHTMLs <- get
+ unitDataDir <- get
unitExposedModules <- get
unitHiddenModules <- get
unitIsIndefinite <- get
@@ -618,12 +640,13 @@ instance Binary DbUnitInfo where
unitDepends
unitAbiDepends
unitImportDirs
- unitLibraries unitExtDepLibsSys unitExtDepLibsGhc
- libraryDirs libraryDynDirs
+ unitLibraries unitExtDepLibsSys unitExtDepLibsStaticSys unitExtDepLibsGhc
+ libraryDirs libraryDirsStatic libraryDynDirs
frameworks frameworkDirs
unitLinkerOptions unitCcOptions
unitIncludes unitIncludeDirs
unitHaddockInterfaces unitHaddockHTMLs
+ unitDataDir
unitExposedModules
unitHiddenModules
unitIsIndefinite unitIsExposed unitIsTrusted)
@@ -713,10 +736,12 @@ mungeUnitInfoPaths top_dir pkgroot pkg =
, unitIncludeDirs = munge_paths (unitIncludeDirs pkg)
, unitLibraryDirs = munge_paths (unitLibraryDirs pkg)
, unitLibraryDynDirs = munge_paths (unitLibraryDynDirs pkg)
+ , unitLibraryDirsStatic = munge_paths (unitLibraryDirsStatic pkg)
, unitExtDepFrameworkDirs = munge_paths (unitExtDepFrameworkDirs pkg)
, unitHaddockInterfaces = munge_paths (unitHaddockInterfaces pkg)
-- haddock-html is allowed to be either a URL or a file
, unitHaddockHTMLs = munge_paths (munge_urls (unitHaddockHTMLs pkg))
+ , unitDataDir = fmap munge_path (unitDataDir pkg)
}
where
munge_paths = map munge_path
diff --git a/libraries/ghc-boot/GHC/Version.hs b/libraries/ghc-boot/GHC/Version.hs
new file mode 100644
index 000000000000..c66da7fec67d
--- /dev/null
+++ b/libraries/ghc-boot/GHC/Version.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE CPP #-}
+module GHC.Version where
+
+#ifndef GIT_COMMIT_ID
+#define GIT_COMMIT_ID 000000000000000000000000000000000000000
+#endif
+
+import PackageInfo_ghc_boot (version)
+import Data.List ((!?))
+import Data.Maybe (fromMaybe)
+import Data.Version (showVersion, versionBranch)
+
+import Prelude -- See Note [Why do we import Prelude here?]
+
+cProjectGitCommitId :: String
+cProjectGitCommitId = "GIT_COMMIT_ID"
+
+cProjectVersion :: String
+cProjectVersion = showVersion version
+
+cProjectVersionInt :: String
+cProjectVersionInt = concatMap show (versionBranch version)
+
+cProjectPatchLevel :: String
+cProjectPatchLevel = case (versionBranch version !? 2, versionBranch version !? 3) of
+ (Just pl1, Just pl2) -> show pl1 ++ show pl2
+ (Just pl1, Nothing) -> show pl1
+ _ -> "0"
+
+cProjectPatchLevel1 :: String
+cProjectPatchLevel1 = show $ fromMaybe 0 (versionBranch version !? 2)
+
+cProjectPatchLevel2 :: String
+cProjectPatchLevel2 = show $ fromMaybe 0 (versionBranch version !? 3)
diff --git a/libraries/ghc-boot/Setup.hs b/libraries/ghc-boot/Setup.hs
index 0995ee3f8ff6..a0b0c7653da9 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
@@ -18,103 +21,122 @@ import System.Environment
import Control.Monad
import Data.Char
import GHC.ResponseFile
+import Distribution.System (Platform(..))
+
+-- | Extract the 'Verbosity' from the configure flags.
+--
+-- Cabal 3.17 (commit edb808a0b8b) split the old @Verbosity@ type into
+-- 'VerbosityFlags' (the CLI-passable part) and 'VerbosityHandles', so
+-- 'configVerbosity' now yields a 'VerbosityFlags' which must be wrapped
+-- back into a 'Verbosity' before passing it to the Cabal library functions.
+configVerbosity' :: ConfigFlags -> Verbosity
+#if MIN_VERSION_Cabal(3,17,0)
+configVerbosity' cfg =
+ mkVerbosity defaultVerbosityHandles (fromFlagOrDefault silent (configVerbosity cfg))
+#else
+configVerbosity' cfg = fromFlagOrDefault minBound (configVerbosity cfg)
+#endif
main :: IO ()
main = defaultMainWithHooks ghcHooks
where
ghcHooks = simpleUserHooks
- { postConf = \args cfg pd lbi -> do
- let verbosity = fromFlagOrDefault minBound (configVerbosity cfg)
+ { confHook = \(gpd, hbi) cfg -> do
+ let verbosity = configVerbosity' cfg
+ lbi <- confHook simpleUserHooks (gpd, hbi) cfg
+ gitCommitId <- lookupEnv "GIT_COMMIT_ID" >>= \case
+ Just str -> return str
+ Nothing -> do
+ (git, progdb) <- requireProgram verbosity (simpleProgram "git") defaultProgramDb
+ getProgramOutput verbosity git ["rev-parse", "HEAD"]
+ info verbosity $ "Git Commit Id = " ++ gitCommitId
+ let cfs = configFlags lbi
+ cPa = configProgramArgs cfs ++ [("ghc", ["-D GIT_COMMIT_ID=" ++ gitCommitId])]
+ return lbi { configFlags = cfs { configProgramArgs = cPa } }
+
+ , postConf = \args cfg pd lbi -> do
+ let verbosity = configVerbosity' cfg
ghcAutogen verbosity lbi
postConf simpleUserHooks args cfg pd lbi
}
ghcAutogen :: Verbosity -> LocalBuildInfo -> IO ()
-ghcAutogen verbosity lbi@LocalBuildInfo{..} = do
+ghcAutogen verbosity lbi@LocalBuildInfo {hostPlatform, pkgDescrFile} = 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
- ghcVersionFile = "GHC/Version.hs"
- ghcVersionPath = autogenPackageModulesDir lbi ghcVersionFile
-
- -- Get compiler settings
- settings <- lookupEnv "HADRIAN_SETTINGS" >>= \case
- Just settings -> pure $ Left $ read settings
- Nothing -> do
- (ghc,withPrograms) <- requireProgram normal ghcProgram withPrograms
- Right . read <$> getProgramOutput normal ghc ["--info"]
-
+ platformHostPath = fromSymPath (autogenPackageModulesDir lbi) platformHostFile
-- Write GHC.Platform.Host
createDirectoryIfMissingVerbose verbosity True (takeDirectory platformHostPath)
- rewriteFileEx verbosity platformHostPath (generatePlatformHostHs settings)
- -- Write GHC.Version
- createDirectoryIfMissingVerbose verbosity True (takeDirectory ghcVersionPath)
- rewriteFileEx verbosity ghcVersionPath (generateVersionHs settings)
-
--- | Takes either a list of hadrian generated settings, or a list of settings from ghc --info,
--- and keys in both lists, and looks up the value in the appropriate list
-getSetting :: Either [(String,String)] [(String,String)] -> String -> String -> Either String String
-getSetting settings kh kr = case settings of
- Left settings -> go settings kh
- Right settings -> go settings kr
- where
- go settings k = case lookup k settings of
- Nothing -> Left (show k ++ " not found in settings: " ++ show settings)
- Just v -> Right v
+ -- hostPlatform is listed in LocalBuildInfo as "the platform we are building for"
+ let Platform arch os = hostPlatform
-generatePlatformHostHs :: Either [(String,String)] [(String,String)] -> String
-generatePlatformHostHs settings = either error id $ do
- let getSetting' = getSetting settings
- cHostPlatformArch <- getSetting' "hostPlatformArch" "target arch"
- cHostPlatformOS <- getSetting' "hostPlatformOS" "target os"
- return $ unlines
+ rewriteFileEx verbosity platformHostPath $
+ unlines
[ "module GHC.Platform.Host where"
, ""
, "import GHC.Platform.ArchOS"
+ , "import Distribution.System hiding (Arch, OS)"
, ""
, "hostPlatformArch :: Arch"
- , "hostPlatformArch = " ++ cHostPlatformArch
+ , "hostPlatformArch = toArch " ++ show arch
, ""
, "hostPlatformOS :: OS"
- , "hostPlatformOS = " ++ cHostPlatformOS
+ , "hostPlatformOS = toOS " ++ show os
, ""
, "hostPlatformArchOS :: ArchOS"
, "hostPlatformArchOS = ArchOS hostPlatformArch hostPlatformOS"
- ]
-
-generateVersionHs :: Either [(String,String)] [(String,String)] -> String
-generateVersionHs settings = either error id $ do
- let getSetting' = getSetting settings
- cProjectGitCommitId <- getSetting' "cProjectGitCommitId" "Project Git commit id"
- cProjectVersion <- getSetting' "cProjectVersion" "Project version"
- cProjectVersionInt <- getSetting' "cProjectVersionInt" "Project Version Int"
-
- cProjectPatchLevel <- getSetting' "cProjectPatchLevel" "Project Patch Level"
- cProjectPatchLevel1 <- getSetting' "cProjectPatchLevel1" "Project Patch Level1"
- cProjectPatchLevel2 <- getSetting' "cProjectPatchLevel2" "Project Patch Level2"
- return $ unlines
- [ "module GHC.Version where"
- , ""
- , "import Prelude -- See Note [Why do we import Prelude here?]"
- , ""
- , "cProjectGitCommitId :: String"
- , "cProjectGitCommitId = " ++ show cProjectGitCommitId
- , ""
- , "cProjectVersion :: String"
- , "cProjectVersion = " ++ show cProjectVersion
- , ""
- , "cProjectVersionInt :: String"
- , "cProjectVersionInt = " ++ show cProjectVersionInt
- , ""
- , "cProjectPatchLevel :: String"
- , "cProjectPatchLevel = " ++ show cProjectPatchLevel
, ""
- , "cProjectPatchLevel1 :: String"
- , "cProjectPatchLevel1 = " ++ show cProjectPatchLevel1
+ , "toArch I386 = ArchX86"
+ , "toArch X86_64 = ArchX86_64"
+ , "toArch PPC = ArchPPC"
+ , "toArch PPC64 = ArchPPC_64 ELF_V1"
+ , "toArch PPC64LE = ArchPPC_64 ELF_V2"
+ , "toArch Sparc = ArchUnknown -- ?"
+ , "toArch Sparc64 = ArchUnknown -- ?"
+ , "toArch Arm = ArchARM ARMv7 [] SOFT -- ?"
+ , "toArch AArch64 = ArchAArch64"
+ , "toArch Mips = ArchUnknown -- ?"
+ , "toArch SH = ArchUnknown -- ?"
+ , "toArch IA64 = ArchUnknown -- ?"
+ , "toArch S390 = ArchUnknown -- ?"
+ , "toArch S390X = ArchUnknown -- ?"
+ , "toArch Alpha = ArchAlpha"
+ , "toArch Hppa = ArchUnknown -- ?"
+ , "toArch Rs6000 = ArchUnknown -- ?"
+ , "toArch M68k = ArchUnknown -- ?"
+ , "toArch Vax = ArchUnknown -- ?"
+ , "toArch RISCV64 = ArchRISCV64"
+ , "toArch LoongArch64 = ArchLoongArch64"
+ , "toArch JavaScript = ArchJavaScript"
+ , "toArch Wasm32 = ArchWasm32"
+ , "toArch (OtherArch _) = ArchUnknown"
, ""
- , "cProjectPatchLevel2 :: String"
- , "cProjectPatchLevel2 = " ++ show cProjectPatchLevel2
+ , "toOS Linux = OSLinux"
+ , "toOS Windows = OSMinGW32"
+ , "toOS OSX = OSDarwin"
+ , "toOS FreeBSD = OSFreeBSD"
+ , "toOS OpenBSD = OSOpenBSD"
+ , "toOS NetBSD = OSNetBSD"
+ , "toOS DragonFly = OSDragonFly"
+ , "toOS Solaris = OSSolaris2"
+ , "toOS AIX = OSAIX"
+ , "toOS HPUX = OSUnknown -- ?"
+ , "toOS IRIX = OSUnknown -- ?"
+ , "toOS HaLVM = OSUnknown -- ?"
+ , "toOS Hurd = OSHurd"
+ , "toOS IOS = OSUnknown -- ?"
+ , "toOS Android = OSUnknown -- ?"
+ , "toOS Ghcjs = OSGhcjs"
+ , "toOS Wasi = OSWasi"
+ , "toOS Haiku = OSHaiku"
+ , "toOS (OtherOS _) = OSUnknown"
]
diff --git a/libraries/ghc-boot/ghc-boot.cabal.in b/libraries/ghc-boot/ghc-boot.cabal.in
index 7760af0e4ffc..9bd33e58da02 100644
--- a/libraries/ghc-boot/ghc-boot.cabal.in
+++ b/libraries/ghc-boot/ghc-boot.cabal.in
@@ -1,4 +1,4 @@
-cabal-version: 3.0
+cabal-version: 3.12
-- WARNING: ghc-boot.cabal is automatically generated from ghc-boot.cabal.in by
-- ../../configure. Make sure you are editing ghc-boot.cabal.in, not
@@ -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.18, Cabal-syntax >= 3.6 && <3.18, directory, filepath
source-repository head
type: git
@@ -72,12 +72,16 @@ Library
-- but done by Hadrian
autogen-modules:
- GHC.Version
+ PackageInfo_ghc_boot
GHC.Platform.Host
+ other-modules:
+ PackageInfo_ghc_boot
+
build-depends: base >= 4.7 && < 4.23,
binary == 0.8.*,
bytestring >= 0.10 && < 0.13,
+ Cabal-syntax >= 3.6 && <3.18,
containers >= 0.5 && < 0.9,
directory >= 1.2 && < 1.4,
filepath >= 1.3 && < 1.6,
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/config.guess b/libraries/ghc-internal/config.guess
new file mode 100644
index 000000000000..a9d01fde4617
--- /dev/null
+++ b/libraries/ghc-internal/config.guess
@@ -0,0 +1,1818 @@
+#! /bin/sh
+# Attempt to guess a canonical system name.
+# Copyright 1992-2025 Free Software Foundation, Inc.
+
+# shellcheck disable=SC2006,SC2268 # see below for rationale
+
+timestamp='2025-07-10'
+
+# This file is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, see .
+#
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that
+# program. This Exception is an additional permission under section 7
+# of the GNU General Public License, version 3 ("GPLv3").
+#
+# Originally written by Per Bothner; maintained since 2000 by Ben Elliston.
+#
+# You can get the latest version of this script from:
+# https://git.savannah.gnu.org/cgit/config.git/plain/config.guess
+#
+# Please send patches to .
+
+
+# The "shellcheck disable" line above the timestamp inhibits complaints
+# about features and limitations of the classic Bourne shell that were
+# superseded or lifted in POSIX. However, this script identifies a wide
+# variety of pre-POSIX systems that do not have POSIX shells at all, and
+# even some reasonably current systems (Solaris 10 as case-in-point) still
+# have a pre-POSIX /bin/sh.
+
+
+me=`echo "$0" | sed -e 's,.*/,,'`
+
+usage="\
+Usage: $0 [OPTION]
+
+Output the configuration name of the system '$me' is run on.
+
+Options:
+ -h, --help print this help, then exit
+ -t, --time-stamp print date of last modification, then exit
+ -v, --version print version number, then exit
+
+Report bugs and patches to ."
+
+version="\
+GNU config.guess ($timestamp)
+
+Originally written by Per Bothner.
+Copyright 1992-2025 Free Software Foundation, Inc.
+
+This is free software; see the source for copying conditions. There is NO
+warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
+
+help="
+Try '$me --help' for more information."
+
+# Parse command line
+while test $# -gt 0 ; do
+ case $1 in
+ --time-stamp | --time* | -t )
+ echo "$timestamp" ; exit ;;
+ --version | -v )
+ echo "$version" ; exit ;;
+ --help | --h* | -h )
+ echo "$usage"; exit ;;
+ -- ) # Stop option processing
+ shift; break ;;
+ - ) # Use stdin as input.
+ break ;;
+ -* )
+ echo "$me: invalid option $1$help" >&2
+ exit 1 ;;
+ * )
+ break ;;
+ esac
+done
+
+if test $# != 0; then
+ echo "$me: too many arguments$help" >&2
+ exit 1
+fi
+
+# Just in case it came from the environment.
+GUESS=
+
+# CC_FOR_BUILD -- compiler used by this script. Note that the use of a
+# compiler to aid in system detection is discouraged as it requires
+# temporary files to be created and, as you can see below, it is a
+# headache to deal with in a portable fashion.
+
+# Historically, 'CC_FOR_BUILD' used to be named 'HOST_CC'. We still
+# use 'HOST_CC' if defined, but it is deprecated.
+
+# Portable tmp directory creation inspired by the Autoconf team.
+
+tmp=
+# shellcheck disable=SC2172
+trap 'test -z "$tmp" || rm -fr "$tmp"' 0 1 2 13 15
+
+set_cc_for_build() {
+ # prevent multiple calls if $tmp is already set
+ test "$tmp" && return 0
+ : "${TMPDIR=/tmp}"
+ # shellcheck disable=SC2039,SC3028
+ { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } ||
+ { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir "$tmp" 2>/dev/null) ; } ||
+ { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir "$tmp" 2>/dev/null) && echo "Warning: creating insecure temp directory" >&2 ; } ||
+ { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; }
+ dummy=$tmp/dummy
+ case ${CC_FOR_BUILD-},${HOST_CC-},${CC-} in
+ ,,) echo "int x;" > "$dummy.c"
+ for driver in cc gcc c17 c99 c89 ; do
+ if ($driver -c -o "$dummy.o" "$dummy.c") >/dev/null 2>&1 ; then
+ CC_FOR_BUILD=$driver
+ break
+ fi
+ done
+ if test x"$CC_FOR_BUILD" = x ; then
+ CC_FOR_BUILD=no_compiler_found
+ fi
+ ;;
+ ,,*) CC_FOR_BUILD=$CC ;;
+ ,*,*) CC_FOR_BUILD=$HOST_CC ;;
+ esac
+}
+
+# This is needed to find uname on a Pyramid OSx when run in the BSD universe.
+# (ghazi@noc.rutgers.edu 1994-08-24)
+if test -f /.attbin/uname ; then
+ PATH=$PATH:/.attbin ; export PATH
+fi
+
+UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown
+UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown
+UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown
+UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown
+
+case $UNAME_SYSTEM in
+Linux|GNU|GNU/*)
+ LIBC=unknown
+
+ set_cc_for_build
+ cat <<-EOF > "$dummy.c"
+ #if defined(__ANDROID__)
+ LIBC=android
+ #else
+ #include
+ #if defined(__UCLIBC__)
+ LIBC=uclibc
+ #elif defined(__dietlibc__)
+ LIBC=dietlibc
+ #elif defined(__GLIBC__)
+ LIBC=gnu
+ #elif defined(__LLVM_LIBC__)
+ LIBC=llvm
+ #else
+ #include
+ /* First heuristic to detect musl libc. */
+ #ifdef __DEFINED_va_list
+ LIBC=musl
+ #endif
+ #endif
+ #endif
+ EOF
+ cc_set_libc=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^LIBC' | sed 's, ,,g'`
+ eval "$cc_set_libc"
+
+ # Second heuristic to detect musl libc.
+ if [ "$LIBC" = unknown ] &&
+ command -v ldd >/dev/null &&
+ ldd --version 2>&1 | grep -q ^musl; then
+ LIBC=musl
+ fi
+
+ # If the system lacks a compiler, then just pick glibc.
+ # We could probably try harder.
+ if [ "$LIBC" = unknown ]; then
+ LIBC=gnu
+ fi
+ ;;
+esac
+
+# Note: order is significant - the case branches are not exclusive.
+
+case $UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION in
+ *:NetBSD:*:*)
+ # NetBSD (nbsd) targets should (where applicable) match one or
+ # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*,
+ # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently
+ # switched to ELF, *-*-netbsd* would select the old
+ # object file format. This provides both forward
+ # compatibility and a consistent mechanism for selecting the
+ # object file format.
+ #
+ # Note: NetBSD doesn't particularly care about the vendor
+ # portion of the name. We always set it to "unknown".
+ UNAME_MACHINE_ARCH=`(uname -p 2>/dev/null || \
+ /sbin/sysctl -n hw.machine_arch 2>/dev/null || \
+ /usr/sbin/sysctl -n hw.machine_arch 2>/dev/null || \
+ echo unknown)`
+ case $UNAME_MACHINE_ARCH in
+ aarch64eb) machine=aarch64_be-unknown ;;
+ armeb) machine=armeb-unknown ;;
+ arm*) machine=arm-unknown ;;
+ sh3el) machine=shl-unknown ;;
+ sh3eb) machine=sh-unknown ;;
+ sh5el) machine=sh5le-unknown ;;
+ earmv*)
+ arch=`echo "$UNAME_MACHINE_ARCH" | sed -e 's,^e\(armv[0-9]\).*$,\1,'`
+ endian=`echo "$UNAME_MACHINE_ARCH" | sed -ne 's,^.*\(eb\)$,\1,p'`
+ machine=${arch}${endian}-unknown
+ ;;
+ *) machine=$UNAME_MACHINE_ARCH-unknown ;;
+ esac
+ # The Operating System including object format, if it has switched
+ # to ELF recently (or will in the future) and ABI.
+ case $UNAME_MACHINE_ARCH in
+ earm*)
+ os=netbsdelf
+ ;;
+ arm*|i386|m68k|ns32k|sh3*|sparc|vax)
+ set_cc_for_build
+ if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \
+ | grep -q __ELF__
+ then
+ # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout).
+ # Return netbsd for either. FIX?
+ os=netbsd
+ else
+ os=netbsdelf
+ fi
+ ;;
+ *)
+ os=netbsd
+ ;;
+ esac
+ # Determine ABI tags.
+ case $UNAME_MACHINE_ARCH in
+ earm*)
+ expr='s/^earmv[0-9]/-eabi/;s/eb$//'
+ abi=`echo "$UNAME_MACHINE_ARCH" | sed -e "$expr"`
+ ;;
+ esac
+ # The OS release
+ # Debian GNU/NetBSD machines have a different userland, and
+ # thus, need a distinct triplet. However, they do not need
+ # kernel version information, so it can be replaced with a
+ # suitable tag, in the style of linux-gnu.
+ case $UNAME_VERSION in
+ Debian*)
+ release='-gnu'
+ ;;
+ *)
+ release=`echo "$UNAME_RELEASE" | sed -e 's/[-_].*//' | cut -d. -f1,2`
+ ;;
+ esac
+ # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM:
+ # contains redundant information, the shorter form:
+ # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used.
+ GUESS=$machine-${os}${release}${abi-}
+ ;;
+ *:Bitrig:*:*)
+ UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'`
+ GUESS=$UNAME_MACHINE_ARCH-unknown-bitrig$UNAME_RELEASE
+ ;;
+ *:OpenBSD:*:*)
+ UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'`
+ GUESS=$UNAME_MACHINE_ARCH-unknown-openbsd$UNAME_RELEASE
+ ;;
+ *:SecBSD:*:*)
+ UNAME_MACHINE_ARCH=`arch | sed 's/SecBSD.//'`
+ GUESS=$UNAME_MACHINE_ARCH-unknown-secbsd$UNAME_RELEASE
+ ;;
+ *:LibertyBSD:*:*)
+ UNAME_MACHINE_ARCH=`arch | sed 's/^.*BSD\.//'`
+ GUESS=$UNAME_MACHINE_ARCH-unknown-libertybsd$UNAME_RELEASE
+ ;;
+ *:MidnightBSD:*:*)
+ GUESS=$UNAME_MACHINE-unknown-midnightbsd$UNAME_RELEASE
+ ;;
+ *:ekkoBSD:*:*)
+ GUESS=$UNAME_MACHINE-unknown-ekkobsd$UNAME_RELEASE
+ ;;
+ *:SolidBSD:*:*)
+ GUESS=$UNAME_MACHINE-unknown-solidbsd$UNAME_RELEASE
+ ;;
+ *:OS108:*:*)
+ GUESS=$UNAME_MACHINE-unknown-os108_$UNAME_RELEASE
+ ;;
+ macppc:MirBSD:*:*)
+ GUESS=powerpc-unknown-mirbsd$UNAME_RELEASE
+ ;;
+ *:MirBSD:*:*)
+ GUESS=$UNAME_MACHINE-unknown-mirbsd$UNAME_RELEASE
+ ;;
+ *:Sortix:*:*)
+ GUESS=$UNAME_MACHINE-unknown-sortix
+ ;;
+ *:Twizzler:*:*)
+ GUESS=$UNAME_MACHINE-unknown-twizzler
+ ;;
+ *:Redox:*:*)
+ GUESS=$UNAME_MACHINE-unknown-redox
+ ;;
+ mips:OSF1:*.*)
+ GUESS=mips-dec-osf1
+ ;;
+ alpha:OSF1:*:*)
+ # Reset EXIT trap before exiting to avoid spurious non-zero exit code.
+ trap '' 0
+ case $UNAME_RELEASE in
+ *4.0)
+ UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'`
+ ;;
+ *5.*)
+ UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'`
+ ;;
+ esac
+ # According to Compaq, /usr/sbin/psrinfo has been available on
+ # OSF/1 and Tru64 systems produced since 1995. I hope that
+ # covers most systems running today. This code pipes the CPU
+ # types through head -n 1, so we only detect the type of CPU 0.
+ ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1`
+ case $ALPHA_CPU_TYPE in
+ "EV4 (21064)")
+ UNAME_MACHINE=alpha ;;
+ "EV4.5 (21064)")
+ UNAME_MACHINE=alpha ;;
+ "LCA4 (21066/21068)")
+ UNAME_MACHINE=alpha ;;
+ "EV5 (21164)")
+ UNAME_MACHINE=alphaev5 ;;
+ "EV5.6 (21164A)")
+ UNAME_MACHINE=alphaev56 ;;
+ "EV5.6 (21164PC)")
+ UNAME_MACHINE=alphapca56 ;;
+ "EV5.7 (21164PC)")
+ UNAME_MACHINE=alphapca57 ;;
+ "EV6 (21264)")
+ UNAME_MACHINE=alphaev6 ;;
+ "EV6.7 (21264A)")
+ UNAME_MACHINE=alphaev67 ;;
+ "EV6.8CB (21264C)")
+ UNAME_MACHINE=alphaev68 ;;
+ "EV6.8AL (21264B)")
+ UNAME_MACHINE=alphaev68 ;;
+ "EV6.8CX (21264D)")
+ UNAME_MACHINE=alphaev68 ;;
+ "EV6.9A (21264/EV69A)")
+ UNAME_MACHINE=alphaev69 ;;
+ "EV7 (21364)")
+ UNAME_MACHINE=alphaev7 ;;
+ "EV7.9 (21364A)")
+ UNAME_MACHINE=alphaev79 ;;
+ esac
+ # A Pn.n version is a patched version.
+ # A Vn.n version is a released version.
+ # A Tn.n version is a released field test version.
+ # A Xn.n version is an unreleased experimental baselevel.
+ # 1.2 uses "1.2" for uname -r.
+ OSF_REL=`echo "$UNAME_RELEASE" | sed -e 's/^[PVTX]//' | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz`
+ GUESS=$UNAME_MACHINE-dec-osf$OSF_REL
+ ;;
+ Amiga*:UNIX_System_V:4.0:*)
+ GUESS=m68k-unknown-sysv4
+ ;;
+ *:[Aa]miga[Oo][Ss]:*:*)
+ GUESS=$UNAME_MACHINE-unknown-amigaos
+ ;;
+ *:[Mm]orph[Oo][Ss]:*:*)
+ GUESS=$UNAME_MACHINE-unknown-morphos
+ ;;
+ *:OS/390:*:*)
+ GUESS=i370-ibm-openedition
+ ;;
+ *:z/VM:*:*)
+ GUESS=s390-ibm-zvmoe
+ ;;
+ *:OS400:*:*)
+ GUESS=powerpc-ibm-os400
+ ;;
+ arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*)
+ GUESS=arm-acorn-riscix$UNAME_RELEASE
+ ;;
+ arm*:riscos:*:*|arm*:RISCOS:*:*)
+ GUESS=arm-unknown-riscos
+ ;;
+ SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*)
+ GUESS=hppa1.1-hitachi-hiuxmpp
+ ;;
+ Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*)
+ # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE.
+ case `(/bin/universe) 2>/dev/null` in
+ att) GUESS=pyramid-pyramid-sysv3 ;;
+ *) GUESS=pyramid-pyramid-bsd ;;
+ esac
+ ;;
+ NILE*:*:*:dcosx)
+ GUESS=pyramid-pyramid-svr4
+ ;;
+ DRS?6000:unix:4.0:6*)
+ GUESS=sparc-icl-nx6
+ ;;
+ DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*)
+ case `/usr/bin/uname -p` in
+ sparc) GUESS=sparc-icl-nx7 ;;
+ esac
+ ;;
+ s390x:SunOS:*:*)
+ SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`
+ GUESS=$UNAME_MACHINE-ibm-solaris2$SUN_REL
+ ;;
+ sun4H:SunOS:5.*:*)
+ SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`
+ GUESS=sparc-hal-solaris2$SUN_REL
+ ;;
+ sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*)
+ SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`
+ GUESS=sparc-sun-solaris2$SUN_REL
+ ;;
+ i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*)
+ GUESS=i386-pc-auroraux$UNAME_RELEASE
+ ;;
+ i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*)
+ set_cc_for_build
+ SUN_ARCH=i386
+ # If there is a compiler, see if it is configured for 64-bit objects.
+ # Note that the Sun cc does not turn __LP64__ into 1 like gcc does.
+ # This test works for both compilers.
+ if test "$CC_FOR_BUILD" != no_compiler_found; then
+ if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \
+ (CCOPTS="" $CC_FOR_BUILD -m64 -E - 2>/dev/null) | \
+ grep IS_64BIT_ARCH >/dev/null
+ then
+ SUN_ARCH=x86_64
+ fi
+ fi
+ SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`
+ GUESS=$SUN_ARCH-pc-solaris2$SUN_REL
+ ;;
+ sun4*:SunOS:6*:*)
+ # According to config.sub, this is the proper way to canonicalize
+ # SunOS6. Hard to guess exactly what SunOS6 will be like, but
+ # it's likely to be more like Solaris than SunOS4.
+ SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`
+ GUESS=sparc-sun-solaris3$SUN_REL
+ ;;
+ sun4*:SunOS:*:*)
+ case `/usr/bin/arch -k` in
+ Series*|S4*)
+ UNAME_RELEASE=`uname -v`
+ ;;
+ esac
+ # Japanese Language versions have a version number like '4.1.3-JL'.
+ SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/-/_/'`
+ GUESS=sparc-sun-sunos$SUN_REL
+ ;;
+ sun3*:SunOS:*:*)
+ GUESS=m68k-sun-sunos$UNAME_RELEASE
+ ;;
+ sun*:*:4.2BSD:*)
+ UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null`
+ test "x$UNAME_RELEASE" = x && UNAME_RELEASE=3
+ case `/bin/arch` in
+ sun3)
+ GUESS=m68k-sun-sunos$UNAME_RELEASE
+ ;;
+ sun4)
+ GUESS=sparc-sun-sunos$UNAME_RELEASE
+ ;;
+ esac
+ ;;
+ aushp:SunOS:*:*)
+ GUESS=sparc-auspex-sunos$UNAME_RELEASE
+ ;;
+ # The situation for MiNT is a little confusing. The machine name
+ # can be virtually everything (everything which is not
+ # "atarist" or "atariste" at least should have a processor
+ # > m68000). The system name ranges from "MiNT" over "FreeMiNT"
+ # to the lowercase version "mint" (or "freemint"). Finally
+ # the system name "TOS" denotes a system which is actually not
+ # MiNT. But MiNT is downward compatible to TOS, so this should
+ # be no problem.
+ atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*)
+ GUESS=m68k-atari-mint$UNAME_RELEASE
+ ;;
+ atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*)
+ GUESS=m68k-atari-mint$UNAME_RELEASE
+ ;;
+ *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*)
+ GUESS=m68k-atari-mint$UNAME_RELEASE
+ ;;
+ milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*)
+ GUESS=m68k-milan-mint$UNAME_RELEASE
+ ;;
+ hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*)
+ GUESS=m68k-hades-mint$UNAME_RELEASE
+ ;;
+ *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*)
+ GUESS=m68k-unknown-mint$UNAME_RELEASE
+ ;;
+ m68k:machten:*:*)
+ GUESS=m68k-apple-machten$UNAME_RELEASE
+ ;;
+ powerpc:machten:*:*)
+ GUESS=powerpc-apple-machten$UNAME_RELEASE
+ ;;
+ RISC*:Mach:*:*)
+ GUESS=mips-dec-mach_bsd4.3
+ ;;
+ RISC*:ULTRIX:*:*)
+ GUESS=mips-dec-ultrix$UNAME_RELEASE
+ ;;
+ VAX*:ULTRIX*:*:*)
+ GUESS=vax-dec-ultrix$UNAME_RELEASE
+ ;;
+ 2020:CLIX:*:* | 2430:CLIX:*:*)
+ GUESS=clipper-intergraph-clix$UNAME_RELEASE
+ ;;
+ mips:*:*:UMIPS | mips:*:*:RISCos)
+ set_cc_for_build
+ sed 's/^ //' << EOF > "$dummy.c"
+#ifdef __cplusplus
+#include /* for printf() prototype */
+ int main (int argc, char *argv[]) {
+#else
+ int main (argc, argv) int argc; char *argv[]; {
+#endif
+ #if defined (host_mips) && defined (MIPSEB)
+ #if defined (SYSTYPE_SYSV)
+ printf ("mips-mips-riscos%ssysv\\n", argv[1]); exit (0);
+ #endif
+ #if defined (SYSTYPE_SVR4)
+ printf ("mips-mips-riscos%ssvr4\\n", argv[1]); exit (0);
+ #endif
+ #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD)
+ printf ("mips-mips-riscos%sbsd\\n", argv[1]); exit (0);
+ #endif
+ #endif
+ exit (-1);
+ }
+EOF
+ $CC_FOR_BUILD -o "$dummy" "$dummy.c" &&
+ dummyarg=`echo "$UNAME_RELEASE" | sed -n 's/\([0-9]*\).*/\1/p'` &&
+ SYSTEM_NAME=`"$dummy" "$dummyarg"` &&
+ { echo "$SYSTEM_NAME"; exit; }
+ GUESS=mips-mips-riscos$UNAME_RELEASE
+ ;;
+ Motorola:PowerMAX_OS:*:*)
+ GUESS=powerpc-motorola-powermax
+ ;;
+ Motorola:*:4.3:PL8-*)
+ GUESS=powerpc-harris-powermax
+ ;;
+ Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*)
+ GUESS=powerpc-harris-powermax
+ ;;
+ Night_Hawk:Power_UNIX:*:*)
+ GUESS=powerpc-harris-powerunix
+ ;;
+ m88k:CX/UX:7*:*)
+ GUESS=m88k-harris-cxux7
+ ;;
+ m88k:*:4*:R4*)
+ GUESS=m88k-motorola-sysv4
+ ;;
+ m88k:*:3*:R3*)
+ GUESS=m88k-motorola-sysv3
+ ;;
+ AViiON:dgux:*:*)
+ # DG/UX returns AViiON for all architectures
+ UNAME_PROCESSOR=`/usr/bin/uname -p`
+ if test "$UNAME_PROCESSOR" = mc88100 || test "$UNAME_PROCESSOR" = mc88110
+ then
+ if test "$TARGET_BINARY_INTERFACE"x = m88kdguxelfx || \
+ test "$TARGET_BINARY_INTERFACE"x = x
+ then
+ GUESS=m88k-dg-dgux$UNAME_RELEASE
+ else
+ GUESS=m88k-dg-dguxbcs$UNAME_RELEASE
+ fi
+ else
+ GUESS=i586-dg-dgux$UNAME_RELEASE
+ fi
+ ;;
+ M88*:DolphinOS:*:*) # DolphinOS (SVR3)
+ GUESS=m88k-dolphin-sysv3
+ ;;
+ M88*:*:R3*:*)
+ # Delta 88k system running SVR3
+ GUESS=m88k-motorola-sysv3
+ ;;
+ XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3)
+ GUESS=m88k-tektronix-sysv3
+ ;;
+ Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD)
+ GUESS=m68k-tektronix-bsd
+ ;;
+ *:IRIX*:*:*)
+ IRIX_REL=`echo "$UNAME_RELEASE" | sed -e 's/-/_/g'`
+ GUESS=mips-sgi-irix$IRIX_REL
+ ;;
+ ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX.
+ GUESS=romp-ibm-aix # uname -m gives an 8 hex-code CPU id
+ ;; # Note that: echo "'`uname -s`'" gives 'AIX '
+ i*86:AIX:*:*)
+ GUESS=i386-ibm-aix
+ ;;
+ ia64:AIX:*:*)
+ if test -x /usr/bin/oslevel ; then
+ IBM_REV=`/usr/bin/oslevel`
+ else
+ IBM_REV=$UNAME_VERSION.$UNAME_RELEASE
+ fi
+ GUESS=$UNAME_MACHINE-ibm-aix$IBM_REV
+ ;;
+ *:AIX:2:3)
+ if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then
+ set_cc_for_build
+ sed 's/^ //' << EOF > "$dummy.c"
+ #include
+
+ int
+ main ()
+ {
+ if (!__power_pc())
+ exit(1);
+ puts("powerpc-ibm-aix3.2.5");
+ exit(0);
+ }
+EOF
+ if $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"`
+ then
+ GUESS=$SYSTEM_NAME
+ else
+ GUESS=rs6000-ibm-aix3.2.5
+ fi
+ elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then
+ GUESS=rs6000-ibm-aix3.2.4
+ else
+ GUESS=rs6000-ibm-aix3.2
+ fi
+ ;;
+ *:AIX:*:[4567])
+ IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'`
+ if /usr/sbin/lsattr -El "$IBM_CPU_ID" | grep ' POWER' >/dev/null 2>&1; then
+ IBM_ARCH=rs6000
+ else
+ IBM_ARCH=powerpc
+ fi
+ if test -x /usr/bin/lslpp ; then
+ IBM_REV=`/usr/bin/lslpp -Lqc bos.rte.libc | \
+ awk -F: '{ print $3 }' | sed s/[0-9]*$/0/`
+ else
+ IBM_REV=$UNAME_VERSION.$UNAME_RELEASE
+ fi
+ GUESS=$IBM_ARCH-ibm-aix$IBM_REV
+ ;;
+ *:AIX:*:*)
+ GUESS=rs6000-ibm-aix
+ ;;
+ ibmrt:4.4BSD:*|romp-ibm:4.4BSD:*)
+ GUESS=romp-ibm-bsd4.4
+ ;;
+ ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and
+ GUESS=romp-ibm-bsd$UNAME_RELEASE # 4.3 with uname added to
+ ;; # report: romp-ibm BSD 4.3
+ *:BOSX:*:*)
+ GUESS=rs6000-bull-bosx
+ ;;
+ DPX/2?00:B.O.S.:*:*)
+ GUESS=m68k-bull-sysv3
+ ;;
+ 9000/[34]??:4.3bsd:1.*:*)
+ GUESS=m68k-hp-bsd
+ ;;
+ hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*)
+ GUESS=m68k-hp-bsd4.4
+ ;;
+ 9000/[34678]??:HP-UX:*:*)
+ HPUX_REV=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*.[0B]*//'`
+ case $UNAME_MACHINE in
+ 9000/31?) HP_ARCH=m68000 ;;
+ 9000/[34]??) HP_ARCH=m68k ;;
+ 9000/[678][0-9][0-9])
+ if test -x /usr/bin/getconf; then
+ sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null`
+ sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null`
+ case $sc_cpu_version in
+ 523) HP_ARCH=hppa1.0 ;; # CPU_PA_RISC1_0
+ 528) HP_ARCH=hppa1.1 ;; # CPU_PA_RISC1_1
+ 532) # CPU_PA_RISC2_0
+ case $sc_kernel_bits in
+ 32) HP_ARCH=hppa2.0n ;;
+ 64) HP_ARCH=hppa2.0w ;;
+ '') HP_ARCH=hppa2.0 ;; # HP-UX 10.20
+ esac ;;
+ esac
+ fi
+ if test "$HP_ARCH" = ""; then
+ set_cc_for_build
+ sed 's/^ //' << EOF > "$dummy.c"
+
+ #define _HPUX_SOURCE
+ #include
+ #include
+
+ int
+ main ()
+ {
+ #if defined(_SC_KERNEL_BITS)
+ long bits = sysconf(_SC_KERNEL_BITS);
+ #endif
+ long cpu = sysconf (_SC_CPU_VERSION);
+
+ switch (cpu)
+ {
+ case CPU_PA_RISC1_0: puts ("hppa1.0"); break;
+ case CPU_PA_RISC1_1: puts ("hppa1.1"); break;
+ case CPU_PA_RISC2_0:
+ #if defined(_SC_KERNEL_BITS)
+ switch (bits)
+ {
+ case 64: puts ("hppa2.0w"); break;
+ case 32: puts ("hppa2.0n"); break;
+ default: puts ("hppa2.0"); break;
+ } break;
+ #else /* !defined(_SC_KERNEL_BITS) */
+ puts ("hppa2.0"); break;
+ #endif
+ default: puts ("hppa1.0"); break;
+ }
+ exit (0);
+ }
+EOF
+ (CCOPTS="" $CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null) && HP_ARCH=`"$dummy"`
+ test -z "$HP_ARCH" && HP_ARCH=hppa
+ fi ;;
+ esac
+ if test "$HP_ARCH" = hppa2.0w
+ then
+ set_cc_for_build
+
+ # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating
+ # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler
+ # generating 64-bit code. GNU and HP use different nomenclature:
+ #
+ # $ CC_FOR_BUILD=cc ./config.guess
+ # => hppa2.0w-hp-hpux11.23
+ # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess
+ # => hppa64-hp-hpux11.23
+
+ if echo __LP64__ | (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) |
+ grep -q __LP64__
+ then
+ HP_ARCH=hppa2.0w
+ else
+ HP_ARCH=hppa64
+ fi
+ fi
+ GUESS=$HP_ARCH-hp-hpux$HPUX_REV
+ ;;
+ ia64:HP-UX:*:*)
+ HPUX_REV=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*.[0B]*//'`
+ GUESS=ia64-hp-hpux$HPUX_REV
+ ;;
+ 3050*:HI-UX:*:*)
+ set_cc_for_build
+ sed 's/^ //' << EOF > "$dummy.c"
+ #include
+ int
+ main ()
+ {
+ long cpu = sysconf (_SC_CPU_VERSION);
+ /* The order matters, because CPU_IS_HP_MC68K erroneously returns
+ true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct
+ results, however. */
+ if (CPU_IS_PA_RISC (cpu))
+ {
+ switch (cpu)
+ {
+ case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break;
+ case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break;
+ case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break;
+ default: puts ("hppa-hitachi-hiuxwe2"); break;
+ }
+ }
+ else if (CPU_IS_HP_MC68K (cpu))
+ puts ("m68k-hitachi-hiuxwe2");
+ else puts ("unknown-hitachi-hiuxwe2");
+ exit (0);
+ }
+EOF
+ $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"` &&
+ { echo "$SYSTEM_NAME"; exit; }
+ GUESS=unknown-hitachi-hiuxwe2
+ ;;
+ 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:*)
+ GUESS=hppa1.1-hp-bsd
+ ;;
+ 9000/8??:4.3bsd:*:*)
+ GUESS=hppa1.0-hp-bsd
+ ;;
+ *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*)
+ GUESS=hppa1.0-hp-mpeix
+ ;;
+ hp7??:OSF1:*:* | hp8?[79]:OSF1:*:*)
+ GUESS=hppa1.1-hp-osf
+ ;;
+ hp8??:OSF1:*:*)
+ GUESS=hppa1.0-hp-osf
+ ;;
+ i*86:OSF1:*:*)
+ if test -x /usr/sbin/sysversion ; then
+ GUESS=$UNAME_MACHINE-unknown-osf1mk
+ else
+ GUESS=$UNAME_MACHINE-unknown-osf1
+ fi
+ ;;
+ parisc*:Lites*:*:*)
+ GUESS=hppa1.1-hp-lites
+ ;;
+ C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*)
+ GUESS=c1-convex-bsd
+ ;;
+ C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*)
+ if getsysinfo -f scalar_acc
+ then echo c32-convex-bsd
+ else echo c2-convex-bsd
+ fi
+ exit ;;
+ C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*)
+ GUESS=c34-convex-bsd
+ ;;
+ C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*)
+ GUESS=c38-convex-bsd
+ ;;
+ C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*)
+ GUESS=c4-convex-bsd
+ ;;
+ CRAY*Y-MP:*:*:*)
+ CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'`
+ GUESS=ymp-cray-unicos$CRAY_REL
+ ;;
+ CRAY*[A-Z]90:*:*:*)
+ echo "$UNAME_MACHINE"-cray-unicos"$UNAME_RELEASE" \
+ | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \
+ -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \
+ -e 's/\.[^.]*$/.X/'
+ exit ;;
+ CRAY*TS:*:*:*)
+ CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'`
+ GUESS=t90-cray-unicos$CRAY_REL
+ ;;
+ CRAY*T3E:*:*:*)
+ CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'`
+ GUESS=alphaev5-cray-unicosmk$CRAY_REL
+ ;;
+ CRAY*SV1:*:*:*)
+ CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'`
+ GUESS=sv1-cray-unicos$CRAY_REL
+ ;;
+ *:UNICOS/mp:*:*)
+ CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'`
+ GUESS=craynv-cray-unicosmp$CRAY_REL
+ ;;
+ F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*)
+ FUJITSU_PROC=`uname -m | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz`
+ FUJITSU_SYS=`uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///'`
+ FUJITSU_REL=`echo "$UNAME_RELEASE" | sed -e 's/ /_/'`
+ GUESS=${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}
+ ;;
+ 5000:UNIX_System_V:4.*:*)
+ FUJITSU_SYS=`uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///'`
+ FUJITSU_REL=`echo "$UNAME_RELEASE" | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/ /_/'`
+ GUESS=sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}
+ ;;
+ i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*)
+ GUESS=$UNAME_MACHINE-pc-bsdi$UNAME_RELEASE
+ ;;
+ sparc*:BSD/OS:*:*)
+ GUESS=sparc-unknown-bsdi$UNAME_RELEASE
+ ;;
+ *:BSD/OS:*:*)
+ GUESS=$UNAME_MACHINE-unknown-bsdi$UNAME_RELEASE
+ ;;
+ arm:FreeBSD:*:*)
+ UNAME_PROCESSOR=`uname -p`
+ set_cc_for_build
+ if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \
+ | grep -q __ARM_PCS_VFP
+ then
+ FREEBSD_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'`
+ GUESS=$UNAME_PROCESSOR-unknown-freebsd$FREEBSD_REL-gnueabi
+ else
+ FREEBSD_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'`
+ GUESS=$UNAME_PROCESSOR-unknown-freebsd$FREEBSD_REL-gnueabihf
+ fi
+ ;;
+ *:FreeBSD:*:*)
+ UNAME_PROCESSOR=`uname -p`
+ case $UNAME_PROCESSOR in
+ amd64)
+ UNAME_PROCESSOR=x86_64 ;;
+ i386)
+ UNAME_PROCESSOR=i586 ;;
+ esac
+ FREEBSD_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'`
+ GUESS=$UNAME_PROCESSOR-unknown-freebsd$FREEBSD_REL
+ ;;
+ i*:CYGWIN*:*)
+ GUESS=$UNAME_MACHINE-pc-cygwin
+ ;;
+ *:MINGW64*:*)
+ GUESS=$UNAME_MACHINE-pc-mingw64
+ ;;
+ *:MINGW*:*)
+ GUESS=$UNAME_MACHINE-pc-mingw32
+ ;;
+ *:MSYS*:*)
+ GUESS=$UNAME_MACHINE-pc-msys
+ ;;
+ i*:PW*:*)
+ GUESS=$UNAME_MACHINE-pc-pw32
+ ;;
+ *:SerenityOS:*:*)
+ GUESS=$UNAME_MACHINE-pc-serenity
+ ;;
+ *:Interix*:*)
+ case $UNAME_MACHINE in
+ x86)
+ GUESS=i586-pc-interix$UNAME_RELEASE
+ ;;
+ authenticamd | genuineintel | EM64T)
+ GUESS=x86_64-unknown-interix$UNAME_RELEASE
+ ;;
+ IA64)
+ GUESS=ia64-unknown-interix$UNAME_RELEASE
+ ;;
+ esac ;;
+ i*:UWIN*:*)
+ GUESS=$UNAME_MACHINE-pc-uwin
+ ;;
+ amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*)
+ GUESS=x86_64-pc-cygwin
+ ;;
+ prep*:SunOS:5.*:*)
+ SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`
+ GUESS=powerpcle-unknown-solaris2$SUN_REL
+ ;;
+ *:GNU:*:*)
+ # the GNU system
+ GNU_ARCH=`echo "$UNAME_MACHINE" | sed -e 's,[-/].*$,,'`
+ GNU_REL=`echo "$UNAME_RELEASE" | sed -e 's,/.*$,,'`
+ GUESS=$GNU_ARCH-unknown-$LIBC$GNU_REL
+ ;;
+ *:GNU/*:*:*)
+ # other systems with GNU libc and userland
+ GNU_SYS=`echo "$UNAME_SYSTEM" | sed 's,^[^/]*/,,' | tr "[:upper:]" "[:lower:]"`
+ GNU_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'`
+ GUESS=$UNAME_MACHINE-unknown-$GNU_SYS$GNU_REL-$LIBC
+ ;;
+ x86_64:[Mm]anagarm:*:*|i?86:[Mm]anagarm:*:*)
+ GUESS="$UNAME_MACHINE-pc-managarm-mlibc"
+ ;;
+ *:[Mm]anagarm:*:*)
+ GUESS="$UNAME_MACHINE-unknown-managarm-mlibc"
+ ;;
+ *:Minix:*:*)
+ GUESS=$UNAME_MACHINE-unknown-minix
+ ;;
+ aarch64:Linux:*:*)
+ set_cc_for_build
+ CPU=$UNAME_MACHINE
+ LIBCABI=$LIBC
+ if test "$CC_FOR_BUILD" != no_compiler_found; then
+ ABI=64
+ sed 's/^ //' << EOF > "$dummy.c"
+ #ifdef __ARM_EABI__
+ #ifdef __ARM_PCS_VFP
+ ABI=eabihf
+ #else
+ ABI=eabi
+ #endif
+ #endif
+EOF
+ cc_set_abi=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^ABI' | sed 's, ,,g'`
+ eval "$cc_set_abi"
+ case $ABI in
+ eabi | eabihf) CPU=armv8l; LIBCABI=$LIBC$ABI ;;
+ esac
+ fi
+ GUESS=$CPU-unknown-linux-$LIBCABI
+ ;;
+ aarch64_be:Linux:*:*)
+ UNAME_MACHINE=aarch64_be
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ alpha:Linux:*:*)
+ case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' /proc/cpuinfo 2>/dev/null` in
+ EV5) UNAME_MACHINE=alphaev5 ;;
+ EV56) UNAME_MACHINE=alphaev56 ;;
+ PCA56) UNAME_MACHINE=alphapca56 ;;
+ PCA57) UNAME_MACHINE=alphapca56 ;;
+ EV6) UNAME_MACHINE=alphaev6 ;;
+ EV67) UNAME_MACHINE=alphaev67 ;;
+ EV68*) UNAME_MACHINE=alphaev68 ;;
+ esac
+ objdump --private-headers /bin/sh | grep -q ld.so.1
+ if test "$?" = 0 ; then LIBC=gnulibc1 ; fi
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ arc:Linux:*:* | arceb:Linux:*:* | arc32:Linux:*:* | arc64:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ arm*:Linux:*:*)
+ set_cc_for_build
+ if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \
+ | grep -q __ARM_EABI__
+ then
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ else
+ if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \
+ | grep -q __ARM_PCS_VFP
+ then
+ GUESS=$UNAME_MACHINE-unknown-linux-${LIBC}eabi
+ else
+ GUESS=$UNAME_MACHINE-unknown-linux-${LIBC}eabihf
+ fi
+ fi
+ ;;
+ avr32*:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ cris:Linux:*:*)
+ GUESS=$UNAME_MACHINE-axis-linux-$LIBC
+ ;;
+ crisv32:Linux:*:*)
+ GUESS=$UNAME_MACHINE-axis-linux-$LIBC
+ ;;
+ e2k:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ frv:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ hexagon:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ i*86:Linux:*:*)
+ GUESS=$UNAME_MACHINE-pc-linux-$LIBC
+ ;;
+ ia64:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ k1om:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ kvx:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ kvx:cos:*:*)
+ GUESS=$UNAME_MACHINE-unknown-cos
+ ;;
+ kvx:mbr:*:*)
+ GUESS=$UNAME_MACHINE-unknown-mbr
+ ;;
+ loongarch32:Linux:*:* | loongarch64:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ m32r*:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ m68*:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ mips:Linux:*:* | mips64:Linux:*:*)
+ set_cc_for_build
+ IS_GLIBC=0
+ test x"${LIBC}" = xgnu && IS_GLIBC=1
+ sed 's/^ //' << EOF > "$dummy.c"
+ #undef CPU
+ #undef mips
+ #undef mipsel
+ #undef mips64
+ #undef mips64el
+ #if ${IS_GLIBC} && defined(_ABI64)
+ LIBCABI=gnuabi64
+ #else
+ #if ${IS_GLIBC} && defined(_ABIN32)
+ LIBCABI=gnuabin32
+ #else
+ LIBCABI=${LIBC}
+ #endif
+ #endif
+
+ #if ${IS_GLIBC} && defined(__mips64) && defined(__mips_isa_rev) && __mips_isa_rev>=6
+ CPU=mipsisa64r6
+ #else
+ #if ${IS_GLIBC} && !defined(__mips64) && defined(__mips_isa_rev) && __mips_isa_rev>=6
+ CPU=mipsisa32r6
+ #else
+ #if defined(__mips64)
+ CPU=mips64
+ #else
+ CPU=mips
+ #endif
+ #endif
+ #endif
+
+ #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL)
+ MIPS_ENDIAN=el
+ #else
+ #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB)
+ MIPS_ENDIAN=
+ #else
+ MIPS_ENDIAN=
+ #endif
+ #endif
+EOF
+ cc_set_vars=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^CPU\|^MIPS_ENDIAN\|^LIBCABI'`
+ eval "$cc_set_vars"
+ test "x$CPU" != x && { echo "$CPU${MIPS_ENDIAN}-unknown-linux-$LIBCABI"; exit; }
+ ;;
+ mips64el:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ openrisc*:Linux:*:*)
+ GUESS=or1k-unknown-linux-$LIBC
+ ;;
+ or32:Linux:*:* | or1k*:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ padre:Linux:*:*)
+ GUESS=sparc-unknown-linux-$LIBC
+ ;;
+ parisc64:Linux:*:* | hppa64:Linux:*:*)
+ GUESS=hppa64-unknown-linux-$LIBC
+ ;;
+ parisc:Linux:*:* | hppa:Linux:*:*)
+ # Look for CPU level
+ case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in
+ PA7*) GUESS=hppa1.1-unknown-linux-$LIBC ;;
+ PA8*) GUESS=hppa2.0-unknown-linux-$LIBC ;;
+ *) GUESS=hppa-unknown-linux-$LIBC ;;
+ esac
+ ;;
+ ppc64:Linux:*:*)
+ GUESS=powerpc64-unknown-linux-$LIBC
+ ;;
+ ppc:Linux:*:*)
+ GUESS=powerpc-unknown-linux-$LIBC
+ ;;
+ ppc64le:Linux:*:*)
+ GUESS=powerpc64le-unknown-linux-$LIBC
+ ;;
+ ppcle:Linux:*:*)
+ GUESS=powerpcle-unknown-linux-$LIBC
+ ;;
+ riscv32:Linux:*:* | riscv32be:Linux:*:* | riscv64:Linux:*:* | riscv64be:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ s390:Linux:*:* | s390x:Linux:*:*)
+ GUESS=$UNAME_MACHINE-ibm-linux-$LIBC
+ ;;
+ sh64*:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ sh*:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ sparc:Linux:*:* | sparc64:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ tile*:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ vax:Linux:*:*)
+ GUESS=$UNAME_MACHINE-dec-linux-$LIBC
+ ;;
+ x86_64:Linux:*:*)
+ set_cc_for_build
+ CPU=$UNAME_MACHINE
+ LIBCABI=$LIBC
+ if test "$CC_FOR_BUILD" != no_compiler_found; then
+ ABI=64
+ sed 's/^ //' << EOF > "$dummy.c"
+ #ifdef __i386__
+ ABI=x86
+ #else
+ #ifdef __ILP32__
+ ABI=x32
+ #endif
+ #endif
+EOF
+ cc_set_abi=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^ABI' | sed 's, ,,g'`
+ eval "$cc_set_abi"
+ case $ABI in
+ x86) CPU=i686 ;;
+ x32) LIBCABI=${LIBC}x32 ;;
+ esac
+ fi
+ GUESS=$CPU-pc-linux-$LIBCABI
+ ;;
+ xtensa*:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ i*86:DYNIX/ptx:4*:*)
+ # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there.
+ # earlier versions are messed up and put the nodename in both
+ # sysname and nodename.
+ GUESS=i386-sequent-sysv4
+ ;;
+ i*86:UNIX_SV:4.2MP:2.*)
+ # Unixware is an offshoot of SVR4, but it has its own version
+ # number series starting with 2...
+ # I am not positive that other SVR4 systems won't match this,
+ # I just have to hope. -- rms.
+ # Use sysv4.2uw... so that sysv4* matches it.
+ GUESS=$UNAME_MACHINE-pc-sysv4.2uw$UNAME_VERSION
+ ;;
+ i*86:OS/2:*:*)
+ # If we were able to find 'uname', then EMX Unix compatibility
+ # is probably installed.
+ GUESS=$UNAME_MACHINE-pc-os2-emx
+ ;;
+ i*86:XTS-300:*:STOP)
+ GUESS=$UNAME_MACHINE-unknown-stop
+ ;;
+ i*86:atheos:*:*)
+ GUESS=$UNAME_MACHINE-unknown-atheos
+ ;;
+ i*86:syllable:*:*)
+ GUESS=$UNAME_MACHINE-pc-syllable
+ ;;
+ i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*)
+ GUESS=i386-unknown-lynxos$UNAME_RELEASE
+ ;;
+ i*86:*DOS:*:*)
+ GUESS=$UNAME_MACHINE-pc-msdosdjgpp
+ ;;
+ i*86:*:4.*:*)
+ UNAME_REL=`echo "$UNAME_RELEASE" | sed 's/\/MP$//'`
+ if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then
+ GUESS=$UNAME_MACHINE-univel-sysv$UNAME_REL
+ else
+ GUESS=$UNAME_MACHINE-pc-sysv$UNAME_REL
+ fi
+ ;;
+ i*86:*:5:[678]*)
+ # UnixWare 7.x, OpenUNIX and OpenServer 6.
+ case `/bin/uname -X | grep "^Machine"` in
+ *486*) UNAME_MACHINE=i486 ;;
+ *Pentium) UNAME_MACHINE=i586 ;;
+ *Pent*|*Celeron) UNAME_MACHINE=i686 ;;
+ esac
+ GUESS=$UNAME_MACHINE-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION}
+ ;;
+ i*86:*:3.2:*)
+ if test -f /usr/options/cb.name; then
+ UNAME_REL=`sed -n 's/.*Version //p' /dev/null >/dev/null ; then
+ UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')`
+ (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486
+ (/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \
+ && UNAME_MACHINE=i586
+ (/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \
+ && UNAME_MACHINE=i686
+ (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \
+ && UNAME_MACHINE=i686
+ GUESS=$UNAME_MACHINE-pc-sco$UNAME_REL
+ else
+ GUESS=$UNAME_MACHINE-pc-sysv32
+ fi
+ ;;
+ pc:*:*:*)
+ # Left here for compatibility:
+ # uname -m prints for DJGPP always 'pc', but it prints nothing about
+ # the processor, so we play safe by assuming i586.
+ # Note: whatever this is, it MUST be the same as what config.sub
+ # prints for the "djgpp" host, or else GDB configure will decide that
+ # this is a cross-build.
+ GUESS=i586-pc-msdosdjgpp
+ ;;
+ Intel:Mach:3*:*)
+ GUESS=i386-pc-mach3
+ ;;
+ paragon:*:*:*)
+ GUESS=i860-intel-osf1
+ ;;
+ i860:*:4.*:*) # i860-SVR4
+ if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then
+ GUESS=i860-stardent-sysv$UNAME_RELEASE # Stardent Vistra i860-SVR4
+ else # Add other i860-SVR4 vendors below as they are discovered.
+ GUESS=i860-unknown-sysv$UNAME_RELEASE # Unknown i860-SVR4
+ fi
+ ;;
+ mini*:CTIX:SYS*5:*)
+ # "miniframe"
+ GUESS=m68010-convergent-sysv
+ ;;
+ mc68k:UNIX:SYSTEM5:3.51m)
+ GUESS=m68k-convergent-sysv
+ ;;
+ M680?0:D-NIX:5.3:*)
+ GUESS=m68k-diab-dnix
+ ;;
+ M68*:*:R3V[5678]*:*)
+ test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;;
+ 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0)
+ OS_REL=''
+ test -r /etc/.relid \
+ && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`
+ /bin/uname -p 2>/dev/null | grep 86 >/dev/null \
+ && { echo i486-ncr-sysv4.3"$OS_REL"; exit; }
+ /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \
+ && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } ;;
+ 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*)
+ /bin/uname -p 2>/dev/null | grep 86 >/dev/null \
+ && { echo i486-ncr-sysv4; exit; } ;;
+ NCR*:*:4.2:* | MPRAS*:*:4.2:*)
+ OS_REL='.3'
+ test -r /etc/.relid \
+ && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`
+ /bin/uname -p 2>/dev/null | grep 86 >/dev/null \
+ && { echo i486-ncr-sysv4.3"$OS_REL"; exit; }
+ /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \
+ && { echo i586-ncr-sysv4.3"$OS_REL"; exit; }
+ /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \
+ && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } ;;
+ m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*)
+ GUESS=m68k-unknown-lynxos$UNAME_RELEASE
+ ;;
+ mc68030:UNIX_System_V:4.*:*)
+ GUESS=m68k-atari-sysv4
+ ;;
+ TSUNAMI:LynxOS:2.*:*)
+ GUESS=sparc-unknown-lynxos$UNAME_RELEASE
+ ;;
+ rs6000:LynxOS:2.*:*)
+ GUESS=rs6000-unknown-lynxos$UNAME_RELEASE
+ ;;
+ PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*)
+ GUESS=powerpc-unknown-lynxos$UNAME_RELEASE
+ ;;
+ SM[BE]S:UNIX_SV:*:*)
+ GUESS=mips-dde-sysv$UNAME_RELEASE
+ ;;
+ RM*:ReliantUNIX-*:*:*)
+ GUESS=mips-sni-sysv4
+ ;;
+ RM*:SINIX-*:*:*)
+ GUESS=mips-sni-sysv4
+ ;;
+ *:SINIX-*:*:*)
+ if uname -p 2>/dev/null >/dev/null ; then
+ UNAME_MACHINE=`(uname -p) 2>/dev/null`
+ GUESS=$UNAME_MACHINE-sni-sysv4
+ else
+ GUESS=ns32k-sni-sysv
+ fi
+ ;;
+ PENTIUM:*:4.0*:*) # Unisys 'ClearPath HMP IX 4000' SVR4/MP effort
+ # says
+ GUESS=i586-unisys-sysv4
+ ;;
+ *:UNIX_System_V:4*:FTX*)
+ # From Gerald Hewes .
+ # How about differentiating between stratus architectures? -djm
+ GUESS=hppa1.1-stratus-sysv4
+ ;;
+ *:*:*:FTX*)
+ # From seanf@swdc.stratus.com.
+ GUESS=i860-stratus-sysv4
+ ;;
+ i*86:VOS:*:*)
+ # From Paul.Green@stratus.com.
+ GUESS=$UNAME_MACHINE-stratus-vos
+ ;;
+ *:VOS:*:*)
+ # From Paul.Green@stratus.com.
+ GUESS=hppa1.1-stratus-vos
+ ;;
+ mc68*:A/UX:*:*)
+ GUESS=m68k-apple-aux$UNAME_RELEASE
+ ;;
+ news*:NEWS-OS:6*:*)
+ GUESS=mips-sony-newsos6
+ ;;
+ R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*)
+ if test -d /usr/nec; then
+ GUESS=mips-nec-sysv$UNAME_RELEASE
+ else
+ GUESS=mips-unknown-sysv$UNAME_RELEASE
+ fi
+ ;;
+ BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only.
+ GUESS=powerpc-be-beos
+ ;;
+ BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only.
+ GUESS=powerpc-apple-beos
+ ;;
+ BePC:BeOS:*:*) # BeOS running on Intel PC compatible.
+ GUESS=i586-pc-beos
+ ;;
+ BePC:Haiku:*:*) # Haiku running on Intel PC compatible.
+ GUESS=i586-pc-haiku
+ ;;
+ ppc:Haiku:*:*) # Haiku running on Apple PowerPC
+ GUESS=powerpc-apple-haiku
+ ;;
+ *:Haiku:*:*) # Haiku modern gcc (not bound by BeOS compat)
+ GUESS=$UNAME_MACHINE-unknown-haiku
+ ;;
+ SX-4:SUPER-UX:*:*)
+ GUESS=sx4-nec-superux$UNAME_RELEASE
+ ;;
+ SX-5:SUPER-UX:*:*)
+ GUESS=sx5-nec-superux$UNAME_RELEASE
+ ;;
+ SX-6:SUPER-UX:*:*)
+ GUESS=sx6-nec-superux$UNAME_RELEASE
+ ;;
+ SX-7:SUPER-UX:*:*)
+ GUESS=sx7-nec-superux$UNAME_RELEASE
+ ;;
+ SX-8:SUPER-UX:*:*)
+ GUESS=sx8-nec-superux$UNAME_RELEASE
+ ;;
+ SX-8R:SUPER-UX:*:*)
+ GUESS=sx8r-nec-superux$UNAME_RELEASE
+ ;;
+ SX-ACE:SUPER-UX:*:*)
+ GUESS=sxace-nec-superux$UNAME_RELEASE
+ ;;
+ Power*:Rhapsody:*:*)
+ GUESS=powerpc-apple-rhapsody$UNAME_RELEASE
+ ;;
+ *:Rhapsody:*:*)
+ GUESS=$UNAME_MACHINE-apple-rhapsody$UNAME_RELEASE
+ ;;
+ arm64:Darwin:*:*)
+ GUESS=aarch64-apple-darwin$UNAME_RELEASE
+ ;;
+ *:Darwin:*:*)
+ UNAME_PROCESSOR=`uname -p`
+ case $UNAME_PROCESSOR in
+ unknown) UNAME_PROCESSOR=powerpc ;;
+ esac
+ if command -v xcode-select > /dev/null 2> /dev/null && \
+ ! xcode-select --print-path > /dev/null 2> /dev/null ; then
+ # Avoid executing cc if there is no toolchain installed as
+ # cc will be a stub that puts up a graphical alert
+ # prompting the user to install developer tools.
+ CC_FOR_BUILD=no_compiler_found
+ else
+ set_cc_for_build
+ fi
+ if test "$CC_FOR_BUILD" != no_compiler_found; then
+ if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \
+ (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \
+ grep IS_64BIT_ARCH >/dev/null
+ then
+ case $UNAME_PROCESSOR in
+ i386) UNAME_PROCESSOR=x86_64 ;;
+ powerpc) UNAME_PROCESSOR=powerpc64 ;;
+ esac
+ fi
+ # On 10.4-10.6 one might compile for PowerPC via gcc -arch ppc
+ if (echo '#ifdef __POWERPC__'; echo IS_PPC; echo '#endif') | \
+ (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \
+ grep IS_PPC >/dev/null
+ then
+ UNAME_PROCESSOR=powerpc
+ fi
+ elif test "$UNAME_PROCESSOR" = i386 ; then
+ # uname -m returns i386 or x86_64
+ UNAME_PROCESSOR=$UNAME_MACHINE
+ fi
+ GUESS=$UNAME_PROCESSOR-apple-darwin$UNAME_RELEASE
+ ;;
+ *:procnto*:*:* | *:QNX:[0123456789]*:*)
+ UNAME_PROCESSOR=`uname -p`
+ if test "$UNAME_PROCESSOR" = x86; then
+ UNAME_PROCESSOR=i386
+ UNAME_MACHINE=pc
+ fi
+ GUESS=$UNAME_PROCESSOR-$UNAME_MACHINE-nto-qnx$UNAME_RELEASE
+ ;;
+ *:QNX:*:4*)
+ GUESS=i386-pc-qnx
+ ;;
+ NEO-*:NONSTOP_KERNEL:*:*)
+ GUESS=neo-tandem-nsk$UNAME_RELEASE
+ ;;
+ NSE-*:NONSTOP_KERNEL:*:*)
+ GUESS=nse-tandem-nsk$UNAME_RELEASE
+ ;;
+ NSR-*:NONSTOP_KERNEL:*:*)
+ GUESS=nsr-tandem-nsk$UNAME_RELEASE
+ ;;
+ NSV-*:NONSTOP_KERNEL:*:*)
+ GUESS=nsv-tandem-nsk$UNAME_RELEASE
+ ;;
+ NSX-*:NONSTOP_KERNEL:*:*)
+ GUESS=nsx-tandem-nsk$UNAME_RELEASE
+ ;;
+ *:NonStop-UX:*:*)
+ GUESS=mips-compaq-nonstopux
+ ;;
+ BS2000:POSIX*:*:*)
+ GUESS=bs2000-siemens-sysv
+ ;;
+ DS/*:UNIX_System_V:*:*)
+ GUESS=$UNAME_MACHINE-$UNAME_SYSTEM-$UNAME_RELEASE
+ ;;
+ *:Plan9:*:*)
+ # "uname -m" is not consistent, so use $cputype instead. 386
+ # is converted to i386 for consistency with other x86
+ # operating systems.
+ if test "${cputype-}" = 386; then
+ UNAME_MACHINE=i386
+ elif test "x${cputype-}" != x; then
+ UNAME_MACHINE=$cputype
+ fi
+ GUESS=$UNAME_MACHINE-unknown-plan9
+ ;;
+ *:TOPS-10:*:*)
+ GUESS=pdp10-unknown-tops10
+ ;;
+ *:TENEX:*:*)
+ GUESS=pdp10-unknown-tenex
+ ;;
+ KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*)
+ GUESS=pdp10-dec-tops20
+ ;;
+ XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*)
+ GUESS=pdp10-xkl-tops20
+ ;;
+ *:TOPS-20:*:*)
+ GUESS=pdp10-unknown-tops20
+ ;;
+ *:ITS:*:*)
+ GUESS=pdp10-unknown-its
+ ;;
+ SEI:*:*:SEIUX)
+ GUESS=mips-sei-seiux$UNAME_RELEASE
+ ;;
+ *:DragonFly:*:*)
+ DRAGONFLY_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'`
+ GUESS=$UNAME_MACHINE-unknown-dragonfly$DRAGONFLY_REL
+ ;;
+ *:*VMS:*:*)
+ UNAME_MACHINE=`(uname -p) 2>/dev/null`
+ case $UNAME_MACHINE in
+ A*) GUESS=alpha-dec-vms ;;
+ I*) GUESS=ia64-dec-vms ;;
+ V*) GUESS=vax-dec-vms ;;
+ esac ;;
+ *:XENIX:*:SysV)
+ GUESS=i386-pc-xenix
+ ;;
+ i*86:skyos:*:*)
+ SKYOS_REL=`echo "$UNAME_RELEASE" | sed -e 's/ .*$//'`
+ GUESS=$UNAME_MACHINE-pc-skyos$SKYOS_REL
+ ;;
+ i*86:rdos:*:*)
+ GUESS=$UNAME_MACHINE-pc-rdos
+ ;;
+ i*86:Fiwix:*:*)
+ GUESS=$UNAME_MACHINE-pc-fiwix
+ ;;
+ *:AROS:*:*)
+ GUESS=$UNAME_MACHINE-unknown-aros
+ ;;
+ x86_64:VMkernel:*:*)
+ GUESS=$UNAME_MACHINE-unknown-esx
+ ;;
+ amd64:Isilon\ OneFS:*:*)
+ GUESS=x86_64-unknown-onefs
+ ;;
+ *:Unleashed:*:*)
+ GUESS=$UNAME_MACHINE-unknown-unleashed$UNAME_RELEASE
+ ;;
+ x86_64:[Ii]ronclad:*:*|i?86:[Ii]ronclad:*:*)
+ GUESS=$UNAME_MACHINE-pc-ironclad-mlibc
+ ;;
+ *:[Ii]ronclad:*:*)
+ GUESS=$UNAME_MACHINE-unknown-ironclad-mlibc
+ ;;
+esac
+
+# Do we have a guess based on uname results?
+if test "x$GUESS" != x; then
+ echo "$GUESS"
+ exit
+fi
+
+# No uname command or uname output not recognized.
+set_cc_for_build
+cat > "$dummy.c" <
+#include
+#endif
+#if defined(ultrix) || defined(_ultrix) || defined(__ultrix) || defined(__ultrix__)
+#if defined (vax) || defined (__vax) || defined (__vax__) || defined(mips) || defined(__mips) || defined(__mips__) || defined(MIPS) || defined(__MIPS__)
+#include
+#if defined(_SIZE_T_) || defined(SIGLOST)
+#include
+#endif
+#endif
+#endif
+int
+main ()
+{
+#if defined (sony)
+#if defined (MIPSEB)
+ /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed,
+ I don't know.... */
+ printf ("mips-sony-bsd\n"); exit (0);
+#else
+#include
+ printf ("m68k-sony-newsos%s\n",
+#ifdef NEWSOS4
+ "4"
+#else
+ ""
+#endif
+ ); exit (0);
+#endif
+#endif
+
+#if defined (NeXT)
+#if !defined (__ARCHITECTURE__)
+#define __ARCHITECTURE__ "m68k"
+#endif
+ int version;
+ version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`;
+ if (version < 4)
+ printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version);
+ else
+ printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version);
+ exit (0);
+#endif
+
+#if defined (MULTIMAX) || defined (n16)
+#if defined (UMAXV)
+ printf ("ns32k-encore-sysv\n"); exit (0);
+#else
+#if defined (CMU)
+ printf ("ns32k-encore-mach\n"); exit (0);
+#else
+ printf ("ns32k-encore-bsd\n"); exit (0);
+#endif
+#endif
+#endif
+
+#if defined (__386BSD__)
+ printf ("i386-pc-bsd\n"); exit (0);
+#endif
+
+#if defined (sequent)
+#if defined (i386)
+ printf ("i386-sequent-dynix\n"); exit (0);
+#endif
+#if defined (ns32000)
+ printf ("ns32k-sequent-dynix\n"); exit (0);
+#endif
+#endif
+
+#if defined (_SEQUENT_)
+ struct utsname un;
+
+ uname(&un);
+ if (strncmp(un.version, "V2", 2) == 0) {
+ printf ("i386-sequent-ptx2\n"); exit (0);
+ }
+ if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */
+ printf ("i386-sequent-ptx1\n"); exit (0);
+ }
+ printf ("i386-sequent-ptx\n"); exit (0);
+#endif
+
+#if defined (vax)
+#if !defined (ultrix)
+#include
+#if defined (BSD)
+#if BSD == 43
+ printf ("vax-dec-bsd4.3\n"); exit (0);
+#else
+#if BSD == 199006
+ printf ("vax-dec-bsd4.3reno\n"); exit (0);
+#else
+ printf ("vax-dec-bsd\n"); exit (0);
+#endif
+#endif
+#else
+ printf ("vax-dec-bsd\n"); exit (0);
+#endif
+#else
+#if defined(_SIZE_T_) || defined(SIGLOST)
+ struct utsname un;
+ uname (&un);
+ printf ("vax-dec-ultrix%s\n", un.release); exit (0);
+#else
+ printf ("vax-dec-ultrix\n"); exit (0);
+#endif
+#endif
+#endif
+#if defined(ultrix) || defined(_ultrix) || defined(__ultrix) || defined(__ultrix__)
+#if defined(mips) || defined(__mips) || defined(__mips__) || defined(MIPS) || defined(__MIPS__)
+#if defined(_SIZE_T_) || defined(SIGLOST)
+ struct utsname *un;
+ uname (&un);
+ printf ("mips-dec-ultrix%s\n", un.release); exit (0);
+#else
+ printf ("mips-dec-ultrix\n"); exit (0);
+#endif
+#endif
+#endif
+
+#if defined (alliant) && defined (i860)
+ printf ("i860-alliant-bsd\n"); exit (0);
+#endif
+
+ exit (1);
+}
+EOF
+
+$CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null && SYSTEM_NAME=`"$dummy"` &&
+ { echo "$SYSTEM_NAME"; exit; }
+
+# Apollos put the system type in the environment.
+test -d /usr/apollo && { echo "$ISP-apollo-$SYSTYPE"; exit; }
+
+echo "$0: unable to guess system type" >&2
+
+case $UNAME_MACHINE:$UNAME_SYSTEM in
+ mips:Linux | mips64:Linux)
+ # If we got here on MIPS GNU/Linux, output extra information.
+ cat >&2 <&2 <&2 </dev/null || echo unknown`
+uname -r = `(uname -r) 2>/dev/null || echo unknown`
+uname -s = `(uname -s) 2>/dev/null || echo unknown`
+uname -v = `(uname -v) 2>/dev/null || echo unknown`
+
+/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null`
+/bin/uname -X = `(/bin/uname -X) 2>/dev/null`
+
+hostinfo = `(hostinfo) 2>/dev/null`
+/bin/universe = `(/bin/universe) 2>/dev/null`
+/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null`
+/bin/arch = `(/bin/arch) 2>/dev/null`
+/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null`
+/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null`
+
+UNAME_MACHINE = "$UNAME_MACHINE"
+UNAME_RELEASE = "$UNAME_RELEASE"
+UNAME_SYSTEM = "$UNAME_SYSTEM"
+UNAME_VERSION = "$UNAME_VERSION"
+EOF
+fi
+
+exit 1
+
+# Local variables:
+# eval: (add-hook 'before-save-hook 'time-stamp nil t)
+# time-stamp-start: "timestamp='"
+# time-stamp-format: "%Y-%02m-%02d"
+# time-stamp-end: "'"
+# End:
diff --git a/libraries/ghc-internal/config.sub b/libraries/ghc-internal/config.sub
new file mode 100644
index 000000000000..3d35cde174de
--- /dev/null
+++ b/libraries/ghc-internal/config.sub
@@ -0,0 +1,2364 @@
+#! /bin/sh
+# Configuration validation subroutine script.
+# Copyright 1992-2025 Free Software Foundation, Inc.
+
+# shellcheck disable=SC2006,SC2268,SC2162 # see below for rationale
+
+timestamp='2025-07-10'
+
+# This file is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, see .
+#
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that
+# program. This Exception is an additional permission under section 7
+# of the GNU General Public License, version 3 ("GPLv3").
+
+
+# Please send patches to .
+#
+# Configuration subroutine to validate and canonicalize a configuration type.
+# Supply the specified configuration type as an argument.
+# If it is invalid, we print an error message on stderr and exit with code 1.
+# Otherwise, we print the canonical config type on stdout and succeed.
+
+# You can get the latest version of this script from:
+# https://git.savannah.gnu.org/cgit/config.git/plain/config.sub
+
+# This file is supposed to be the same for all GNU packages
+# and recognize all the CPU types, system types and aliases
+# that are meaningful with *any* GNU software.
+# Each package is responsible for reporting which valid configurations
+# it does not support. The user should be able to distinguish
+# a failure to support a valid configuration from a meaningless
+# configuration.
+
+# The goal of this file is to map all the various variations of a given
+# machine specification into a single specification in the form:
+# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM
+# or in some cases, the newer four-part form:
+# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM
+# It is wrong to echo any other type of specification.
+
+# The "shellcheck disable" line above the timestamp inhibits complaints
+# about features and limitations of the classic Bourne shell that were
+# superseded or lifted in POSIX. However, this script identifies a wide
+# variety of pre-POSIX systems that do not have POSIX shells at all, and
+# even some reasonably current systems (Solaris 10 as case-in-point) still
+# have a pre-POSIX /bin/sh.
+
+me=`echo "$0" | sed -e 's,.*/,,'`
+
+usage="\
+Usage: $0 [OPTION] CPU-MFR-OPSYS or ALIAS
+
+Canonicalize a configuration name.
+
+Options:
+ -h, --help print this help, then exit
+ -t, --time-stamp print date of last modification, then exit
+ -v, --version print version number, then exit
+
+Report bugs and patches to ."
+
+version="\
+GNU config.sub ($timestamp)
+
+Copyright 1992-2025 Free Software Foundation, Inc.
+
+This is free software; see the source for copying conditions. There is NO
+warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
+
+help="
+Try '$me --help' for more information."
+
+# Parse command line
+while test $# -gt 0 ; do
+ case $1 in
+ --time-stamp | --time* | -t )
+ echo "$timestamp" ; exit ;;
+ --version | -v )
+ echo "$version" ; exit ;;
+ --help | --h* | -h )
+ echo "$usage"; exit ;;
+ -- ) # Stop option processing
+ shift; break ;;
+ - ) # Use stdin as input.
+ break ;;
+ -* )
+ echo "$me: invalid option $1$help" >&2
+ exit 1 ;;
+
+ *local*)
+ # First pass through any local machine types.
+ echo "$1"
+ exit ;;
+
+ * )
+ break ;;
+ esac
+done
+
+case $# in
+ 0) echo "$me: missing argument$help" >&2
+ exit 1;;
+ 1) ;;
+ *) echo "$me: too many arguments$help" >&2
+ exit 1;;
+esac
+
+# Split fields of configuration type
+saved_IFS=$IFS
+IFS="-" read field1 field2 field3 field4 <&2
+ exit 1
+ ;;
+ *-*-*-*)
+ basic_machine=$field1-$field2
+ basic_os=$field3-$field4
+ ;;
+ *-*-*)
+ # Ambiguous whether COMPANY is present, or skipped and KERNEL-OS is two
+ # parts
+ maybe_os=$field2-$field3
+ case $maybe_os in
+ cloudabi*-eabi* \
+ | kfreebsd*-gnu* \
+ | knetbsd*-gnu* \
+ | kopensolaris*-gnu* \
+ | ironclad-* \
+ | linux-* \
+ | managarm-* \
+ | netbsd*-eabi* \
+ | netbsd*-gnu* \
+ | nto-qnx* \
+ | os2-emx* \
+ | rtmk-nova* \
+ | storm-chaos* \
+ | uclinux-gnu* \
+ | uclinux-uclibc* \
+ | windows-* )
+ basic_machine=$field1
+ basic_os=$maybe_os
+ ;;
+ android-linux)
+ basic_machine=$field1-unknown
+ basic_os=linux-android
+ ;;
+ *)
+ basic_machine=$field1-$field2
+ basic_os=$field3
+ ;;
+ esac
+ ;;
+ *-*)
+ case $field1-$field2 in
+ # Shorthands that happen to contain a single dash
+ convex-c[12] | convex-c3[248])
+ basic_machine=$field2-convex
+ basic_os=
+ ;;
+ decstation-3100)
+ basic_machine=mips-dec
+ basic_os=
+ ;;
+ *-*)
+ # Second component is usually, but not always the OS
+ case $field2 in
+ # Do not treat sunos as a manufacturer
+ sun*os*)
+ basic_machine=$field1
+ basic_os=$field2
+ ;;
+ # Manufacturers
+ 3100* \
+ | 32* \
+ | 3300* \
+ | 3600* \
+ | 7300* \
+ | acorn \
+ | altos* \
+ | apollo \
+ | apple \
+ | atari \
+ | att* \
+ | axis \
+ | be \
+ | bull \
+ | cbm \
+ | ccur \
+ | cisco \
+ | commodore \
+ | convergent* \
+ | convex* \
+ | cray \
+ | crds \
+ | dec* \
+ | delta* \
+ | dg \
+ | digital \
+ | dolphin \
+ | encore* \
+ | gould \
+ | harris \
+ | highlevel \
+ | hitachi* \
+ | hp \
+ | ibm* \
+ | intergraph \
+ | isi* \
+ | knuth \
+ | masscomp \
+ | microblaze* \
+ | mips* \
+ | motorola* \
+ | ncr* \
+ | news \
+ | next \
+ | ns \
+ | oki \
+ | omron* \
+ | pc533* \
+ | rebel \
+ | rom68k \
+ | rombug \
+ | semi \
+ | sequent* \
+ | sgi* \
+ | siemens \
+ | sim \
+ | sni \
+ | sony* \
+ | stratus \
+ | sun \
+ | sun[234]* \
+ | tektronix \
+ | tti* \
+ | ultra \
+ | unicom* \
+ | wec \
+ | winbond \
+ | wrs)
+ basic_machine=$field1-$field2
+ basic_os=
+ ;;
+ tock* | zephyr*)
+ basic_machine=$field1-unknown
+ basic_os=$field2
+ ;;
+ *)
+ basic_machine=$field1
+ basic_os=$field2
+ ;;
+ esac
+ ;;
+ esac
+ ;;
+ *)
+ # Convert single-component short-hands not valid as part of
+ # multi-component configurations.
+ case $field1 in
+ 386bsd)
+ basic_machine=i386-pc
+ basic_os=bsd
+ ;;
+ a29khif)
+ basic_machine=a29k-amd
+ basic_os=udi
+ ;;
+ adobe68k)
+ basic_machine=m68010-adobe
+ basic_os=scout
+ ;;
+ alliant)
+ basic_machine=fx80-alliant
+ basic_os=
+ ;;
+ altos | altos3068)
+ basic_machine=m68k-altos
+ basic_os=
+ ;;
+ am29k)
+ basic_machine=a29k-none
+ basic_os=bsd
+ ;;
+ amdahl)
+ basic_machine=580-amdahl
+ basic_os=sysv
+ ;;
+ amiga)
+ basic_machine=m68k-unknown
+ basic_os=
+ ;;
+ amigaos | amigados)
+ basic_machine=m68k-unknown
+ basic_os=amigaos
+ ;;
+ amigaunix | amix)
+ basic_machine=m68k-unknown
+ basic_os=sysv4
+ ;;
+ apollo68)
+ basic_machine=m68k-apollo
+ basic_os=sysv
+ ;;
+ apollo68bsd)
+ basic_machine=m68k-apollo
+ basic_os=bsd
+ ;;
+ aros)
+ basic_machine=i386-pc
+ basic_os=aros
+ ;;
+ aux)
+ basic_machine=m68k-apple
+ basic_os=aux
+ ;;
+ balance)
+ basic_machine=ns32k-sequent
+ basic_os=dynix
+ ;;
+ blackfin)
+ basic_machine=bfin-unknown
+ basic_os=linux
+ ;;
+ cegcc)
+ basic_machine=arm-unknown
+ basic_os=cegcc
+ ;;
+ cray)
+ basic_machine=j90-cray
+ basic_os=unicos
+ ;;
+ crds | unos)
+ basic_machine=m68k-crds
+ basic_os=
+ ;;
+ da30)
+ basic_machine=m68k-da30
+ basic_os=
+ ;;
+ decstation | pmax | pmin | dec3100 | decstatn)
+ basic_machine=mips-dec
+ basic_os=
+ ;;
+ delta88)
+ basic_machine=m88k-motorola
+ basic_os=sysv3
+ ;;
+ dicos)
+ basic_machine=i686-pc
+ basic_os=dicos
+ ;;
+ djgpp)
+ basic_machine=i586-pc
+ basic_os=msdosdjgpp
+ ;;
+ ebmon29k)
+ basic_machine=a29k-amd
+ basic_os=ebmon
+ ;;
+ es1800 | OSE68k | ose68k | ose | OSE)
+ basic_machine=m68k-ericsson
+ basic_os=ose
+ ;;
+ gmicro)
+ basic_machine=tron-gmicro
+ basic_os=sysv
+ ;;
+ go32)
+ basic_machine=i386-pc
+ basic_os=go32
+ ;;
+ h8300hms)
+ basic_machine=h8300-hitachi
+ basic_os=hms
+ ;;
+ h8300xray)
+ basic_machine=h8300-hitachi
+ basic_os=xray
+ ;;
+ h8500hms)
+ basic_machine=h8500-hitachi
+ basic_os=hms
+ ;;
+ harris)
+ basic_machine=m88k-harris
+ basic_os=sysv3
+ ;;
+ hp300 | hp300hpux)
+ basic_machine=m68k-hp
+ basic_os=hpux
+ ;;
+ hp300bsd)
+ basic_machine=m68k-hp
+ basic_os=bsd
+ ;;
+ hppaosf)
+ basic_machine=hppa1.1-hp
+ basic_os=osf
+ ;;
+ hppro)
+ basic_machine=hppa1.1-hp
+ basic_os=proelf
+ ;;
+ i386mach)
+ basic_machine=i386-mach
+ basic_os=mach
+ ;;
+ isi68 | isi)
+ basic_machine=m68k-isi
+ basic_os=sysv
+ ;;
+ m68knommu)
+ basic_machine=m68k-unknown
+ basic_os=linux
+ ;;
+ magnum | m3230)
+ basic_machine=mips-mips
+ basic_os=sysv
+ ;;
+ merlin)
+ basic_machine=ns32k-utek
+ basic_os=sysv
+ ;;
+ mingw64)
+ basic_machine=x86_64-pc
+ basic_os=mingw64
+ ;;
+ mingw32)
+ basic_machine=i686-pc
+ basic_os=mingw32
+ ;;
+ mingw32ce)
+ basic_machine=arm-unknown
+ basic_os=mingw32ce
+ ;;
+ monitor)
+ basic_machine=m68k-rom68k
+ basic_os=coff
+ ;;
+ morphos)
+ basic_machine=powerpc-unknown
+ basic_os=morphos
+ ;;
+ moxiebox)
+ basic_machine=moxie-unknown
+ basic_os=moxiebox
+ ;;
+ msdos)
+ basic_machine=i386-pc
+ basic_os=msdos
+ ;;
+ msys)
+ basic_machine=i686-pc
+ basic_os=msys
+ ;;
+ mvs)
+ basic_machine=i370-ibm
+ basic_os=mvs
+ ;;
+ nacl)
+ basic_machine=le32-unknown
+ basic_os=nacl
+ ;;
+ ncr3000)
+ basic_machine=i486-ncr
+ basic_os=sysv4
+ ;;
+ netbsd386)
+ basic_machine=i386-pc
+ basic_os=netbsd
+ ;;
+ netwinder)
+ basic_machine=armv4l-rebel
+ basic_os=linux
+ ;;
+ news | news700 | news800 | news900)
+ basic_machine=m68k-sony
+ basic_os=newsos
+ ;;
+ news1000)
+ basic_machine=m68030-sony
+ basic_os=newsos
+ ;;
+ necv70)
+ basic_machine=v70-nec
+ basic_os=sysv
+ ;;
+ nh3000)
+ basic_machine=m68k-harris
+ basic_os=cxux
+ ;;
+ nh[45]000)
+ basic_machine=m88k-harris
+ basic_os=cxux
+ ;;
+ nindy960)
+ basic_machine=i960-intel
+ basic_os=nindy
+ ;;
+ mon960)
+ basic_machine=i960-intel
+ basic_os=mon960
+ ;;
+ nonstopux)
+ basic_machine=mips-compaq
+ basic_os=nonstopux
+ ;;
+ os400)
+ basic_machine=powerpc-ibm
+ basic_os=os400
+ ;;
+ OSE68000 | ose68000)
+ basic_machine=m68000-ericsson
+ basic_os=ose
+ ;;
+ os68k)
+ basic_machine=m68k-none
+ basic_os=os68k
+ ;;
+ paragon)
+ basic_machine=i860-intel
+ basic_os=osf
+ ;;
+ parisc)
+ basic_machine=hppa-unknown
+ basic_os=linux
+ ;;
+ psp)
+ basic_machine=mipsallegrexel-sony
+ basic_os=psp
+ ;;
+ pw32)
+ basic_machine=i586-unknown
+ basic_os=pw32
+ ;;
+ rdos | rdos64)
+ basic_machine=x86_64-pc
+ basic_os=rdos
+ ;;
+ rdos32)
+ basic_machine=i386-pc
+ basic_os=rdos
+ ;;
+ rom68k)
+ basic_machine=m68k-rom68k
+ basic_os=coff
+ ;;
+ sa29200)
+ basic_machine=a29k-amd
+ basic_os=udi
+ ;;
+ sei)
+ basic_machine=mips-sei
+ basic_os=seiux
+ ;;
+ sequent)
+ basic_machine=i386-sequent
+ basic_os=
+ ;;
+ sps7)
+ basic_machine=m68k-bull
+ basic_os=sysv2
+ ;;
+ st2000)
+ basic_machine=m68k-tandem
+ basic_os=
+ ;;
+ stratus)
+ basic_machine=i860-stratus
+ basic_os=sysv4
+ ;;
+ sun2)
+ basic_machine=m68000-sun
+ basic_os=
+ ;;
+ sun2os3)
+ basic_machine=m68000-sun
+ basic_os=sunos3
+ ;;
+ sun2os4)
+ basic_machine=m68000-sun
+ basic_os=sunos4
+ ;;
+ sun3)
+ basic_machine=m68k-sun
+ basic_os=
+ ;;
+ sun3os3)
+ basic_machine=m68k-sun
+ basic_os=sunos3
+ ;;
+ sun3os4)
+ basic_machine=m68k-sun
+ basic_os=sunos4
+ ;;
+ sun4)
+ basic_machine=sparc-sun
+ basic_os=
+ ;;
+ sun4os3)
+ basic_machine=sparc-sun
+ basic_os=sunos3
+ ;;
+ sun4os4)
+ basic_machine=sparc-sun
+ basic_os=sunos4
+ ;;
+ sun4sol2)
+ basic_machine=sparc-sun
+ basic_os=solaris2
+ ;;
+ sun386 | sun386i | roadrunner)
+ basic_machine=i386-sun
+ basic_os=
+ ;;
+ sv1)
+ basic_machine=sv1-cray
+ basic_os=unicos
+ ;;
+ symmetry)
+ basic_machine=i386-sequent
+ basic_os=dynix
+ ;;
+ t3e)
+ basic_machine=alphaev5-cray
+ basic_os=unicos
+ ;;
+ t90)
+ basic_machine=t90-cray
+ basic_os=unicos
+ ;;
+ toad1)
+ basic_machine=pdp10-xkl
+ basic_os=tops20
+ ;;
+ tpf)
+ basic_machine=s390x-ibm
+ basic_os=tpf
+ ;;
+ udi29k)
+ basic_machine=a29k-amd
+ basic_os=udi
+ ;;
+ ultra3)
+ basic_machine=a29k-nyu
+ basic_os=sym1
+ ;;
+ v810 | necv810)
+ basic_machine=v810-nec
+ basic_os=none
+ ;;
+ vaxv)
+ basic_machine=vax-dec
+ basic_os=sysv
+ ;;
+ vms)
+ basic_machine=vax-dec
+ basic_os=vms
+ ;;
+ vsta)
+ basic_machine=i386-pc
+ basic_os=vsta
+ ;;
+ vxworks960)
+ basic_machine=i960-wrs
+ basic_os=vxworks
+ ;;
+ vxworks68)
+ basic_machine=m68k-wrs
+ basic_os=vxworks
+ ;;
+ vxworks29k)
+ basic_machine=a29k-wrs
+ basic_os=vxworks
+ ;;
+ xbox)
+ basic_machine=i686-pc
+ basic_os=mingw32
+ ;;
+ ymp)
+ basic_machine=ymp-cray
+ basic_os=unicos
+ ;;
+ *)
+ basic_machine=$1
+ basic_os=
+ ;;
+ esac
+ ;;
+esac
+
+# Decode 1-component or ad-hoc basic machines
+case $basic_machine in
+ # Here we handle the default manufacturer of certain CPU types. It is in
+ # some cases the only manufacturer, in others, it is the most popular.
+ w89k)
+ cpu=hppa1.1
+ vendor=winbond
+ ;;
+ op50n)
+ cpu=hppa1.1
+ vendor=oki
+ ;;
+ op60c)
+ cpu=hppa1.1
+ vendor=oki
+ ;;
+ ibm*)
+ cpu=i370
+ vendor=ibm
+ ;;
+ orion105)
+ cpu=clipper
+ vendor=highlevel
+ ;;
+ mac | mpw | mac-mpw)
+ cpu=m68k
+ vendor=apple
+ ;;
+ pmac | pmac-mpw)
+ cpu=powerpc
+ vendor=apple
+ ;;
+
+ # Recognize the various machine names and aliases which stand
+ # for a CPU type and a company and sometimes even an OS.
+ 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc)
+ cpu=m68000
+ vendor=att
+ ;;
+ 3b*)
+ cpu=we32k
+ vendor=att
+ ;;
+ bluegene*)
+ cpu=powerpc
+ vendor=ibm
+ basic_os=cnk
+ ;;
+ decsystem10* | dec10*)
+ cpu=pdp10
+ vendor=dec
+ basic_os=tops10
+ ;;
+ decsystem20* | dec20*)
+ cpu=pdp10
+ vendor=dec
+ basic_os=tops20
+ ;;
+ delta | 3300 | delta-motorola | 3300-motorola | motorola-delta | motorola-3300)
+ cpu=m68k
+ vendor=motorola
+ ;;
+ # This used to be dpx2*, but that gets the RS6000-based
+ # DPX/20 and the x86-based DPX/2-100 wrong. See
+ # https://oldskool.silicium.org/stations/bull_dpx20.htm
+ # https://www.feb-patrimoine.com/english/bull_dpx2.htm
+ # https://www.feb-patrimoine.com/english/unix_and_bull.htm
+ dpx2 | dpx2[23]00 | dpx2[23]xx)
+ cpu=m68k
+ vendor=bull
+ ;;
+ dpx2100 | dpx21xx)
+ cpu=i386
+ vendor=bull
+ ;;
+ dpx20)
+ cpu=rs6000
+ vendor=bull
+ ;;
+ encore | umax | mmax)
+ cpu=ns32k
+ vendor=encore
+ ;;
+ elxsi)
+ cpu=elxsi
+ vendor=elxsi
+ basic_os=${basic_os:-bsd}
+ ;;
+ fx2800)
+ cpu=i860
+ vendor=alliant
+ ;;
+ genix)
+ cpu=ns32k
+ vendor=ns
+ ;;
+ h3050r* | hiux*)
+ cpu=hppa1.1
+ vendor=hitachi
+ basic_os=hiuxwe2
+ ;;
+ hp3k9[0-9][0-9] | hp9[0-9][0-9])
+ cpu=hppa1.0
+ vendor=hp
+ ;;
+ hp9k2[0-9][0-9] | hp9k31[0-9])
+ cpu=m68000
+ vendor=hp
+ ;;
+ hp9k3[2-9][0-9])
+ cpu=m68k
+ vendor=hp
+ ;;
+ hp9k6[0-9][0-9] | hp6[0-9][0-9])
+ cpu=hppa1.0
+ vendor=hp
+ ;;
+ hp9k7[0-79][0-9] | hp7[0-79][0-9])
+ cpu=hppa1.1
+ vendor=hp
+ ;;
+ hp9k78[0-9] | hp78[0-9])
+ # FIXME: really hppa2.0-hp
+ cpu=hppa1.1
+ vendor=hp
+ ;;
+ hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893)
+ # FIXME: really hppa2.0-hp
+ cpu=hppa1.1
+ vendor=hp
+ ;;
+ hp9k8[0-9][13679] | hp8[0-9][13679])
+ cpu=hppa1.1
+ vendor=hp
+ ;;
+ hp9k8[0-9][0-9] | hp8[0-9][0-9])
+ cpu=hppa1.0
+ vendor=hp
+ ;;
+ i*86v32)
+ cpu=`echo "$1" | sed -e 's/86.*/86/'`
+ vendor=pc
+ basic_os=sysv32
+ ;;
+ i*86v4*)
+ cpu=`echo "$1" | sed -e 's/86.*/86/'`
+ vendor=pc
+ basic_os=sysv4
+ ;;
+ i*86v)
+ cpu=`echo "$1" | sed -e 's/86.*/86/'`
+ vendor=pc
+ basic_os=sysv
+ ;;
+ i*86sol2)
+ cpu=`echo "$1" | sed -e 's/86.*/86/'`
+ vendor=pc
+ basic_os=solaris2
+ ;;
+ j90 | j90-cray)
+ cpu=j90
+ vendor=cray
+ basic_os=${basic_os:-unicos}
+ ;;
+ iris | iris4d)
+ cpu=mips
+ vendor=sgi
+ case $basic_os in
+ irix*)
+ ;;
+ *)
+ basic_os=irix4
+ ;;
+ esac
+ ;;
+ miniframe)
+ cpu=m68000
+ vendor=convergent
+ ;;
+ *mint | mint[0-9]* | *MiNT | *MiNT[0-9]*)
+ cpu=m68k
+ vendor=atari
+ basic_os=mint
+ ;;
+ news-3600 | risc-news)
+ cpu=mips
+ vendor=sony
+ basic_os=newsos
+ ;;
+ next | m*-next)
+ cpu=m68k
+ vendor=next
+ ;;
+ np1)
+ cpu=np1
+ vendor=gould
+ ;;
+ op50n-* | op60c-*)
+ cpu=hppa1.1
+ vendor=oki
+ basic_os=proelf
+ ;;
+ pa-hitachi)
+ cpu=hppa1.1
+ vendor=hitachi
+ basic_os=hiuxwe2
+ ;;
+ pbd)
+ cpu=sparc
+ vendor=tti
+ ;;
+ pbb)
+ cpu=m68k
+ vendor=tti
+ ;;
+ pc532)
+ cpu=ns32k
+ vendor=pc532
+ ;;
+ pn)
+ cpu=pn
+ vendor=gould
+ ;;
+ power)
+ cpu=power
+ vendor=ibm
+ ;;
+ ps2)
+ cpu=i386
+ vendor=ibm
+ ;;
+ rm[46]00)
+ cpu=mips
+ vendor=siemens
+ ;;
+ rtpc | rtpc-*)
+ cpu=romp
+ vendor=ibm
+ ;;
+ sde)
+ cpu=mipsisa32
+ vendor=sde
+ basic_os=${basic_os:-elf}
+ ;;
+ simso-wrs)
+ cpu=sparclite
+ vendor=wrs
+ basic_os=vxworks
+ ;;
+ tower | tower-32)
+ cpu=m68k
+ vendor=ncr
+ ;;
+ vpp*|vx|vx-*)
+ cpu=f301
+ vendor=fujitsu
+ ;;
+ w65)
+ cpu=w65
+ vendor=wdc
+ ;;
+ w89k-*)
+ cpu=hppa1.1
+ vendor=winbond
+ basic_os=proelf
+ ;;
+ none)
+ cpu=none
+ vendor=none
+ ;;
+ leon|leon[3-9])
+ cpu=sparc
+ vendor=$basic_machine
+ ;;
+ leon-*|leon[3-9]-*)
+ cpu=sparc
+ vendor=`echo "$basic_machine" | sed 's/-.*//'`
+ ;;
+
+ *-*)
+ saved_IFS=$IFS
+ IFS="-" read cpu vendor <&2
+ exit 1
+ ;;
+ esac
+ ;;
+esac
+
+# Here we canonicalize certain aliases for manufacturers.
+case $vendor in
+ digital*)
+ vendor=dec
+ ;;
+ commodore*)
+ vendor=cbm
+ ;;
+ *)
+ ;;
+esac
+
+# Decode manufacturer-specific aliases for certain operating systems.
+
+if test x"$basic_os" != x
+then
+
+# First recognize some ad-hoc cases, or perhaps split kernel-os, or else just
+# set os.
+obj=
+case $basic_os in
+ gnu/linux*)
+ kernel=linux
+ os=`echo "$basic_os" | sed -e 's|gnu/linux|gnu|'`
+ ;;
+ os2-emx)
+ kernel=os2
+ os=`echo "$basic_os" | sed -e 's|os2-emx|emx|'`
+ ;;
+ nto-qnx*)
+ kernel=nto
+ os=`echo "$basic_os" | sed -e 's|nto-qnx|qnx|'`
+ ;;
+ *-*)
+ saved_IFS=$IFS
+ IFS="-" read kernel os <&2
+ fi
+ ;;
+ *)
+ echo "Invalid configuration '$1': OS '$os' not recognized" 1>&2
+ exit 1
+ ;;
+esac
+
+case $obj in
+ aout* | coff* | elf* | pe*)
+ ;;
+ '')
+ # empty is fine
+ ;;
+ *)
+ echo "Invalid configuration '$1': Machine code format '$obj' not recognized" 1>&2
+ exit 1
+ ;;
+esac
+
+# Here we handle the constraint that a (synthetic) cpu and os are
+# valid only in combination with each other and nowhere else.
+case $cpu-$os in
+ # The "javascript-unknown-ghcjs" triple is used by GHC; we
+ # accept it here in order to tolerate that, but reject any
+ # variations.
+ javascript-ghcjs)
+ ;;
+ javascript-* | *-ghcjs)
+ echo "Invalid configuration '$1': cpu '$cpu' is not valid with os '$os$obj'" 1>&2
+ exit 1
+ ;;
+esac
+
+# As a final step for OS-related things, validate the OS-kernel combination
+# (given a valid OS), if there is a kernel.
+case $kernel-$os-$obj in
+ linux-gnu*- | linux-android*- | linux-dietlibc*- | linux-llvm*- \
+ | linux-mlibc*- | linux-musl*- | linux-newlib*- \
+ | linux-relibc*- | linux-uclibc*- | linux-ohos*- )
+ ;;
+ uclinux-uclibc*- | uclinux-gnu*- )
+ ;;
+ ironclad-mlibc*-)
+ ;;
+ managarm-mlibc*- | managarm-kernel*- )
+ ;;
+ windows*-msvc*-)
+ ;;
+ -dietlibc*- | -llvm*- | -mlibc*- | -musl*- | -newlib*- | -relibc*- \
+ | -uclibc*- )
+ # These are just libc implementations, not actual OSes, and thus
+ # require a kernel.
+ echo "Invalid configuration '$1': libc '$os' needs explicit kernel." 1>&2
+ exit 1
+ ;;
+ -kernel*- )
+ echo "Invalid configuration '$1': '$os' needs explicit kernel." 1>&2
+ exit 1
+ ;;
+ *-kernel*- )
+ echo "Invalid configuration '$1': '$kernel' does not support '$os'." 1>&2
+ exit 1
+ ;;
+ *-msvc*- )
+ echo "Invalid configuration '$1': '$os' needs 'windows'." 1>&2
+ exit 1
+ ;;
+ kfreebsd*-gnu*- | knetbsd*-gnu*- | netbsd*-gnu*- | kopensolaris*-gnu*-)
+ ;;
+ vxworks-simlinux- | vxworks-simwindows- | vxworks-spe-)
+ ;;
+ nto-qnx*-)
+ ;;
+ os2-emx-)
+ ;;
+ rtmk-nova-)
+ ;;
+ *-eabi*- | *-gnueabi*-)
+ ;;
+ ios*-simulator- | tvos*-simulator- | watchos*-simulator- )
+ ;;
+ none--*)
+ # None (no kernel, i.e. freestanding / bare metal),
+ # can be paired with an machine code file format
+ ;;
+ -*-)
+ # Blank kernel with real OS is always fine.
+ ;;
+ --*)
+ # Blank kernel and OS with real machine code file format is always fine.
+ ;;
+ *-*-*)
+ echo "Invalid configuration '$1': Kernel '$kernel' not known to work with OS '$os'." 1>&2
+ exit 1
+ ;;
+esac
+
+# Here we handle the case where we know the os, and the CPU type, but not the
+# manufacturer. We pick the logical manufacturer.
+case $vendor in
+ unknown)
+ case $cpu-$os in
+ *-riscix*)
+ vendor=acorn
+ ;;
+ *-sunos* | *-solaris*)
+ vendor=sun
+ ;;
+ *-cnk* | *-aix*)
+ vendor=ibm
+ ;;
+ *-beos*)
+ vendor=be
+ ;;
+ *-hpux*)
+ vendor=hp
+ ;;
+ *-mpeix*)
+ vendor=hp
+ ;;
+ *-hiux*)
+ vendor=hitachi
+ ;;
+ *-unos*)
+ vendor=crds
+ ;;
+ *-dgux*)
+ vendor=dg
+ ;;
+ *-luna*)
+ vendor=omron
+ ;;
+ *-genix*)
+ vendor=ns
+ ;;
+ *-clix*)
+ vendor=intergraph
+ ;;
+ *-mvs* | *-opened*)
+ vendor=ibm
+ ;;
+ *-os400*)
+ vendor=ibm
+ ;;
+ s390-* | s390x-*)
+ vendor=ibm
+ ;;
+ *-ptx*)
+ vendor=sequent
+ ;;
+ *-tpf*)
+ vendor=ibm
+ ;;
+ *-vxsim* | *-vxworks* | *-windiss*)
+ vendor=wrs
+ ;;
+ *-aux*)
+ vendor=apple
+ ;;
+ *-hms*)
+ vendor=hitachi
+ ;;
+ *-mpw* | *-macos*)
+ vendor=apple
+ ;;
+ *-*mint | *-mint[0-9]* | *-*MiNT | *-MiNT[0-9]*)
+ vendor=atari
+ ;;
+ *-vos*)
+ vendor=stratus
+ ;;
+ esac
+ ;;
+esac
+
+echo "$cpu-$vendor${kernel:+-$kernel}${os:+-$os}${obj:+-$obj}"
+exit
+
+# Local variables:
+# eval: (add-hook 'before-save-hook 'time-stamp nil t)
+# time-stamp-start: "timestamp='"
+# time-stamp-format: "%Y-%02m-%02d"
+# time-stamp-end: "'"
+# End:
diff --git a/libraries/ghc-internal/configure.ac b/libraries/ghc-internal/configure.ac
index b87652f61d25..4bcf90948884 100644
--- a/libraries/ghc-internal/configure.ac
+++ b/libraries/ghc-internal/configure.ac
@@ -6,12 +6,15 @@ 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
+AC_CANONICAL_HOST
AC_MSG_CHECKING(for WINDOWS platform)
-case $host_alias in
+case $host in
*mingw32*|*mingw64*|*cygwin*|*msys*|*windows*)
WINDOWS=YES;;
*)
@@ -402,10 +405,40 @@ 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_ARG_VAR([GHC], [Path to the ghc program])
+
+AC_ARG_WITH([compiler],
+ [AS_HELP_STRING([--with-compiler],
+ [The haskell compiler to use])],
+ [GHC="$withval"
+ AC_MSG_NOTICE([Using GHC $GHC])
+ ],
+ [AC_PATH_PROG([GHC], ghc)])
+
+if test -z "$GHC"; then
+ AC_MSG_ERROR([Cannot find ghc])
+fi
+
+AC_MSG_CHECKING([for GHC/Internal/Prim.hs])
+if mkdir -p GHC/Internal && $GHC --print-prim-module > GHC/Internal/Prim.hs; then
+ AC_MSG_RESULT([created])
+else
+ AC_MSG_RESULT([failed to create])
+ AC_MSG_ERROR([Failed to run $GHC --print-prim-module > GHC/Internal/Prim.hs])
+fi
+
+AC_MSG_CHECKING([for GHC/Internal/PrimopWrappers.hs])
+if mkdir -p GHC/Internal && $GHC --print-prim-wrappers-module > GHC/Internal/PrimopWrappers.hs; then
+ AC_MSG_RESULT([created])
+else
+ AC_MSG_RESULT([failed to create])
+ AC_MSG_ERROR([Failed to run $GHC --print-prim-wrappers-module > GHC/Internal/PrimopWrappers.hs])
+fi
AC_SUBST(EXTRA_LIBS)
AC_CONFIG_FILES([ghc-internal.buildinfo include/HsIntegerGmp.h])
diff --git a/libraries/ghc-internal/ghc-internal.buildinfo.in b/libraries/ghc-internal/ghc-internal.buildinfo.in
index 77677620162b..6d6ef57f5966 100644
--- a/libraries/ghc-internal/ghc-internal.buildinfo.in
+++ b/libraries/ghc-internal/ghc-internal.buildinfo.in
@@ -1,5 +1,6 @@
extra-lib-dirs: @ICONV_LIB_DIRS@ @GMP_LIB_DIRS@
extra-libraries: @EXTRA_LIBS@ @GMP_LIBS@
+extra-libraries-static: @EXTRA_LIBS@ @GMP_LIBS@
include-dirs: @ICONV_INCLUDE_DIRS@ @GMP_INCLUDE_DIRS@
frameworks: @GMP_FRAMEWORK@
install-includes: HsBaseConfig.h EventConfig.h @GMP_INSTALL_INCLUDES@
diff --git a/libraries/ghc-internal/ghc-internal.cabal.in b/libraries/ghc-internal/ghc-internal.cabal.in
index dd8116b0cb82..8a953439dd8b 100644
--- a/libraries/ghc-internal/ghc-internal.cabal.in
+++ b/libraries/ghc-internal/ghc-internal.cabal.in
@@ -1,4 +1,4 @@
-cabal-version: 3.0
+cabal-version: 3.8
-- WARNING: ghc-internal.cabal is automatically generated from ghc-internal.cabal.in by
-- the top-level ./configure script. Make sure you are editing ghc-internal.cabal.in, not ghc-internal.cabal.
name: ghc-internal
@@ -39,7 +39,6 @@ extra-source-files:
include/HsBaseConfig.h.in
include/ieee-flpt.h
include/md5.h
- include/fs.h
include/winio_structs.h
include/WordSize.h
include/HsIntegerGmp.h.in
@@ -120,7 +119,8 @@ Library
Unsafe
build-depends:
- rts == 1.0.*
+ rts == 1.0.*,
+ rts-fs == 1.0.*
exposed-modules:
GHC.Internal.AllocationLimitHandler
@@ -353,9 +353,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
@@ -441,7 +443,6 @@ Library
cbits/md5.c
cbits/primFloat.c
cbits/sysconf.c
- cbits/fs.c
cbits/strerror.c
cbits/debug.c
cbits/Stack_c.c
@@ -471,7 +472,7 @@ Library
if flag(need-atomic)
-- for 64-bit atomic ops on armel (#20549)
extra-libraries: atomic
-
+ extra-libraries-static: atomic
-- OS Specific
if os(windows)
-- Windows requires some extra libraries for linking because the RTS
@@ -494,6 +495,9 @@ Library
extra-libraries:
wsock32, user32, shell32, mingw32, kernel32, advapi32,
mingwex, ws2_32, shlwapi, ole32, rpcrt4, ntdll, ucrt
+ extra-libraries-static:
+ wsock32, user32, shell32, mingw32, kernel32, advapi32,
+ mingwex, ws2_32, shlwapi, ole32, rpcrt4, ntdll, ucrt
-- Minimum supported Windows version.
-- These numbers can be found at:
-- https://msdn.microsoft.com/en-us/library/windows/desktop/aa383745(v=vs.85).aspx
@@ -540,6 +544,7 @@ Library
-- we need libm, but for musl and other's we might need libc, as libm
-- is just an empty shell.
extra-libraries: c, m
+ extra-libraries-static: c, m
-- The Ports framework always passes this flag when building software that
-- uses iconv to make iconv from Ports compatible with iconv from the base system
diff --git a/libraries/ghc-internal/gmp/gmp-tarballs b/libraries/ghc-internal/gmp/gmp-tarballs
deleted file mode 160000
index 01149ce34711..000000000000
--- a/libraries/ghc-internal/gmp/gmp-tarballs
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit 01149ce3471128e9fe0feca607579981f4b64395
diff --git a/libraries/ghc-internal/include/HsBase.h b/libraries/ghc-internal/include/HsBase.h
index 0e159237e39f..f7155b72cf00 100644
--- a/libraries/ghc-internal/include/HsBase.h
+++ b/libraries/ghc-internal/include/HsBase.h
@@ -515,16 +515,16 @@ extern void __hscore_set_saved_termios(int fd, void* ts);
#if defined(_WIN32)
/* Defined in fs.c. */
-extern int __hs_swopen (const wchar_t* filename, int oflag, int shflag,
+extern int __rts_swopen (const wchar_t* filename, int oflag, int shflag,
int pmode);
INLINE int __hscore_open(wchar_t *file, int how, mode_t mode) {
int result = -1;
if ((how & O_WRONLY) || (how & O_RDWR) || (how & O_APPEND))
- result = __hs_swopen(file,how | _O_NOINHERIT,_SH_DENYNO,mode);
+ result = __rts_swopen(file,how | _O_NOINHERIT,_SH_DENYNO,mode);
// _O_NOINHERIT: see #2650
else
- result = __hs_swopen(file,how | _O_NOINHERIT,_SH_DENYNO,mode);
+ result = __rts_swopen(file,how | _O_NOINHERIT,_SH_DENYNO,mode);
// _O_NOINHERIT: see #2650
/* This call is very important, otherwise the I/O system will not propagate
diff --git a/libraries/ghc-internal/src/GHC/Internal/IO/Windows/Paths.hs b/libraries/ghc-internal/src/GHC/Internal/IO/Windows/Paths.hs
index 532cf1fc5ad7..98a500027805 100644
--- a/libraries/ghc-internal/src/GHC/Internal/IO/Windows/Paths.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/IO/Windows/Paths.hs
@@ -28,7 +28,7 @@ import GHC.Internal.IO
import GHC.Internal.Foreign.C.String
import GHC.Internal.Foreign.Marshal.Alloc (free)
-foreign import ccall safe "__hs_create_device_name"
+foreign import ccall safe "__rts_create_device_name"
c_GetDevicePath :: CWString -> IO CWString
-- | This function converts Windows paths between namespaces. More specifically
diff --git a/libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs b/libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs
index 7fd0fe75159d..a5dd56061228 100644
--- a/libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs
@@ -97,7 +97,11 @@ data {-# CTYPE "struct stat" #-} CStat
data {-# CTYPE "struct termios" #-} CTermios
data {-# CTYPE "struct tm" #-} CTm
data {-# CTYPE "struct tms" #-} CTms
+#if defined(mingw32_HOST_OS)
+data {-# CTYPE "struct _utimbuf" #-} CUtimbuf
+#else
data {-# CTYPE "struct utimbuf" #-} CUtimbuf
+#endif
data {-# CTYPE "struct utsname" #-} CUtsname
type FD = CInt
diff --git a/libraries/ghci/GHCi/CreateBCO.hs b/libraries/ghci/GHCi/CreateBCO.hs
index c1275a9b024e..847583e94969 100644
--- a/libraries/ghci/GHCi/CreateBCO.hs
+++ b/libraries/ghci/GHCi/CreateBCO.hs
@@ -6,6 +6,10 @@
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}
+-- Only needed when we don't have ghc-internal (and must import deprecated names)
+#ifndef HAVE_GHC_INTERNAL
+{-# OPTIONS_GHC -Wno-warnings-deprecations #-}
+#endif
--
-- (c) The University of Glasgow 2002-2006
@@ -26,8 +30,13 @@ import Data.Array.Base
import Foreign hiding (newArray)
import Unsafe.Coerce (unsafeCoerce)
import GHC.Arr ( Array(..) )
-import GHC.Exts hiding ( BCO, mkApUpd0#, newBCO# )
+-- When ghc-internal is available prefer the non-deprecated exports.
+#ifdef HAVE_GHC_INTERNAL
+import GHC.Exts hiding ( BCO, mkApUpd0#, newBCO# )
import GHC.Internal.Base ( BCO, mkApUpd0#, newBCO# )
+#else
+import GHC.Exts
+#endif
import GHC.IO
import Control.Exception ( ErrorCall(..) )
diff --git a/libraries/ghci/GHCi/FFI.hsc b/libraries/ghci/GHCi/FFI.hsc
index f88a7b0dd678..a001f332e679 100644
--- a/libraries/ghci/GHCi/FFI.hsc
+++ b/libraries/ghci/GHCi/FFI.hsc
@@ -6,22 +6,19 @@
--
-----------------------------------------------------------------------------
-{- Note [FFI for the JS-Backend]
- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
- The JS-backend does not use GHC's native rts, as such you might think that it
- doesn't require ghci. However, that is not true, because we need ghci in
- order to interoperate with iserv even if we do not use any of the FFI stuff
- in this file. So obviously we do not require libffi, but we still need to be
- able to build ghci in order for the JS-Backend to supply its own iserv
- interop solution. Thus we bite the bullet and wrap all the unneeded bits in a
- CPP conditional compilation blocks that detect the JS-backend. A necessary
- evil to be sure; notice that the only symbols remaining the JS_HOST_ARCH case
- are those that are explicitly exported by this module and set to error if
- they are every used.
+{- Note [FFI for the JS-Backend and WASM-Backend]
+ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+ Neither the JS-backend nor the WASM-backend use libffi: the JS-backend has
+ no native RTS, and the WASM/WASI target does not provide libffi in its sysroot
+ (libffi's WASM support is Emscripten-only). Both backends still need to build
+ the ghci library in order to interoperate with iserv even if the FFI machinery
+ in this file is never exercised. So we wrap all the libffi-dependent bits in
+ CPP guards that exclude both backends. The only symbols that remain in the
+ guarded-out case are the exported stubs, which error if called at runtime.
-}
-#if !defined(javascript_HOST_ARCH)
+#if !defined(javascript_HOST_ARCH) && !defined(wasm32_HOST_ARCH)
-- See Note [FFI_GO_CLOSURES workaround] in ghc_ffi.h
-- We can't include ghc_ffi.h here as we must build with stage0
#if defined(darwin_HOST_OS)
@@ -42,7 +39,7 @@ module GHCi.FFI
) where
import Prelude -- See note [Why do we import Prelude here?]
-#if !defined(javascript_HOST_ARCH)
+#if !defined(javascript_HOST_ARCH) && !defined(wasm32_HOST_ARCH)
import Control.Exception
import Foreign.C
#endif
@@ -70,7 +67,7 @@ prepForeignCall
-> FFIType -- result type
-> IO (Ptr C_ffi_cif) -- token for making calls (must be freed by caller)
-#if !defined(javascript_HOST_ARCH)
+#if !defined(javascript_HOST_ARCH) && !defined(wasm32_HOST_ARCH)
prepForeignCall arg_types result_type = do
let n_args = length arg_types
arg_arr <- mallocArray n_args
@@ -91,7 +88,7 @@ prepForeignCall _ _ =
freeForeignCallInfo :: Ptr C_ffi_cif -> IO ()
-#if !defined(javascript_HOST_ARCH)
+#if !defined(javascript_HOST_ARCH) && !defined(wasm32_HOST_ARCH)
freeForeignCallInfo p = do
free ((#ptr ffi_cif, arg_types) p)
free p
@@ -102,7 +99,7 @@ freeForeignCallInfo _ =
data C_ffi_cif
-#if !defined(javascript_HOST_ARCH)
+#if !defined(javascript_HOST_ARCH) && !defined(wasm32_HOST_ARCH)
data C_ffi_type
strError :: C_ffi_status -> String
diff --git a/libraries/ghci/GHCi/InfoTable.hsc b/libraries/ghci/GHCi/InfoTable.hsc
index 649b99a568b8..a6737ac11d32 100644
--- a/libraries/ghci/GHCi/InfoTable.hsc
+++ b/libraries/ghci/GHCi/InfoTable.hsc
@@ -19,7 +19,10 @@ import Foreign
import Foreign.C
import GHC.Ptr
import GHC.Exts
+#ifndef BOOTSTRAPPING
import GHC.Exts.Heap
+import System.IO.Unsafe (unsafePerformIO)
+#endif
import Data.ByteString (ByteString)
import Control.Monad.Fail
import qualified Data.ByteString as BS
@@ -36,11 +39,16 @@ mkConInfoTable
-> Int -- constr tag
-> Int -- pointer tag
-> ByteString -- con desc
+#ifndef BOOTSTRAPPING
-> IO (Ptr StgInfoTable)
+#else
+ -> IO (Ptr ())
+#endif
-- resulting info table is allocated with allocateExecPage(), and
-- should be freed with freeExecPage().
mkConInfoTable tables_next_to_code ptr_words nonptr_words tag ptrtag con_desc = do
+#ifndef BOOTSTRAPPING
let entry_addr = interpConstrEntry !! ptrtag
code' <- if tables_next_to_code
then Just <$> mkJumpToAddr entry_addr
@@ -57,8 +65,11 @@ mkConInfoTable tables_next_to_code ptr_words nonptr_words tag ptrtag con_desc =
code = code'
}
castFunPtrToPtr <$> newExecConItbl tables_next_to_code itbl con_desc
+#else
+ return nullPtr
+#endif
-
+#ifndef BOOTSTRAPPING
-- -----------------------------------------------------------------------------
-- Building machine code fragments for a constructor's entry code
@@ -258,26 +269,43 @@ byte7 w = fromIntegral (w `shiftR` 56)
-- -----------------------------------------------------------------------------
--- read & write intfo tables
-
--- entry point for direct returns for created constr itbls
-foreign import ccall "&stg_interp_constr1_entry" stg_interp_constr1_entry :: EntryFunPtr
-foreign import ccall "&stg_interp_constr2_entry" stg_interp_constr2_entry :: EntryFunPtr
-foreign import ccall "&stg_interp_constr3_entry" stg_interp_constr3_entry :: EntryFunPtr
-foreign import ccall "&stg_interp_constr4_entry" stg_interp_constr4_entry :: EntryFunPtr
-foreign import ccall "&stg_interp_constr5_entry" stg_interp_constr5_entry :: EntryFunPtr
-foreign import ccall "&stg_interp_constr6_entry" stg_interp_constr6_entry :: EntryFunPtr
-foreign import ccall "&stg_interp_constr7_entry" stg_interp_constr7_entry :: EntryFunPtr
+-- read & write info tables
+-- Note [Dynamic lookup of stg_interp_constr entry points]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- We need to look up stg_interp_constr*_entry symbols dynamically at runtime
+-- rather than using static FFI imports. Here's why:
+--
+-- In DYNAMIC=1 builds, libHSghci.so might be linked against a different copy
+-- of libHSrts.so than what ghc-iserv uses at runtime.
+-- Static FFI imports (foreign import ccall "&symbol") are resolved at library
+-- load time, BEFORE the RTS has promoted boot libraries to RTLD_GLOBAL via
+-- promoteBootLibrariesToGlobal().
+--
+-- If libHSghci.so's NEEDED entry references a different copy of libHSrts.so
+-- than what ghc-iserv uses at runtime, the FFI imports would resolve to the
+-- wrong RTS copy. When mkConInfoTable creates info tables with jump
+-- code pointing to the wrong RTS's entry points, GC crashes occur because
+-- the closures reference invalid addresses.
+--
+-- The fix: Use an RTS function (getInterpConstrEntryAddr) that returns the
+-- addresses directly from the running RTS. This is called at runtime after
+-- promoteBootLibrariesToGlobal() has run, ensuring we get the correct RTS.
+--
+-- | RTS function to get stg_interp_constr*_entry address.
+-- This returns the address directly from the running RTS, avoiding any
+-- symbol resolution issues from library loading order.
+foreign import ccall unsafe "getInterpConstrEntryAddr"
+ getInterpConstrEntryAddr :: CInt -> IO (FunPtr a)
+
+-- | Cached interpreter constructor entry points.
+-- Uses a CAF (NOINLINE + unsafePerformIO) to ensure the lookup
+-- happens once, after RTS init (when promoteBootLibrariesToGlobal has run).
+{-# NOINLINE interpConstrEntry #-}
interpConstrEntry :: [EntryFunPtr]
-interpConstrEntry = [ error "pointer tag 0"
- , stg_interp_constr1_entry
- , stg_interp_constr2_entry
- , stg_interp_constr3_entry
- , stg_interp_constr4_entry
- , stg_interp_constr5_entry
- , stg_interp_constr6_entry
- , stg_interp_constr7_entry ]
+interpConstrEntry = unsafePerformIO $ do
+ entries <- mapM (\n -> getInterpConstrEntryAddr (fromIntegral n)) [1..7]
+ return (error "pointer tag 0" : entries)
data StgConInfoTable = StgConInfoTable {
conDesc :: Ptr Word8,
@@ -382,3 +410,4 @@ wORD_SIZE = (#const SIZEOF_HSINT)
conInfoTableSizeB :: Int
conInfoTableSizeB = wORD_SIZE + itblSize
+#endif
diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs
index c731d33e3167..9e996cdb43f4 100644
--- a/libraries/ghci/GHCi/Message.hs
+++ b/libraries/ghci/GHCi/Message.hs
@@ -37,9 +37,7 @@ import GHCi.ResolvedBCO
import GHC.LanguageExtensions
import GHC.InfoProv
-#if MIN_VERSION_ghc_internal(9,1500,0)
-import qualified GHC.Exts.Heap as Heap
-#else
+#ifndef BOOTSTRAPPING
import qualified GHC.Exts.Heap as Heap
#endif
import GHC.ForeignSrcLang
@@ -122,9 +120,15 @@ data Message a where
FreeFFI :: RemotePtr C_ffi_cif -> Message ()
-- | Create an info table for a constructor
+#ifndef BOOTSTRAPPING
MkConInfoTable
:: !ConInfoTable
-> Message (RemotePtr Heap.StgInfoTable)
+#else
+ MkConInfoTable
+ :: !ConInfoTable
+ -> Message (RemotePtr ())
+#endif
-- | Evaluate a statement
EvalStmt
@@ -225,9 +229,11 @@ data Message a where
-- | Remote interface to GHC.Internal.Heap.getClosureData. This is used by
-- the GHCi debugger to inspect values in the heap for :print and
-- type reconstruction.
+#ifndef BOOTSTRAPPING
GetClosure
:: HValueRef
-> Message (Heap.GenClosure HValueRef)
+#endif
-- | Remote interface to GHC.InfoProv.whereFrom. This is used by
-- the GHCi debugger to inspect the provenance of thunks for :print.
@@ -522,11 +528,14 @@ instance Binary (FunPtr a) where
put = put . castFunPtrToPtr
get = castPtrToFunPtr <$> get
+#ifndef BOOTSTRAPPING
+#if defined(MIN_VERSION_ghc_internal)
#if MIN_VERSION_ghc_internal(9,1400,0)
instance Binary Heap.HalfWord where
put x = put (fromIntegral x :: Word32)
get = fromIntegral <$> (get :: Get Word32)
#endif
+#endif
-- Binary instances to support the GetClosure message
instance Binary Heap.StgTSOProfInfo
@@ -541,6 +550,7 @@ instance Binary Heap.StgInfoTable
instance Binary Heap.ClosureType
instance Binary Heap.PrimType
instance Binary a => Binary (Heap.GenClosure a)
+#endif
instance Binary InfoProv where
#if MIN_VERSION_base(4,20,0)
get = InfoProv <$> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get
@@ -593,7 +603,9 @@ getMessage = do
32 -> Msg <$> (RunModFinalizers <$> get <*> get)
33 -> Msg <$> (AddSptEntry <$> get <*> get)
34 -> Msg <$> (RunTH <$> get <*> get <*> get <*> get)
+#ifndef BOOTSTRAPPING
35 -> Msg <$> (GetClosure <$> get)
+#endif
36 -> Msg <$> (Seq <$> get)
37 -> Msg <$> return RtsRevertCAFs
38 -> Msg <$> (ResumeSeq <$> get)
@@ -639,7 +651,9 @@ putMessage m = case m of
RunModFinalizers a b -> putWord8 32 >> put a >> put b
AddSptEntry a b -> putWord8 33 >> put a >> put b
RunTH st q loc ty -> putWord8 34 >> put st >> put q >> put loc >> put ty
+#ifndef BOOTSTRAPPING
GetClosure a -> putWord8 35 >> put a
+#endif
Seq a -> putWord8 36 >> put a
RtsRevertCAFs -> putWord8 37
ResumeSeq a -> putWord8 38 >> put a
diff --git a/libraries/ghci/GHCi/Run.hs b/libraries/ghci/GHCi/Run.hs
index 03a57bdf777d..cb4096d364d6 100644
--- a/libraries/ghci/GHCi/Run.hs
+++ b/libraries/ghci/GHCi/Run.hs
@@ -37,7 +37,9 @@ import Data.ByteString (ByteString)
import qualified Data.ByteString.Short as BS
import qualified Data.ByteString.Unsafe as B
import GHC.Exts
+#ifndef BOOTSTRAPPING
import qualified GHC.Exts.Heap as Heap
+#endif
import GHC.Stack
import Foreign hiding (void)
import Foreign.C
@@ -114,9 +116,11 @@ run m = case m of
PrepFFI args res -> toRemotePtr <$> prepForeignCall args res
FreeFFI p -> freeForeignCallInfo (fromRemotePtr p)
StartTH -> startTH
+#ifndef BOOTSTRAPPING
GetClosure ref -> do
clos <- Heap.getClosureData =<< localRef ref
mapM (\(Heap.Box x) -> mkRemoteRef (HValue x)) clos
+#endif
WhereFrom ref ->
InfoProv.whereFrom =<< localRef ref
Seq ref -> doSeq ref
diff --git a/libraries/ghci/GHCi/TH.hs b/libraries/ghci/GHCi/TH.hs
index f15621f20d0d..534610aae780 100644
--- a/libraries/ghci/GHCi/TH.hs
+++ b/libraries/ghci/GHCi/TH.hs
@@ -1,6 +1,11 @@
{-# LANGUAGE ScopedTypeVariables, StandaloneDeriving, DeriveGeneric,
TupleSections, RecordWildCards, InstanceSigs, CPP #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+-- Suppress deprecation warnings only when we must import deprecated symbols
+-- (i.e. when ghc-internal isn't available yet).
+#ifndef HAVE_GHC_INTERNAL
+{-# OPTIONS_GHC -Wno-warnings-deprecations #-}
+#endif
-- |
-- Running TH splices
@@ -109,7 +114,12 @@ import Data.IORef
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe
+-- Prefer the non-deprecated internal path when available.
+#ifdef HAVE_GHC_INTERNAL
import GHC.Internal.Desugar (AnnotationWrapper(..))
+#else
+import GHC.Desugar (AnnotationWrapper(..))
+#endif
import qualified GHC.Boot.TH.Syntax as TH
import Unsafe.Coerce
diff --git a/libraries/ghci/ghci.cabal.in b/libraries/ghci/ghci.cabal.in
index f64365545a3f..cf8704a36c13 100644
--- a/libraries/ghci/ghci.cabal.in
+++ b/libraries/ghci/ghci.cabal.in
@@ -1,9 +1,10 @@
+cabal-version: 3.8
-- WARNING: ghci.cabal is automatically generated from ghci.cabal.in by
-- ../../configure. Make sure you are editing ghci.cabal.in, not ghci.cabal.
name: ghci
version: @ProjectVersionMunged@
-license: BSD3
+license: BSD-3-Clause
license-file: LICENSE
category: GHC
maintainer: ghc-devs@haskell.org
@@ -13,7 +14,6 @@ description:
This library offers interfaces which mediate interactions between the
@ghci@ interactive shell and @iserv@, GHC's out-of-process interpreter
backend.
-cabal-version: >=1.10
build-type: Simple
extra-source-files: changelog.md
@@ -31,6 +31,10 @@ Flag bootstrap
Default: False
Manual: True
+flag use-system-libffi
+ default: False
+ manual: True
+
source-repository head
type: git
location: https://gitlab.haskell.org/ghc/ghc.git
@@ -86,7 +90,6 @@ library
rts,
array == 0.5.*,
base >= 4.8 && < 4.23,
- ghc-internal >= 9.1001.0 && <=@ProjectVersionForLib@.0,
ghc-prim >= 0.5.0 && < 0.14,
binary == 0.8.*,
bytestring >= 0.10 && < 0.13,
@@ -94,15 +97,40 @@ library
deepseq >= 1.4 && < 1.6,
filepath >= 1.4 && < 1.6,
ghc-boot == @ProjectVersionMunged@,
- ghc-heap >= 9.10.1 && <=@ProjectVersionMunged@,
transformers >= 0.5 && < 0.7
+ -- libffi is not available on JS (no native RTS) or WASM/WASI (libffi's
+ -- WASM support is Emscripten-only; the WASI sysroot has no libffi).
+ -- See Note [FFI for the JS-Backend and WASM-Backend] in GHCi/FFI.hsc.
+ if !arch(javascript) && !arch(wasm32)
+ if flag(use-system-libffi)
+ extra-libraries: ffi
+ extra-libraries-static: ffi
+ else
+ build-depends: libffi-clib
+
+ if impl(ghc > 9.10)
+ -- ghc-internal is only available (and required) when building
+ -- with a compiler that itself provides the ghc-internal
+ -- library. Older bootstrap compilers (<= 9.10) don't ship it,
+ -- so we must not depend on it in that case.
+ --
+ -- When available we depend on the in-tree version (matching
+ -- @ProjectVersionForLib@) and define HAVE_GHC_INTERNAL so that
+ -- sources can import the non-deprecated modules from
+ -- GHC.Internal.* instead of the legacy (deprecated) locations.
+ Build-Depends:
+ ghc-internal >= 9.1001.0 && <=@ProjectVersionForLib@.0
+ CPP-Options: -DHAVE_GHC_INTERNAL
+
if flag(bootstrap)
+ CPP-Options: -DBOOTSTRAPPING
build-depends:
ghc-boot-th-next == @ProjectVersionMunged@
else
build-depends:
- ghc-boot-th == @ProjectVersionMunged@
+ ghc-boot-th == @ProjectVersionMunged@,
+ ghc-heap >= 9.10.1 && <=@ProjectVersionMunged@
if !os(windows)
Build-Depends: unix >= 2.7 && < 2.9
diff --git a/libraries/haskeline b/libraries/haskeline
deleted file mode 160000
index 991953cd5d3b..000000000000
--- a/libraries/haskeline
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit 991953cd5d3bb9e8057de4a0d8f2cae3455865d8
diff --git a/libraries/hpc b/libraries/hpc
deleted file mode 160000
index 12675279dc5c..000000000000
--- a/libraries/hpc
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit 12675279dc5cbea4ade8b5157b080390d598f03f
diff --git a/libraries/mtl b/libraries/mtl
deleted file mode 160000
index 37cbd924cb71..000000000000
--- a/libraries/mtl
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit 37cbd924cb71eba591a2e2b6b131767f632d22c9
diff --git a/libraries/os-string b/libraries/os-string
deleted file mode 160000
index c08666bf7bf5..000000000000
--- a/libraries/os-string
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit c08666bf7bf528e607fc1eacc20032ec59e69df3
diff --git a/libraries/parsec b/libraries/parsec
deleted file mode 160000
index 552730e23e1f..000000000000
--- a/libraries/parsec
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit 552730e23e1fd2dae46a60d75138b8d173492462
diff --git a/libraries/pretty b/libraries/pretty
deleted file mode 160000
index c3a1469306b3..000000000000
--- a/libraries/pretty
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit c3a1469306b35fa5d023dc570554f97f1a90435d
diff --git a/libraries/process b/libraries/process
deleted file mode 160000
index ae50731b5fb2..000000000000
--- a/libraries/process
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit ae50731b5fb221a7631f7e9d818fc6716c85c51e
diff --git a/libraries/semaphore-compat b/libraries/semaphore-compat
deleted file mode 160000
index ba87d1bb0209..000000000000
--- a/libraries/semaphore-compat
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit ba87d1bb0209bd9f29bda1c878ddf345f8a2b199
diff --git a/libraries/stm b/libraries/stm
deleted file mode 160000
index 23bdcc231996..000000000000
--- a/libraries/stm
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit 23bdcc2319965911af28542e76fc01f37c107d40
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/libraries/template-haskell-lift b/libraries/template-haskell-lift
deleted file mode 160000
index 06c18dfc2d68..000000000000
--- a/libraries/template-haskell-lift
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit 06c18dfc2d689baabf0e923e3fb9483ac89b8d01
diff --git a/libraries/template-haskell-quasiquoter b/libraries/template-haskell-quasiquoter
deleted file mode 160000
index 65246071e828..000000000000
--- a/libraries/template-haskell-quasiquoter
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit 65246071e82819aa27922c1172861ba346612230
diff --git a/libraries/terminfo b/libraries/terminfo
deleted file mode 160000
index 16db154e3e97..000000000000
--- a/libraries/terminfo
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit 16db154e3e97e6bff62329574163851a7090f3b6
diff --git a/libraries/text b/libraries/text
deleted file mode 160000
index 5f343f668f42..000000000000
--- a/libraries/text
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit 5f343f668f421bfb30cead594e52d0ac6206ff67
diff --git a/libraries/time b/libraries/time
deleted file mode 160000
index 507f50844802..000000000000
--- a/libraries/time
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit 507f50844802f1469ba6cadfeefd4e3fecee0416
diff --git a/libraries/transformers b/libraries/transformers
deleted file mode 160000
index cee47cca7705..000000000000
--- a/libraries/transformers
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit cee47cca7705edafe0a5839439e679edbd61890a
diff --git a/libraries/unix b/libraries/unix
deleted file mode 160000
index 60f432b76871..000000000000
--- a/libraries/unix
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit 60f432b76871bd7787df07dd3e2a567caba393f5
diff --git a/libraries/xhtml b/libraries/xhtml
deleted file mode 160000
index 68353ccd1a2e..000000000000
--- a/libraries/xhtml
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit 68353ccd1a2e776d6c2b11619265d8140bb7dc07
diff --git a/m4/fp_check_pthreads.m4 b/m4/fp_check_pthreads.m4
index 55657f60b550..ab007fc01887 100644
--- a/m4/fp_check_pthreads.m4
+++ b/m4/fp_check_pthreads.m4
@@ -12,22 +12,7 @@ AC_DEFUN([FP_CHECK_PTHREAD_LIB],
dnl
dnl Note that it is important that this happens before we AC_CHECK_LIB(thread)
AC_MSG_CHECKING(whether -lpthread is needed for pthreads)
- AC_CHECK_FUNC(pthread_create,
- [
- AC_MSG_RESULT(no)
- UseLibpthread=NO
- ],
- [
- AC_CHECK_LIB(pthread, pthread_create,
- [
- AC_MSG_RESULT(yes)
- UseLibpthread=YES
- ],
- [
- AC_MSG_RESULT([no pthreads support found.])
- UseLibpthread=NO
- ])
- ])
+ AC_SEARCH_LIBS([pthread_create],[pthread])
])
# FP_CHECK_PTHREAD_FUNCS
@@ -37,6 +22,7 @@ AC_DEFUN([FP_CHECK_PTHREAD_LIB],
# `AC_DEFINE`s various C `HAVE_*` macros.
AC_DEFUN([FP_CHECK_PTHREAD_FUNCS],
[
+ OLD_LIBS=$LIBS
dnl Setting thread names
dnl ~~~~~~~~~~~~~~~~~~~~
dnl The portability situation here is complicated:
@@ -123,4 +109,5 @@ AC_DEFUN([FP_CHECK_PTHREAD_FUNCS],
)
AC_CHECK_FUNCS_ONCE([pthread_condattr_setclock])
+ LIBS=$OLD_LIBS
])
diff --git a/m4/fp_linker_supports_verbatim.m4 b/m4/fp_linker_supports_verbatim.m4
new file mode 100644
index 000000000000..1d0780ea999e
--- /dev/null
+++ b/m4/fp_linker_supports_verbatim.m4
@@ -0,0 +1,60 @@
+# Checks whether the linker supports '-l:libfoo.a' syntax
+# via invoking the C compiler.
+AC_DEFUN([LINKER_SUPPORTS_VERBATIM_LINKING],[
+ AC_MSG_CHECKING([whether linker supports -l:libfoo.a])
+
+ # autoconf macros don't give us enough flexibility to run this test:
+ #
+ # * we need to manually create a static archive
+ # * link against said static archive via custom linker options
+ test_verbatim() {
+ # from https://www.gnu.org/software/autoconf/manual/autoconf-2.68/html_node/Limitations-of-Usual-Tools.html
+ # Create a temporary directory $dir in $TMPDIR (default /tmp).
+ # Use mktemp if possible; otherwise fall back on mkdir,
+ # with $RANDOM to make collisions less likely.
+ : "${TMPDIR:=/tmp}"
+ {
+ dir=$(umask 077 && mktemp -d "$TMPDIR/fooXXXXXX") 2>/dev/null &&
+ test -d "$dir"
+ } || {
+ dir=$TMPDIR/foo$$-$RANDOM
+
+ (umask 077 && mkdir "$dir")
+ } || exit $?
+
+ cat > "${dir}/test.c" << EOF
+void my_func(void) {
+ /* A simple function to be archived */
+}
+EOF
+
+ cat > ${dir}/main.c << EOF
+void my_func(void);
+int main(void) {
+ my_func();
+ return 0;
+}
+EOF
+
+ $CC -c "${dir}/test.c" -o "${dir}/test.o"
+ $AR q "${dir}/libtest.a" "${dir}/test.o"
+ $RANLIB "${dir}/libtest.a"
+ $CC "${dir}/main.c" -o "${dir}/main" "-L${dir}" -l:libtest.a || return 1
+
+ rm -f "${dir}/test.c" "${dir}/test.o" "${dir}/libtest.a" "${dir}/main.c" "${dir}/main"
+ rmdir "${dir}"
+ }
+
+test_verbatim >&AS_MESSAGE_LOG_FD 2>&1
+status=$?
+
+if test $status -ne 0 ; then
+ AC_MSG_RESULT([no])
+ AC_SUBST([LdSupportsVerbatimNamespace], [NO])
+else
+ AC_MSG_RESULT([yes])
+ AC_SUBST([LdSupportsVerbatimNamespace], [YES])
+fi
+
+]
+)
diff --git a/m4/prep_target_file.m4 b/m4/prep_target_file.m4
index 1d5a115fd130..c0f6312376f4 100644
--- a/m4/prep_target_file.m4
+++ b/m4/prep_target_file.m4
@@ -152,6 +152,7 @@ AC_DEFUN([PREP_TARGET_FILE],[
PREP_BOOLEAN([LdHasFilelist])
PREP_BOOLEAN([LdHasSingleModule])
PREP_BOOLEAN([LdIsGNULd])
+ PREP_BOOLEAN([LdSupportsVerbatimNamespace])
PREP_BOOLEAN([LdHasNoCompactUnwind])
PREP_BOOLEAN([TargetHasSubsectionsViaSymbols])
PREP_BOOLEAN([Unregisterised])
diff --git a/mk/collect-metrics.sh b/mk/collect-metrics.sh
new file mode 100755
index 000000000000..f40f9f6f2aa5
--- /dev/null
+++ b/mk/collect-metrics.sh
@@ -0,0 +1,246 @@
+#!/usr/bin/env bash
+# collect-metrics.sh - Collect CPU and memory metrics during build
+#
+# Bash dependency: uses bash features (<<<, [[ ]], local) — bash is
+# guaranteed in CI where this script runs (GitHub Actions, Hydra).
+#
+# Usage: collect-metrics.sh start [METRICS_DIR] [INTERVAL]
+# collect-metrics.sh stop
+#
+# Commands:
+# start - Start collecting metrics (runs in background)
+# stop - Stop metrics collection
+#
+# Arguments:
+# METRICS_DIR - Directory for metrics output (default: _build/metrics)
+# INTERVAL - Sample interval in seconds (default: 0.5)
+#
+# Output files:
+# $METRICS_DIR/metrics.csv - CSV with timestamp, cpu%, mem_used_mb, mem_total_mb
+# $METRICS_DIR/collector.pid - PID file for the collector process
+
+set -uo pipefail
+
+CMD="${1:-}"
+METRICS_DIR="${2:-_build/metrics}"
+INTERVAL="${3:-0.5}"
+
+PID_FILE="$METRICS_DIR/collector.pid"
+METRICS_FILE="$METRICS_DIR/metrics.csv"
+
+# Detect OS for platform-specific commands
+OS="$(uname -s)"
+
+# State file for CPU delta calculation (Linux only).
+# Format: '$total $idle' (two space-separated integers from /proc/stat).
+# Initialized here so the path is visible at the top of the script;
+# run_collector() clears the file before the first sample.
+CPU_STATE_FILE="$METRICS_DIR/.cpu_state"
+
+# ---------------------------------------------------------------------------
+# CPU helpers
+# ---------------------------------------------------------------------------
+
+# macOS: sum per-process CPU usage via ps.
+# kern.cp_time is FreeBSD-only and doesn't exist on macOS, so we fall
+# back to aggregating per-process values.
+# Use absolute path — nix devx shell may not include /bin in PATH.
+# Use POSIX 'pcpu' keyword (not '%cpu') for portability.
+# NR>1 skips the header line that ps prints.
+get_cpu_usage_darwin() {
+ /bin/ps -A -o pcpu 2>/dev/null \
+ | awk 'NR>1 {sum += $1} END {printf "%.1f", sum}' \
+ || { echo "Error: ps -A -o pcpu failed" >&2; exit 1; }
+}
+
+# Linux: calculate from /proc/stat with delta.
+# /proc/stat format:
+# cpu [steal] [guest] [guest_nice]
+get_cpu_usage_linux() {
+ # Guard: /proc/stat may be absent in minimal containers (e.g. scratch
+ # Docker images without procfs mounted). Fail loudly — if we can't
+ # sample CPU, the metrics are useless and the CI job should notice.
+ if [[ ! -f /proc/stat ]]; then
+ echo "Error: /proc/stat not found (procfs not mounted?)" >&2
+ exit 1
+ fi
+
+ local line
+ read -r line < /proc/stat
+
+ # Parse fields — use named variable for label instead of _ (special bash variable).
+ # /proc/stat has 10 numeric fields; we only need the first 7 for CPU calculation.
+ # The 'rest' variable captures any additional fields (steal, guest, guest_nice).
+ local label user nice sys idle iowait irq softirq rest
+ read label user nice sys idle iowait irq softirq rest <<< "$line"
+
+ # Validate we got numeric values (guards against parse failures)
+ if [[ -z "$user" || -z "$idle" ]]; then
+ echo "Error: failed to parse /proc/stat" >&2
+ exit 1
+ fi
+
+ local total=$((user + nice + sys + idle + iowait + irq + softirq))
+
+ if [[ -f "$CPU_STATE_FILE" ]]; then
+ local prev_total prev_idle
+ read prev_total prev_idle < "$CPU_STATE_FILE"
+ local delta_total=$((total - prev_total))
+ local delta_idle=$((idle - prev_idle))
+ if [[ $delta_total -gt 0 ]]; then
+ echo "$total $idle" > "$CPU_STATE_FILE"
+ awk "BEGIN {printf \"%.1f\", 100 * (1 - $delta_idle / $delta_total)}"
+ return
+ fi
+ fi
+
+ echo "$total $idle" > "$CPU_STATE_FILE"
+ if [[ $total -gt 0 ]]; then
+ awk "BEGIN {printf \"%.1f\", 100 * (1 - $idle / $total)}"
+ else
+ echo "Error: /proc/stat total CPU time is zero" >&2
+ exit 1
+ fi
+}
+
+# Get CPU usage percentage (cross-platform).
+# Dispatches to the platform-specific helper.
+# Prints CPU usage percentage (float) to stdout.
+get_cpu_usage() {
+ case "$OS" in
+ Darwin) get_cpu_usage_darwin ;;
+ Linux) get_cpu_usage_linux ;;
+ *) echo "Error: unsupported OS '$OS' for CPU metrics" >&2; exit 1 ;;
+ esac
+}
+
+# ---------------------------------------------------------------------------
+# Memory helpers
+# ---------------------------------------------------------------------------
+
+# macOS: use vm_stat and sysctl with absolute paths.
+# Nix devx shell may not include /usr/bin or /usr/sbin in PATH.
+# Prints used_mb,total_mb to stdout.
+get_memory_usage_darwin() {
+ local page_size total_mb
+ page_size=$(/usr/sbin/sysctl -n hw.pagesize 2>/dev/null) \
+ || { echo "Error: sysctl hw.pagesize failed" >&2; exit 1; }
+ total_mb=$(( $(/usr/sbin/sysctl -n hw.memsize 2>/dev/null \
+ || { echo "Error: sysctl hw.memsize failed" >&2; exit 1; }) / 1024 / 1024 ))
+
+ # Parse vm_stat output — use $NF (last field) so the varying label
+ # column count doesn't matter.
+ # The '+ 0' strips the trailing period that vm_stat appends to each
+ # numeric value (e.g. "1234." becomes 1234).
+ /usr/bin/vm_stat 2>/dev/null \
+ | awk -v ps="$page_size" -v total="$total_mb" '
+ /Pages active/ { active = $NF + 0 }
+ /Pages wired/ { wired = $NF + 0 }
+ /Pages stored in compressor/ { compressed = $NF + 0 }
+ END {
+ used_mb = int((active + wired + compressed) * ps / 1024 / 1024)
+ printf "%d,%d", used_mb, total
+ }
+ ' \
+ || { echo "Error: vm_stat failed" >&2; exit 1; }
+}
+
+# Linux: parse /proc/meminfo.
+# Prints used_mb,total_mb to stdout.
+get_memory_usage_linux() {
+ if [[ ! -f /proc/meminfo ]]; then
+ echo "Error: /proc/meminfo not found (procfs not mounted?)" >&2
+ exit 1
+ fi
+
+ awk '
+ /^MemTotal:/ { total = $2 }
+ /^MemAvailable:/ { available = $2 }
+ END {
+ total_mb = int(total / 1024)
+ used_mb = int((total - available) / 1024)
+ printf "%d,%d", used_mb, total_mb
+ }
+ ' /proc/meminfo \
+ || { echo "Error: failed to parse /proc/meminfo" >&2; exit 1; }
+}
+
+# Get memory usage in MB (cross-platform).
+# Dispatches to the platform-specific helper.
+# Prints used_mb,total_mb (CSV integers) to stdout.
+get_memory_usage() {
+ case "$OS" in
+ Darwin) get_memory_usage_darwin ;;
+ Linux) get_memory_usage_linux ;;
+ *) echo "Error: unsupported OS '$OS' for memory metrics" >&2; exit 1 ;;
+ esac
+}
+
+# ---------------------------------------------------------------------------
+# Collector loop
+# ---------------------------------------------------------------------------
+
+run_collector() {
+ mkdir -p "$METRICS_DIR"
+
+ # Clear any stale CPU state from a previous run
+ rm -f "$CPU_STATE_FILE"
+
+ # Write CSV header
+ echo "timestamp,cpu_percent,mem_used_mb,mem_total_mb" > "$METRICS_FILE"
+
+ while true; do
+ timestamp=$(date +%s)
+ cpu=$(get_cpu_usage)
+ mem=$(get_memory_usage)
+
+ echo "$timestamp,$cpu,$mem" >> "$METRICS_FILE"
+ sleep "$INTERVAL"
+ done
+}
+
+# ---------------------------------------------------------------------------
+# Entry point
+# ---------------------------------------------------------------------------
+
+case "$CMD" in
+ start)
+ mkdir -p "$METRICS_DIR"
+
+ # Stop any existing collector
+ if [[ -f "$PID_FILE" ]]; then
+ old_pid=$(cat "$PID_FILE")
+ kill "$old_pid" 2>/dev/null || true
+ rm -f "$PID_FILE"
+ fi
+
+ # Start collector in background
+ run_collector &
+ collector_pid=$!
+ echo "$collector_pid" > "$PID_FILE"
+ echo "Started metrics collector (PID: $collector_pid, interval: ${INTERVAL}s)"
+ echo "Output: $METRICS_FILE"
+ ;;
+
+ stop)
+ if [[ -f "$PID_FILE" ]]; then
+ pid=$(cat "$PID_FILE")
+ # SIGTERM is sufficient — the collector is a simple sleep loop
+ # with no signal handlers or cleanup requirements.
+ if kill "$pid" 2>/dev/null; then
+ echo "Stopped metrics collector (PID: $pid)"
+ else
+ echo "Collector process $pid not running"
+ fi
+ rm -f "$PID_FILE"
+ else
+ echo "No collector PID file found"
+ fi
+ ;;
+
+ *)
+ echo "Usage: $0 start [METRICS_DIR] [INTERVAL]"
+ echo " $0 stop"
+ exit 1
+ ;;
+esac
diff --git a/mk/detect-cpu-count.sh b/mk/detect-cpu-count.sh
index abc47387d16d..b919c52370dc 100755
--- a/mk/detect-cpu-count.sh
+++ b/mk/detect-cpu-count.sh
@@ -6,6 +6,11 @@ detect_cpu_count () {
CPUS="$NUMBER_OF_PROCESSORS"
fi
+ # macOS / BSD — use absolute path to avoid PATH issues in nix devx shell
+ if [ "$CPUS" = "" ]; then
+ CPUS=`/usr/sbin/sysctl -n hw.ncpu 2>/dev/null`
+ fi
+
if [ "$CPUS" = "" ]; then
# Linux
CPUS=`getconf _NPROCESSORS_ONLN 2>/dev/null`
diff --git a/mk/plot-metrics.py b/mk/plot-metrics.py
new file mode 100644
index 000000000000..47ac3c741a02
--- /dev/null
+++ b/mk/plot-metrics.py
@@ -0,0 +1,479 @@
+#!/usr/bin/env python3
+"""
+plot-metrics.py - Generate build metrics visualization
+
+Usage: plot-metrics.py METRICS_DIR TIMING_DIR [OUTPUT_PREFIX]
+
+Arguments:
+ METRICS_DIR - Directory containing metrics.csv
+ TIMING_DIR - Directory containing phase timing files (.start, .end)
+ OUTPUT_PREFIX - Output file prefix (default: METRICS_DIR/build-metrics)
+ Generates: PREFIX-build.svg and PREFIX-test.svg
+
+Creates dual-axis plots showing:
+ - CPU usage over time (left axis, blue)
+ - Memory usage over time (right axis, green)
+ - Phase markers with shaded regions and labels
+
+Two separate plots are generated:
+ - Build plot: cabal, stage1, stage2, stage3-* phases (with sub-phases)
+ - Test plot: test phase only
+"""
+
+import sys
+import os
+import csv
+import colorsys
+import hashlib
+from datetime import datetime, timedelta
+from pathlib import Path
+
+# Try to import matplotlib, provide helpful error if not available
+try:
+ import matplotlib
+ matplotlib.use('Agg') # Non-interactive backend for headless use
+ import matplotlib.pyplot as plt
+ import matplotlib.dates as mdates
+ from matplotlib.patches import Rectangle
+except ImportError:
+ print("Error: matplotlib is required. Install with:")
+ print(" nix run nixpkgs#python3Packages.matplotlib -- mk/plot-metrics.py ...")
+ print(" # or: pip install matplotlib")
+ sys.exit(1)
+
+# ---------------------------------------------------------------------------
+# Data pipeline overview
+#
+# The script processes metrics in five stages:
+#
+# 1. COLLECT — mk/collect-metrics.sh samples CPU% and memory at a fixed
+# interval and writes rows to metrics.csv.
+# 2. READ — read_metrics() / read_phases() parse the CSV and the
+# per-phase .start/.end timestamp files into lists.
+# 3. SELECT — select_display_phases() decides which phases to render:
+# sub-phases replace their parent when available.
+# 4. FILTER — filter_metrics_for_phases() trims the time-series to the
+# window covered by the selected phases (±30 s margin).
+# 5. PLOT — create_plot() renders a dual-axis (CPU + memory) SVG with
+# phase shading and labels.
+# ---------------------------------------------------------------------------
+
+
+def read_metrics(metrics_file):
+ """Read metrics CSV file and return timestamps, cpu, and memory data."""
+ timestamps = []
+ cpu_percent = []
+ mem_used_mb = []
+ mem_total_mb = []
+
+ with open(metrics_file, 'r') as f:
+ reader = csv.DictReader(f)
+ for row in reader:
+ try:
+ ts = int(row['timestamp'])
+ timestamps.append(datetime.fromtimestamp(ts))
+ cpu_percent.append(float(row['cpu_percent']))
+ mem_used_mb.append(float(row['mem_used_mb']))
+ mem_total_mb.append(float(row['mem_total_mb']))
+ except (ValueError, KeyError) as e:
+ continue # Skip malformed rows
+
+ return timestamps, cpu_percent, mem_used_mb, mem_total_mb
+
+
+def read_phases(timing_dir):
+ """Read phase timing files and return list of (name, start_time, end_time, status)."""
+ phases = []
+ timing_path = Path(timing_dir)
+
+ # Find all .start files
+ for start_file in timing_path.glob('*.start'):
+ phase_name = start_file.stem
+ end_file = timing_path / f"{phase_name}.end"
+ status_file = timing_path / f"{phase_name}.status"
+
+ if not end_file.exists():
+ continue
+
+ try:
+ with open(start_file) as f:
+ start_ts = int(f.read().strip())
+ with open(end_file) as f:
+ end_ts = int(f.read().strip())
+
+ status = "OK"
+ if status_file.exists():
+ with open(status_file) as f:
+ status = "FAIL" if f.read().strip() == "1" else "OK"
+
+ phases.append((
+ phase_name,
+ datetime.fromtimestamp(start_ts),
+ datetime.fromtimestamp(end_ts),
+ status
+ ))
+ except (ValueError, IOError):
+ continue
+
+ # Sort by start time
+ phases.sort(key=lambda x: x[1])
+ return phases
+
+
+def format_duration(seconds):
+ """Format duration in human-readable form."""
+ if seconds < 60:
+ return f"{seconds}s"
+ elif seconds < 3600:
+ mins = seconds // 60
+ secs = seconds % 60
+ return f"{mins}m {secs}s"
+ else:
+ hours = seconds // 3600
+ mins = (seconds % 3600) // 60
+ return f"{hours}h {mins}m"
+
+
+def _vary_color(hex_color, index, total):
+ """Generate a color variation for sub-phase `index` of `total`.
+
+ Shifts HLS lightness up/down symmetrically around the base color so
+ that adjacent sub-phases are visually distinct.
+ """
+ if total <= 1:
+ return hex_color
+ r, g, b = matplotlib.colors.to_rgb(hex_color)
+ h, l, s = colorsys.rgb_to_hls(r, g, b)
+ # Spread from -0.15 to +0.15 lightness shift
+ t = (index / (total - 1)) - 0.5 # [-0.5, 0.5]
+ l = min(max(l + t * 0.30, 0.0), 1.0)
+ return matplotlib.colors.to_hex(colorsys.hls_to_rgb(h, l, s))
+
+
+# Top-level build phase names (and prefixes for stage3-*)
+_BUILD_PARENTS = {'cabal', 'stage1', 'stage2'}
+
+# Base colors for top-level phases
+_PHASE_COLORS = {
+ 'cabal': '#FFD700', # Gold
+ 'stage1': '#FF6B6B', # Red
+ 'stage2': '#4ECDC4', # Teal
+ 'test': '#DDA0DD', # Plum
+}
+_STAGE3_PALETTE = ['#FF8C42', '#6A0572', '#1B998B', '#E55934']
+
+
+def _parent_of(name):
+ """Return the parent phase name, or None if top-level.
+
+ 'stage2.rts' -> 'stage2'
+ 'stage3-x86_64-linux.libraries' -> 'stage3-x86_64-linux'
+ 'cabal' -> None
+ """
+ if '.' in name:
+ return name.rsplit('.', 1)[0]
+ return None
+
+
+def _base_color_for(name):
+ """Return the base color for a phase (top-level or sub-phase)."""
+ parent = _parent_of(name)
+ lookup = parent if parent else name
+ if lookup in _PHASE_COLORS:
+ return _PHASE_COLORS[lookup]
+ if lookup.startswith('stage3-'):
+ idx = int(hashlib.sha256(lookup.encode()).hexdigest(), 16) % len(_STAGE3_PALETTE)
+ return _STAGE3_PALETTE[idx]
+ return '#CCCCCC'
+
+
+def select_display_phases(all_phases):
+ """Choose which phases to display in the build plot.
+
+ When sub-phases exist for a parent (e.g. stage2.rts, stage2.libraries),
+ show only the sub-phases — they're more informative.
+ When no sub-phases exist (e.g. cabal), show the parent phase.
+ """
+ # Determine which parents have sub-phases
+ parents_with_subs = set()
+ for name, _, _, _ in all_phases:
+ parent = _parent_of(name)
+ if parent is not None:
+ parents_with_subs.add(parent)
+
+ result = []
+ for phase in all_phases:
+ name = phase[0]
+ parent = _parent_of(name)
+ if parent is not None:
+ # This IS a sub-phase — always include it
+ result.append(phase)
+ elif name not in parents_with_subs:
+ # Top-level phase with no sub-phases — include it
+ result.append(phase)
+ # else: top-level with sub-phases — skip (sub-phases cover it)
+
+ return result
+
+
+def _display_label(name):
+ """Produce a short display label for a phase.
+
+ Sub-phases strip the parent prefix for readability:
+ 'stage2.rts' -> 'rts'
+ 'stage2.executables' -> 'executables'
+ 'cabal' -> 'cabal'
+ """
+ if '.' in name:
+ return name.rsplit('.', 1)[1]
+ return name
+
+
+def create_plot(timestamps, cpu, mem_used, mem_total, phases, title, output_file):
+ """Create a dual-axis metrics plot and save it as SVG.
+
+ Left y-axis: CPU usage (%) — on multi-core machines CPU can exceed
+ 100%, so the axis scales to ``effective_cores * 100``.
+ Right y-axis: Memory used (GB).
+
+ Each phase is drawn as a translucent shaded region with a dashed
+ vertical line at its start. Labels alternate between two y-positions
+ (top / slightly below top) so that narrow adjacent phases don't
+ overlap each other's text.
+
+ Args:
+ timestamps: list[datetime] — sample times.
+ cpu: list[float] — CPU percentage per sample.
+ mem_used: list[float] — used memory in MB per sample.
+ mem_total: list[float] — total memory in MB per sample.
+ phases: list of (name, start, end, status) tuples.
+ title: str — plot title text.
+ output_file: str — destination path (SVG).
+ """
+ cpu_color = '#2E86AB' # Blue
+ mem_color = '#28A745' # Green
+
+ # Create figure with dual y-axes — wider aspect ratio (20:6)
+ fig, ax1 = plt.subplots(figsize=(20, 6))
+
+ # On multi-core machines ps / /proc/stat report aggregate CPU%, so a
+ # 4-core box fully loaded reads ~400%. We derive the effective core
+ # count from the peak value and scale the y-axis to cores*100 so the
+ # chart fills the available space without clipping.
+ max_cpu = max(cpu) if cpu else 100
+ effective_cores = int((max_cpu + 99) // 100) # ceil(max_cpu / 100)
+ cpu_limit = effective_cores * 100
+
+ # Plot CPU usage
+ ax1.set_xlabel('Time', fontsize=11)
+ ax1.set_ylabel(f'CPU Usage (%, {effective_cores} cores)', color=cpu_color, fontsize=11)
+ line1, = ax1.plot(timestamps, cpu, color=cpu_color, linewidth=1.2, alpha=0.8, label='CPU %')
+ ax1.tick_params(axis='y', labelcolor=cpu_color)
+ ax1.set_ylim(0, cpu_limit * 1.05)
+ ax1.grid(True, alpha=0.3)
+
+ # Create second y-axis for memory
+ ax2 = ax1.twinx()
+ ax2.set_ylabel('Memory Used (GB)', color=mem_color, fontsize=11)
+ mem_gb = [m / 1024 for m in mem_used]
+ line2, = ax2.plot(timestamps, mem_gb, color=mem_color, linewidth=1.2, alpha=0.8, label='Memory (GB)')
+ ax2.tick_params(axis='y', labelcolor=mem_color)
+
+ # Set memory y-axis limit based on total memory
+ if mem_total:
+ max_mem_gb = max(mem_total) / 1024
+ ax2.set_ylim(0, max_mem_gb * 1.1)
+
+ # Assign colors to phases. Sub-phases inherit their parent's base
+ # color (_base_color_for) and get a lightness variation via
+ # _vary_color() so that e.g. stage2.rts / stage2.libraries /
+ # stage2.executables are visually distinct yet clearly related.
+ # Top-level phases without sub-phases use the base color directly.
+ parent_groups = {}
+ for name, _, _, _ in phases:
+ parent = _parent_of(name)
+ if parent is not None:
+ parent_groups.setdefault(parent, []).append(name)
+
+ def color_for(name):
+ parent = _parent_of(name)
+ if parent is not None and parent in parent_groups:
+ siblings = parent_groups[parent]
+ idx = siblings.index(name)
+ return _vary_color(_base_color_for(name), idx, len(siblings))
+ return _base_color_for(name)
+
+ # Add phase markers as shaded regions
+ if phases and timestamps:
+ plot_start = timestamps[0]
+ plot_end = timestamps[-1]
+
+ for phase_idx, (phase_name, start, end, status) in enumerate(phases):
+ # Clamp to plot range
+ if end < plot_start or start > plot_end:
+ continue
+
+ start = max(start, plot_start)
+ end = min(end, plot_end)
+
+ color = color_for(phase_name)
+
+ # Add shaded region
+ ax1.axvspan(start, end, alpha=0.2, color=color)
+
+ # Add vertical line at phase start
+ ax1.axvline(x=start, color=color, linestyle='--', linewidth=1, alpha=0.7)
+
+ # Label positioning — alternate between two y-positions (top of
+ # chart vs slightly below) for even/odd phase indices. This
+ # prevents text overlap when consecutive phases are narrow and
+ # their labels would otherwise sit on top of each other.
+ mid_time = start + (end - start) / 2
+ duration = int((end - start).total_seconds())
+ duration_str = format_duration(duration)
+ status_marker = '\u2713' if status == 'OK' else '\u2717'
+ label = _display_label(phase_name)
+
+ if phase_idx % 2 == 0:
+ y_pos = cpu_limit
+ va = 'top'
+ else:
+ y_pos = cpu_limit * 0.88
+ va = 'bottom'
+
+ ax1.annotate(
+ f'{label}\n{duration_str} {status_marker}',
+ xy=(mid_time, y_pos),
+ fontsize=9,
+ ha='center',
+ va=va,
+ bbox=dict(boxstyle='round,pad=0.3', facecolor=color, alpha=0.7)
+ )
+
+ # Format x-axis
+ ax1.xaxis.set_major_formatter(mdates.DateFormatter('%H:%M'))
+ ax1.xaxis.set_major_locator(mdates.AutoDateLocator())
+ plt.xticks(rotation=45)
+
+ # Title
+ plt.title(title, fontsize=13, fontweight='bold')
+
+ # Legend
+ lines = [line1, line2]
+ labels = ['CPU Usage (%)', 'Memory Used (GB)']
+ ax1.legend(lines, labels, loc='upper left', framealpha=0.9)
+
+ # Tight layout
+ plt.tight_layout()
+
+ # Save as SVG
+ plt.savefig(output_file, format='svg', bbox_inches='tight')
+ plt.close(fig)
+ print(f"Plot saved to: {output_file}")
+
+
+def filter_metrics_for_phases(timestamps, cpu, mem_used, mem_total, phases):
+ """Filter metrics data to only include time range covered by phases."""
+ if not phases or not timestamps:
+ return timestamps, cpu, mem_used, mem_total
+
+ # Get time range from phases
+ phase_start = min(p[1] for p in phases)
+ phase_end = max(p[2] for p in phases)
+
+ # Add some margin (30 seconds before and after)
+ margin = timedelta(seconds=30)
+ range_start = phase_start - margin
+ range_end = phase_end + margin
+
+ # Filter data
+ filtered = [(t, c, m, mt) for t, c, m, mt in zip(timestamps, cpu, mem_used, mem_total)
+ if range_start <= t <= range_end]
+
+ if not filtered:
+ return timestamps, cpu, mem_used, mem_total
+
+ return zip(*filtered)
+
+
+def _is_build_phase(name):
+ """Return True if `name` is a build-related phase (top-level or sub-phase)."""
+ top = name.split('.')[0] # 'stage2.rts' -> 'stage2'
+ return top in _BUILD_PARENTS or top.startswith('stage3-')
+
+
+def plot_metrics(metrics_dir, timing_dir, output_prefix):
+ """Generate the metrics plots (build and test separately)."""
+ metrics_file = Path(metrics_dir) / 'metrics.csv'
+
+ if not metrics_file.exists():
+ print(f"Error: Metrics file not found: {metrics_file}")
+ sys.exit(1)
+
+ # Read data
+ timestamps, cpu, mem_used, mem_total = read_metrics(metrics_file)
+ all_phases = read_phases(timing_dir)
+
+ if not timestamps:
+ print("Error: No metrics data found")
+ sys.exit(1)
+
+ # Choose which phases to show — prefer sub-phases over parents
+ display_phases = select_display_phases(all_phases)
+
+ build_phases = [p for p in display_phases if _is_build_phase(p[0])]
+ test_phases = [p for p in display_phases if p[0] == 'test']
+
+ # Generate build plot
+ if build_phases:
+ ts_build, cpu_build, mem_build, mem_total_build = filter_metrics_for_phases(
+ timestamps, cpu, mem_used, mem_total, build_phases)
+ ts_build, cpu_build, mem_build, mem_total_build = list(ts_build), list(cpu_build), list(mem_build), list(mem_total_build)
+
+ build_duration = int((build_phases[-1][2] - build_phases[0][1]).total_seconds())
+ build_title = f'GHC Build Metrics - Total: {format_duration(build_duration)}'
+ build_output = f"{output_prefix}-build.svg"
+ create_plot(ts_build, cpu_build, mem_build, mem_total_build,
+ build_phases, build_title, build_output)
+
+ # Generate test plot
+ if test_phases:
+ ts_test, cpu_test, mem_test, mem_total_test = filter_metrics_for_phases(
+ timestamps, cpu, mem_used, mem_total, test_phases)
+ ts_test, cpu_test, mem_test, mem_total_test = list(ts_test), list(cpu_test), list(mem_test), list(mem_total_test)
+
+ test_duration = int((test_phases[-1][2] - test_phases[0][1]).total_seconds())
+ test_title = f'GHC Test Metrics - Duration: {format_duration(test_duration)}'
+ test_output = f"{output_prefix}-test.svg"
+ create_plot(ts_test, cpu_test, mem_test, mem_total_test,
+ test_phases, test_title, test_output)
+
+ # Print phase summary (all phases, including sub-phases)
+ if all_phases:
+ total_duration = int((all_phases[-1][2] - all_phases[0][1]).total_seconds())
+ print("\nPhase Summary:")
+ print("-" * 55)
+ for phase_name, start, end, status in all_phases:
+ duration = int((end - start).total_seconds())
+ # Indent sub-phases for readability
+ indent = " " if '.' in phase_name else " "
+ label = _display_label(phase_name) if '.' in phase_name else phase_name
+ print(f"{indent}{label:20} {format_duration(duration):>10} [{status}]")
+ print("-" * 55)
+ print(f" {'TOTAL':20} {format_duration(total_duration):>10}")
+
+
+def main():
+ if len(sys.argv) < 3:
+ print(__doc__)
+ sys.exit(1)
+
+ metrics_dir = sys.argv[1]
+ timing_dir = sys.argv[2]
+ output_prefix = sys.argv[3] if len(sys.argv) > 3 else os.path.join(metrics_dir, 'metrics')
+
+ plot_metrics(metrics_dir, timing_dir, output_prefix)
+
+
+if __name__ == '__main__':
+ main()
diff --git a/mk/run-phase.sh b/mk/run-phase.sh
new file mode 100755
index 000000000000..07cae5373834
--- /dev/null
+++ b/mk/run-phase.sh
@@ -0,0 +1,91 @@
+#!/usr/bin/env bash
+# run-phase.sh - Wrapper for timed build phases with quiet mode support
+#
+# Usage: run-phase.sh PHASE_NAME QUIET TIMING_DIR LOGS_DIR -- COMMAND...
+#
+# Arguments:
+# PHASE_NAME - Name of the build phase (cabal, stage1, stage2, bindist, test)
+# QUIET - "1" to suppress output (log to file), "0" for normal output
+# TIMING_DIR - Directory for timing files (.start, .end, .status)
+# LOGS_DIR - Directory for log files
+# COMMAND... - The actual build command to run
+#
+# Creates:
+# $TIMING_DIR/$PHASE.start - Unix timestamp when phase started
+# $TIMING_DIR/$PHASE.end - Unix timestamp when phase ended
+# $TIMING_DIR/$PHASE.status - "0" for success, "1" for failure
+# $LOGS_DIR/$PHASE.log - Build output (only in quiet mode)
+#
+# On failure in quiet mode, prints last 100 lines of log.
+#
+# No-op detection:
+# If a build completes in < 30s AND previous timing files exist with
+# duration > 30s, the previous timing is preserved. This prevents
+# "make test" from overwriting real build times with no-op verification times.
+
+set -uo pipefail
+
+PHASE="$1"
+QUIET="$2"
+TIMING_DIR="$3"
+LOGS_DIR="$4"
+shift 4
+
+# Consume the -- separator if present
+[[ "${1:-}" == "--" ]] && shift
+
+mkdir -p "$TIMING_DIR" "$LOGS_DIR"
+
+# Save existing timing if present (for no-op detection)
+OLD_START=""
+OLD_END=""
+if [[ -f "$TIMING_DIR/$PHASE.start" && -f "$TIMING_DIR/$PHASE.end" ]]; then
+ OLD_START=$(cat "$TIMING_DIR/$PHASE.start")
+ OLD_END=$(cat "$TIMING_DIR/$PHASE.end")
+fi
+
+# Record start time
+START_TIME=$(date +%s)
+echo "$START_TIME" > "$TIMING_DIR/$PHASE.start"
+echo ">>> Building $PHASE..."
+
+if [[ "$QUIET" == "1" ]]; then
+ # Quiet mode: redirect all output to log file
+ if "$@" > "$LOGS_DIR/$PHASE.log" 2>&1; then
+ echo "0" > "$TIMING_DIR/$PHASE.status"
+ else
+ echo "1" > "$TIMING_DIR/$PHASE.status"
+ date +%s > "$TIMING_DIR/$PHASE.end"
+ echo ""
+ echo "=== ERROR building $PHASE (last 100 lines) ==="
+ tail -100 "$LOGS_DIR/$PHASE.log"
+ exit 1
+ fi
+else
+ # Normal mode: show output directly
+ if "$@"; then
+ echo "0" > "$TIMING_DIR/$PHASE.status"
+ else
+ echo "1" > "$TIMING_DIR/$PHASE.status"
+ date +%s > "$TIMING_DIR/$PHASE.end"
+ exit 1
+ fi
+fi
+
+END_TIME=$(date +%s)
+DURATION=$((END_TIME - START_TIME))
+
+# No-op detection: If build took < 30s AND we had previous timing, restore it
+# This preserves real build times when make re-runs stages as no-ops
+NOOP_THRESHOLD=30
+if [[ -n "$OLD_START" && -n "$OLD_END" && "$DURATION" -lt "$NOOP_THRESHOLD" ]]; then
+ OLD_DURATION=$((OLD_END - OLD_START))
+ # Only restore if old duration was significantly longer (real build)
+ if [[ "$OLD_DURATION" -gt "$NOOP_THRESHOLD" ]]; then
+ echo "$OLD_START" > "$TIMING_DIR/$PHASE.start"
+ echo "$OLD_END" > "$TIMING_DIR/$PHASE.end"
+ exit 0
+ fi
+fi
+
+echo "$END_TIME" > "$TIMING_DIR/$PHASE.end"
diff --git a/mk/system-cxx-std-lib-1.0.conf.in b/mk/system-cxx-std-lib-1.0.conf.in
index 1873720bd1a9..134c0c05d49d 100644
--- a/mk/system-cxx-std-lib-1.0.conf.in
+++ b/mk/system-cxx-std-lib-1.0.conf.in
@@ -18,5 +18,6 @@ abi: 00000000000000000000000000000000
exposed: True
exposed-modules:
extra-libraries: @CXX_STD_LIB_LIBS@
+extra-libraries-static: @CXX_STD_LIB_LIBS@
library-dirs: @CXX_STD_LIB_LIB_DIRS@
dynamic-library-dirs: @CXX_STD_LIB_DYN_LIB_DIRS@
diff --git a/mk/timing-summary.sh b/mk/timing-summary.sh
new file mode 100755
index 000000000000..e98d38f5ca9d
--- /dev/null
+++ b/mk/timing-summary.sh
@@ -0,0 +1,195 @@
+#!/usr/bin/env bash
+# timing-summary.sh - Display and save timing information for build phases
+#
+# Usage: timing-summary.sh TIMING_DIR
+#
+# Auto-discovers phases from *.start files in TIMING_DIR. Displays top-level
+# phases (cabal, stage1, stage2, stage3-*, test) with their sub-phases indented.
+# Sub-phase durations are informational; TOTAL sums only top-level phases to
+# avoid double-counting.
+#
+# Also saves summary to TIMING_DIR/summary.txt
+
+set -uo pipefail
+
+TIMING_DIR="${1:-.}"
+
+# Format seconds into human-readable duration (right-aligned in 13 chars)
+format_duration() {
+ local dur=$1
+ local hrs=$((dur / 3600))
+ local mins=$(((dur % 3600) / 60))
+ local secs=$((dur % 60))
+
+ if [[ $hrs -gt 0 ]]; then
+ printf "%dh %2dm %2ds" "$hrs" "$mins" "$secs"
+ elif [[ $mins -gt 0 ]]; then
+ printf "%dm %2ds" "$mins" "$secs"
+ else
+ printf "%ds" "$secs"
+ fi
+}
+
+# Read status file and return OK/FAIL/-
+read_status() {
+ local phase=$1
+ local status
+ status=$(cat "$TIMING_DIR/$phase.status" 2>/dev/null || echo "?")
+ if [[ "$status" == "0" ]]; then
+ echo "OK"
+ elif [[ "$status" == "1" ]]; then
+ echo "FAIL"
+ else
+ echo "-"
+ fi
+}
+
+# Compute duration for a phase (returns -1 if files missing)
+phase_duration() {
+ local phase=$1
+ if [[ -f "$TIMING_DIR/$phase.start" ]] && [[ -f "$TIMING_DIR/$phase.end" ]]; then
+ local start end
+ start=$(cat "$TIMING_DIR/$phase.start")
+ end=$(cat "$TIMING_DIR/$phase.end")
+ echo $((end - start))
+ else
+ echo -1
+ fi
+}
+
+# Collect all completed phases (have both .start and .end files)
+declare -a all_phases=()
+if [[ -d "$TIMING_DIR" ]]; then
+ for f in "$TIMING_DIR"/*.start; do
+ [[ -f "$f" ]] || continue
+ phase=$(basename "$f" .start)
+ [[ -f "$TIMING_DIR/$phase.end" ]] || continue
+ all_phases+=("$phase")
+ done
+fi
+
+if [[ ${#all_phases[@]} -eq 0 ]]; then
+ echo "No timing data found in $TIMING_DIR"
+ exit 0
+fi
+
+# Classify phases: top-level vs sub-phase
+# Top-level: cabal, stage1, stage2, stage3-*, test
+# Sub-phase: anything with a dot (stage2.rts, stage3-x86_64-musl-linux.dist, etc.)
+declare -a top_level=()
+declare -a sub_phases=()
+
+for phase in "${all_phases[@]}"; do
+ if [[ "$phase" == *.* ]]; then
+ sub_phases+=("$phase")
+ else
+ top_level+=("$phase")
+ fi
+done
+
+# Define display order for top-level phases
+ordered_top_level() {
+ local -a ordered=()
+ # Fixed-order phases first
+ for p in cabal stage1 stage2; do
+ for t in "${top_level[@]}"; do
+ [[ "$t" == "$p" ]] && ordered+=("$t")
+ done
+ done
+ # stage3-* phases sorted alphabetically
+ for t in "${top_level[@]}"; do
+ [[ "$t" == stage3-* ]] && ordered+=("$t")
+ done
+ # test last
+ for t in "${top_level[@]}"; do
+ [[ "$t" == "test" ]] && ordered+=("$t")
+ done
+ # Anything else we missed
+ for t in "${top_level[@]}"; do
+ local found=0
+ for o in "${ordered[@]}"; do
+ [[ "$t" == "$o" ]] && found=1 && break
+ done
+ [[ $found -eq 0 ]] && ordered+=("$t")
+ done
+ printf '%s\n' "${ordered[@]}"
+}
+
+# Get sub-phases for a top-level phase, sorted alphabetically
+sub_phases_of() {
+ local parent=$1
+ for sp in "${sub_phases[@]}"; do
+ # Match: parent.suffix (single level only, no nested dots)
+ if [[ "$sp" == "$parent".* && "$sp" != "$parent".*.* ]]; then
+ echo "$sp"
+ fi
+ done | sort
+}
+
+# Column width for phase name (accommodates stage3-javascript-unknown-ghcjs.libraries)
+COL_PHASE=38
+
+# Print table
+sep="+$(printf '%0.s-' $(seq 1 $((COL_PHASE + 2))))+---------------+--------+"
+
+echo ""
+echo "$sep"
+printf "| %-${COL_PHASE}s | %-13s | %-6s |\n" "Phase" "Duration" "Status"
+echo "$sep"
+
+total=0
+while IFS= read -r phase; do
+ dur=$(phase_duration "$phase")
+ [[ $dur -lt 0 ]] && continue
+
+ total=$((total + dur))
+ dur_str=$(format_duration "$dur")
+ status_str=$(read_status "$phase")
+
+ printf "| %-${COL_PHASE}s | %13s | %-6s |\n" "$phase" "$dur_str" "$status_str"
+
+ # Print sub-phases indented
+ while IFS= read -r sp; do
+ [[ -z "$sp" ]] && continue
+ sp_dur=$(phase_duration "$sp")
+ [[ $sp_dur -lt 0 ]] && continue
+
+ sp_dur_str=$(format_duration "$sp_dur")
+ sp_status_str=$(read_status "$sp")
+
+ # Truncate long sub-phase names with ellipsis
+ display_name=" $sp"
+ if [[ ${#display_name} -gt $COL_PHASE ]]; then
+ display_name="${display_name:0:$((COL_PHASE - 1))}"$'\u2026'
+ fi
+
+ printf "| %-${COL_PHASE}s | %13s | %-6s |\n" "$display_name" "$sp_dur_str" "$sp_status_str"
+ done < <(sub_phases_of "$phase")
+
+done < <(ordered_top_level)
+
+echo "$sep"
+
+total_str=$(format_duration "$total")
+printf "| %-${COL_PHASE}s | %13s | |\n" "TOTAL" "$total_str"
+echo "$sep"
+
+# Save summary to file (top-level phases only, for machine consumption)
+mkdir -p "$TIMING_DIR"
+rm -f "$TIMING_DIR/summary.txt"
+while IFS= read -r phase; do
+ dur=$(phase_duration "$phase")
+ [[ $dur -lt 0 ]] && continue
+ status=$(cat "$TIMING_DIR/$phase.status" 2>/dev/null || echo "?")
+ echo "$phase $dur $status" >> "$TIMING_DIR/summary.txt"
+
+ # Also record sub-phases
+ while IFS= read -r sp; do
+ [[ -z "$sp" ]] && continue
+ sp_dur=$(phase_duration "$sp")
+ [[ $sp_dur -lt 0 ]] && continue
+ sp_status=$(cat "$TIMING_DIR/$sp.status" 2>/dev/null || echo "?")
+ echo "$sp $sp_dur $sp_status" >> "$TIMING_DIR/summary.txt"
+ done < <(sub_phases_of "$phase")
+
+done < <(ordered_top_level)
diff --git a/nofib b/nofib
deleted file mode 160000
index b7391df4540a..000000000000
--- a/nofib
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit b7391df4540ac8b11b35e1b2e2c15819b5171798
diff --git a/packages b/packages
index 4f02d0133c0b..d6bb0cd77e13 100644
--- a/packages
+++ b/packages
@@ -37,7 +37,6 @@
# localpath tag remotepath upstreamurl
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ghc-tarballs windows ghc-tarballs.git -
-libffi-tarballs - - -
utils/hsc2hs - - ssh://git@github.com/haskell/hsc2hs.git
libraries/array - - -
libraries/binary - - https://github.com/kolmodin/binary.git
diff --git a/utils/fs/README b/rts-fs/README
similarity index 68%
rename from utils/fs/README
rename to rts-fs/README
index 5011939a381f..446f95e9eceb 100644
--- a/utils/fs/README
+++ b/rts-fs/README
@@ -1,4 +1,2 @@
This "fs" library, used by various ghc utilities is used to share some common
I/O filesystem functions with different packages.
-
-This file is copied across the build-system by configure.
diff --git a/utils/fs/fs.c b/rts-fs/fs.c
similarity index 100%
rename from utils/fs/fs.c
rename to rts-fs/fs.c
diff --git a/utils/fs/fs.h b/rts-fs/fs.h
similarity index 100%
rename from utils/fs/fs.h
rename to rts-fs/fs.h
diff --git a/rts-fs/rts-fs.cabal b/rts-fs/rts-fs.cabal
new file mode 100644
index 000000000000..f013754d3f40
--- /dev/null
+++ b/rts-fs/rts-fs.cabal
@@ -0,0 +1,17 @@
+cabal-version: 3.0
+name: rts-fs
+version: 1.0.0.0
+license: NONE
+author: Andrea Bedini
+maintainer: andrea@andreabedini.com
+build-type: Simple
+extra-doc-files: README
+extra-source-files: fs.h
+
+library
+ cc-options: -DFS_NAMESPACE=rts -DCOMPILING_RTS
+ cpp-options: -DFS_NAMESPACE=rts -DCOMPILING_RTS
+ c-sources: fs.c
+ include-dirs: .
+ install-includes: fs.h
+ default-language: Haskell2010
diff --git a/rts/include/rts/Bytecodes.h b/rts-headers/include/rts/Bytecodes.h
similarity index 100%
rename from rts/include/rts/Bytecodes.h
rename to rts-headers/include/rts/Bytecodes.h
diff --git a/rts/include/rts/storage/ClosureTypes.h b/rts-headers/include/rts/storage/ClosureTypes.h
similarity index 100%
rename from rts/include/rts/storage/ClosureTypes.h
rename to rts-headers/include/rts/storage/ClosureTypes.h
diff --git a/rts/include/rts/storage/FunTypes.h b/rts-headers/include/rts/storage/FunTypes.h
similarity index 100%
rename from rts/include/rts/storage/FunTypes.h
rename to rts-headers/include/rts/storage/FunTypes.h
diff --git a/rts/include/stg/MachRegs.h b/rts-headers/include/stg/MachRegs.h
similarity index 100%
rename from rts/include/stg/MachRegs.h
rename to rts-headers/include/stg/MachRegs.h
diff --git a/rts/include/stg/MachRegs/arm32.h b/rts-headers/include/stg/MachRegs/arm32.h
similarity index 100%
rename from rts/include/stg/MachRegs/arm32.h
rename to rts-headers/include/stg/MachRegs/arm32.h
diff --git a/rts/include/stg/MachRegs/arm64.h b/rts-headers/include/stg/MachRegs/arm64.h
similarity index 100%
rename from rts/include/stg/MachRegs/arm64.h
rename to rts-headers/include/stg/MachRegs/arm64.h
diff --git a/rts/include/stg/MachRegs/loongarch64.h b/rts-headers/include/stg/MachRegs/loongarch64.h
similarity index 100%
rename from rts/include/stg/MachRegs/loongarch64.h
rename to rts-headers/include/stg/MachRegs/loongarch64.h
diff --git a/rts/include/stg/MachRegs/ppc.h b/rts-headers/include/stg/MachRegs/ppc.h
similarity index 100%
rename from rts/include/stg/MachRegs/ppc.h
rename to rts-headers/include/stg/MachRegs/ppc.h
diff --git a/rts/include/stg/MachRegs/riscv64.h b/rts-headers/include/stg/MachRegs/riscv64.h
similarity index 100%
rename from rts/include/stg/MachRegs/riscv64.h
rename to rts-headers/include/stg/MachRegs/riscv64.h
diff --git a/rts/include/stg/MachRegs/s390x.h b/rts-headers/include/stg/MachRegs/s390x.h
similarity index 100%
rename from rts/include/stg/MachRegs/s390x.h
rename to rts-headers/include/stg/MachRegs/s390x.h
diff --git a/rts/include/stg/MachRegs/wasm32.h b/rts-headers/include/stg/MachRegs/wasm32.h
similarity index 100%
rename from rts/include/stg/MachRegs/wasm32.h
rename to rts-headers/include/stg/MachRegs/wasm32.h
diff --git a/rts/include/stg/MachRegs/x86.h b/rts-headers/include/stg/MachRegs/x86.h
similarity index 100%
rename from rts/include/stg/MachRegs/x86.h
rename to rts-headers/include/stg/MachRegs/x86.h
diff --git a/rts-headers/rts-headers.cabal b/rts-headers/rts-headers.cabal
new file mode 100644
index 000000000000..6d1b89a7ca33
--- /dev/null
+++ b/rts-headers/rts-headers.cabal
@@ -0,0 +1,31 @@
+cabal-version: 3.4
+name: rts-headers
+version: 1.0.3
+synopsis: The GHC runtime system
+description:
+ The GHC runtime system.
+
+ Code produced by GHC links this library to provide missing functionality
+ that cannot be written in Haskell itself.
+license: BSD-3-Clause
+maintainer: glasgow-haskell-users@haskell.org
+build-type: Simple
+
+
+library
+ include-dirs:
+ include
+
+ install-includes:
+ rts/Bytecodes.h
+ rts/storage/ClosureTypes.h
+ rts/storage/FunTypes.h
+ stg/MachRegs.h
+ stg/MachRegs/arm32.h
+ stg/MachRegs/arm64.h
+ stg/MachRegs/loongarch64.h
+ stg/MachRegs/ppc.h
+ stg/MachRegs/riscv64.h
+ stg/MachRegs/s390x.h
+ stg/MachRegs/wasm32.h
+ stg/MachRegs/x86.h
diff --git a/rts/.gitignore b/rts/.gitignore
index 179d62d55cf7..9fd252c383ff 100644
--- a/rts/.gitignore
+++ b/rts/.gitignore
@@ -8,7 +8,6 @@
/package.conf.inplace.raw
/package.conf.install
/package.conf.install.raw
-/fs.*
/aclocal.m4
/autom4te.cache/
@@ -20,3 +19,5 @@
/ghcautoconf.h.autoconf.in
/ghcautoconf.h.autoconf
/include/ghcautoconf.h
+
+/rts.buildinfo
diff --git a/rts/AutoApply.cmm b/rts/AutoApply.cmm
new file mode 100644
index 000000000000..22ed09ee02cd
--- /dev/null
+++ b/rts/AutoApply.cmm
@@ -0,0 +1 @@
+#include
diff --git a/rts/AutoApply_V16.cmm b/rts/AutoApply_V16.cmm
new file mode 100644
index 000000000000..5cc5142317b6
--- /dev/null
+++ b/rts/AutoApply_V16.cmm
@@ -0,0 +1 @@
+#include
diff --git a/rts/AutoApply_V32.cmm b/rts/AutoApply_V32.cmm
new file mode 100644
index 000000000000..9a4427459b5b
--- /dev/null
+++ b/rts/AutoApply_V32.cmm
@@ -0,0 +1 @@
+#include
diff --git a/rts/AutoApply_V64.cmm b/rts/AutoApply_V64.cmm
new file mode 100644
index 000000000000..343853d6e16a
--- /dev/null
+++ b/rts/AutoApply_V64.cmm
@@ -0,0 +1 @@
+#include
diff --git a/rts/Capability.c b/rts/Capability.c
index 8a5d1c8eb1a1..6e84567140ab 100644
--- a/rts/Capability.c
+++ b/rts/Capability.c
@@ -252,39 +252,24 @@ popReturningTask (Capability *cap)
static void
initCapability (Capability *cap, uint32_t i)
{
+ // Note: Capabilities are either:
+ // - Static (MainCapability): zeroed by C runtime (BSS section)
+ // - Dynamic: allocated via stgCallocAlignedBytes (zeroed)
+ // So we only need to initialize non-zero fields here.
+
uint32_t g;
cap->no = i;
cap->node = capNoToNumaNode(i);
- cap->in_haskell = false;
- cap->idle = 0;
- cap->disabled = false;
cap->run_queue_hd = END_TSO_QUEUE;
cap->run_queue_tl = END_TSO_QUEUE;
- cap->n_run_queue = 0;
#if defined(THREADED_RTS)
initMutex(&cap->lock);
- cap->running_task = NULL; // indicates cap is free
- cap->spare_workers = NULL;
- cap->n_spare_workers = 0;
- cap->suspended_ccalls = NULL;
- cap->n_suspended_ccalls = 0;
- cap->returning_tasks_hd = NULL;
- cap->returning_tasks_tl = NULL;
- cap->n_returning_tasks = 0;
cap->inbox = (Message*)END_TSO_QUEUE;
- cap->putMVars = NULL;
cap->sparks = allocSparkPool();
- cap->spark_stats.created = 0;
- cap->spark_stats.dud = 0;
- cap->spark_stats.overflowed = 0;
- cap->spark_stats.converted = 0;
- cap->spark_stats.gcd = 0;
- cap->spark_stats.fizzled = 0;
#endif
- cap->total_allocated = 0;
initCapabilityIOManager(cap); /* initialises cap->iomgr */
@@ -298,39 +283,22 @@ initCapability (Capability *cap, uint32_t i)
cap->saved_mut_lists = stgMallocBytes(sizeof(bdescr *) *
RtsFlags.GcFlags.generations,
"initCapability");
- cap->current_segments = NULL;
-
-
- // At this point storage manager is not initialized yet, so this will be
- // initialized in initStorage().
- cap->upd_rem_set.queue.blocks = NULL;
+ // mut_lists elements are zeroed by stgMallocBytes returning zeroed memory?
+ // No - stgMallocBytes doesn't zero. But stgCallocBytes would.
+ // Keep the loop for now since mut_lists is allocated separately.
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
cap->mut_lists[g] = NULL;
}
- cap->weak_ptr_list_hd = NULL;
- cap->weak_ptr_list_tl = NULL;
cap->free_tvar_watch_queues = END_STM_WATCH_QUEUE;
cap->free_trec_chunks = END_STM_CHUNK_LIST;
cap->free_trec_headers = NO_TREC;
- cap->transaction_tokens = 0;
- cap->context_switch = 0;
- cap->interrupt = 0;
- cap->pinned_object_block = NULL;
- cap->pinned_object_blocks = NULL;
- cap->pinned_object_empty = NULL;
#if defined(PROFILING)
cap->r.rCCCS = CCS_SYSTEM;
-#else
- cap->r.rCCCS = NULL;
#endif
- // cap->r.rCurrentTSO is charged for calls to allocate(), so we
- // don't want it set when not running a Haskell thread.
- cap->r.rCurrentTSO = NULL;
-
traceCapCreate(cap);
traceCapsetAssignCap(CAPSET_OSPROCESS_DEFAULT, i);
traceCapsetAssignCap(CAPSET_CLOCKDOMAIN_DEFAULT, i);
@@ -461,7 +429,7 @@ moreCapabilities (uint32_t from USED_IF_THREADS, uint32_t to USED_IF_THREADS)
{
for (uint32_t i = 0; i < to; i++) {
if (i >= from) {
- capabilities[i] = stgMallocAlignedBytes(sizeof(Capability),
+ capabilities[i] = stgCallocAlignedBytes(sizeof(Capability),
CAPABILITY_ALIGNMENT,
"moreCapabilities");
initCapability(capabilities[i], i);
diff --git a/rts/RtsMessages.c b/rts/RtsMessages.c
index 5b536b7ac8f0..0b407d40fefe 100644
--- a/rts/RtsMessages.c
+++ b/rts/RtsMessages.c
@@ -179,7 +179,7 @@ rtsFatalInternalErrorFn(const char *s, va_list ap)
#endif
fprintf(stderr, "\n");
fprintf(stderr, " (GHC version %s for %s)\n", __GLASGOW_HASKELL_FULL_VERSION__, xstr(HostPlatform_TYPE));
- fprintf(stderr, " Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug\n");
+ fprintf(stderr, " Please report this as a GHC bug: https://github.com/stable-haskell/ghc/issues\n");
fflush(stderr);
}
#if defined(mingw32_HOST_OS)
diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index e9a5b6d44b3e..48dc644251f3 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -6,6 +6,12 @@
*
* ---------------------------------------------------------------------------*/
+/* _GNU_SOURCE needed for RTLD_NOLOAD on some Linux/glibc configurations.
+ * Must be defined before any headers are included. */
+#if !defined(mingw32_HOST_OS) && !defined(_GNU_SOURCE)
+#define _GNU_SOURCE
+#endif
+
#include "Rts.h"
#include "RtsAPI.h"
#include "HsFFI.h"
@@ -57,7 +63,6 @@
#endif
#if defined(mingw32_HOST_OS)
-#include
#include
#else
#include "posix/TTY.h"
@@ -70,6 +75,174 @@
#include
#endif
+/*
+ * Note [Promoting Boot Libraries to RTLD_GLOBAL]
+ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ * Boot libraries (ghc-internal, RTS) are loaded by the system linker at
+ * program startup with RTLD_LOCAL (default). When user code is later
+ * dlopen'd, the dynamic linker can't see these existing copies and loads
+ * FRESH copies, causing duplicate global state.
+ *
+ * With ghc-internal, this causes GC crashes ("strange closure type")
+ * because the RTS's ghc_hs_iface pointer references info tables from
+ * the first copy, while user code uses info tables from the second copy.
+ *
+ * With the RTS, dynamically created info tables (from mkConInfoTable in
+ * GHCi) contain jumps to stg_interp_constr*_entry. These RTS symbols must
+ * be visible to dlopen'd code, otherwise the info table pointers become
+ * invalid when the RTS is loaded as a separate copy.
+ *
+ * Fix: Promote boot libraries to RTLD_GLOBAL scope early in RTS init,
+ * before any user code can trigger dlopen.
+ *
+ * This is a no-op on:
+ * - Windows (different linking model)
+ * - WASM/WASI (no dynamic linking support: dladdr/Dl_info unavailable)
+ * - Systems without RTLD_NOLOAD
+ * - Static executables (symbols already global)
+ */
+#if !defined(mingw32_HOST_OS) && !defined(wasm32_HOST_ARCH)
+#include
+#endif
+
+#if !defined(mingw32_HOST_OS) && !defined(wasm32_HOST_ARCH) && defined(RTLD_NOLOAD)
+/* Helper to promote a single library to RTLD_GLOBAL */
+static void promoteLibraryToGlobal(const char* name, void* symbol)
+{
+ Dl_info info;
+ if (dladdr(symbol, &info) && info.dli_fname) {
+ void* handle = dlopen(info.dli_fname, RTLD_NOW | RTLD_NOLOAD | RTLD_GLOBAL);
+ IF_DEBUG(linker,
+ if (handle) {
+ debugBelch("RTS: promoted %s (%s) to RTLD_GLOBAL\n",
+ name, info.dli_fname);
+ }
+ );
+ (void)handle;
+ }
+}
+
+static void promoteBootLibrariesToGlobal(void)
+{
+ extern void init_ghc_hs_iface(void);
+
+ /* Promote ghc-internal - contains GHC API info tables */
+ promoteLibraryToGlobal("ghc-internal", (void*)&init_ghc_hs_iface);
+
+ /* Promote the RTS - contains stg_interp_constr*_entry and other RTS symbols
+ * that dynamically created info tables need to reference.
+ * This is essential for ghci-ext tests in DYNAMIC=1 builds. */
+ promoteLibraryToGlobal("libHSrts", (void*)&hs_init);
+}
+#endif
+
+/*
+ * Note [Getting stg_interp_constr entry points from the RTS]
+ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ * The interpreter needs the addresses of stg_interp_constr*_entry symbols
+ * when creating info tables for dynamically loaded constructors.
+ *
+ * Previously, libHSghci used FFI imports to get these addresses:
+ * foreign import ccall "&stg_interp_constr1_entry" ...
+ *
+ * However, FFI imports are resolved at library load time, BEFORE
+ * promoteBootLibrariesToGlobal() runs. On systems where libraries have
+ * unique absolute paths in their NEEDED entries, libHSghci might resolve
+ * these symbols to a different copy of libHSrts than the one ghc-iserv
+ * uses at runtime.
+ *
+ * Simply moving the address lookup to an RTS function doesn't help either,
+ * because the FFI import of getInterpConstrEntryAddr itself would also be
+ * resolved at load time to the wrong RTS copy!
+ *
+ * The fix: Use dlsym(RTLD_DEFAULT, ...) to look up symbols from the
+ * RTLD_GLOBAL namespace at runtime. After promoteBootLibrariesToGlobal()
+ * has run, RTLD_DEFAULT will find the symbols in the correct RTS.
+ *
+ * Note: On non-dynamic builds, we fall back to static symbol references
+ * since dlopen/dlsym might not be available or the symbols aren't exported.
+ */
+
+#if !defined(mingw32_HOST_OS) && defined(DYNAMIC)
+#include
+
+/* Cache for dynamic symbol lookups */
+static StgFunPtr cached_interp_constr_entry[8] = {NULL};
+static bool interp_constr_entry_cached = false;
+
+static void cacheInterpConstrEntries(void)
+{
+ if (interp_constr_entry_cached) return;
+
+ /* Look up symbols from RTLD_DEFAULT (global namespace) */
+ cached_interp_constr_entry[1] = (StgFunPtr)dlsym(RTLD_DEFAULT, "stg_interp_constr1_entry");
+ cached_interp_constr_entry[2] = (StgFunPtr)dlsym(RTLD_DEFAULT, "stg_interp_constr2_entry");
+ cached_interp_constr_entry[3] = (StgFunPtr)dlsym(RTLD_DEFAULT, "stg_interp_constr3_entry");
+ cached_interp_constr_entry[4] = (StgFunPtr)dlsym(RTLD_DEFAULT, "stg_interp_constr4_entry");
+ cached_interp_constr_entry[5] = (StgFunPtr)dlsym(RTLD_DEFAULT, "stg_interp_constr5_entry");
+ cached_interp_constr_entry[6] = (StgFunPtr)dlsym(RTLD_DEFAULT, "stg_interp_constr6_entry");
+ cached_interp_constr_entry[7] = (StgFunPtr)dlsym(RTLD_DEFAULT, "stg_interp_constr7_entry");
+
+ interp_constr_entry_cached = true;
+}
+
+/*
+ * Get the address of stg_interp_constr*_entry for the given constructor tag.
+ * Tag must be in range 1-7.
+ *
+ * Uses dlsym(RTLD_DEFAULT, ...) to look up symbols from the global namespace,
+ * ensuring we get the correct addresses from the RTS that was promoted to
+ * RTLD_GLOBAL by promoteBootLibrariesToGlobal().
+ */
+StgFunPtr getInterpConstrEntryAddr(int tag)
+{
+ if (tag < 1 || tag > 7) {
+ barf("getInterpConstrEntryAddr: invalid tag %d (must be 1-7)", tag);
+ }
+
+ cacheInterpConstrEntries();
+
+ StgFunPtr result = cached_interp_constr_entry[tag];
+ if (result == NULL) {
+ barf("getInterpConstrEntryAddr: dlsym failed for stg_interp_constr%d_entry", tag);
+ }
+ return result;
+}
+
+#else /* Non-dynamic builds or Windows */
+
+/* Declare the stg_interp_constr*_entry symbols */
+extern StgFunPtr stg_interp_constr1_entry(void);
+extern StgFunPtr stg_interp_constr2_entry(void);
+extern StgFunPtr stg_interp_constr3_entry(void);
+extern StgFunPtr stg_interp_constr4_entry(void);
+extern StgFunPtr stg_interp_constr5_entry(void);
+extern StgFunPtr stg_interp_constr6_entry(void);
+extern StgFunPtr stg_interp_constr7_entry(void);
+
+/*
+ * Get the address of stg_interp_constr*_entry for the given constructor tag.
+ * Tag must be in range 1-7.
+ *
+ * Non-dynamic version uses static symbol references.
+ */
+StgFunPtr getInterpConstrEntryAddr(int tag)
+{
+ switch (tag) {
+ case 1: return (StgFunPtr)&stg_interp_constr1_entry;
+ case 2: return (StgFunPtr)&stg_interp_constr2_entry;
+ case 3: return (StgFunPtr)&stg_interp_constr3_entry;
+ case 4: return (StgFunPtr)&stg_interp_constr4_entry;
+ case 5: return (StgFunPtr)&stg_interp_constr5_entry;
+ case 6: return (StgFunPtr)&stg_interp_constr6_entry;
+ case 7: return (StgFunPtr)&stg_interp_constr7_entry;
+ default:
+ barf("getInterpConstrEntryAddr: invalid tag %d (must be 1-7)", tag);
+ }
+}
+
+#endif /* DYNAMIC */
+
// Count of how many outstanding hs_init()s there have been.
static StgWord hs_init_count = 0;
static bool rts_shutdown = false;
@@ -91,15 +264,7 @@ static void flushStdHandles(void);
static void
x86_init_fpu ( void )
{
-#if defined(mingw32_HOST_OS) && defined(x86_64_HOST_ARCH) && !X86_INIT_FPU
- /* Mingw-w64 does a stupid thing. They set the FPU precision to extended mode by default.
- The reasoning is that it's for compatibility with GNU Linux ported libraries. However the
- problem is this is incompatible with the standard Windows double precision mode. In fact,
- if we create a new OS thread then Windows will reset the FPU to double precision mode.
- So we end up with a weird state where the main thread by default has a different precision
- than any child threads. */
- fesetenv(FE_PC53_ENV);
-#elif X86_INIT_FPU
+#if X86_INIT_FPU
__volatile unsigned short int fpu_cw;
// Grab the control word
@@ -120,14 +285,6 @@ x86_init_fpu ( void )
}
#if defined(mingw32_HOST_OS)
-/* And now we have to override the build in ones in Mingw-W64's CRT. */
-void _fpreset(void)
-{
- x86_init_fpu();
-}
-
-void __attribute__((alias("_fpreset"))) fpreset(void);
-
/* Set the console's CodePage to UTF-8 if using the new I/O manager and the CP
is still the default one. */
static void
@@ -267,6 +424,12 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
init_ghc_hs_iface();
+#if !defined(mingw32_HOST_OS) && defined(RTLD_NOLOAD)
+ /* Promote boot libraries to RTLD_GLOBAL for dynamic code loading.
+ * See Note [Promoting Boot Libraries to RTLD_GLOBAL] */
+ promoteBootLibrariesToGlobal();
+#endif
+
/* Initialise the stats department, phase 0 */
initStats0();
diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c
index b5612df10454..991ca5e57a49 100644
--- a/rts/RtsSymbols.c
+++ b/rts/RtsSymbols.c
@@ -30,6 +30,7 @@
#include /* SHGetFolderPathW */
#include "IOManager.h"
#include "win32/AsyncWinIO.h"
+#include "fs.h"
#endif
#if defined(openbsd_HOST_OS)
@@ -157,6 +158,9 @@ extern char **environ;
* https://docs.microsoft.com/en-us/cpp/porting/visual-cpp-change-history-2003-2015?view=vs-2017#stdioh-and-conioh
*/
#define RTS_MINGW_ONLY_SYMBOLS \
+ SymI_HasProto(_assert) \
+ SymI_HasProto(__rts_swopen) \
+ SymI_HasProto(__rts_create_device_name) \
SymI_HasProto(stg_asyncReadzh) \
SymI_HasProto(stg_asyncWritezh) \
SymI_HasProto(stg_asyncDoProczh) \
@@ -576,6 +580,7 @@ extern char **environ;
SymI_HasProto(hs_init) \
SymI_HasProto(hs_init_with_rtsopts) \
SymI_HasProto(hs_init_ghc) \
+ SymI_HasProto(getInterpConstrEntryAddr) \
SymI_HasProto(hs_exit) \
SymI_HasProto(hs_exit_nowait) \
SymI_HasProto(hs_set_argv) \
diff --git a/rts/RtsUtils.c b/rts/RtsUtils.c
index 095e6b3499e0..e27cf71a082c 100644
--- a/rts/RtsUtils.c
+++ b/rts/RtsUtils.c
@@ -131,10 +131,12 @@ stgFree(void* p)
free(p);
}
+// Aligned allocation that zeros memory (calloc semantics).
// N.B. Allocations resulting from this function must be freed by
-// `stgFreeAligned`, not `stgFree`. This is necessary due to the properties of Windows' `_aligned_malloc`
+// `stgFreeAligned`, not `stgFree`. This is necessary due to the properties
+// of Windows' `_aligned_malloc`.
void *
-stgMallocAlignedBytes (size_t n, size_t align, char *msg)
+stgCallocAlignedBytes (size_t n, size_t align, char *msg)
{
void *space;
@@ -164,7 +166,10 @@ stgMallocAlignedBytes (size_t n, size_t align, char *msg)
rtsConfig.mallocFailHook((W_) n, msg);
stg_exit(EXIT_INTERNAL_ERROR);
}
- IF_DEBUG(zero_on_gc, memset(space, 0xbb, n));
+
+ // Zero the allocated memory (calloc semantics)
+ memset(space, 0, n);
+
return space;
}
diff --git a/rts/RtsUtils.h b/rts/RtsUtils.h
index 095f8d1bc7a7..e4544c39cf40 100644
--- a/rts/RtsUtils.h
+++ b/rts/RtsUtils.h
@@ -39,7 +39,14 @@ void *stgCallocBytes(size_t count, size_t size, char *msg)
char *stgStrndup(const char *s, size_t n)
STG_MALLOC STG_MALLOC1(stgFree);
-void *stgMallocAlignedBytes(size_t n, size_t align, char *msg);
+// Aligned allocation that zeros memory (calloc semantics)
+void *stgCallocAlignedBytes(size_t n, size_t align, char *msg);
+
+// Deprecated: use stgCallocAlignedBytes instead. This wrapper now zeros memory.
+__attribute__((deprecated("use stgCallocAlignedBytes instead")))
+static inline void *stgMallocAlignedBytes(size_t n, size_t align, char *msg) {
+ return stgCallocAlignedBytes(n, align, msg);
+}
void stgFreeAligned(void *p);
diff --git a/rts/Stats.c b/rts/Stats.c
index e60c0f2ac38e..3988c6f254b9 100644
--- a/rts/Stats.c
+++ b/rts/Stats.c
@@ -1278,8 +1278,6 @@ stat_exitReport (void)
Time exit_gc_cpu = stats.gc_cpu_ns - start_exit_gc_cpu;
Time exit_gc_elapsed = stats.gc_elapsed_ns - start_exit_gc_elapsed;
- WARN(exit_gc_elapsed > 0);
-
sum.exit_cpu_ns = end_exit_cpu
- start_exit_cpu
- exit_gc_cpu;
@@ -1287,7 +1285,35 @@ stat_exitReport (void)
- start_exit_elapsed
- exit_gc_elapsed;
- WARN(sum.exit_elapsed_ns >= 0);
+ // Note [Clamping exit_cpu_ns and exit_elapsed_ns]
+ // ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ // In rare cases, these values can become negative due to a timing
+ // accounting edge case when a GC cycle straddles the exit boundary:
+ //
+ // 1. A GC begins (stat_startGC records gc_start_elapsed/cpu)
+ // 2. stat_startExit() is called, capturing start_exit_gc_elapsed
+ // = stats.gc_elapsed_ns (which does NOT include the in-progress GC)
+ // 3. The GC completes (stat_endGC adds the FULL GC duration to
+ // stats.gc_elapsed_ns)
+ // 4. stat_endExit() is called
+ //
+ // When we calculate:
+ // exit_gc_elapsed = stats.gc_elapsed_ns - start_exit_gc_elapsed
+ //
+ // This includes the ENTIRE duration of the straddling GC, even the
+ // portion that occurred BEFORE stat_startExit() was called. This can
+ // make exit_gc_elapsed > (end_exit_elapsed - start_exit_elapsed),
+ // resulting in negative sum.exit_elapsed_ns.
+ //
+ // This is more likely to manifest on systems with different scheduler
+ // behavior or timing granularity (observed on Alpine Linux / musl).
+ //
+ // We clamp to zero rather than attempting complex fixes because:
+ // - These statistics are best-effort approximations anyway
+ // - The edge case is rare (requires GC to straddle exit boundary)
+ // - This matches the existing pattern for mutator_cpu_ns below
+ if (sum.exit_cpu_ns < 0) { sum.exit_cpu_ns = 0; }
+ if (sum.exit_elapsed_ns < 0) { sum.exit_elapsed_ns = 0; }
stats.mutator_cpu_ns = start_exit_cpu
- end_init_cpu
@@ -1297,20 +1323,8 @@ stat_exitReport (void)
- end_init_elapsed
- (stats.gc_elapsed_ns - exit_gc_elapsed);
- WARN(stats.mutator_elapsed_ns >= 0);
-
if (stats.mutator_cpu_ns < 0) { stats.mutator_cpu_ns = 0; }
- // The subdivision of runtime into INIT/EXIT/GC/MUT is just adding
- // and subtracting, so the parts should add up to the total exactly.
- // Note that stats->total_ns is captured a tiny bit later than
- // end_exit_elapsed, so we don't use it here.
- WARN(stats.init_elapsed_ns // INIT
- + stats.mutator_elapsed_ns // MUT
- + stats.gc_elapsed_ns // GC
- + sum.exit_elapsed_ns // EXIT
- == end_exit_elapsed - start_init_elapsed);
-
// heapCensus() is called by the GC, so RP and HC time are
// included in the GC stats. We therefore subtract them to
// obtain the actual GC cpu time.
diff --git a/rts/StgMiscClosures.cmm b/rts/StgMiscClosures.cmm
index ea02ba989423..80828401500d 100644
--- a/rts/StgMiscClosures.cmm
+++ b/rts/StgMiscClosures.cmm
@@ -17,8 +17,11 @@ import AcquireSRWLockExclusive;
import ReleaseSRWLockExclusive;
#if defined(PROF_SPIN)
-import whitehole_lockClosure_spin;
-import whitehole_lockClosure_yield;
+// These are C data variables (volatile StgWord64 in Stats.c). Use CLOSURE so
+// the WASM NCG treats them as data symbols, not functions. Plain 'import NAME'
+// defaults to ForeignLabel IsFunction, causing wasm-ld type mismatch errors.
+import CLOSURE whitehole_lockClosure_spin;
+import CLOSURE whitehole_lockClosure_yield;
#endif
#if !defined(UnregisterisedCompiler)
diff --git a/rts/Threads.h b/rts/Threads.h
index b74ac1381dc1..57c251842d50 100644
--- a/rts/Threads.h
+++ b/rts/Threads.h
@@ -38,7 +38,6 @@ StgBool isThreadBound (StgTSO* tso);
// Overflow/underflow
void threadStackOverflow (Capability *cap, StgTSO *tso);
-W_ threadStackUnderflow (Capability *cap, StgTSO *tso);
bool performTryPutMVar(Capability *cap, StgMVar *mvar, StgClosure *value);
@@ -51,3 +50,5 @@ void printThreadQueue (StgTSO *t);
#endif
#include "EndPrivate.h"
+
+W_ threadStackUnderflow (Capability *cap, StgTSO *tso);
diff --git a/rts/config.guess b/rts/config.guess
new file mode 100755
index 000000000000..f6d217a49f8f
--- /dev/null
+++ b/rts/config.guess
@@ -0,0 +1,1812 @@
+#! /bin/sh
+# Attempt to guess a canonical system name.
+# Copyright 1992-2024 Free Software Foundation, Inc.
+
+# shellcheck disable=SC2006,SC2268 # see below for rationale
+
+timestamp='2024-01-01'
+
+# This file is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, see .
+#
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that
+# program. This Exception is an additional permission under section 7
+# of the GNU General Public License, version 3 ("GPLv3").
+#
+# Originally written by Per Bothner; maintained since 2000 by Ben Elliston.
+#
+# You can get the latest version of this script from:
+# https://git.savannah.gnu.org/cgit/config.git/plain/config.guess
+#
+# Please send patches to .
+
+
+# The "shellcheck disable" line above the timestamp inhibits complaints
+# about features and limitations of the classic Bourne shell that were
+# superseded or lifted in POSIX. However, this script identifies a wide
+# variety of pre-POSIX systems that do not have POSIX shells at all, and
+# even some reasonably current systems (Solaris 10 as case-in-point) still
+# have a pre-POSIX /bin/sh.
+
+
+me=`echo "$0" | sed -e 's,.*/,,'`
+
+usage="\
+Usage: $0 [OPTION]
+
+Output the configuration name of the system '$me' is run on.
+
+Options:
+ -h, --help print this help, then exit
+ -t, --time-stamp print date of last modification, then exit
+ -v, --version print version number, then exit
+
+Report bugs and patches to ."
+
+version="\
+GNU config.guess ($timestamp)
+
+Originally written by Per Bothner.
+Copyright 1992-2024 Free Software Foundation, Inc.
+
+This is free software; see the source for copying conditions. There is NO
+warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
+
+help="
+Try '$me --help' for more information."
+
+# Parse command line
+while test $# -gt 0 ; do
+ case $1 in
+ --time-stamp | --time* | -t )
+ echo "$timestamp" ; exit ;;
+ --version | -v )
+ echo "$version" ; exit ;;
+ --help | --h* | -h )
+ echo "$usage"; exit ;;
+ -- ) # Stop option processing
+ shift; break ;;
+ - ) # Use stdin as input.
+ break ;;
+ -* )
+ echo "$me: invalid option $1$help" >&2
+ exit 1 ;;
+ * )
+ break ;;
+ esac
+done
+
+if test $# != 0; then
+ echo "$me: too many arguments$help" >&2
+ exit 1
+fi
+
+# Just in case it came from the environment.
+GUESS=
+
+# CC_FOR_BUILD -- compiler used by this script. Note that the use of a
+# compiler to aid in system detection is discouraged as it requires
+# temporary files to be created and, as you can see below, it is a
+# headache to deal with in a portable fashion.
+
+# Historically, 'CC_FOR_BUILD' used to be named 'HOST_CC'. We still
+# use 'HOST_CC' if defined, but it is deprecated.
+
+# Portable tmp directory creation inspired by the Autoconf team.
+
+tmp=
+# shellcheck disable=SC2172
+trap 'test -z "$tmp" || rm -fr "$tmp"' 0 1 2 13 15
+
+set_cc_for_build() {
+ # prevent multiple calls if $tmp is already set
+ test "$tmp" && return 0
+ : "${TMPDIR=/tmp}"
+ # shellcheck disable=SC2039,SC3028
+ { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } ||
+ { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir "$tmp" 2>/dev/null) ; } ||
+ { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir "$tmp" 2>/dev/null) && echo "Warning: creating insecure temp directory" >&2 ; } ||
+ { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; }
+ dummy=$tmp/dummy
+ case ${CC_FOR_BUILD-},${HOST_CC-},${CC-} in
+ ,,) echo "int x;" > "$dummy.c"
+ for driver in cc gcc c89 c99 ; do
+ if ($driver -c -o "$dummy.o" "$dummy.c") >/dev/null 2>&1 ; then
+ CC_FOR_BUILD=$driver
+ break
+ fi
+ done
+ if test x"$CC_FOR_BUILD" = x ; then
+ CC_FOR_BUILD=no_compiler_found
+ fi
+ ;;
+ ,,*) CC_FOR_BUILD=$CC ;;
+ ,*,*) CC_FOR_BUILD=$HOST_CC ;;
+ esac
+}
+
+# This is needed to find uname on a Pyramid OSx when run in the BSD universe.
+# (ghazi@noc.rutgers.edu 1994-08-24)
+if test -f /.attbin/uname ; then
+ PATH=$PATH:/.attbin ; export PATH
+fi
+
+UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown
+UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown
+UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown
+UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown
+
+case $UNAME_SYSTEM in
+Linux|GNU|GNU/*)
+ LIBC=unknown
+
+ set_cc_for_build
+ cat <<-EOF > "$dummy.c"
+ #if defined(__ANDROID__)
+ LIBC=android
+ #else
+ #include
+ #if defined(__UCLIBC__)
+ LIBC=uclibc
+ #elif defined(__dietlibc__)
+ LIBC=dietlibc
+ #elif defined(__GLIBC__)
+ LIBC=gnu
+ #elif defined(__LLVM_LIBC__)
+ LIBC=llvm
+ #else
+ #include
+ /* First heuristic to detect musl libc. */
+ #ifdef __DEFINED_va_list
+ LIBC=musl
+ #endif
+ #endif
+ #endif
+ EOF
+ cc_set_libc=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^LIBC' | sed 's, ,,g'`
+ eval "$cc_set_libc"
+
+ # Second heuristic to detect musl libc.
+ if [ "$LIBC" = unknown ] &&
+ command -v ldd >/dev/null &&
+ ldd --version 2>&1 | grep -q ^musl; then
+ LIBC=musl
+ fi
+
+ # If the system lacks a compiler, then just pick glibc.
+ # We could probably try harder.
+ if [ "$LIBC" = unknown ]; then
+ LIBC=gnu
+ fi
+ ;;
+esac
+
+# Note: order is significant - the case branches are not exclusive.
+
+case $UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION in
+ *:NetBSD:*:*)
+ # NetBSD (nbsd) targets should (where applicable) match one or
+ # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*,
+ # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently
+ # switched to ELF, *-*-netbsd* would select the old
+ # object file format. This provides both forward
+ # compatibility and a consistent mechanism for selecting the
+ # object file format.
+ #
+ # Note: NetBSD doesn't particularly care about the vendor
+ # portion of the name. We always set it to "unknown".
+ UNAME_MACHINE_ARCH=`(uname -p 2>/dev/null || \
+ /sbin/sysctl -n hw.machine_arch 2>/dev/null || \
+ /usr/sbin/sysctl -n hw.machine_arch 2>/dev/null || \
+ echo unknown)`
+ case $UNAME_MACHINE_ARCH in
+ aarch64eb) machine=aarch64_be-unknown ;;
+ armeb) machine=armeb-unknown ;;
+ arm*) machine=arm-unknown ;;
+ sh3el) machine=shl-unknown ;;
+ sh3eb) machine=sh-unknown ;;
+ sh5el) machine=sh5le-unknown ;;
+ earmv*)
+ arch=`echo "$UNAME_MACHINE_ARCH" | sed -e 's,^e\(armv[0-9]\).*$,\1,'`
+ endian=`echo "$UNAME_MACHINE_ARCH" | sed -ne 's,^.*\(eb\)$,\1,p'`
+ machine=${arch}${endian}-unknown
+ ;;
+ *) machine=$UNAME_MACHINE_ARCH-unknown ;;
+ esac
+ # The Operating System including object format, if it has switched
+ # to ELF recently (or will in the future) and ABI.
+ case $UNAME_MACHINE_ARCH in
+ earm*)
+ os=netbsdelf
+ ;;
+ arm*|i386|m68k|ns32k|sh3*|sparc|vax)
+ set_cc_for_build
+ if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \
+ | grep -q __ELF__
+ then
+ # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout).
+ # Return netbsd for either. FIX?
+ os=netbsd
+ else
+ os=netbsdelf
+ fi
+ ;;
+ *)
+ os=netbsd
+ ;;
+ esac
+ # Determine ABI tags.
+ case $UNAME_MACHINE_ARCH in
+ earm*)
+ expr='s/^earmv[0-9]/-eabi/;s/eb$//'
+ abi=`echo "$UNAME_MACHINE_ARCH" | sed -e "$expr"`
+ ;;
+ esac
+ # The OS release
+ # Debian GNU/NetBSD machines have a different userland, and
+ # thus, need a distinct triplet. However, they do not need
+ # kernel version information, so it can be replaced with a
+ # suitable tag, in the style of linux-gnu.
+ case $UNAME_VERSION in
+ Debian*)
+ release='-gnu'
+ ;;
+ *)
+ release=`echo "$UNAME_RELEASE" | sed -e 's/[-_].*//' | cut -d. -f1,2`
+ ;;
+ esac
+ # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM:
+ # contains redundant information, the shorter form:
+ # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used.
+ GUESS=$machine-${os}${release}${abi-}
+ ;;
+ *:Bitrig:*:*)
+ UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'`
+ GUESS=$UNAME_MACHINE_ARCH-unknown-bitrig$UNAME_RELEASE
+ ;;
+ *:OpenBSD:*:*)
+ UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'`
+ GUESS=$UNAME_MACHINE_ARCH-unknown-openbsd$UNAME_RELEASE
+ ;;
+ *:SecBSD:*:*)
+ UNAME_MACHINE_ARCH=`arch | sed 's/SecBSD.//'`
+ GUESS=$UNAME_MACHINE_ARCH-unknown-secbsd$UNAME_RELEASE
+ ;;
+ *:LibertyBSD:*:*)
+ UNAME_MACHINE_ARCH=`arch | sed 's/^.*BSD\.//'`
+ GUESS=$UNAME_MACHINE_ARCH-unknown-libertybsd$UNAME_RELEASE
+ ;;
+ *:MidnightBSD:*:*)
+ GUESS=$UNAME_MACHINE-unknown-midnightbsd$UNAME_RELEASE
+ ;;
+ *:ekkoBSD:*:*)
+ GUESS=$UNAME_MACHINE-unknown-ekkobsd$UNAME_RELEASE
+ ;;
+ *:SolidBSD:*:*)
+ GUESS=$UNAME_MACHINE-unknown-solidbsd$UNAME_RELEASE
+ ;;
+ *:OS108:*:*)
+ GUESS=$UNAME_MACHINE-unknown-os108_$UNAME_RELEASE
+ ;;
+ macppc:MirBSD:*:*)
+ GUESS=powerpc-unknown-mirbsd$UNAME_RELEASE
+ ;;
+ *:MirBSD:*:*)
+ GUESS=$UNAME_MACHINE-unknown-mirbsd$UNAME_RELEASE
+ ;;
+ *:Sortix:*:*)
+ GUESS=$UNAME_MACHINE-unknown-sortix
+ ;;
+ *:Twizzler:*:*)
+ GUESS=$UNAME_MACHINE-unknown-twizzler
+ ;;
+ *:Redox:*:*)
+ GUESS=$UNAME_MACHINE-unknown-redox
+ ;;
+ mips:OSF1:*.*)
+ GUESS=mips-dec-osf1
+ ;;
+ alpha:OSF1:*:*)
+ # Reset EXIT trap before exiting to avoid spurious non-zero exit code.
+ trap '' 0
+ case $UNAME_RELEASE in
+ *4.0)
+ UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'`
+ ;;
+ *5.*)
+ UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'`
+ ;;
+ esac
+ # According to Compaq, /usr/sbin/psrinfo has been available on
+ # OSF/1 and Tru64 systems produced since 1995. I hope that
+ # covers most systems running today. This code pipes the CPU
+ # types through head -n 1, so we only detect the type of CPU 0.
+ ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1`
+ case $ALPHA_CPU_TYPE in
+ "EV4 (21064)")
+ UNAME_MACHINE=alpha ;;
+ "EV4.5 (21064)")
+ UNAME_MACHINE=alpha ;;
+ "LCA4 (21066/21068)")
+ UNAME_MACHINE=alpha ;;
+ "EV5 (21164)")
+ UNAME_MACHINE=alphaev5 ;;
+ "EV5.6 (21164A)")
+ UNAME_MACHINE=alphaev56 ;;
+ "EV5.6 (21164PC)")
+ UNAME_MACHINE=alphapca56 ;;
+ "EV5.7 (21164PC)")
+ UNAME_MACHINE=alphapca57 ;;
+ "EV6 (21264)")
+ UNAME_MACHINE=alphaev6 ;;
+ "EV6.7 (21264A)")
+ UNAME_MACHINE=alphaev67 ;;
+ "EV6.8CB (21264C)")
+ UNAME_MACHINE=alphaev68 ;;
+ "EV6.8AL (21264B)")
+ UNAME_MACHINE=alphaev68 ;;
+ "EV6.8CX (21264D)")
+ UNAME_MACHINE=alphaev68 ;;
+ "EV6.9A (21264/EV69A)")
+ UNAME_MACHINE=alphaev69 ;;
+ "EV7 (21364)")
+ UNAME_MACHINE=alphaev7 ;;
+ "EV7.9 (21364A)")
+ UNAME_MACHINE=alphaev79 ;;
+ esac
+ # A Pn.n version is a patched version.
+ # A Vn.n version is a released version.
+ # A Tn.n version is a released field test version.
+ # A Xn.n version is an unreleased experimental baselevel.
+ # 1.2 uses "1.2" for uname -r.
+ OSF_REL=`echo "$UNAME_RELEASE" | sed -e 's/^[PVTX]//' | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz`
+ GUESS=$UNAME_MACHINE-dec-osf$OSF_REL
+ ;;
+ Amiga*:UNIX_System_V:4.0:*)
+ GUESS=m68k-unknown-sysv4
+ ;;
+ *:[Aa]miga[Oo][Ss]:*:*)
+ GUESS=$UNAME_MACHINE-unknown-amigaos
+ ;;
+ *:[Mm]orph[Oo][Ss]:*:*)
+ GUESS=$UNAME_MACHINE-unknown-morphos
+ ;;
+ *:OS/390:*:*)
+ GUESS=i370-ibm-openedition
+ ;;
+ *:z/VM:*:*)
+ GUESS=s390-ibm-zvmoe
+ ;;
+ *:OS400:*:*)
+ GUESS=powerpc-ibm-os400
+ ;;
+ arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*)
+ GUESS=arm-acorn-riscix$UNAME_RELEASE
+ ;;
+ arm*:riscos:*:*|arm*:RISCOS:*:*)
+ GUESS=arm-unknown-riscos
+ ;;
+ SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*)
+ GUESS=hppa1.1-hitachi-hiuxmpp
+ ;;
+ Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*)
+ # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE.
+ case `(/bin/universe) 2>/dev/null` in
+ att) GUESS=pyramid-pyramid-sysv3 ;;
+ *) GUESS=pyramid-pyramid-bsd ;;
+ esac
+ ;;
+ NILE*:*:*:dcosx)
+ GUESS=pyramid-pyramid-svr4
+ ;;
+ DRS?6000:unix:4.0:6*)
+ GUESS=sparc-icl-nx6
+ ;;
+ DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*)
+ case `/usr/bin/uname -p` in
+ sparc) GUESS=sparc-icl-nx7 ;;
+ esac
+ ;;
+ s390x:SunOS:*:*)
+ SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`
+ GUESS=$UNAME_MACHINE-ibm-solaris2$SUN_REL
+ ;;
+ sun4H:SunOS:5.*:*)
+ SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`
+ GUESS=sparc-hal-solaris2$SUN_REL
+ ;;
+ sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*)
+ SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`
+ GUESS=sparc-sun-solaris2$SUN_REL
+ ;;
+ i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*)
+ GUESS=i386-pc-auroraux$UNAME_RELEASE
+ ;;
+ i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*)
+ set_cc_for_build
+ SUN_ARCH=i386
+ # If there is a compiler, see if it is configured for 64-bit objects.
+ # Note that the Sun cc does not turn __LP64__ into 1 like gcc does.
+ # This test works for both compilers.
+ if test "$CC_FOR_BUILD" != no_compiler_found; then
+ if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \
+ (CCOPTS="" $CC_FOR_BUILD -m64 -E - 2>/dev/null) | \
+ grep IS_64BIT_ARCH >/dev/null
+ then
+ SUN_ARCH=x86_64
+ fi
+ fi
+ SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`
+ GUESS=$SUN_ARCH-pc-solaris2$SUN_REL
+ ;;
+ sun4*:SunOS:6*:*)
+ # According to config.sub, this is the proper way to canonicalize
+ # SunOS6. Hard to guess exactly what SunOS6 will be like, but
+ # it's likely to be more like Solaris than SunOS4.
+ SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`
+ GUESS=sparc-sun-solaris3$SUN_REL
+ ;;
+ sun4*:SunOS:*:*)
+ case `/usr/bin/arch -k` in
+ Series*|S4*)
+ UNAME_RELEASE=`uname -v`
+ ;;
+ esac
+ # Japanese Language versions have a version number like '4.1.3-JL'.
+ SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/-/_/'`
+ GUESS=sparc-sun-sunos$SUN_REL
+ ;;
+ sun3*:SunOS:*:*)
+ GUESS=m68k-sun-sunos$UNAME_RELEASE
+ ;;
+ sun*:*:4.2BSD:*)
+ UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null`
+ test "x$UNAME_RELEASE" = x && UNAME_RELEASE=3
+ case `/bin/arch` in
+ sun3)
+ GUESS=m68k-sun-sunos$UNAME_RELEASE
+ ;;
+ sun4)
+ GUESS=sparc-sun-sunos$UNAME_RELEASE
+ ;;
+ esac
+ ;;
+ aushp:SunOS:*:*)
+ GUESS=sparc-auspex-sunos$UNAME_RELEASE
+ ;;
+ # The situation for MiNT is a little confusing. The machine name
+ # can be virtually everything (everything which is not
+ # "atarist" or "atariste" at least should have a processor
+ # > m68000). The system name ranges from "MiNT" over "FreeMiNT"
+ # to the lowercase version "mint" (or "freemint"). Finally
+ # the system name "TOS" denotes a system which is actually not
+ # MiNT. But MiNT is downward compatible to TOS, so this should
+ # be no problem.
+ atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*)
+ GUESS=m68k-atari-mint$UNAME_RELEASE
+ ;;
+ atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*)
+ GUESS=m68k-atari-mint$UNAME_RELEASE
+ ;;
+ *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*)
+ GUESS=m68k-atari-mint$UNAME_RELEASE
+ ;;
+ milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*)
+ GUESS=m68k-milan-mint$UNAME_RELEASE
+ ;;
+ hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*)
+ GUESS=m68k-hades-mint$UNAME_RELEASE
+ ;;
+ *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*)
+ GUESS=m68k-unknown-mint$UNAME_RELEASE
+ ;;
+ m68k:machten:*:*)
+ GUESS=m68k-apple-machten$UNAME_RELEASE
+ ;;
+ powerpc:machten:*:*)
+ GUESS=powerpc-apple-machten$UNAME_RELEASE
+ ;;
+ RISC*:Mach:*:*)
+ GUESS=mips-dec-mach_bsd4.3
+ ;;
+ RISC*:ULTRIX:*:*)
+ GUESS=mips-dec-ultrix$UNAME_RELEASE
+ ;;
+ VAX*:ULTRIX*:*:*)
+ GUESS=vax-dec-ultrix$UNAME_RELEASE
+ ;;
+ 2020:CLIX:*:* | 2430:CLIX:*:*)
+ GUESS=clipper-intergraph-clix$UNAME_RELEASE
+ ;;
+ mips:*:*:UMIPS | mips:*:*:RISCos)
+ set_cc_for_build
+ sed 's/^ //' << EOF > "$dummy.c"
+#ifdef __cplusplus
+#include /* for printf() prototype */
+ int main (int argc, char *argv[]) {
+#else
+ int main (argc, argv) int argc; char *argv[]; {
+#endif
+ #if defined (host_mips) && defined (MIPSEB)
+ #if defined (SYSTYPE_SYSV)
+ printf ("mips-mips-riscos%ssysv\\n", argv[1]); exit (0);
+ #endif
+ #if defined (SYSTYPE_SVR4)
+ printf ("mips-mips-riscos%ssvr4\\n", argv[1]); exit (0);
+ #endif
+ #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD)
+ printf ("mips-mips-riscos%sbsd\\n", argv[1]); exit (0);
+ #endif
+ #endif
+ exit (-1);
+ }
+EOF
+ $CC_FOR_BUILD -o "$dummy" "$dummy.c" &&
+ dummyarg=`echo "$UNAME_RELEASE" | sed -n 's/\([0-9]*\).*/\1/p'` &&
+ SYSTEM_NAME=`"$dummy" "$dummyarg"` &&
+ { echo "$SYSTEM_NAME"; exit; }
+ GUESS=mips-mips-riscos$UNAME_RELEASE
+ ;;
+ Motorola:PowerMAX_OS:*:*)
+ GUESS=powerpc-motorola-powermax
+ ;;
+ Motorola:*:4.3:PL8-*)
+ GUESS=powerpc-harris-powermax
+ ;;
+ Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*)
+ GUESS=powerpc-harris-powermax
+ ;;
+ Night_Hawk:Power_UNIX:*:*)
+ GUESS=powerpc-harris-powerunix
+ ;;
+ m88k:CX/UX:7*:*)
+ GUESS=m88k-harris-cxux7
+ ;;
+ m88k:*:4*:R4*)
+ GUESS=m88k-motorola-sysv4
+ ;;
+ m88k:*:3*:R3*)
+ GUESS=m88k-motorola-sysv3
+ ;;
+ AViiON:dgux:*:*)
+ # DG/UX returns AViiON for all architectures
+ UNAME_PROCESSOR=`/usr/bin/uname -p`
+ if test "$UNAME_PROCESSOR" = mc88100 || test "$UNAME_PROCESSOR" = mc88110
+ then
+ if test "$TARGET_BINARY_INTERFACE"x = m88kdguxelfx || \
+ test "$TARGET_BINARY_INTERFACE"x = x
+ then
+ GUESS=m88k-dg-dgux$UNAME_RELEASE
+ else
+ GUESS=m88k-dg-dguxbcs$UNAME_RELEASE
+ fi
+ else
+ GUESS=i586-dg-dgux$UNAME_RELEASE
+ fi
+ ;;
+ M88*:DolphinOS:*:*) # DolphinOS (SVR3)
+ GUESS=m88k-dolphin-sysv3
+ ;;
+ M88*:*:R3*:*)
+ # Delta 88k system running SVR3
+ GUESS=m88k-motorola-sysv3
+ ;;
+ XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3)
+ GUESS=m88k-tektronix-sysv3
+ ;;
+ Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD)
+ GUESS=m68k-tektronix-bsd
+ ;;
+ *:IRIX*:*:*)
+ IRIX_REL=`echo "$UNAME_RELEASE" | sed -e 's/-/_/g'`
+ GUESS=mips-sgi-irix$IRIX_REL
+ ;;
+ ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX.
+ GUESS=romp-ibm-aix # uname -m gives an 8 hex-code CPU id
+ ;; # Note that: echo "'`uname -s`'" gives 'AIX '
+ i*86:AIX:*:*)
+ GUESS=i386-ibm-aix
+ ;;
+ ia64:AIX:*:*)
+ if test -x /usr/bin/oslevel ; then
+ IBM_REV=`/usr/bin/oslevel`
+ else
+ IBM_REV=$UNAME_VERSION.$UNAME_RELEASE
+ fi
+ GUESS=$UNAME_MACHINE-ibm-aix$IBM_REV
+ ;;
+ *:AIX:2:3)
+ if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then
+ set_cc_for_build
+ sed 's/^ //' << EOF > "$dummy.c"
+ #include
+
+ main()
+ {
+ if (!__power_pc())
+ exit(1);
+ puts("powerpc-ibm-aix3.2.5");
+ exit(0);
+ }
+EOF
+ if $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"`
+ then
+ GUESS=$SYSTEM_NAME
+ else
+ GUESS=rs6000-ibm-aix3.2.5
+ fi
+ elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then
+ GUESS=rs6000-ibm-aix3.2.4
+ else
+ GUESS=rs6000-ibm-aix3.2
+ fi
+ ;;
+ *:AIX:*:[4567])
+ IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'`
+ if /usr/sbin/lsattr -El "$IBM_CPU_ID" | grep ' POWER' >/dev/null 2>&1; then
+ IBM_ARCH=rs6000
+ else
+ IBM_ARCH=powerpc
+ fi
+ if test -x /usr/bin/lslpp ; then
+ IBM_REV=`/usr/bin/lslpp -Lqc bos.rte.libc | \
+ awk -F: '{ print $3 }' | sed s/[0-9]*$/0/`
+ else
+ IBM_REV=$UNAME_VERSION.$UNAME_RELEASE
+ fi
+ GUESS=$IBM_ARCH-ibm-aix$IBM_REV
+ ;;
+ *:AIX:*:*)
+ GUESS=rs6000-ibm-aix
+ ;;
+ ibmrt:4.4BSD:*|romp-ibm:4.4BSD:*)
+ GUESS=romp-ibm-bsd4.4
+ ;;
+ ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and
+ GUESS=romp-ibm-bsd$UNAME_RELEASE # 4.3 with uname added to
+ ;; # report: romp-ibm BSD 4.3
+ *:BOSX:*:*)
+ GUESS=rs6000-bull-bosx
+ ;;
+ DPX/2?00:B.O.S.:*:*)
+ GUESS=m68k-bull-sysv3
+ ;;
+ 9000/[34]??:4.3bsd:1.*:*)
+ GUESS=m68k-hp-bsd
+ ;;
+ hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*)
+ GUESS=m68k-hp-bsd4.4
+ ;;
+ 9000/[34678]??:HP-UX:*:*)
+ HPUX_REV=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*.[0B]*//'`
+ case $UNAME_MACHINE in
+ 9000/31?) HP_ARCH=m68000 ;;
+ 9000/[34]??) HP_ARCH=m68k ;;
+ 9000/[678][0-9][0-9])
+ if test -x /usr/bin/getconf; then
+ sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null`
+ sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null`
+ case $sc_cpu_version in
+ 523) HP_ARCH=hppa1.0 ;; # CPU_PA_RISC1_0
+ 528) HP_ARCH=hppa1.1 ;; # CPU_PA_RISC1_1
+ 532) # CPU_PA_RISC2_0
+ case $sc_kernel_bits in
+ 32) HP_ARCH=hppa2.0n ;;
+ 64) HP_ARCH=hppa2.0w ;;
+ '') HP_ARCH=hppa2.0 ;; # HP-UX 10.20
+ esac ;;
+ esac
+ fi
+ if test "$HP_ARCH" = ""; then
+ set_cc_for_build
+ sed 's/^ //' << EOF > "$dummy.c"
+
+ #define _HPUX_SOURCE
+ #include
+ #include
+
+ int main ()
+ {
+ #if defined(_SC_KERNEL_BITS)
+ long bits = sysconf(_SC_KERNEL_BITS);
+ #endif
+ long cpu = sysconf (_SC_CPU_VERSION);
+
+ switch (cpu)
+ {
+ case CPU_PA_RISC1_0: puts ("hppa1.0"); break;
+ case CPU_PA_RISC1_1: puts ("hppa1.1"); break;
+ case CPU_PA_RISC2_0:
+ #if defined(_SC_KERNEL_BITS)
+ switch (bits)
+ {
+ case 64: puts ("hppa2.0w"); break;
+ case 32: puts ("hppa2.0n"); break;
+ default: puts ("hppa2.0"); break;
+ } break;
+ #else /* !defined(_SC_KERNEL_BITS) */
+ puts ("hppa2.0"); break;
+ #endif
+ default: puts ("hppa1.0"); break;
+ }
+ exit (0);
+ }
+EOF
+ (CCOPTS="" $CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null) && HP_ARCH=`"$dummy"`
+ test -z "$HP_ARCH" && HP_ARCH=hppa
+ fi ;;
+ esac
+ if test "$HP_ARCH" = hppa2.0w
+ then
+ set_cc_for_build
+
+ # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating
+ # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler
+ # generating 64-bit code. GNU and HP use different nomenclature:
+ #
+ # $ CC_FOR_BUILD=cc ./config.guess
+ # => hppa2.0w-hp-hpux11.23
+ # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess
+ # => hppa64-hp-hpux11.23
+
+ if echo __LP64__ | (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) |
+ grep -q __LP64__
+ then
+ HP_ARCH=hppa2.0w
+ else
+ HP_ARCH=hppa64
+ fi
+ fi
+ GUESS=$HP_ARCH-hp-hpux$HPUX_REV
+ ;;
+ ia64:HP-UX:*:*)
+ HPUX_REV=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*.[0B]*//'`
+ GUESS=ia64-hp-hpux$HPUX_REV
+ ;;
+ 3050*:HI-UX:*:*)
+ set_cc_for_build
+ sed 's/^ //' << EOF > "$dummy.c"
+ #include
+ int
+ main ()
+ {
+ long cpu = sysconf (_SC_CPU_VERSION);
+ /* The order matters, because CPU_IS_HP_MC68K erroneously returns
+ true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct
+ results, however. */
+ if (CPU_IS_PA_RISC (cpu))
+ {
+ switch (cpu)
+ {
+ case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break;
+ case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break;
+ case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break;
+ default: puts ("hppa-hitachi-hiuxwe2"); break;
+ }
+ }
+ else if (CPU_IS_HP_MC68K (cpu))
+ puts ("m68k-hitachi-hiuxwe2");
+ else puts ("unknown-hitachi-hiuxwe2");
+ exit (0);
+ }
+EOF
+ $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"` &&
+ { echo "$SYSTEM_NAME"; exit; }
+ GUESS=unknown-hitachi-hiuxwe2
+ ;;
+ 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:*)
+ GUESS=hppa1.1-hp-bsd
+ ;;
+ 9000/8??:4.3bsd:*:*)
+ GUESS=hppa1.0-hp-bsd
+ ;;
+ *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*)
+ GUESS=hppa1.0-hp-mpeix
+ ;;
+ hp7??:OSF1:*:* | hp8?[79]:OSF1:*:*)
+ GUESS=hppa1.1-hp-osf
+ ;;
+ hp8??:OSF1:*:*)
+ GUESS=hppa1.0-hp-osf
+ ;;
+ i*86:OSF1:*:*)
+ if test -x /usr/sbin/sysversion ; then
+ GUESS=$UNAME_MACHINE-unknown-osf1mk
+ else
+ GUESS=$UNAME_MACHINE-unknown-osf1
+ fi
+ ;;
+ parisc*:Lites*:*:*)
+ GUESS=hppa1.1-hp-lites
+ ;;
+ C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*)
+ GUESS=c1-convex-bsd
+ ;;
+ C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*)
+ if getsysinfo -f scalar_acc
+ then echo c32-convex-bsd
+ else echo c2-convex-bsd
+ fi
+ exit ;;
+ C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*)
+ GUESS=c34-convex-bsd
+ ;;
+ C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*)
+ GUESS=c38-convex-bsd
+ ;;
+ C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*)
+ GUESS=c4-convex-bsd
+ ;;
+ CRAY*Y-MP:*:*:*)
+ CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'`
+ GUESS=ymp-cray-unicos$CRAY_REL
+ ;;
+ CRAY*[A-Z]90:*:*:*)
+ echo "$UNAME_MACHINE"-cray-unicos"$UNAME_RELEASE" \
+ | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \
+ -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \
+ -e 's/\.[^.]*$/.X/'
+ exit ;;
+ CRAY*TS:*:*:*)
+ CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'`
+ GUESS=t90-cray-unicos$CRAY_REL
+ ;;
+ CRAY*T3E:*:*:*)
+ CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'`
+ GUESS=alphaev5-cray-unicosmk$CRAY_REL
+ ;;
+ CRAY*SV1:*:*:*)
+ CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'`
+ GUESS=sv1-cray-unicos$CRAY_REL
+ ;;
+ *:UNICOS/mp:*:*)
+ CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'`
+ GUESS=craynv-cray-unicosmp$CRAY_REL
+ ;;
+ F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*)
+ FUJITSU_PROC=`uname -m | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz`
+ FUJITSU_SYS=`uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///'`
+ FUJITSU_REL=`echo "$UNAME_RELEASE" | sed -e 's/ /_/'`
+ GUESS=${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}
+ ;;
+ 5000:UNIX_System_V:4.*:*)
+ FUJITSU_SYS=`uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///'`
+ FUJITSU_REL=`echo "$UNAME_RELEASE" | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/ /_/'`
+ GUESS=sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}
+ ;;
+ i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*)
+ GUESS=$UNAME_MACHINE-pc-bsdi$UNAME_RELEASE
+ ;;
+ sparc*:BSD/OS:*:*)
+ GUESS=sparc-unknown-bsdi$UNAME_RELEASE
+ ;;
+ *:BSD/OS:*:*)
+ GUESS=$UNAME_MACHINE-unknown-bsdi$UNAME_RELEASE
+ ;;
+ arm:FreeBSD:*:*)
+ UNAME_PROCESSOR=`uname -p`
+ set_cc_for_build
+ if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \
+ | grep -q __ARM_PCS_VFP
+ then
+ FREEBSD_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'`
+ GUESS=$UNAME_PROCESSOR-unknown-freebsd$FREEBSD_REL-gnueabi
+ else
+ FREEBSD_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'`
+ GUESS=$UNAME_PROCESSOR-unknown-freebsd$FREEBSD_REL-gnueabihf
+ fi
+ ;;
+ *:FreeBSD:*:*)
+ UNAME_PROCESSOR=`uname -p`
+ case $UNAME_PROCESSOR in
+ amd64)
+ UNAME_PROCESSOR=x86_64 ;;
+ i386)
+ UNAME_PROCESSOR=i586 ;;
+ esac
+ FREEBSD_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'`
+ GUESS=$UNAME_PROCESSOR-unknown-freebsd$FREEBSD_REL
+ ;;
+ i*:CYGWIN*:*)
+ GUESS=$UNAME_MACHINE-pc-cygwin
+ ;;
+ *:MINGW64*:*)
+ GUESS=$UNAME_MACHINE-pc-mingw64
+ ;;
+ *:MINGW*:*)
+ GUESS=$UNAME_MACHINE-pc-mingw32
+ ;;
+ *:MSYS*:*)
+ GUESS=$UNAME_MACHINE-pc-msys
+ ;;
+ i*:PW*:*)
+ GUESS=$UNAME_MACHINE-pc-pw32
+ ;;
+ *:SerenityOS:*:*)
+ GUESS=$UNAME_MACHINE-pc-serenity
+ ;;
+ *:Interix*:*)
+ case $UNAME_MACHINE in
+ x86)
+ GUESS=i586-pc-interix$UNAME_RELEASE
+ ;;
+ authenticamd | genuineintel | EM64T)
+ GUESS=x86_64-unknown-interix$UNAME_RELEASE
+ ;;
+ IA64)
+ GUESS=ia64-unknown-interix$UNAME_RELEASE
+ ;;
+ esac ;;
+ i*:UWIN*:*)
+ GUESS=$UNAME_MACHINE-pc-uwin
+ ;;
+ amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*)
+ GUESS=x86_64-pc-cygwin
+ ;;
+ prep*:SunOS:5.*:*)
+ SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`
+ GUESS=powerpcle-unknown-solaris2$SUN_REL
+ ;;
+ *:GNU:*:*)
+ # the GNU system
+ GNU_ARCH=`echo "$UNAME_MACHINE" | sed -e 's,[-/].*$,,'`
+ GNU_REL=`echo "$UNAME_RELEASE" | sed -e 's,/.*$,,'`
+ GUESS=$GNU_ARCH-unknown-$LIBC$GNU_REL
+ ;;
+ *:GNU/*:*:*)
+ # other systems with GNU libc and userland
+ GNU_SYS=`echo "$UNAME_SYSTEM" | sed 's,^[^/]*/,,' | tr "[:upper:]" "[:lower:]"`
+ GNU_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'`
+ GUESS=$UNAME_MACHINE-unknown-$GNU_SYS$GNU_REL-$LIBC
+ ;;
+ x86_64:[Mm]anagarm:*:*|i?86:[Mm]anagarm:*:*)
+ GUESS="$UNAME_MACHINE-pc-managarm-mlibc"
+ ;;
+ *:[Mm]anagarm:*:*)
+ GUESS="$UNAME_MACHINE-unknown-managarm-mlibc"
+ ;;
+ *:Minix:*:*)
+ GUESS=$UNAME_MACHINE-unknown-minix
+ ;;
+ aarch64:Linux:*:*)
+ set_cc_for_build
+ CPU=$UNAME_MACHINE
+ LIBCABI=$LIBC
+ if test "$CC_FOR_BUILD" != no_compiler_found; then
+ ABI=64
+ sed 's/^ //' << EOF > "$dummy.c"
+ #ifdef __ARM_EABI__
+ #ifdef __ARM_PCS_VFP
+ ABI=eabihf
+ #else
+ ABI=eabi
+ #endif
+ #endif
+EOF
+ cc_set_abi=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^ABI' | sed 's, ,,g'`
+ eval "$cc_set_abi"
+ case $ABI in
+ eabi | eabihf) CPU=armv8l; LIBCABI=$LIBC$ABI ;;
+ esac
+ fi
+ GUESS=$CPU-unknown-linux-$LIBCABI
+ ;;
+ aarch64_be:Linux:*:*)
+ UNAME_MACHINE=aarch64_be
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ alpha:Linux:*:*)
+ case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' /proc/cpuinfo 2>/dev/null` in
+ EV5) UNAME_MACHINE=alphaev5 ;;
+ EV56) UNAME_MACHINE=alphaev56 ;;
+ PCA56) UNAME_MACHINE=alphapca56 ;;
+ PCA57) UNAME_MACHINE=alphapca56 ;;
+ EV6) UNAME_MACHINE=alphaev6 ;;
+ EV67) UNAME_MACHINE=alphaev67 ;;
+ EV68*) UNAME_MACHINE=alphaev68 ;;
+ esac
+ objdump --private-headers /bin/sh | grep -q ld.so.1
+ if test "$?" = 0 ; then LIBC=gnulibc1 ; fi
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ arc:Linux:*:* | arceb:Linux:*:* | arc32:Linux:*:* | arc64:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ arm*:Linux:*:*)
+ set_cc_for_build
+ if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \
+ | grep -q __ARM_EABI__
+ then
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ else
+ if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \
+ | grep -q __ARM_PCS_VFP
+ then
+ GUESS=$UNAME_MACHINE-unknown-linux-${LIBC}eabi
+ else
+ GUESS=$UNAME_MACHINE-unknown-linux-${LIBC}eabihf
+ fi
+ fi
+ ;;
+ avr32*:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ cris:Linux:*:*)
+ GUESS=$UNAME_MACHINE-axis-linux-$LIBC
+ ;;
+ crisv32:Linux:*:*)
+ GUESS=$UNAME_MACHINE-axis-linux-$LIBC
+ ;;
+ e2k:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ frv:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ hexagon:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ i*86:Linux:*:*)
+ GUESS=$UNAME_MACHINE-pc-linux-$LIBC
+ ;;
+ ia64:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ k1om:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ kvx:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ kvx:cos:*:*)
+ GUESS=$UNAME_MACHINE-unknown-cos
+ ;;
+ kvx:mbr:*:*)
+ GUESS=$UNAME_MACHINE-unknown-mbr
+ ;;
+ loongarch32:Linux:*:* | loongarch64:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ m32r*:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ m68*:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ mips:Linux:*:* | mips64:Linux:*:*)
+ set_cc_for_build
+ IS_GLIBC=0
+ test x"${LIBC}" = xgnu && IS_GLIBC=1
+ sed 's/^ //' << EOF > "$dummy.c"
+ #undef CPU
+ #undef mips
+ #undef mipsel
+ #undef mips64
+ #undef mips64el
+ #if ${IS_GLIBC} && defined(_ABI64)
+ LIBCABI=gnuabi64
+ #else
+ #if ${IS_GLIBC} && defined(_ABIN32)
+ LIBCABI=gnuabin32
+ #else
+ LIBCABI=${LIBC}
+ #endif
+ #endif
+
+ #if ${IS_GLIBC} && defined(__mips64) && defined(__mips_isa_rev) && __mips_isa_rev>=6
+ CPU=mipsisa64r6
+ #else
+ #if ${IS_GLIBC} && !defined(__mips64) && defined(__mips_isa_rev) && __mips_isa_rev>=6
+ CPU=mipsisa32r6
+ #else
+ #if defined(__mips64)
+ CPU=mips64
+ #else
+ CPU=mips
+ #endif
+ #endif
+ #endif
+
+ #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL)
+ MIPS_ENDIAN=el
+ #else
+ #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB)
+ MIPS_ENDIAN=
+ #else
+ MIPS_ENDIAN=
+ #endif
+ #endif
+EOF
+ cc_set_vars=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^CPU\|^MIPS_ENDIAN\|^LIBCABI'`
+ eval "$cc_set_vars"
+ test "x$CPU" != x && { echo "$CPU${MIPS_ENDIAN}-unknown-linux-$LIBCABI"; exit; }
+ ;;
+ mips64el:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ openrisc*:Linux:*:*)
+ GUESS=or1k-unknown-linux-$LIBC
+ ;;
+ or32:Linux:*:* | or1k*:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ padre:Linux:*:*)
+ GUESS=sparc-unknown-linux-$LIBC
+ ;;
+ parisc64:Linux:*:* | hppa64:Linux:*:*)
+ GUESS=hppa64-unknown-linux-$LIBC
+ ;;
+ parisc:Linux:*:* | hppa:Linux:*:*)
+ # Look for CPU level
+ case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in
+ PA7*) GUESS=hppa1.1-unknown-linux-$LIBC ;;
+ PA8*) GUESS=hppa2.0-unknown-linux-$LIBC ;;
+ *) GUESS=hppa-unknown-linux-$LIBC ;;
+ esac
+ ;;
+ ppc64:Linux:*:*)
+ GUESS=powerpc64-unknown-linux-$LIBC
+ ;;
+ ppc:Linux:*:*)
+ GUESS=powerpc-unknown-linux-$LIBC
+ ;;
+ ppc64le:Linux:*:*)
+ GUESS=powerpc64le-unknown-linux-$LIBC
+ ;;
+ ppcle:Linux:*:*)
+ GUESS=powerpcle-unknown-linux-$LIBC
+ ;;
+ riscv32:Linux:*:* | riscv32be:Linux:*:* | riscv64:Linux:*:* | riscv64be:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ s390:Linux:*:* | s390x:Linux:*:*)
+ GUESS=$UNAME_MACHINE-ibm-linux-$LIBC
+ ;;
+ sh64*:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ sh*:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ sparc:Linux:*:* | sparc64:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ tile*:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ vax:Linux:*:*)
+ GUESS=$UNAME_MACHINE-dec-linux-$LIBC
+ ;;
+ x86_64:Linux:*:*)
+ set_cc_for_build
+ CPU=$UNAME_MACHINE
+ LIBCABI=$LIBC
+ if test "$CC_FOR_BUILD" != no_compiler_found; then
+ ABI=64
+ sed 's/^ //' << EOF > "$dummy.c"
+ #ifdef __i386__
+ ABI=x86
+ #else
+ #ifdef __ILP32__
+ ABI=x32
+ #endif
+ #endif
+EOF
+ cc_set_abi=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^ABI' | sed 's, ,,g'`
+ eval "$cc_set_abi"
+ case $ABI in
+ x86) CPU=i686 ;;
+ x32) LIBCABI=${LIBC}x32 ;;
+ esac
+ fi
+ GUESS=$CPU-pc-linux-$LIBCABI
+ ;;
+ xtensa*:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ i*86:DYNIX/ptx:4*:*)
+ # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there.
+ # earlier versions are messed up and put the nodename in both
+ # sysname and nodename.
+ GUESS=i386-sequent-sysv4
+ ;;
+ i*86:UNIX_SV:4.2MP:2.*)
+ # Unixware is an offshoot of SVR4, but it has its own version
+ # number series starting with 2...
+ # I am not positive that other SVR4 systems won't match this,
+ # I just have to hope. -- rms.
+ # Use sysv4.2uw... so that sysv4* matches it.
+ GUESS=$UNAME_MACHINE-pc-sysv4.2uw$UNAME_VERSION
+ ;;
+ i*86:OS/2:*:*)
+ # If we were able to find 'uname', then EMX Unix compatibility
+ # is probably installed.
+ GUESS=$UNAME_MACHINE-pc-os2-emx
+ ;;
+ i*86:XTS-300:*:STOP)
+ GUESS=$UNAME_MACHINE-unknown-stop
+ ;;
+ i*86:atheos:*:*)
+ GUESS=$UNAME_MACHINE-unknown-atheos
+ ;;
+ i*86:syllable:*:*)
+ GUESS=$UNAME_MACHINE-pc-syllable
+ ;;
+ i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*)
+ GUESS=i386-unknown-lynxos$UNAME_RELEASE
+ ;;
+ i*86:*DOS:*:*)
+ GUESS=$UNAME_MACHINE-pc-msdosdjgpp
+ ;;
+ i*86:*:4.*:*)
+ UNAME_REL=`echo "$UNAME_RELEASE" | sed 's/\/MP$//'`
+ if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then
+ GUESS=$UNAME_MACHINE-univel-sysv$UNAME_REL
+ else
+ GUESS=$UNAME_MACHINE-pc-sysv$UNAME_REL
+ fi
+ ;;
+ i*86:*:5:[678]*)
+ # UnixWare 7.x, OpenUNIX and OpenServer 6.
+ case `/bin/uname -X | grep "^Machine"` in
+ *486*) UNAME_MACHINE=i486 ;;
+ *Pentium) UNAME_MACHINE=i586 ;;
+ *Pent*|*Celeron) UNAME_MACHINE=i686 ;;
+ esac
+ GUESS=$UNAME_MACHINE-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION}
+ ;;
+ i*86:*:3.2:*)
+ if test -f /usr/options/cb.name; then
+ UNAME_REL=`sed -n 's/.*Version //p' /dev/null >/dev/null ; then
+ UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')`
+ (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486
+ (/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \
+ && UNAME_MACHINE=i586
+ (/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \
+ && UNAME_MACHINE=i686
+ (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \
+ && UNAME_MACHINE=i686
+ GUESS=$UNAME_MACHINE-pc-sco$UNAME_REL
+ else
+ GUESS=$UNAME_MACHINE-pc-sysv32
+ fi
+ ;;
+ pc:*:*:*)
+ # Left here for compatibility:
+ # uname -m prints for DJGPP always 'pc', but it prints nothing about
+ # the processor, so we play safe by assuming i586.
+ # Note: whatever this is, it MUST be the same as what config.sub
+ # prints for the "djgpp" host, or else GDB configure will decide that
+ # this is a cross-build.
+ GUESS=i586-pc-msdosdjgpp
+ ;;
+ Intel:Mach:3*:*)
+ GUESS=i386-pc-mach3
+ ;;
+ paragon:*:*:*)
+ GUESS=i860-intel-osf1
+ ;;
+ i860:*:4.*:*) # i860-SVR4
+ if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then
+ GUESS=i860-stardent-sysv$UNAME_RELEASE # Stardent Vistra i860-SVR4
+ else # Add other i860-SVR4 vendors below as they are discovered.
+ GUESS=i860-unknown-sysv$UNAME_RELEASE # Unknown i860-SVR4
+ fi
+ ;;
+ mini*:CTIX:SYS*5:*)
+ # "miniframe"
+ GUESS=m68010-convergent-sysv
+ ;;
+ mc68k:UNIX:SYSTEM5:3.51m)
+ GUESS=m68k-convergent-sysv
+ ;;
+ M680?0:D-NIX:5.3:*)
+ GUESS=m68k-diab-dnix
+ ;;
+ M68*:*:R3V[5678]*:*)
+ test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;;
+ 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0)
+ OS_REL=''
+ test -r /etc/.relid \
+ && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`
+ /bin/uname -p 2>/dev/null | grep 86 >/dev/null \
+ && { echo i486-ncr-sysv4.3"$OS_REL"; exit; }
+ /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \
+ && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } ;;
+ 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*)
+ /bin/uname -p 2>/dev/null | grep 86 >/dev/null \
+ && { echo i486-ncr-sysv4; exit; } ;;
+ NCR*:*:4.2:* | MPRAS*:*:4.2:*)
+ OS_REL='.3'
+ test -r /etc/.relid \
+ && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`
+ /bin/uname -p 2>/dev/null | grep 86 >/dev/null \
+ && { echo i486-ncr-sysv4.3"$OS_REL"; exit; }
+ /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \
+ && { echo i586-ncr-sysv4.3"$OS_REL"; exit; }
+ /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \
+ && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } ;;
+ m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*)
+ GUESS=m68k-unknown-lynxos$UNAME_RELEASE
+ ;;
+ mc68030:UNIX_System_V:4.*:*)
+ GUESS=m68k-atari-sysv4
+ ;;
+ TSUNAMI:LynxOS:2.*:*)
+ GUESS=sparc-unknown-lynxos$UNAME_RELEASE
+ ;;
+ rs6000:LynxOS:2.*:*)
+ GUESS=rs6000-unknown-lynxos$UNAME_RELEASE
+ ;;
+ PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*)
+ GUESS=powerpc-unknown-lynxos$UNAME_RELEASE
+ ;;
+ SM[BE]S:UNIX_SV:*:*)
+ GUESS=mips-dde-sysv$UNAME_RELEASE
+ ;;
+ RM*:ReliantUNIX-*:*:*)
+ GUESS=mips-sni-sysv4
+ ;;
+ RM*:SINIX-*:*:*)
+ GUESS=mips-sni-sysv4
+ ;;
+ *:SINIX-*:*:*)
+ if uname -p 2>/dev/null >/dev/null ; then
+ UNAME_MACHINE=`(uname -p) 2>/dev/null`
+ GUESS=$UNAME_MACHINE-sni-sysv4
+ else
+ GUESS=ns32k-sni-sysv
+ fi
+ ;;
+ PENTIUM:*:4.0*:*) # Unisys 'ClearPath HMP IX 4000' SVR4/MP effort
+ # says
+ GUESS=i586-unisys-sysv4
+ ;;
+ *:UNIX_System_V:4*:FTX*)
+ # From Gerald Hewes .
+ # How about differentiating between stratus architectures? -djm
+ GUESS=hppa1.1-stratus-sysv4
+ ;;
+ *:*:*:FTX*)
+ # From seanf@swdc.stratus.com.
+ GUESS=i860-stratus-sysv4
+ ;;
+ i*86:VOS:*:*)
+ # From Paul.Green@stratus.com.
+ GUESS=$UNAME_MACHINE-stratus-vos
+ ;;
+ *:VOS:*:*)
+ # From Paul.Green@stratus.com.
+ GUESS=hppa1.1-stratus-vos
+ ;;
+ mc68*:A/UX:*:*)
+ GUESS=m68k-apple-aux$UNAME_RELEASE
+ ;;
+ news*:NEWS-OS:6*:*)
+ GUESS=mips-sony-newsos6
+ ;;
+ R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*)
+ if test -d /usr/nec; then
+ GUESS=mips-nec-sysv$UNAME_RELEASE
+ else
+ GUESS=mips-unknown-sysv$UNAME_RELEASE
+ fi
+ ;;
+ BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only.
+ GUESS=powerpc-be-beos
+ ;;
+ BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only.
+ GUESS=powerpc-apple-beos
+ ;;
+ BePC:BeOS:*:*) # BeOS running on Intel PC compatible.
+ GUESS=i586-pc-beos
+ ;;
+ BePC:Haiku:*:*) # Haiku running on Intel PC compatible.
+ GUESS=i586-pc-haiku
+ ;;
+ ppc:Haiku:*:*) # Haiku running on Apple PowerPC
+ GUESS=powerpc-apple-haiku
+ ;;
+ *:Haiku:*:*) # Haiku modern gcc (not bound by BeOS compat)
+ GUESS=$UNAME_MACHINE-unknown-haiku
+ ;;
+ SX-4:SUPER-UX:*:*)
+ GUESS=sx4-nec-superux$UNAME_RELEASE
+ ;;
+ SX-5:SUPER-UX:*:*)
+ GUESS=sx5-nec-superux$UNAME_RELEASE
+ ;;
+ SX-6:SUPER-UX:*:*)
+ GUESS=sx6-nec-superux$UNAME_RELEASE
+ ;;
+ SX-7:SUPER-UX:*:*)
+ GUESS=sx7-nec-superux$UNAME_RELEASE
+ ;;
+ SX-8:SUPER-UX:*:*)
+ GUESS=sx8-nec-superux$UNAME_RELEASE
+ ;;
+ SX-8R:SUPER-UX:*:*)
+ GUESS=sx8r-nec-superux$UNAME_RELEASE
+ ;;
+ SX-ACE:SUPER-UX:*:*)
+ GUESS=sxace-nec-superux$UNAME_RELEASE
+ ;;
+ Power*:Rhapsody:*:*)
+ GUESS=powerpc-apple-rhapsody$UNAME_RELEASE
+ ;;
+ *:Rhapsody:*:*)
+ GUESS=$UNAME_MACHINE-apple-rhapsody$UNAME_RELEASE
+ ;;
+ arm64:Darwin:*:*)
+ GUESS=aarch64-apple-darwin$UNAME_RELEASE
+ ;;
+ *:Darwin:*:*)
+ UNAME_PROCESSOR=`uname -p`
+ case $UNAME_PROCESSOR in
+ unknown) UNAME_PROCESSOR=powerpc ;;
+ esac
+ if command -v xcode-select > /dev/null 2> /dev/null && \
+ ! xcode-select --print-path > /dev/null 2> /dev/null ; then
+ # Avoid executing cc if there is no toolchain installed as
+ # cc will be a stub that puts up a graphical alert
+ # prompting the user to install developer tools.
+ CC_FOR_BUILD=no_compiler_found
+ else
+ set_cc_for_build
+ fi
+ if test "$CC_FOR_BUILD" != no_compiler_found; then
+ if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \
+ (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \
+ grep IS_64BIT_ARCH >/dev/null
+ then
+ case $UNAME_PROCESSOR in
+ i386) UNAME_PROCESSOR=x86_64 ;;
+ powerpc) UNAME_PROCESSOR=powerpc64 ;;
+ esac
+ fi
+ # On 10.4-10.6 one might compile for PowerPC via gcc -arch ppc
+ if (echo '#ifdef __POWERPC__'; echo IS_PPC; echo '#endif') | \
+ (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \
+ grep IS_PPC >/dev/null
+ then
+ UNAME_PROCESSOR=powerpc
+ fi
+ elif test "$UNAME_PROCESSOR" = i386 ; then
+ # uname -m returns i386 or x86_64
+ UNAME_PROCESSOR=$UNAME_MACHINE
+ fi
+ GUESS=$UNAME_PROCESSOR-apple-darwin$UNAME_RELEASE
+ ;;
+ *:procnto*:*:* | *:QNX:[0123456789]*:*)
+ UNAME_PROCESSOR=`uname -p`
+ if test "$UNAME_PROCESSOR" = x86; then
+ UNAME_PROCESSOR=i386
+ UNAME_MACHINE=pc
+ fi
+ GUESS=$UNAME_PROCESSOR-$UNAME_MACHINE-nto-qnx$UNAME_RELEASE
+ ;;
+ *:QNX:*:4*)
+ GUESS=i386-pc-qnx
+ ;;
+ NEO-*:NONSTOP_KERNEL:*:*)
+ GUESS=neo-tandem-nsk$UNAME_RELEASE
+ ;;
+ NSE-*:NONSTOP_KERNEL:*:*)
+ GUESS=nse-tandem-nsk$UNAME_RELEASE
+ ;;
+ NSR-*:NONSTOP_KERNEL:*:*)
+ GUESS=nsr-tandem-nsk$UNAME_RELEASE
+ ;;
+ NSV-*:NONSTOP_KERNEL:*:*)
+ GUESS=nsv-tandem-nsk$UNAME_RELEASE
+ ;;
+ NSX-*:NONSTOP_KERNEL:*:*)
+ GUESS=nsx-tandem-nsk$UNAME_RELEASE
+ ;;
+ *:NonStop-UX:*:*)
+ GUESS=mips-compaq-nonstopux
+ ;;
+ BS2000:POSIX*:*:*)
+ GUESS=bs2000-siemens-sysv
+ ;;
+ DS/*:UNIX_System_V:*:*)
+ GUESS=$UNAME_MACHINE-$UNAME_SYSTEM-$UNAME_RELEASE
+ ;;
+ *:Plan9:*:*)
+ # "uname -m" is not consistent, so use $cputype instead. 386
+ # is converted to i386 for consistency with other x86
+ # operating systems.
+ if test "${cputype-}" = 386; then
+ UNAME_MACHINE=i386
+ elif test "x${cputype-}" != x; then
+ UNAME_MACHINE=$cputype
+ fi
+ GUESS=$UNAME_MACHINE-unknown-plan9
+ ;;
+ *:TOPS-10:*:*)
+ GUESS=pdp10-unknown-tops10
+ ;;
+ *:TENEX:*:*)
+ GUESS=pdp10-unknown-tenex
+ ;;
+ KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*)
+ GUESS=pdp10-dec-tops20
+ ;;
+ XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*)
+ GUESS=pdp10-xkl-tops20
+ ;;
+ *:TOPS-20:*:*)
+ GUESS=pdp10-unknown-tops20
+ ;;
+ *:ITS:*:*)
+ GUESS=pdp10-unknown-its
+ ;;
+ SEI:*:*:SEIUX)
+ GUESS=mips-sei-seiux$UNAME_RELEASE
+ ;;
+ *:DragonFly:*:*)
+ DRAGONFLY_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'`
+ GUESS=$UNAME_MACHINE-unknown-dragonfly$DRAGONFLY_REL
+ ;;
+ *:*VMS:*:*)
+ UNAME_MACHINE=`(uname -p) 2>/dev/null`
+ case $UNAME_MACHINE in
+ A*) GUESS=alpha-dec-vms ;;
+ I*) GUESS=ia64-dec-vms ;;
+ V*) GUESS=vax-dec-vms ;;
+ esac ;;
+ *:XENIX:*:SysV)
+ GUESS=i386-pc-xenix
+ ;;
+ i*86:skyos:*:*)
+ SKYOS_REL=`echo "$UNAME_RELEASE" | sed -e 's/ .*$//'`
+ GUESS=$UNAME_MACHINE-pc-skyos$SKYOS_REL
+ ;;
+ i*86:rdos:*:*)
+ GUESS=$UNAME_MACHINE-pc-rdos
+ ;;
+ i*86:Fiwix:*:*)
+ GUESS=$UNAME_MACHINE-pc-fiwix
+ ;;
+ *:AROS:*:*)
+ GUESS=$UNAME_MACHINE-unknown-aros
+ ;;
+ x86_64:VMkernel:*:*)
+ GUESS=$UNAME_MACHINE-unknown-esx
+ ;;
+ amd64:Isilon\ OneFS:*:*)
+ GUESS=x86_64-unknown-onefs
+ ;;
+ *:Unleashed:*:*)
+ GUESS=$UNAME_MACHINE-unknown-unleashed$UNAME_RELEASE
+ ;;
+ *:Ironclad:*:*)
+ GUESS=$UNAME_MACHINE-unknown-ironclad
+ ;;
+esac
+
+# Do we have a guess based on uname results?
+if test "x$GUESS" != x; then
+ echo "$GUESS"
+ exit
+fi
+
+# No uname command or uname output not recognized.
+set_cc_for_build
+cat > "$dummy.c" <
+#include
+#endif
+#if defined(ultrix) || defined(_ultrix) || defined(__ultrix) || defined(__ultrix__)
+#if defined (vax) || defined (__vax) || defined (__vax__) || defined(mips) || defined(__mips) || defined(__mips__) || defined(MIPS) || defined(__MIPS__)
+#include
+#if defined(_SIZE_T_) || defined(SIGLOST)
+#include
+#endif
+#endif
+#endif
+main ()
+{
+#if defined (sony)
+#if defined (MIPSEB)
+ /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed,
+ I don't know.... */
+ printf ("mips-sony-bsd\n"); exit (0);
+#else
+#include
+ printf ("m68k-sony-newsos%s\n",
+#ifdef NEWSOS4
+ "4"
+#else
+ ""
+#endif
+ ); exit (0);
+#endif
+#endif
+
+#if defined (NeXT)
+#if !defined (__ARCHITECTURE__)
+#define __ARCHITECTURE__ "m68k"
+#endif
+ int version;
+ version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`;
+ if (version < 4)
+ printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version);
+ else
+ printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version);
+ exit (0);
+#endif
+
+#if defined (MULTIMAX) || defined (n16)
+#if defined (UMAXV)
+ printf ("ns32k-encore-sysv\n"); exit (0);
+#else
+#if defined (CMU)
+ printf ("ns32k-encore-mach\n"); exit (0);
+#else
+ printf ("ns32k-encore-bsd\n"); exit (0);
+#endif
+#endif
+#endif
+
+#if defined (__386BSD__)
+ printf ("i386-pc-bsd\n"); exit (0);
+#endif
+
+#if defined (sequent)
+#if defined (i386)
+ printf ("i386-sequent-dynix\n"); exit (0);
+#endif
+#if defined (ns32000)
+ printf ("ns32k-sequent-dynix\n"); exit (0);
+#endif
+#endif
+
+#if defined (_SEQUENT_)
+ struct utsname un;
+
+ uname(&un);
+ if (strncmp(un.version, "V2", 2) == 0) {
+ printf ("i386-sequent-ptx2\n"); exit (0);
+ }
+ if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */
+ printf ("i386-sequent-ptx1\n"); exit (0);
+ }
+ printf ("i386-sequent-ptx\n"); exit (0);
+#endif
+
+#if defined (vax)
+#if !defined (ultrix)
+#include
+#if defined (BSD)
+#if BSD == 43
+ printf ("vax-dec-bsd4.3\n"); exit (0);
+#else
+#if BSD == 199006
+ printf ("vax-dec-bsd4.3reno\n"); exit (0);
+#else
+ printf ("vax-dec-bsd\n"); exit (0);
+#endif
+#endif
+#else
+ printf ("vax-dec-bsd\n"); exit (0);
+#endif
+#else
+#if defined(_SIZE_T_) || defined(SIGLOST)
+ struct utsname un;
+ uname (&un);
+ printf ("vax-dec-ultrix%s\n", un.release); exit (0);
+#else
+ printf ("vax-dec-ultrix\n"); exit (0);
+#endif
+#endif
+#endif
+#if defined(ultrix) || defined(_ultrix) || defined(__ultrix) || defined(__ultrix__)
+#if defined(mips) || defined(__mips) || defined(__mips__) || defined(MIPS) || defined(__MIPS__)
+#if defined(_SIZE_T_) || defined(SIGLOST)
+ struct utsname *un;
+ uname (&un);
+ printf ("mips-dec-ultrix%s\n", un.release); exit (0);
+#else
+ printf ("mips-dec-ultrix\n"); exit (0);
+#endif
+#endif
+#endif
+
+#if defined (alliant) && defined (i860)
+ printf ("i860-alliant-bsd\n"); exit (0);
+#endif
+
+ exit (1);
+}
+EOF
+
+$CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null && SYSTEM_NAME=`"$dummy"` &&
+ { echo "$SYSTEM_NAME"; exit; }
+
+# Apollos put the system type in the environment.
+test -d /usr/apollo && { echo "$ISP-apollo-$SYSTYPE"; exit; }
+
+echo "$0: unable to guess system type" >&2
+
+case $UNAME_MACHINE:$UNAME_SYSTEM in
+ mips:Linux | mips64:Linux)
+ # If we got here on MIPS GNU/Linux, output extra information.
+ cat >&2 <&2 <&2 </dev/null || echo unknown`
+uname -r = `(uname -r) 2>/dev/null || echo unknown`
+uname -s = `(uname -s) 2>/dev/null || echo unknown`
+uname -v = `(uname -v) 2>/dev/null || echo unknown`
+
+/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null`
+/bin/uname -X = `(/bin/uname -X) 2>/dev/null`
+
+hostinfo = `(hostinfo) 2>/dev/null`
+/bin/universe = `(/bin/universe) 2>/dev/null`
+/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null`
+/bin/arch = `(/bin/arch) 2>/dev/null`
+/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null`
+/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null`
+
+UNAME_MACHINE = "$UNAME_MACHINE"
+UNAME_RELEASE = "$UNAME_RELEASE"
+UNAME_SYSTEM = "$UNAME_SYSTEM"
+UNAME_VERSION = "$UNAME_VERSION"
+EOF
+fi
+
+exit 1
+
+# Local variables:
+# eval: (add-hook 'before-save-hook 'time-stamp)
+# time-stamp-start: "timestamp='"
+# time-stamp-format: "%:y-%02m-%02d"
+# time-stamp-end: "'"
+# End:
diff --git a/rts/config.sub b/rts/config.sub
new file mode 100755
index 000000000000..2c6a07ab3c34
--- /dev/null
+++ b/rts/config.sub
@@ -0,0 +1,1971 @@
+#! /bin/sh
+# Configuration validation subroutine script.
+# Copyright 1992-2024 Free Software Foundation, Inc.
+
+# shellcheck disable=SC2006,SC2268 # see below for rationale
+
+timestamp='2024-01-01'
+
+# This file is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, see .
+#
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that
+# program. This Exception is an additional permission under section 7
+# of the GNU General Public License, version 3 ("GPLv3").
+
+
+# Please send patches to .
+#
+# Configuration subroutine to validate and canonicalize a configuration type.
+# Supply the specified configuration type as an argument.
+# If it is invalid, we print an error message on stderr and exit with code 1.
+# Otherwise, we print the canonical config type on stdout and succeed.
+
+# You can get the latest version of this script from:
+# https://git.savannah.gnu.org/cgit/config.git/plain/config.sub
+
+# This file is supposed to be the same for all GNU packages
+# and recognize all the CPU types, system types and aliases
+# that are meaningful with *any* GNU software.
+# Each package is responsible for reporting which valid configurations
+# it does not support. The user should be able to distinguish
+# a failure to support a valid configuration from a meaningless
+# configuration.
+
+# The goal of this file is to map all the various variations of a given
+# machine specification into a single specification in the form:
+# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM
+# or in some cases, the newer four-part form:
+# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM
+# It is wrong to echo any other type of specification.
+
+# The "shellcheck disable" line above the timestamp inhibits complaints
+# about features and limitations of the classic Bourne shell that were
+# superseded or lifted in POSIX. However, this script identifies a wide
+# variety of pre-POSIX systems that do not have POSIX shells at all, and
+# even some reasonably current systems (Solaris 10 as case-in-point) still
+# have a pre-POSIX /bin/sh.
+
+me=`echo "$0" | sed -e 's,.*/,,'`
+
+usage="\
+Usage: $0 [OPTION] CPU-MFR-OPSYS or ALIAS
+
+Canonicalize a configuration name.
+
+Options:
+ -h, --help print this help, then exit
+ -t, --time-stamp print date of last modification, then exit
+ -v, --version print version number, then exit
+
+Report bugs and patches to ."
+
+version="\
+GNU config.sub ($timestamp)
+
+Copyright 1992-2024 Free Software Foundation, Inc.
+
+This is free software; see the source for copying conditions. There is NO
+warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
+
+help="
+Try '$me --help' for more information."
+
+# Parse command line
+while test $# -gt 0 ; do
+ case $1 in
+ --time-stamp | --time* | -t )
+ echo "$timestamp" ; exit ;;
+ --version | -v )
+ echo "$version" ; exit ;;
+ --help | --h* | -h )
+ echo "$usage"; exit ;;
+ -- ) # Stop option processing
+ shift; break ;;
+ - ) # Use stdin as input.
+ break ;;
+ -* )
+ echo "$me: invalid option $1$help" >&2
+ exit 1 ;;
+
+ *local*)
+ # First pass through any local machine types.
+ echo "$1"
+ exit ;;
+
+ * )
+ break ;;
+ esac
+done
+
+case $# in
+ 0) echo "$me: missing argument$help" >&2
+ exit 1;;
+ 1) ;;
+ *) echo "$me: too many arguments$help" >&2
+ exit 1;;
+esac
+
+# Split fields of configuration type
+# shellcheck disable=SC2162
+saved_IFS=$IFS
+IFS="-" read field1 field2 field3 field4 <&2
+ exit 1
+ ;;
+ *-*-*-*)
+ basic_machine=$field1-$field2
+ basic_os=$field3-$field4
+ ;;
+ *-*-*)
+ # Ambiguous whether COMPANY is present, or skipped and KERNEL-OS is two
+ # parts
+ maybe_os=$field2-$field3
+ case $maybe_os in
+ nto-qnx* | linux-* | uclinux-uclibc* \
+ | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* \
+ | netbsd*-eabi* | kopensolaris*-gnu* | cloudabi*-eabi* \
+ | storm-chaos* | os2-emx* | rtmk-nova* | managarm-* \
+ | windows-* )
+ basic_machine=$field1
+ basic_os=$maybe_os
+ ;;
+ android-linux)
+ basic_machine=$field1-unknown
+ basic_os=linux-android
+ ;;
+ *)
+ basic_machine=$field1-$field2
+ basic_os=$field3
+ ;;
+ esac
+ ;;
+ *-*)
+ # A lone config we happen to match not fitting any pattern
+ case $field1-$field2 in
+ decstation-3100)
+ basic_machine=mips-dec
+ basic_os=
+ ;;
+ *-*)
+ # Second component is usually, but not always the OS
+ case $field2 in
+ # Prevent following clause from handling this valid os
+ sun*os*)
+ basic_machine=$field1
+ basic_os=$field2
+ ;;
+ zephyr*)
+ basic_machine=$field1-unknown
+ basic_os=$field2
+ ;;
+ # Manufacturers
+ dec* | mips* | sequent* | encore* | pc533* | sgi* | sony* \
+ | att* | 7300* | 3300* | delta* | motorola* | sun[234]* \
+ | unicom* | ibm* | next | hp | isi* | apollo | altos* \
+ | convergent* | ncr* | news | 32* | 3600* | 3100* \
+ | hitachi* | c[123]* | convex* | sun | crds | omron* | dg \
+ | ultra | tti* | harris | dolphin | highlevel | gould \
+ | cbm | ns | masscomp | apple | axis | knuth | cray \
+ | microblaze* | sim | cisco \
+ | oki | wec | wrs | winbond)
+ basic_machine=$field1-$field2
+ basic_os=
+ ;;
+ *)
+ basic_machine=$field1
+ basic_os=$field2
+ ;;
+ esac
+ ;;
+ esac
+ ;;
+ *)
+ # Convert single-component short-hands not valid as part of
+ # multi-component configurations.
+ case $field1 in
+ 386bsd)
+ basic_machine=i386-pc
+ basic_os=bsd
+ ;;
+ a29khif)
+ basic_machine=a29k-amd
+ basic_os=udi
+ ;;
+ adobe68k)
+ basic_machine=m68010-adobe
+ basic_os=scout
+ ;;
+ alliant)
+ basic_machine=fx80-alliant
+ basic_os=
+ ;;
+ altos | altos3068)
+ basic_machine=m68k-altos
+ basic_os=
+ ;;
+ am29k)
+ basic_machine=a29k-none
+ basic_os=bsd
+ ;;
+ amdahl)
+ basic_machine=580-amdahl
+ basic_os=sysv
+ ;;
+ amiga)
+ basic_machine=m68k-unknown
+ basic_os=
+ ;;
+ amigaos | amigados)
+ basic_machine=m68k-unknown
+ basic_os=amigaos
+ ;;
+ amigaunix | amix)
+ basic_machine=m68k-unknown
+ basic_os=sysv4
+ ;;
+ apollo68)
+ basic_machine=m68k-apollo
+ basic_os=sysv
+ ;;
+ apollo68bsd)
+ basic_machine=m68k-apollo
+ basic_os=bsd
+ ;;
+ aros)
+ basic_machine=i386-pc
+ basic_os=aros
+ ;;
+ aux)
+ basic_machine=m68k-apple
+ basic_os=aux
+ ;;
+ balance)
+ basic_machine=ns32k-sequent
+ basic_os=dynix
+ ;;
+ blackfin)
+ basic_machine=bfin-unknown
+ basic_os=linux
+ ;;
+ cegcc)
+ basic_machine=arm-unknown
+ basic_os=cegcc
+ ;;
+ convex-c1)
+ basic_machine=c1-convex
+ basic_os=bsd
+ ;;
+ convex-c2)
+ basic_machine=c2-convex
+ basic_os=bsd
+ ;;
+ convex-c32)
+ basic_machine=c32-convex
+ basic_os=bsd
+ ;;
+ convex-c34)
+ basic_machine=c34-convex
+ basic_os=bsd
+ ;;
+ convex-c38)
+ basic_machine=c38-convex
+ basic_os=bsd
+ ;;
+ cray)
+ basic_machine=j90-cray
+ basic_os=unicos
+ ;;
+ crds | unos)
+ basic_machine=m68k-crds
+ basic_os=
+ ;;
+ da30)
+ basic_machine=m68k-da30
+ basic_os=
+ ;;
+ decstation | pmax | pmin | dec3100 | decstatn)
+ basic_machine=mips-dec
+ basic_os=
+ ;;
+ delta88)
+ basic_machine=m88k-motorola
+ basic_os=sysv3
+ ;;
+ dicos)
+ basic_machine=i686-pc
+ basic_os=dicos
+ ;;
+ djgpp)
+ basic_machine=i586-pc
+ basic_os=msdosdjgpp
+ ;;
+ ebmon29k)
+ basic_machine=a29k-amd
+ basic_os=ebmon
+ ;;
+ es1800 | OSE68k | ose68k | ose | OSE)
+ basic_machine=m68k-ericsson
+ basic_os=ose
+ ;;
+ gmicro)
+ basic_machine=tron-gmicro
+ basic_os=sysv
+ ;;
+ go32)
+ basic_machine=i386-pc
+ basic_os=go32
+ ;;
+ h8300hms)
+ basic_machine=h8300-hitachi
+ basic_os=hms
+ ;;
+ h8300xray)
+ basic_machine=h8300-hitachi
+ basic_os=xray
+ ;;
+ h8500hms)
+ basic_machine=h8500-hitachi
+ basic_os=hms
+ ;;
+ harris)
+ basic_machine=m88k-harris
+ basic_os=sysv3
+ ;;
+ hp300 | hp300hpux)
+ basic_machine=m68k-hp
+ basic_os=hpux
+ ;;
+ hp300bsd)
+ basic_machine=m68k-hp
+ basic_os=bsd
+ ;;
+ hppaosf)
+ basic_machine=hppa1.1-hp
+ basic_os=osf
+ ;;
+ hppro)
+ basic_machine=hppa1.1-hp
+ basic_os=proelf
+ ;;
+ i386mach)
+ basic_machine=i386-mach
+ basic_os=mach
+ ;;
+ isi68 | isi)
+ basic_machine=m68k-isi
+ basic_os=sysv
+ ;;
+ m68knommu)
+ basic_machine=m68k-unknown
+ basic_os=linux
+ ;;
+ magnum | m3230)
+ basic_machine=mips-mips
+ basic_os=sysv
+ ;;
+ merlin)
+ basic_machine=ns32k-utek
+ basic_os=sysv
+ ;;
+ mingw64)
+ basic_machine=x86_64-pc
+ basic_os=mingw64
+ ;;
+ mingw32)
+ basic_machine=i686-pc
+ basic_os=mingw32
+ ;;
+ mingw32ce)
+ basic_machine=arm-unknown
+ basic_os=mingw32ce
+ ;;
+ monitor)
+ basic_machine=m68k-rom68k
+ basic_os=coff
+ ;;
+ morphos)
+ basic_machine=powerpc-unknown
+ basic_os=morphos
+ ;;
+ moxiebox)
+ basic_machine=moxie-unknown
+ basic_os=moxiebox
+ ;;
+ msdos)
+ basic_machine=i386-pc
+ basic_os=msdos
+ ;;
+ msys)
+ basic_machine=i686-pc
+ basic_os=msys
+ ;;
+ mvs)
+ basic_machine=i370-ibm
+ basic_os=mvs
+ ;;
+ nacl)
+ basic_machine=le32-unknown
+ basic_os=nacl
+ ;;
+ ncr3000)
+ basic_machine=i486-ncr
+ basic_os=sysv4
+ ;;
+ netbsd386)
+ basic_machine=i386-pc
+ basic_os=netbsd
+ ;;
+ netwinder)
+ basic_machine=armv4l-rebel
+ basic_os=linux
+ ;;
+ news | news700 | news800 | news900)
+ basic_machine=m68k-sony
+ basic_os=newsos
+ ;;
+ news1000)
+ basic_machine=m68030-sony
+ basic_os=newsos
+ ;;
+ necv70)
+ basic_machine=v70-nec
+ basic_os=sysv
+ ;;
+ nh3000)
+ basic_machine=m68k-harris
+ basic_os=cxux
+ ;;
+ nh[45]000)
+ basic_machine=m88k-harris
+ basic_os=cxux
+ ;;
+ nindy960)
+ basic_machine=i960-intel
+ basic_os=nindy
+ ;;
+ mon960)
+ basic_machine=i960-intel
+ basic_os=mon960
+ ;;
+ nonstopux)
+ basic_machine=mips-compaq
+ basic_os=nonstopux
+ ;;
+ os400)
+ basic_machine=powerpc-ibm
+ basic_os=os400
+ ;;
+ OSE68000 | ose68000)
+ basic_machine=m68000-ericsson
+ basic_os=ose
+ ;;
+ os68k)
+ basic_machine=m68k-none
+ basic_os=os68k
+ ;;
+ paragon)
+ basic_machine=i860-intel
+ basic_os=osf
+ ;;
+ parisc)
+ basic_machine=hppa-unknown
+ basic_os=linux
+ ;;
+ psp)
+ basic_machine=mipsallegrexel-sony
+ basic_os=psp
+ ;;
+ pw32)
+ basic_machine=i586-unknown
+ basic_os=pw32
+ ;;
+ rdos | rdos64)
+ basic_machine=x86_64-pc
+ basic_os=rdos
+ ;;
+ rdos32)
+ basic_machine=i386-pc
+ basic_os=rdos
+ ;;
+ rom68k)
+ basic_machine=m68k-rom68k
+ basic_os=coff
+ ;;
+ sa29200)
+ basic_machine=a29k-amd
+ basic_os=udi
+ ;;
+ sei)
+ basic_machine=mips-sei
+ basic_os=seiux
+ ;;
+ sequent)
+ basic_machine=i386-sequent
+ basic_os=
+ ;;
+ sps7)
+ basic_machine=m68k-bull
+ basic_os=sysv2
+ ;;
+ st2000)
+ basic_machine=m68k-tandem
+ basic_os=
+ ;;
+ stratus)
+ basic_machine=i860-stratus
+ basic_os=sysv4
+ ;;
+ sun2)
+ basic_machine=m68000-sun
+ basic_os=
+ ;;
+ sun2os3)
+ basic_machine=m68000-sun
+ basic_os=sunos3
+ ;;
+ sun2os4)
+ basic_machine=m68000-sun
+ basic_os=sunos4
+ ;;
+ sun3)
+ basic_machine=m68k-sun
+ basic_os=
+ ;;
+ sun3os3)
+ basic_machine=m68k-sun
+ basic_os=sunos3
+ ;;
+ sun3os4)
+ basic_machine=m68k-sun
+ basic_os=sunos4
+ ;;
+ sun4)
+ basic_machine=sparc-sun
+ basic_os=
+ ;;
+ sun4os3)
+ basic_machine=sparc-sun
+ basic_os=sunos3
+ ;;
+ sun4os4)
+ basic_machine=sparc-sun
+ basic_os=sunos4
+ ;;
+ sun4sol2)
+ basic_machine=sparc-sun
+ basic_os=solaris2
+ ;;
+ sun386 | sun386i | roadrunner)
+ basic_machine=i386-sun
+ basic_os=
+ ;;
+ sv1)
+ basic_machine=sv1-cray
+ basic_os=unicos
+ ;;
+ symmetry)
+ basic_machine=i386-sequent
+ basic_os=dynix
+ ;;
+ t3e)
+ basic_machine=alphaev5-cray
+ basic_os=unicos
+ ;;
+ t90)
+ basic_machine=t90-cray
+ basic_os=unicos
+ ;;
+ toad1)
+ basic_machine=pdp10-xkl
+ basic_os=tops20
+ ;;
+ tpf)
+ basic_machine=s390x-ibm
+ basic_os=tpf
+ ;;
+ udi29k)
+ basic_machine=a29k-amd
+ basic_os=udi
+ ;;
+ ultra3)
+ basic_machine=a29k-nyu
+ basic_os=sym1
+ ;;
+ v810 | necv810)
+ basic_machine=v810-nec
+ basic_os=none
+ ;;
+ vaxv)
+ basic_machine=vax-dec
+ basic_os=sysv
+ ;;
+ vms)
+ basic_machine=vax-dec
+ basic_os=vms
+ ;;
+ vsta)
+ basic_machine=i386-pc
+ basic_os=vsta
+ ;;
+ vxworks960)
+ basic_machine=i960-wrs
+ basic_os=vxworks
+ ;;
+ vxworks68)
+ basic_machine=m68k-wrs
+ basic_os=vxworks
+ ;;
+ vxworks29k)
+ basic_machine=a29k-wrs
+ basic_os=vxworks
+ ;;
+ xbox)
+ basic_machine=i686-pc
+ basic_os=mingw32
+ ;;
+ ymp)
+ basic_machine=ymp-cray
+ basic_os=unicos
+ ;;
+ *)
+ basic_machine=$1
+ basic_os=
+ ;;
+ esac
+ ;;
+esac
+
+# Decode 1-component or ad-hoc basic machines
+case $basic_machine in
+ # Here we handle the default manufacturer of certain CPU types. It is in
+ # some cases the only manufacturer, in others, it is the most popular.
+ w89k)
+ cpu=hppa1.1
+ vendor=winbond
+ ;;
+ op50n)
+ cpu=hppa1.1
+ vendor=oki
+ ;;
+ op60c)
+ cpu=hppa1.1
+ vendor=oki
+ ;;
+ ibm*)
+ cpu=i370
+ vendor=ibm
+ ;;
+ orion105)
+ cpu=clipper
+ vendor=highlevel
+ ;;
+ mac | mpw | mac-mpw)
+ cpu=m68k
+ vendor=apple
+ ;;
+ pmac | pmac-mpw)
+ cpu=powerpc
+ vendor=apple
+ ;;
+
+ # Recognize the various machine names and aliases which stand
+ # for a CPU type and a company and sometimes even an OS.
+ 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc)
+ cpu=m68000
+ vendor=att
+ ;;
+ 3b*)
+ cpu=we32k
+ vendor=att
+ ;;
+ bluegene*)
+ cpu=powerpc
+ vendor=ibm
+ basic_os=cnk
+ ;;
+ decsystem10* | dec10*)
+ cpu=pdp10
+ vendor=dec
+ basic_os=tops10
+ ;;
+ decsystem20* | dec20*)
+ cpu=pdp10
+ vendor=dec
+ basic_os=tops20
+ ;;
+ delta | 3300 | motorola-3300 | motorola-delta \
+ | 3300-motorola | delta-motorola)
+ cpu=m68k
+ vendor=motorola
+ ;;
+ dpx2*)
+ cpu=m68k
+ vendor=bull
+ basic_os=sysv3
+ ;;
+ encore | umax | mmax)
+ cpu=ns32k
+ vendor=encore
+ ;;
+ elxsi)
+ cpu=elxsi
+ vendor=elxsi
+ basic_os=${basic_os:-bsd}
+ ;;
+ fx2800)
+ cpu=i860
+ vendor=alliant
+ ;;
+ genix)
+ cpu=ns32k
+ vendor=ns
+ ;;
+ h3050r* | hiux*)
+ cpu=hppa1.1
+ vendor=hitachi
+ basic_os=hiuxwe2
+ ;;
+ hp3k9[0-9][0-9] | hp9[0-9][0-9])
+ cpu=hppa1.0
+ vendor=hp
+ ;;
+ hp9k2[0-9][0-9] | hp9k31[0-9])
+ cpu=m68000
+ vendor=hp
+ ;;
+ hp9k3[2-9][0-9])
+ cpu=m68k
+ vendor=hp
+ ;;
+ hp9k6[0-9][0-9] | hp6[0-9][0-9])
+ cpu=hppa1.0
+ vendor=hp
+ ;;
+ hp9k7[0-79][0-9] | hp7[0-79][0-9])
+ cpu=hppa1.1
+ vendor=hp
+ ;;
+ hp9k78[0-9] | hp78[0-9])
+ # FIXME: really hppa2.0-hp
+ cpu=hppa1.1
+ vendor=hp
+ ;;
+ hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893)
+ # FIXME: really hppa2.0-hp
+ cpu=hppa1.1
+ vendor=hp
+ ;;
+ hp9k8[0-9][13679] | hp8[0-9][13679])
+ cpu=hppa1.1
+ vendor=hp
+ ;;
+ hp9k8[0-9][0-9] | hp8[0-9][0-9])
+ cpu=hppa1.0
+ vendor=hp
+ ;;
+ i*86v32)
+ cpu=`echo "$1" | sed -e 's/86.*/86/'`
+ vendor=pc
+ basic_os=sysv32
+ ;;
+ i*86v4*)
+ cpu=`echo "$1" | sed -e 's/86.*/86/'`
+ vendor=pc
+ basic_os=sysv4
+ ;;
+ i*86v)
+ cpu=`echo "$1" | sed -e 's/86.*/86/'`
+ vendor=pc
+ basic_os=sysv
+ ;;
+ i*86sol2)
+ cpu=`echo "$1" | sed -e 's/86.*/86/'`
+ vendor=pc
+ basic_os=solaris2
+ ;;
+ j90 | j90-cray)
+ cpu=j90
+ vendor=cray
+ basic_os=${basic_os:-unicos}
+ ;;
+ iris | iris4d)
+ cpu=mips
+ vendor=sgi
+ case $basic_os in
+ irix*)
+ ;;
+ *)
+ basic_os=irix4
+ ;;
+ esac
+ ;;
+ miniframe)
+ cpu=m68000
+ vendor=convergent
+ ;;
+ *mint | mint[0-9]* | *MiNT | *MiNT[0-9]*)
+ cpu=m68k
+ vendor=atari
+ basic_os=mint
+ ;;
+ news-3600 | risc-news)
+ cpu=mips
+ vendor=sony
+ basic_os=newsos
+ ;;
+ next | m*-next)
+ cpu=m68k
+ vendor=next
+ case $basic_os in
+ openstep*)
+ ;;
+ nextstep*)
+ ;;
+ ns2*)
+ basic_os=nextstep2
+ ;;
+ *)
+ basic_os=nextstep3
+ ;;
+ esac
+ ;;
+ np1)
+ cpu=np1
+ vendor=gould
+ ;;
+ op50n-* | op60c-*)
+ cpu=hppa1.1
+ vendor=oki
+ basic_os=proelf
+ ;;
+ pa-hitachi)
+ cpu=hppa1.1
+ vendor=hitachi
+ basic_os=hiuxwe2
+ ;;
+ pbd)
+ cpu=sparc
+ vendor=tti
+ ;;
+ pbb)
+ cpu=m68k
+ vendor=tti
+ ;;
+ pc532)
+ cpu=ns32k
+ vendor=pc532
+ ;;
+ pn)
+ cpu=pn
+ vendor=gould
+ ;;
+ power)
+ cpu=power
+ vendor=ibm
+ ;;
+ ps2)
+ cpu=i386
+ vendor=ibm
+ ;;
+ rm[46]00)
+ cpu=mips
+ vendor=siemens
+ ;;
+ rtpc | rtpc-*)
+ cpu=romp
+ vendor=ibm
+ ;;
+ sde)
+ cpu=mipsisa32
+ vendor=sde
+ basic_os=${basic_os:-elf}
+ ;;
+ simso-wrs)
+ cpu=sparclite
+ vendor=wrs
+ basic_os=vxworks
+ ;;
+ tower | tower-32)
+ cpu=m68k
+ vendor=ncr
+ ;;
+ vpp*|vx|vx-*)
+ cpu=f301
+ vendor=fujitsu
+ ;;
+ w65)
+ cpu=w65
+ vendor=wdc
+ ;;
+ w89k-*)
+ cpu=hppa1.1
+ vendor=winbond
+ basic_os=proelf
+ ;;
+ none)
+ cpu=none
+ vendor=none
+ ;;
+ leon|leon[3-9])
+ cpu=sparc
+ vendor=$basic_machine
+ ;;
+ leon-*|leon[3-9]-*)
+ cpu=sparc
+ vendor=`echo "$basic_machine" | sed 's/-.*//'`
+ ;;
+
+ *-*)
+ # shellcheck disable=SC2162
+ saved_IFS=$IFS
+ IFS="-" read cpu vendor <&2
+ exit 1
+ ;;
+ esac
+ ;;
+esac
+
+# Here we canonicalize certain aliases for manufacturers.
+case $vendor in
+ digital*)
+ vendor=dec
+ ;;
+ commodore*)
+ vendor=cbm
+ ;;
+ *)
+ ;;
+esac
+
+# Decode manufacturer-specific aliases for certain operating systems.
+
+if test x"$basic_os" != x
+then
+
+# First recognize some ad-hoc cases, or perhaps split kernel-os, or else just
+# set os.
+obj=
+case $basic_os in
+ gnu/linux*)
+ kernel=linux
+ os=`echo "$basic_os" | sed -e 's|gnu/linux|gnu|'`
+ ;;
+ os2-emx)
+ kernel=os2
+ os=`echo "$basic_os" | sed -e 's|os2-emx|emx|'`
+ ;;
+ nto-qnx*)
+ kernel=nto
+ os=`echo "$basic_os" | sed -e 's|nto-qnx|qnx|'`
+ ;;
+ *-*)
+ # shellcheck disable=SC2162
+ saved_IFS=$IFS
+ IFS="-" read kernel os <&2
+ fi
+ ;;
+ *)
+ echo "Invalid configuration '$1': OS '$os' not recognized" 1>&2
+ exit 1
+ ;;
+esac
+
+case $obj in
+ aout* | coff* | elf* | pe*)
+ ;;
+ '')
+ # empty is fine
+ ;;
+ *)
+ echo "Invalid configuration '$1': Machine code format '$obj' not recognized" 1>&2
+ exit 1
+ ;;
+esac
+
+# Here we handle the constraint that a (synthetic) cpu and os are
+# valid only in combination with each other and nowhere else.
+case $cpu-$os in
+ # The "javascript-unknown-ghcjs" triple is used by GHC; we
+ # accept it here in order to tolerate that, but reject any
+ # variations.
+ javascript-ghcjs)
+ ;;
+ javascript-* | *-ghcjs)
+ echo "Invalid configuration '$1': cpu '$cpu' is not valid with os '$os$obj'" 1>&2
+ exit 1
+ ;;
+esac
+
+# As a final step for OS-related things, validate the OS-kernel combination
+# (given a valid OS), if there is a kernel.
+case $kernel-$os-$obj in
+ linux-gnu*- | linux-android*- | linux-dietlibc*- | linux-llvm*- \
+ | linux-mlibc*- | linux-musl*- | linux-newlib*- \
+ | linux-relibc*- | linux-uclibc*- )
+ ;;
+ uclinux-uclibc*- )
+ ;;
+ managarm-mlibc*- | managarm-kernel*- )
+ ;;
+ windows*-msvc*-)
+ ;;
+ -dietlibc*- | -llvm*- | -mlibc*- | -musl*- | -newlib*- | -relibc*- \
+ | -uclibc*- )
+ # These are just libc implementations, not actual OSes, and thus
+ # require a kernel.
+ echo "Invalid configuration '$1': libc '$os' needs explicit kernel." 1>&2
+ exit 1
+ ;;
+ -kernel*- )
+ echo "Invalid configuration '$1': '$os' needs explicit kernel." 1>&2
+ exit 1
+ ;;
+ *-kernel*- )
+ echo "Invalid configuration '$1': '$kernel' does not support '$os'." 1>&2
+ exit 1
+ ;;
+ *-msvc*- )
+ echo "Invalid configuration '$1': '$os' needs 'windows'." 1>&2
+ exit 1
+ ;;
+ kfreebsd*-gnu*- | kopensolaris*-gnu*-)
+ ;;
+ vxworks-simlinux- | vxworks-simwindows- | vxworks-spe-)
+ ;;
+ nto-qnx*-)
+ ;;
+ os2-emx-)
+ ;;
+ *-eabi*- | *-gnueabi*-)
+ ;;
+ none--*)
+ # None (no kernel, i.e. freestanding / bare metal),
+ # can be paired with an machine code file format
+ ;;
+ -*-)
+ # Blank kernel with real OS is always fine.
+ ;;
+ --*)
+ # Blank kernel and OS with real machine code file format is always fine.
+ ;;
+ *-*-*)
+ echo "Invalid configuration '$1': Kernel '$kernel' not known to work with OS '$os'." 1>&2
+ exit 1
+ ;;
+esac
+
+# Here we handle the case where we know the os, and the CPU type, but not the
+# manufacturer. We pick the logical manufacturer.
+case $vendor in
+ unknown)
+ case $cpu-$os in
+ *-riscix*)
+ vendor=acorn
+ ;;
+ *-sunos*)
+ vendor=sun
+ ;;
+ *-cnk* | *-aix*)
+ vendor=ibm
+ ;;
+ *-beos*)
+ vendor=be
+ ;;
+ *-hpux*)
+ vendor=hp
+ ;;
+ *-mpeix*)
+ vendor=hp
+ ;;
+ *-hiux*)
+ vendor=hitachi
+ ;;
+ *-unos*)
+ vendor=crds
+ ;;
+ *-dgux*)
+ vendor=dg
+ ;;
+ *-luna*)
+ vendor=omron
+ ;;
+ *-genix*)
+ vendor=ns
+ ;;
+ *-clix*)
+ vendor=intergraph
+ ;;
+ *-mvs* | *-opened*)
+ vendor=ibm
+ ;;
+ *-os400*)
+ vendor=ibm
+ ;;
+ s390-* | s390x-*)
+ vendor=ibm
+ ;;
+ *-ptx*)
+ vendor=sequent
+ ;;
+ *-tpf*)
+ vendor=ibm
+ ;;
+ *-vxsim* | *-vxworks* | *-windiss*)
+ vendor=wrs
+ ;;
+ *-aux*)
+ vendor=apple
+ ;;
+ *-hms*)
+ vendor=hitachi
+ ;;
+ *-mpw* | *-macos*)
+ vendor=apple
+ ;;
+ *-*mint | *-mint[0-9]* | *-*MiNT | *-MiNT[0-9]*)
+ vendor=atari
+ ;;
+ *-vos*)
+ vendor=stratus
+ ;;
+ esac
+ ;;
+esac
+
+echo "$cpu-$vendor${kernel:+-$kernel}${os:+-$os}${obj:+-$obj}"
+exit
+
+# Local variables:
+# eval: (add-hook 'before-save-hook 'time-stamp)
+# time-stamp-start: "timestamp='"
+# time-stamp-format: "%:y-%02m-%02d"
+# time-stamp-end: "'"
+# End:
diff --git a/rts/configure.ac b/rts/configure.ac
index 3b660caebb9b..aee34095810b 100644
--- a/rts/configure.ac
+++ b/rts/configure.ac
@@ -24,6 +24,10 @@ AC_PREREQ([2.69])
AC_CONFIG_FILES([ghcplatform.h.top])
+AC_CONFIG_FILES([rts.buildinfo])
+AC_SUBST([EXTRA_LIBS],[` printf " %s " "$LIBS" | sed -E 's/ -l([[^ ]]*)/\1 /g' `])
+
+
AC_CONFIG_HEADERS([ghcautoconf.h.autoconf])
AC_ARG_ENABLE(asserts-all-ways,
@@ -53,6 +57,9 @@ dnl detect compiler (prefer gcc over clang) and set $CC (unless CC already set),
dnl later CC is copied to CC_STAGE{1,2,3}
AC_PROG_CC([cc gcc clang])
+dnl Portable mkdir -p (sets MKDIR_P)
+AC_PROG_MKDIR_P
+
dnl make extensions visible to allow feature-tests to detect them lateron
AC_USE_SYSTEM_EXTENSIONS
@@ -162,14 +169,7 @@ AC_CHECK_DECLS([program_invocation_short_name], , ,
[#define _GNU_SOURCE 1
#include ])
-dnl ** check for math library
-dnl Keep that check as early as possible.
-dnl as we need to know whether we need libm
-dnl for math functions or not
-dnl (see https://gitlab.haskell.org/ghc/ghc/issues/3730)
-AS_IF(
- [test "$CABAL_FLAG_libm" = 1],
- [AC_DEFINE([HAVE_LIBM], [1], [Define to 1 if you need to link with libm])])
+AC_SEARCH_LIBS([exp2], [m])
AS_IF([test "$CABAL_FLAG_libbfd" = 1], [FP_WHEN_ENABLED_BFD])
@@ -178,10 +178,13 @@ dnl Check for libraries
dnl ################################################################
dnl ** check whether we need -ldl to get dlopen()
-AC_CHECK_LIB([dl], [dlopen])
+AC_SEARCH_LIBS([dlopen], [dl])
dnl ** check whether we have dlinfo
AC_CHECK_FUNCS([dlinfo])
+FP_CHECK_PTHREAD_LIB
+
+
dnl --------------------------------------------------
dnl * Miscellaneous feature tests
dnl --------------------------------------------------
@@ -232,6 +235,19 @@ AC_CHECK_FUNCS([eventfd])
AC_CHECK_FUNCS([getpid getuid raise])
+dnl ** Check for __thread support in the compiler
+AC_MSG_CHECKING(for __thread support)
+AC_COMPILE_IFELSE(
+ [ AC_LANG_SOURCE([[__thread int tester = 0;]]) ],
+ [
+ AC_MSG_RESULT(yes)
+ AC_DEFINE([CC_SUPPORTS_TLS],[1],[Define to 1 if __thread is supported])
+ ],
+ [
+ AC_MSG_RESULT(no)
+ AC_DEFINE([CC_SUPPORTS_TLS],[0],[Define to 1 if __thread is supported])
+ ])
+
dnl large address space support (see rts/include/rts/storage/MBlock.h)
dnl
dnl Darwin has vm_allocate/vm_protect
@@ -417,6 +433,8 @@ GHC_IOMANAGER_DEFAULT_AC_DEFINE([IOManagerThreadedDefault], [threaded],
[winio], [IOMGR_DEFAULT_THREADED_WINIO])
+AC_SUBST([EXTRA_LIBS],[` printf " %s " "$LIBS" | sed -E 's/ -l([[^ ]]*)/\1 /g' `])
+
dnl ** Write config files
dnl --------------------------------------------------------------
@@ -427,7 +445,7 @@ dnl Generate ghcplatform.h
dnl ######################################################################
[
-mkdir -p include
+${MKDIR_P} include
touch include/ghcplatform.h
> include/ghcplatform.h
@@ -464,3 +482,110 @@ cat ghcautoconf.h.autoconf | sed \
>> include/ghcautoconf.h
echo "#endif /* __GHCAUTOCONF_H__ */" >> include/ghcautoconf.h
]
+dnl --------------------------------------------------------------
+dnl Generate derived constants
+dnl --------------------------------------------------------------
+
+AC_ARG_VAR([NM], [Path to the nm program])
+AC_PATH_PROG([NM], nm)
+if test -z "$NM"; then
+ AC_MSG_ERROR([Cannot find nm])
+fi
+
+AC_ARG_VAR([OBJDUMP], [Path to the objdump program])
+AC_PATH_PROG([OBJDUMP], objdump)
+if test -z "$OBJDUMP"; then
+ AC_MSG_ERROR([Cannot find objdump])
+fi
+
+AC_ARG_VAR([DERIVE_CONSTANTS], [Path to the deriveConstants program])
+AC_PATH_PROG([DERIVE_CONSTANTS], deriveConstants)
+AS_IF([test "x$DERIVE_CONSTANTS" = x], [AC_MSG_ERROR([deriveConstants executable not found. Please install deriveConstants or set DERIVE_CONSTANTS environment variable.])])
+
+AC_ARG_VAR([GENAPPLY], [Path to the genapply program])
+AC_PATH_PROG([GENAPPLY], genapply)
+AS_IF([test "x$GENAPPLY" = x], [AC_MSG_ERROR([genapply executable not found. Please install genapply or set GENAPPLY environment variable.])])
+
+AC_CHECK_PROGS([PYTHON], [python3 python python2])
+AS_IF([test "x$PYTHON" = x], [AC_MSG_ERROR([Python interpreter not found. Please install Python or set PYTHON environment variable.])])
+
+AC_MSG_CHECKING([for DerivedConstants.h])
+dnl NOTE: dnl pass `-fcommon` to force symbols into the common section. If they end
+dnl up in the ro data section `nm` won't list their size, and thus derivedConstants
+dnl will fail. Recent clang (e.g. 16) will by default use `-fno-common`.
+dnl
+dnl FIXME: using a relative path here is TERRIBLE; Cabal should provide some
+dnl env var for _build-dependencies_ headers!
+dnl
+
+if $DERIVE_CONSTANTS \
+ --gen-header \
+ -o include/DerivedConstants.h \
+ --target-os "$HostOS_CPP" \
+ --gcc-program "$CC" \
+ --nm-program "$NM" \
+ --objdump-program "$OBJDUMP" \
+ --tmpdir "$(mktemp -d)" \
+ --gcc-flag "-fcommon" \
+ --gcc-flag "-I$srcdir" \
+ --gcc-flag "-I$srcdir/include" \
+ --gcc-flag "-Iinclude" \
+ --gcc-flag "-I$srcdir/../rts-headers/include" ; then
+ AC_MSG_RESULT([created])
+else
+ AC_MSG_RESULT([failed to create])
+ AC_MSG_ERROR([Failed to run $DERIVE_CONSTANTS --gen-header ...])
+fi
+
+AC_MSG_CHECKING([for include/rts/AutoApply.cmm.h])
+if ${MKDIR_P} include/rts && $GENAPPLY include/DerivedConstants.h > include/rts/AutoApply.cmm.h; then
+ AC_MSG_RESULT([created])
+else
+ AC_MSG_RESULT([failed to create])
+ AC_MSG_ERROR([Failed to run $GENAPPLY include/DerivedConstants.h > include/rts/AutoApply.cmm.h])
+fi
+
+AC_MSG_CHECKING([for include/rts/AutoApply_V16.cmm.h])
+if ${MKDIR_P} include/rts && $GENAPPLY include/DerivedConstants.h -V16 > include/rts/AutoApply_V16.cmm.h; then
+ AC_MSG_RESULT([created])
+else
+ AC_MSG_RESULT([failed to create])
+ AC_MSG_ERROR([Failed to run $GENAPPLY include/DerivedConstants.h -V16 > include/rts/AutoApply_V16.cmm.h])
+fi
+
+AC_MSG_CHECKING([for include/rts/AutoApply_V32.cmm.h])
+if ${MKDIR_P} include/rts && $GENAPPLY include/DerivedConstants.h -V32 > include/rts/AutoApply_V32.cmm.h; then
+ AC_MSG_RESULT([created])
+else
+ AC_MSG_RESULT([failed to create])
+ AC_MSG_ERROR([Failed to run $GENAPPLY include/DerivedConstants.h -V32 > include/rts/AutoApply_V32.cmm.h])
+fi
+
+AC_MSG_CHECKING([for include/rts/AutoApply_V64.cmm.h])
+if ${MKDIR_P} include/rts && $GENAPPLY include/DerivedConstants.h -V64 > include/rts/AutoApply_V64.cmm.h; then
+ AC_MSG_RESULT([created])
+else
+ AC_MSG_RESULT([failed to create])
+ AC_MSG_ERROR([Failed to run $GENAPPLY include/DerivedConstants.h -V64 > include/rts/AutoApply_V64.cmm.h])
+fi
+
+AC_MSG_CHECKING([for include/rts/EventLogConstants.h])
+if ${MKDIR_P} include/rts && $PYTHON $srcdir/gen_event_types.py --event-types-defines include/rts/EventLogConstants.h; then
+ AC_MSG_RESULT([created])
+else
+ AC_MSG_RESULT([failed to create])
+ AC_MSG_ERROR([Failed to run $PYTHON gen_event_types.py])
+fi
+
+AC_MSG_CHECKING([for include/rts/EventTypes.h])
+if ${MKDIR_P} include/rts && $PYTHON $srcdir/gen_event_types.py --event-types-array include/rts/EventTypes.h; then
+ AC_MSG_RESULT([created])
+else
+ AC_MSG_RESULT([failed to create])
+ AC_MSG_ERROR([Failed to run $PYTHON gen_event_types.py])
+fi
+
+dnl ** Write config files
+dnl --------------------------------------------------------------
+
+AC_OUTPUT
diff --git a/rts/eventlog/EventLog.c b/rts/eventlog/EventLog.c
index 11119311af26..dce7cb255d4e 100644
--- a/rts/eventlog/EventLog.c
+++ b/rts/eventlog/EventLog.c
@@ -484,13 +484,7 @@ endEventLogging(void)
eventlog_enabled = false;
- // Flush all events remaining in the buffers.
- //
- // N.B. Don't flush if shutting down: this was done in
- // finishCapEventLogging and the capabilities have already been freed.
- if (getSchedState() != SCHED_SHUTTING_DOWN) {
- flushEventLog(NULL);
- }
+ flushEventLog(NULL);
ACQUIRE_LOCK(&eventBufMutex);
@@ -1618,15 +1612,24 @@ void flushEventLog(Capability **cap USED_IF_THREADS)
return;
}
+ // N.B. Don't flush if shutting down: this was done in
+ // finishCapEventLogging and the capabilities have already been freed.
+ // This can also race against the shutdown if the flush is triggered by the
+ // ticker thread. (#26573)
+ if (getSchedState() == SCHED_SHUTTING_DOWN) {
+ return;
+ }
+
ACQUIRE_LOCK(&eventBufMutex);
printAndClearEventBuf(&eventBuf);
RELEASE_LOCK(&eventBufMutex);
#if defined(THREADED_RTS)
- Task *task = getMyTask();
+ Task *task = newBoundTask();
stopAllCapabilitiesWith(cap, task, SYNC_FLUSH_EVENT_LOG);
flushAllCapsEventsBufs();
releaseAllCapabilities(getNumCapabilities(), cap ? *cap : NULL, task);
+ exitMyTask();
#else
flushLocalEventsBuf(getCapability(0));
#endif
diff --git a/rts/include/Cmm.h b/rts/include/Cmm.h
index 2f42889bdea8..c4a6497e9310 100644
--- a/rts/include/Cmm.h
+++ b/rts/include/Cmm.h
@@ -966,6 +966,11 @@
// See Note [Update remembered set] in NonMovingMark.c.
#if defined(THREADED_RTS)
+// nonmoving_write_barrier_enabled is a C data variable (StgWord). Declare it
+// as CLOSURE so the WASM NCG classifies it as a data symbol, not a function.
+// Without this, bare 'import NAME' in Cmm defaults to ForeignLabel IsFunction,
+// causing wasm-ld "symbol type mismatch" errors at link time.
+import CLOSURE nonmoving_write_barrier_enabled;
#define IF_NONMOVING_WRITE_BARRIER_ENABLED \
if (W_[nonmoving_write_barrier_enabled] != 0) (likely: False)
#else
diff --git a/rts/include/RtsAPI.h b/rts/include/RtsAPI.h
index 7cdad2202e76..9a6448ae5feb 100644
--- a/rts/include/RtsAPI.h
+++ b/rts/include/RtsAPI.h
@@ -311,6 +311,13 @@ extern void hs_init_with_rtsopts (int *argc, char **argv[]);
extern void hs_init_ghc (int *argc, char **argv[], // program arguments
RtsConfig rts_config); // RTS configuration
+/*
+ * Get the address of stg_interp_constr*_entry for the given constructor tag.
+ * Tag must be in range 1-7. Used by the interpreter to create info tables.
+ * See Note [Getting stg_interp_constr entry points from the RTS] in RtsStartup.c.
+ */
+extern StgFunPtr getInterpConstrEntryAddr (int tag);
+
extern void shutdownHaskellAndExit (int exitCode, int fastExit)
STG_NORETURN;
diff --git a/rts/include/stg/MachRegsForHost.h b/rts/include/stg/MachRegsForHost.h
index 7c045c0214bf..cd28215ea0f1 100644
--- a/rts/include/stg/MachRegsForHost.h
+++ b/rts/include/stg/MachRegsForHost.h
@@ -84,4 +84,4 @@
#endif
-#include "MachRegs.h"
+#include "stg/MachRegs.h"
diff --git a/rts/include/stg/MiscClosures.h b/rts/include/stg/MiscClosures.h
index 541548d4ed87..fc27deba634e 100644
--- a/rts/include/stg/MiscClosures.h
+++ b/rts/include/stg/MiscClosures.h
@@ -74,18 +74,13 @@ RTS_RET(stg_restore_cccs_v64);
RTS_RET(stg_restore_cccs_eval);
RTS_RET(stg_prompt_frame);
-// RTS_FUN(stg_interp_constr1_entry);
-// RTS_FUN(stg_interp_constr2_entry);
-// RTS_FUN(stg_interp_constr3_entry);
-// RTS_FUN(stg_interp_constr4_entry);
-// RTS_FUN(stg_interp_constr5_entry);
-// RTS_FUN(stg_interp_constr6_entry);
-// RTS_FUN(stg_interp_constr7_entry);
-//
-// This is referenced using the FFI in the compiler (GHC.ByteCode.InfoTable),
-// so we can't give it the correct type here because the prototypes
-// would clash (FFI references are always declared with type StgWord[]
-// in the generated C code).
+RTS_FUN(stg_interp_constr1_entry);
+RTS_FUN(stg_interp_constr2_entry);
+RTS_FUN(stg_interp_constr3_entry);
+RTS_FUN(stg_interp_constr4_entry);
+RTS_FUN(stg_interp_constr5_entry);
+RTS_FUN(stg_interp_constr6_entry);
+RTS_FUN(stg_interp_constr7_entry);
/* Magic glue code for when compiled code returns a value in R1/F1/D1
or a VoidRep to the interpreter. */
diff --git a/rts/linker/Elf.c b/rts/linker/Elf.c
index 85a56c120d49..e77b754e2508 100644
--- a/rts/linker/Elf.c
+++ b/rts/linker/Elf.c
@@ -52,27 +52,30 @@
#include
#endif
-/* on x86_64 we have a problem with relocating symbol references in
- * code that was compiled without -fPIC. By default, the small memory
- * model is used, which assumes that symbol references can fit in a
- * 32-bit slot. The system dynamic linker makes this work for
- * references to shared libraries by either (a) allocating a jump
- * table slot for code references, or (b) moving the symbol at load
- * time (and copying its contents, if necessary) for data references.
+/* On x86_64, relocating symbol references in code compiled without -fPIC
+ * requires special handling. The small memory model assumes symbol references
+ * fit in a 32-bit slot. When a reference to a symbol in a shared library
+ * exceeds this range, we can use a hack (enabled by X86_64_ELF_NONPIC_HACK)
+ * which consists in generating "jump islands" (trampolines) for code references
+ * (this happens in makeSymbolExtra()).
*
- * We unfortunately can't tell whether symbol references are to code
- * or data. So for now we assume they are code (the vast majority
- * are), and allocate jump-table slots. Unfortunately this will
- * SILENTLY generate crashing code for data references. This hack is
- * enabled by X86_64_ELF_NONPIC_HACK.
+ * For FUNCTION symbols (STT_FUNC), jump islands work correctly: the call
+ * bounces through the trampoline to reach the real function.
*
- * One workaround is to use shared Haskell libraries. This is the case
- * when dynamically-linked GHCi is used.
+ * For DATA symbols (STT_OBJECT, STT_NOTYPE), jump islands are INCORRECT:
+ * the jump island address would be embedded as a data pointer (e.g., an info
+ * table pointer in a closure), causing the GC to interpret jump island memory
+ * as a valid info table — leading to "strange closure type" crashes.
*
- * Another workaround is to keep the static libraries but compile them
- * with -fPIC -fexternal-dynamic-refs, because that will generate PIC
- * references to data which can be relocated. This is the case when
- * +RTS -xp is passed.
+ * We detect data references using ELF_ST_TYPE(sym.st_info) from the symbol
+ * table. When a non-function symbol overflows 32-bit range, we emit a clear
+ * error message instead of silently creating a corrupt jump island.
+ *
+ * Workarounds for data reference overflow:
+ * - Use shared Haskell libraries (dynamically-linked GHCi)
+ * - Compile with -fPIC -fexternal-dynamic-refs (generates GOT-based
+ * relocations that can handle arbitrary distances)
+ * - Use +RTS -xp (maps loaded objects into low memory)
*
* See bug #781
* See thread http://www.haskell.org/pipermail/cvs-ghc/2007-September/038458.html
@@ -89,6 +92,28 @@
* Sym*_NeedsProto: the symbol is undefined and we add a dummy
* default proto extern void sym(void);
*/
+/* Note [X86_64_ELF_NONPIC_HACK and data references]
+ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ * When a relocation overflows 32-bit range, X86_64_ELF_NONPIC_HACK creates
+ * a "jump island" (trampoline) via makeSymbolExtra(). The SymbolExtra struct
+ * (see rts/LinkerInternals.h) on x86_64 contains:
+ *
+ * struct { uint64_t addr; uint8_t jumpIsland[8]; }
+ *
+ * where jumpIsland = { 0xFF, 0x25, 0xF2, 0xFF, 0xFF, 0xFF, 0x00, 0x00 }
+ * is a `jmp *-14(%rip)` instruction that reads `addr` to reach the real symbol.
+ *
+ * For FUNCTION references (call/jmp targets), this works: the call bounces
+ * through the trampoline. For DATA references (e.g., info table pointers like
+ * _con_info), the jump island address gets embedded as a data pointer. When
+ * the GC later follows this pointer, it finds the jump island bytes instead
+ * of a valid info table, causing a "strange closure type" crash.
+ *
+ * We detect data references using ELF_ST_TYPE() on the symbol table entry.
+ * Symbols with type STT_FUNC get the jump island treatment. All other types
+ * (STT_OBJECT, STT_NOTYPE — which includes GHC's _con_info symbols) trigger
+ * a clear error message directing the user to recompile with -fPIC.
+ */
#define X86_64_ELF_NONPIC_HACK (!RtsFlags.MiscFlags.linkerAlwaysPic)
#if defined(i386_HOST_ARCH)
@@ -205,7 +230,7 @@ ocInit_ELF(ObjectCode * oc)
oc->info->sectionHeader = (Elf_Shdr *) ((uint8_t*)oc->image
+ oc->info->elfHeader->e_shoff);
oc->info->sectionHeaderStrtab = (char*)((uint8_t*)oc->image +
- oc->info->sectionHeader[oc->info->elfHeader->e_shstrndx].sh_offset);
+ oc->info->sectionHeader[elf_shstrndx(oc->info->elfHeader)].sh_offset);
oc->n_sections = elf_shnum(oc->info->elfHeader);
@@ -1765,6 +1790,21 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
{
StgInt64 off = value - P;
if (off != (Elf64_Sword)off && X86_64_ELF_NONPIC_HACK) {
+ /* Check symbol type: jump islands only work for code (functions).
+ * For data references (STT_OBJECT, STT_NOTYPE), the jump island
+ * address would be used as a data pointer (e.g., info table pointer),
+ * causing GC crashes ("strange closure type").
+ * See Note [X86_64_ELF_NONPIC_HACK and data references] */
+ unsigned char symtype = ELF_ST_TYPE(stab[ELF_R_SYM(info)].st_info);
+ if (symtype != STT_FUNC) {
+ errorBelch(
+ "R_X86_64_PC32 overflow for non-function symbol `%s' "
+ "(type %d, distance 0x%" PRIx64 ").\n"
+ " Jump islands only work for code, not data references.\n"
+ " Recompile %s with -fPIC -fexternal-dynamic-refs.",
+ symbol, symtype, (uint64_t)(value - P), oc->fileName);
+ return 0;
+ }
StgInt64 pltAddress =
(StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
-> jumpIsland;
@@ -1792,6 +1832,17 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
case COMPAT_R_X86_64_32:
{
if (value != (Elf64_Word)value && X86_64_ELF_NONPIC_HACK) {
+ /* See Note [X86_64_ELF_NONPIC_HACK and data references] */
+ unsigned char symtype = ELF_ST_TYPE(stab[ELF_R_SYM(info)].st_info);
+ if (symtype != STT_FUNC) {
+ errorBelch(
+ "R_X86_64_32 overflow for non-function symbol `%s' "
+ "(type %d, value 0x%" PRIx64 ").\n"
+ " Jump islands only work for code, not data references.\n"
+ " Recompile %s with -fPIC -fexternal-dynamic-refs.",
+ symbol, symtype, (uint64_t)value, oc->fileName);
+ return 0;
+ }
StgInt64 pltAddress =
(StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
-> jumpIsland;
@@ -1812,6 +1863,17 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
case COMPAT_R_X86_64_32S:
{
if ((StgInt64)value != (Elf64_Sword)value && X86_64_ELF_NONPIC_HACK) {
+ /* See Note [X86_64_ELF_NONPIC_HACK and data references] */
+ unsigned char symtype = ELF_ST_TYPE(stab[ELF_R_SYM(info)].st_info);
+ if (symtype != STT_FUNC) {
+ errorBelch(
+ "R_X86_64_32S overflow for non-function symbol `%s' "
+ "(type %d, value 0x%" PRIx64 ").\n"
+ " Jump islands only work for code, not data references.\n"
+ " Recompile %s with -fPIC -fexternal-dynamic-refs.",
+ symbol, symtype, (uint64_t)value, oc->fileName);
+ return 0;
+ }
StgInt64 pltAddress =
(StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
-> jumpIsland;
diff --git a/rts/linker/LoadArchive.c b/rts/linker/LoadArchive.c
index c9ab4961bb54..0db84618c67c 100644
--- a/rts/linker/LoadArchive.c
+++ b/rts/linker/LoadArchive.c
@@ -592,6 +592,8 @@ HsInt loadArchive_ (pathchar *path)
if (!readThinArchiveMember(n, memberSize, path, fileName, image)) {
goto fail;
}
+ // Re-identify object format from actual object data
+ object_fmt = identifyObjectFile_(image, memberSize);
}
else
{
diff --git a/rts/linker/LoadNativeObjPosix.c b/rts/linker/LoadNativeObjPosix.c
index fbdecc512b00..db04ec7b3fed 100644
--- a/rts/linker/LoadNativeObjPosix.c
+++ b/rts/linker/LoadNativeObjPosix.c
@@ -167,10 +167,26 @@ void * loadNativeObj_POSIX (pathchar *path, char **errmsg)
#endif
const int dlopen_mode = load_now ? RTLD_NOW : RTLD_LAZY;
+
+ IF_DEBUG(linker, debugBelch("loadNativeObj: about to dlopen %" PATH_FMT "\n", path));
+ IF_DEBUG(linker, debugBelch("loadNativeObj: mode = %s|RTLD_LOCAL\n",
+ load_now ? "RTLD_NOW" : "RTLD_LAZY"));
+
hdl = dlopen(path, dlopen_mode|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */
nc->dlopen_handle = hdl;
nc->status = OBJECT_READY;
+ // Save dlerror immediately - it can only be retrieved once
+ const char *dl_err = hdl ? NULL : dlerror();
+
+ IF_DEBUG(linker,
+ if (hdl) {
+ debugBelch("loadNativeObj: dlopen succeeded, handle=%p\n", hdl);
+ } else {
+ debugBelch("loadNativeObj: dlopen failed: %s\n", dl_err ? dl_err : "(unknown)");
+ }
+ );
+
#if defined(PROFILING)
RELEASE_LOCK(&ccs_mutex);
#endif
@@ -184,7 +200,7 @@ void * loadNativeObj_POSIX (pathchar *path, char **errmsg)
goto try_again;
} else {
/* dlopen failed; save the message in errmsg */
- copyErrmsg(errmsg, dlerror());
+ copyErrmsg(errmsg, (char*)dl_err);
goto dlopen_fail;
}
}
diff --git a/rts/prim/atomic.c b/rts/prim/atomic.c
index 29f4cc77840c..e0e06a74f74a 100644
--- a/rts/prim/atomic.c
+++ b/rts/prim/atomic.c
@@ -1,8 +1,8 @@
#if !defined(arm_HOST_ARCH)
#include "Rts.h"
-// Fallbacks for atomic primops on byte arrays. The builtins used
-// below are supported on both GCC and LLVM.
+// Fallbacks for atomic primops on byte arrays. The modern __atomic
+// builtins used below are supported on both GCC and LLVM.
//
// Ideally these function would take StgWord8, StgWord16, etc but
// older GCC versions incorrectly assume that the register that the
@@ -12,243 +12,214 @@
// FetchAddByteArrayOp_Int
-StgWord hs_atomic_add8(StgWord x, StgWord val)
+extern StgWord hs_atomic_add8(StgWord x, StgWord val);
+StgWord
+hs_atomic_add8(StgWord x, StgWord val)
{
- return __sync_fetch_and_add((volatile StgWord8 *) x, (StgWord8) val);
+ return __atomic_fetch_add((StgWord8 *) x, (StgWord8) val, __ATOMIC_SEQ_CST);
}
-StgWord hs_atomic_add16(StgWord x, StgWord val)
+extern StgWord hs_atomic_add16(StgWord x, StgWord val);
+StgWord
+hs_atomic_add16(StgWord x, StgWord val)
{
- return __sync_fetch_and_add((volatile StgWord16 *) x, (StgWord16) val);
+ return __atomic_fetch_add((StgWord16 *) x, (StgWord16) val, __ATOMIC_SEQ_CST);
}
-StgWord hs_atomic_add32(StgWord x, StgWord val)
+extern StgWord hs_atomic_add32(StgWord x, StgWord val);
+StgWord
+hs_atomic_add32(StgWord x, StgWord val)
{
- return __sync_fetch_and_add((volatile StgWord32 *) x, (StgWord32) val);
+ return __atomic_fetch_add((StgWord32 *) x, (StgWord32) val, __ATOMIC_SEQ_CST);
}
-StgWord64 hs_atomic_add64(StgWord x, StgWord64 val)
+extern StgWord64 hs_atomic_add64(StgWord x, StgWord64 val);
+StgWord64
+hs_atomic_add64(StgWord x, StgWord64 val)
{
- return __sync_fetch_and_add((volatile StgWord64 *) x, val);
+ return __atomic_fetch_add((StgWord64 *) x, val, __ATOMIC_SEQ_CST);
}
// FetchSubByteArrayOp_Int
-StgWord hs_atomic_sub8(StgWord x, StgWord val)
+extern StgWord hs_atomic_sub8(StgWord x, StgWord val);
+StgWord
+hs_atomic_sub8(StgWord x, StgWord val)
{
- return __sync_fetch_and_sub((volatile StgWord8 *) x, (StgWord8) val);
+ return __atomic_fetch_sub((StgWord8 *) x, (StgWord8) val, __ATOMIC_SEQ_CST);
}
-StgWord hs_atomic_sub16(StgWord x, StgWord val)
+extern StgWord hs_atomic_sub16(StgWord x, StgWord val);
+StgWord
+hs_atomic_sub16(StgWord x, StgWord val)
{
- return __sync_fetch_and_sub((volatile StgWord16 *) x, (StgWord16) val);
+ return __atomic_fetch_sub((StgWord16 *) x, (StgWord16) val, __ATOMIC_SEQ_CST);
}
-StgWord hs_atomic_sub32(StgWord x, StgWord val)
+extern StgWord hs_atomic_sub32(StgWord x, StgWord val);
+StgWord
+hs_atomic_sub32(StgWord x, StgWord val)
{
- return __sync_fetch_and_sub((volatile StgWord32 *) x, (StgWord32) val);
+ return __atomic_fetch_sub((StgWord32 *) x, (StgWord32) val, __ATOMIC_SEQ_CST);
}
-StgWord64 hs_atomic_sub64(StgWord x, StgWord64 val)
+extern StgWord64 hs_atomic_sub64(StgWord x, StgWord64 val);
+StgWord64
+hs_atomic_sub64(StgWord x, StgWord64 val)
{
- return __sync_fetch_and_sub((volatile StgWord64 *) x, val);
+ return __atomic_fetch_sub((StgWord64 *) x, val, __ATOMIC_SEQ_CST);
}
// FetchAndByteArrayOp_Int
-StgWord hs_atomic_and8(StgWord x, StgWord val)
+extern StgWord hs_atomic_and8(StgWord x, StgWord val);
+StgWord
+hs_atomic_and8(StgWord x, StgWord val)
{
- return __sync_fetch_and_and((volatile StgWord8 *) x, (StgWord8) val);
+ return __atomic_fetch_and((StgWord8 *) x, (StgWord8) val, __ATOMIC_SEQ_CST);
}
-StgWord hs_atomic_and16(StgWord x, StgWord val)
+extern StgWord hs_atomic_and16(StgWord x, StgWord val);
+StgWord
+hs_atomic_and16(StgWord x, StgWord val)
{
- return __sync_fetch_and_and((volatile StgWord16 *) x, (StgWord16) val);
+ return __atomic_fetch_and((StgWord16 *) x, (StgWord16) val, __ATOMIC_SEQ_CST);
}
-StgWord hs_atomic_and32(StgWord x, StgWord val)
+extern StgWord hs_atomic_and32(StgWord x, StgWord val);
+StgWord
+hs_atomic_and32(StgWord x, StgWord val)
{
- return __sync_fetch_and_and((volatile StgWord32 *) x, (StgWord32) val);
+ return __atomic_fetch_and((StgWord32 *) x, (StgWord32) val, __ATOMIC_SEQ_CST);
}
-StgWord64 hs_atomic_and64(StgWord x, StgWord64 val)
+extern StgWord64 hs_atomic_and64(StgWord x, StgWord64 val);
+StgWord64
+hs_atomic_and64(StgWord x, StgWord64 val)
{
- return __sync_fetch_and_and((volatile StgWord64 *) x, val);
+ return __atomic_fetch_and((StgWord64 *) x, val, __ATOMIC_SEQ_CST);
}
-// FetchNandByteArrayOp_Int
-
-// Note [__sync_fetch_and_nand usage]
-// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-// The __sync_fetch_and_nand builtin is a bit of a disaster. It was introduced
-// in GCC long ago with silly semantics. Specifically:
-//
-// *ptr = ~(tmp & value)
-//
-// Clang introduced the builtin with the same semantics.
-//
-// In GCC 4.4 the operation's semantics were rightly changed to,
-//
-// *ptr = ~tmp & value
-//
-// and the -Wsync-nand warning was added warning users of the operation about
-// the change.
-//
-// Clang took this change as a reason to remove support for the
-// builtin in 2010. Then, in 2014 Clang re-added support with the new
-// semantics. However, the warning flag was given a different name
-// (-Wsync-fetch-and-nand-semantics-changed) for added fun.
-//
-// Consequently, we are left with a bit of a mess: GHC requires GCC >4.4
-// (enforced by the FP_GCC_VERSION autoconf check), so we thankfully don't need
-// to support the operation's older broken semantics. However, we need to take
-// care to explicitly disable -Wsync-nand wherever possible, lest the build
-// fails with -Werror. Furthermore, we need to emulate the operation when
-// building with some Clang versions (shipped by some Mac OS X releases) which
-// lack support for the builtin.
-//
-// In the words of Bob Dylan: everything is broken.
-//
-// See also:
-//
-// * https://bugs.llvm.org/show_bug.cgi?id=8842
-// * https://gitlab.haskell.org/ghc/ghc/issues/9678
-//
-
-#define CAS_NAND(x, val) \
- { \
- __typeof__ (*(x)) tmp = *(x); \
- while (!__sync_bool_compare_and_swap(x, tmp, ~(tmp & (val)))) { \
- tmp = *(x); \
- } \
- return tmp; \
- }
-
-// N.B. __has_builtin is only provided by clang
-#if !defined(__has_builtin)
-#define __has_builtin(x) 0
-#endif
-
-#if defined(__clang__) && !__has_builtin(__sync_fetch_and_nand)
-#define USE_SYNC_FETCH_AND_NAND 0
-#else
-#define USE_SYNC_FETCH_AND_NAND 1
-#endif
-
-// Otherwise this fails with -Werror
-#pragma GCC diagnostic push
-#if defined(__clang__)
-#pragma GCC diagnostic ignored "-Wsync-fetch-and-nand-semantics-changed"
-#else
-#pragma GCC diagnostic ignored "-Wsync-nand"
-#endif
-
-StgWord hs_atomic_nand8(StgWord x, StgWord val)
+extern StgWord hs_atomic_nand8(StgWord x, StgWord val);
+StgWord
+hs_atomic_nand8(StgWord x, StgWord val)
{
-#if USE_SYNC_FETCH_AND_NAND
- return __sync_fetch_and_nand((volatile StgWord8 *) x, (StgWord8) val);
-#else
- CAS_NAND((volatile StgWord8 *) x, (StgWord8) val)
-#endif
+ return __atomic_fetch_nand((StgWord8 *) x, (StgWord8) val, __ATOMIC_SEQ_CST);
}
-StgWord hs_atomic_nand16(StgWord x, StgWord val)
+extern StgWord hs_atomic_nand16(StgWord x, StgWord val);
+StgWord
+hs_atomic_nand16(StgWord x, StgWord val)
{
-#if USE_SYNC_FETCH_AND_NAND
- return __sync_fetch_and_nand((volatile StgWord16 *) x, (StgWord16) val);
-#else
- CAS_NAND((volatile StgWord16 *) x, (StgWord16) val);
-#endif
+ return __atomic_fetch_nand((StgWord16 *) x, (StgWord16) val, __ATOMIC_SEQ_CST);
}
-StgWord hs_atomic_nand32(StgWord x, StgWord val)
+extern StgWord hs_atomic_nand32(StgWord x, StgWord val);
+StgWord
+hs_atomic_nand32(StgWord x, StgWord val)
{
-#if USE_SYNC_FETCH_AND_NAND
- return __sync_fetch_and_nand((volatile StgWord32 *) x, (StgWord32) val);
-#else
- CAS_NAND((volatile StgWord32 *) x, (StgWord32) val);
-#endif
+ return __atomic_fetch_nand((StgWord32 *) x, (StgWord32) val, __ATOMIC_SEQ_CST);
}
-StgWord64 hs_atomic_nand64(StgWord x, StgWord64 val)
+extern StgWord64 hs_atomic_nand64(StgWord x, StgWord64 val);
+StgWord64
+hs_atomic_nand64(StgWord x, StgWord64 val)
{
-#if USE_SYNC_FETCH_AND_NAND
- return __sync_fetch_and_nand((volatile StgWord64 *) x, val);
-#else
- CAS_NAND((volatile StgWord64 *) x, val);
-#endif
+ return __atomic_fetch_nand((StgWord64 *) x, val, __ATOMIC_SEQ_CST);
}
-#pragma GCC diagnostic pop
-
// FetchOrByteArrayOp_Int
-StgWord hs_atomic_or8(StgWord x, StgWord val)
+extern StgWord hs_atomic_or8(StgWord x, StgWord val);
+StgWord
+hs_atomic_or8(StgWord x, StgWord val)
{
- return __sync_fetch_and_or((volatile StgWord8 *) x, (StgWord8) val);
+ return __atomic_fetch_or((StgWord8 *) x, (StgWord8) val, __ATOMIC_SEQ_CST);
}
-StgWord hs_atomic_or16(StgWord x, StgWord val)
+extern StgWord hs_atomic_or16(StgWord x, StgWord val);
+StgWord
+hs_atomic_or16(StgWord x, StgWord val)
{
- return __sync_fetch_and_or((volatile StgWord16 *) x, (StgWord16) val);
+ return __atomic_fetch_or((StgWord16 *) x, (StgWord16) val, __ATOMIC_SEQ_CST);
}
-StgWord hs_atomic_or32(StgWord x, StgWord val)
+extern StgWord hs_atomic_or32(StgWord x, StgWord val);
+StgWord
+hs_atomic_or32(StgWord x, StgWord val)
{
- return __sync_fetch_and_or((volatile StgWord32 *) x, (StgWord32) val);
+ return __atomic_fetch_or((StgWord32 *) x, (StgWord32) val, __ATOMIC_SEQ_CST);
}
-StgWord64 hs_atomic_or64(StgWord x, StgWord64 val)
+extern StgWord64 hs_atomic_or64(StgWord x, StgWord64 val);
+StgWord64
+hs_atomic_or64(StgWord x, StgWord64 val)
{
- return __sync_fetch_and_or((volatile StgWord64 *) x, val);
+ return __atomic_fetch_or((StgWord64 *) x, val, __ATOMIC_SEQ_CST);
}
// FetchXorByteArrayOp_Int
-StgWord hs_atomic_xor8(StgWord x, StgWord val)
+extern StgWord hs_atomic_xor8(StgWord x, StgWord val);
+StgWord
+hs_atomic_xor8(StgWord x, StgWord val)
{
- return __sync_fetch_and_xor((volatile StgWord8 *) x, (StgWord8) val);
+ return __atomic_fetch_xor((StgWord8 *) x, (StgWord8) val, __ATOMIC_SEQ_CST);
}
-StgWord hs_atomic_xor16(StgWord x, StgWord val)
+extern StgWord hs_atomic_xor16(StgWord x, StgWord val);
+StgWord
+hs_atomic_xor16(StgWord x, StgWord val)
{
- return __sync_fetch_and_xor((volatile StgWord16 *) x, (StgWord16) val);
+ return __atomic_fetch_xor((StgWord16 *) x, (StgWord16) val, __ATOMIC_SEQ_CST);
}
-StgWord hs_atomic_xor32(StgWord x, StgWord val)
+extern StgWord hs_atomic_xor32(StgWord x, StgWord val);
+StgWord
+hs_atomic_xor32(StgWord x, StgWord val)
{
- return __sync_fetch_and_xor((volatile StgWord32 *) x, (StgWord32) val);
+ return __atomic_fetch_xor((StgWord32 *) x, (StgWord32) val, __ATOMIC_SEQ_CST);
}
-StgWord64 hs_atomic_xor64(StgWord x, StgWord64 val)
+extern StgWord64 hs_atomic_xor64(StgWord x, StgWord64 val);
+StgWord64
+hs_atomic_xor64(StgWord x, StgWord64 val)
{
- return __sync_fetch_and_xor((volatile StgWord64 *) x, val);
+ return __atomic_fetch_xor((StgWord64 *) x, val, __ATOMIC_SEQ_CST);
}
// CasByteArrayOp_Int
-StgWord hs_cmpxchg8(StgWord x, StgWord old, StgWord new)
+extern StgWord hs_cmpxchg8(StgWord x, StgWord old, StgWord new);
+StgWord
+hs_cmpxchg8(StgWord x, StgWord old, StgWord new)
{
StgWord8 expected = (StgWord8) old;
__atomic_compare_exchange_n((StgWord8 *) x, &expected, (StgWord8) new, false, __ATOMIC_SEQ_CST, __ATOMIC_SEQ_CST);
return expected;
}
-StgWord hs_cmpxchg16(StgWord x, StgWord old, StgWord new)
+extern StgWord hs_cmpxchg16(StgWord x, StgWord old, StgWord new);
+StgWord
+hs_cmpxchg16(StgWord x, StgWord old, StgWord new)
{
StgWord16 expected = (StgWord16) old;
__atomic_compare_exchange_n((StgWord16 *) x, &expected, (StgWord16) new, false, __ATOMIC_SEQ_CST, __ATOMIC_SEQ_CST);
return expected;
}
-StgWord hs_cmpxchg32(StgWord x, StgWord old, StgWord new)
+extern StgWord hs_cmpxchg32(StgWord x, StgWord old, StgWord new);
+StgWord
+hs_cmpxchg32(StgWord x, StgWord old, StgWord new)
{
StgWord32 expected = (StgWord32) old;
__atomic_compare_exchange_n((StgWord32 *) x, &expected, (StgWord32) new, false, __ATOMIC_SEQ_CST, __ATOMIC_SEQ_CST);
return expected;
}
-StgWord64 hs_cmpxchg64(StgWord x, StgWord64 old, StgWord64 new)
+extern StgWord64 hs_cmpxchg64(StgWord x, StgWord64 old, StgWord64 new);
+StgWord64
+hs_cmpxchg64(StgWord x, StgWord64 old, StgWord64 new)
{
StgWord64 expected = (StgWord64) old;
__atomic_compare_exchange_n((StgWord64 *) x, &expected, (StgWord64) new, false, __ATOMIC_SEQ_CST, __ATOMIC_SEQ_CST);
@@ -257,23 +228,31 @@ StgWord64 hs_cmpxchg64(StgWord x, StgWord64 old, StgWord64 new)
// Atomic exchange operations
-StgWord hs_xchg8(StgWord x, StgWord val)
+extern StgWord hs_xchg8(StgWord x, StgWord val);
+StgWord
+hs_xchg8(StgWord x, StgWord val)
{
return (StgWord) __atomic_exchange_n((StgWord8 *) x, (StgWord8) val, __ATOMIC_SEQ_CST);
}
-StgWord hs_xchg16(StgWord x, StgWord val)
+extern StgWord hs_xchg16(StgWord x, StgWord val);
+StgWord
+hs_xchg16(StgWord x, StgWord val)
{
return (StgWord) __atomic_exchange_n((StgWord16 *)x, (StgWord16) val, __ATOMIC_SEQ_CST);
}
-StgWord hs_xchg32(StgWord x, StgWord val)
+extern StgWord hs_xchg32(StgWord x, StgWord val);
+StgWord
+hs_xchg32(StgWord x, StgWord val)
{
return (StgWord) __atomic_exchange_n((StgWord32 *) x, (StgWord32) val, __ATOMIC_SEQ_CST);
}
//GCC provides this even on 32bit, but StgWord is still 32 bits.
-StgWord64 hs_xchg64(StgWord x, StgWord64 val)
+extern StgWord64 hs_xchg64(StgWord x, StgWord64 val);
+StgWord64
+hs_xchg64(StgWord x, StgWord64 val)
{
return (StgWord64) __atomic_exchange_n((StgWord64 *) x, (StgWord64) val, __ATOMIC_SEQ_CST);
}
@@ -283,27 +262,31 @@ StgWord64 hs_xchg64(StgWord x, StgWord64 val)
// __ATOMIC_SEQ_CST: Full barrier in both directions (hoisting and sinking
// of code) and synchronizes with acquire loads and release stores in
// all threads.
-//
-// When we lack C11 atomics support we emulate these using the old GCC __sync
-// primitives which the GCC documentation claims "usually" implies a full
-// barrier.
-StgWord hs_atomicread8(StgWord x)
+extern StgWord hs_atomicread8(StgWord x);
+StgWord
+hs_atomicread8(StgWord x)
{
return __atomic_load_n((StgWord8 *) x, __ATOMIC_SEQ_CST);
}
-StgWord hs_atomicread16(StgWord x)
+extern StgWord hs_atomicread16(StgWord x);
+StgWord
+hs_atomicread16(StgWord x)
{
return __atomic_load_n((StgWord16 *) x, __ATOMIC_SEQ_CST);
}
-StgWord hs_atomicread32(StgWord x)
+extern StgWord hs_atomicread32(StgWord x);
+StgWord
+hs_atomicread32(StgWord x)
{
return __atomic_load_n((StgWord32 *) x, __ATOMIC_SEQ_CST);
}
-StgWord64 hs_atomicread64(StgWord x)
+extern StgWord64 hs_atomicread64(StgWord x);
+StgWord64
+hs_atomicread64(StgWord x)
{
return __atomic_load_n((StgWord64 *) x, __ATOMIC_SEQ_CST);
}
@@ -312,22 +295,30 @@ StgWord64 hs_atomicread64(StgWord x)
// Implies a full memory barrier (see compiler/GHC/Builtin/primops.txt.pp)
// __ATOMIC_SEQ_CST: Full barrier (see hs_atomicread8 above).
-void hs_atomicwrite8(StgWord x, StgWord val)
+extern void hs_atomicwrite8(StgWord x, StgWord val);
+void
+hs_atomicwrite8(StgWord x, StgWord val)
{
__atomic_store_n((StgWord8 *) x, (StgWord8) val, __ATOMIC_SEQ_CST);
}
-void hs_atomicwrite16(StgWord x, StgWord val)
+extern void hs_atomicwrite16(StgWord x, StgWord val);
+void
+hs_atomicwrite16(StgWord x, StgWord val)
{
__atomic_store_n((StgWord16 *) x, (StgWord16) val, __ATOMIC_SEQ_CST);
}
-void hs_atomicwrite32(StgWord x, StgWord val)
+extern void hs_atomicwrite32(StgWord x, StgWord val);
+void
+hs_atomicwrite32(StgWord x, StgWord val)
{
__atomic_store_n((StgWord32 *) x, (StgWord32) val, __ATOMIC_SEQ_CST);
}
-void hs_atomicwrite64(StgWord x, StgWord64 val)
+extern void hs_atomicwrite64(StgWord x, StgWord64 val);
+void
+hs_atomicwrite64(StgWord x, StgWord64 val)
{
__atomic_store_n((StgWord64 *) x, (StgWord64) val, __ATOMIC_SEQ_CST);
}
diff --git a/rts/rts.buildinfo.in b/rts/rts.buildinfo.in
new file mode 100644
index 000000000000..86fe4f260aaf
--- /dev/null
+++ b/rts/rts.buildinfo.in
@@ -0,0 +1,2 @@
+extra-libraries: @EXTRA_LIBS@
+extra-libraries-static: @EXTRA_LIBS@
diff --git a/rts/rts.cabal b/rts/rts.cabal
index 768925a2be9e..88ed403bbb08 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,36 +13,260 @@ build-type: Configure
extra-source-files:
configure
+ config.guess
+ config.sub
+ ghcplatform.h.top.in
+ ghcplatform.h.bottom
+ ghcautoconf.h.autoconf.in
configure.ac
+ 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
+ wasm/WasmGlobalRegs.S
+ -- 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
+ 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/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/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/RtsToHsIface.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/MachRegsForHost.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
+ 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
+ rts.buildinfo
config.log
config.status
+-- WASM GlobalRegs source file, needed at executable link time
+-- See Note [WASM GlobalRegs Linking] in rts/wasm/WasmGlobalRegs.S
+data-files:
+ wasm/WasmGlobalRegs.S
+
source-repository head
type: git
location: https://gitlab.haskell.org/ghc/ghc.git
subdir: rts
-flag libm
- default: False
- manual: True
flag librt
default: False
manual: True
-flag libdl
- default: False
- manual: True
flag use-system-libffi
default: False
manual: True
flag libffi-adjustors
default: False
manual: True
-flag need-pthread
- default: False
- manual: True
flag libbfd
default: False
manual: True
@@ -76,11 +300,11 @@ flag smp
flag find-ptr
default: False
manual: True
--- Some cabal flags used to control the flavours we want to produce
--- for libHSrts in hadrian. By default, we just produce vanilla and
--- threaded. The flags "compose": if you enable debug and profiling,
--- you will produce vanilla, _thr, _debug, _p but also _thr_p,
--- _thr_debug_p and so on.
+-- -- Some cabal flags used to control the flavours we want to produce
+-- -- for libHSrts in hadrian. By default, we just produce vanilla and
+-- -- threaded. The flags "compose": if you enable debug and profiling,
+-- -- you will produce vanilla, _thr, _debug, _p but also _thr_p,
+-- -- _thr_debug_p and so on.
flag profiling
default: False
manual: True
@@ -101,482 +325,579 @@ flag thread-sanitizer
default: False
manual: True
-library
- -- rts is a wired in package and
- -- expects the unit-id to be
- -- set without version
- ghc-options: -this-unit-id rts
+common rts-base-config
+ ghc-options: -ghcversion-file=include/ghcversion.h -optc-DFS_NAMESPACE=rts
+ cmm-options:
- exposed: True
- exposed-modules:
+ include-dirs: include .
+ includes: Rts.h
+ build-depends:
+ rts-headers,
+ rts-fs,
+ rts
+
+common rts-cmm-sources-base
+ if !arch(javascript)
+ -- Note: These .cmm files are thin wrappers that #include the corresponding
+ -- .cmm.h files. This ensures each sublibrary compiles them with its own
+ -- flags (-DDEBUG, -DTHREADED_RTS, etc.) applied correctly.
+ cmm-sources:
+ AutoApply.cmm
+ AutoApply_V16.cmm
+
+ if arch(x86_64)
+ cmm-sources:
+ Jumps_V32.cmm (-mavx2)
+ Jumps_V64.cmm (-mavx512f)
+ AutoApply_V32.cmm (-mavx2)
+ AutoApply_V64.cmm (-mavx512f)
+ else
+ cmm-sources:
+ Jumps_V32.cmm
+ Jumps_V64.cmm
+ AutoApply_V32.cmm
+ AutoApply_V64.cmm
+
+ -- this is required so we don't have ghc inject ghc-internal (which depends on the rts)
+ -- during the build phase of this library.
+ ghc-options: -no-ghc-internal
- if arch(javascript)
- include-dirs: include
-
- js-sources:
- js/config.js
- js/structs.js
- js/arith.js
- js/compact.js
- js/debug.js
- js/enum.js
- js/environment.js
- js/eventlog.js
- js/gc.js
- js/goog.js
- js/hscore.js
- js/md5.js
- js/mem.js
- js/node-exports.js
- js/object.js
- js/profiling.js
- js/rts.js
- js/stableptr.js
- js/staticpointer.js
- js/stm.js
- js/string.js
- js/thread.js
- js/unicode.js
- js/verify.js
- js/weak.js
- js/globals.js
- js/time.js
-
- install-includes: HsFFI.h MachDeps.h Rts.h RtsAPI.h Stg.h
- ghcautoconf.h ghcconfig.h ghcplatform.h ghcversion.h
- DerivedConstants.h
- stg/MachRegs.h
- stg/MachRegs/arm32.h
- stg/MachRegs/arm64.h
- stg/MachRegs/loongarch64.h
- stg/MachRegs/ppc.h
- stg/MachRegs/riscv64.h
- stg/MachRegs/s390x.h
- stg/MachRegs/wasm32.h
- stg/MachRegs/x86.h
- stg/MachRegsForHost.h
- stg/Types.h
+common rts-c-sources-base
+ if !arch(javascript)
+ cmm-sources:
+ Apply.cmm
+ Compact.cmm
+ ContinuationOps.cmm
+ Exception.cmm
+ HeapStackCheck.cmm
+ Jumps_D.cmm
+ Jumps_V16.cmm
+ PrimOps.cmm
+ StgMiscClosures.cmm
+ StgStartup.cmm
+ StgStdThunks.cmm
+ Updates.cmm
+ -- Adjustor stuff
+ if flag(libffi-adjustors)
+ c-sources: adjustor/LibffiAdjustor.c
else
- -- If we are using an in-tree libffi then we must declare it as a bundled
- -- library to ensure that Cabal installs it.
- if !flag(use-system-libffi)
- if os(windows)
- extra-bundled-libraries: Cffi-6
+ 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
- extra-bundled-libraries: Cffi
-
- install-includes: ffi.h ffitarget.h
- -- ^ see Note [Packaging libffi headers] in
- -- GHC.Driver.CodeOutput.
-
- -- Here we declare several flavours to be available when passing the
- -- suitable (combination of) flag(s) when configuring the RTS from hadrian,
- -- using Cabal.
- if flag(threaded)
- extra-library-flavours: _thr
- if flag(dynamic)
- extra-dynamic-library-flavours: _thr
-
- if flag(profiling)
- extra-library-flavours: _p
- if flag(threaded)
- extra-library-flavours: _thr_p
- if flag(debug)
- extra-library-flavours: _debug_p
- if flag(threaded)
- extra-library-flavours: _thr_debug_p
- if flag(dynamic)
- extra-dynamic-library-flavours: _p
- if flag(threaded)
- extra-dynamic-library-flavours: _thr_p
- if flag(debug)
- extra-dynamic-library-flavours: _debug_p
- if flag(threaded)
- extra-dynamic-library-flavours: _thr_debug_p
-
- if flag(debug)
- extra-library-flavours: _debug
- if flag(dynamic)
- extra-dynamic-library-flavours: _debug
- if flag(threaded)
- extra-library-flavours: _thr_debug
- if flag(dynamic)
- extra-dynamic-library-flavours: _thr_debug
-
- if flag(thread-sanitizer)
- cc-options: -fsanitize=thread
- ld-options: -fsanitize=thread
-
- if os(linux)
- -- the RTS depends upon libc. while this dependency is generally
- -- implicitly added by `cc`, we must explicitly add it here to ensure
- -- that it is ordered correctly with libpthread, since ghc-internal.cabal
- -- also explicitly lists libc. See #19029.
- extra-libraries: c
- if flag(libm)
- -- for ldexp()
- extra-libraries: m
- if flag(librt)
- extra-libraries: rt
- if flag(libdl)
- extra-libraries: dl
- if flag(use-system-libffi)
- extra-libraries: ffi
- if os(windows)
- extra-libraries:
- -- for the linker
- wsock32 gdi32 winmm
- -- for crash dump
- dbghelp
- -- for process information
- psapi
- -- TODO: Hadrian will use this cabal file, so drop WINVER from Hadrian's configs.
- -- Minimum supported Windows version.
- -- These numbers can be found at:
- -- https://msdn.microsoft.com/en-us/library/windows/desktop/aa383745(v=vs.85).aspx
- -- If we're compiling on windows, enforce that we only support Windows 7+
- -- Adding this here means it doesn't have to be done in individual .c files
- -- and also centralizes the versioning.
- cpp-options: -D_WIN32_WINNT=0x06010000
- cc-options: -D_WIN32_WINNT=0x06010000
- if flag(need-pthread)
- -- for pthread_getthreadid_np, pthread_create, ...
- extra-libraries: pthread
- if flag(need-atomic)
- -- for sub-word-sized atomic operations (#19119)
- extra-libraries: atomic
- if flag(libbfd)
- -- for debugging
- extra-libraries: bfd iberty
- if flag(libdw)
- -- for backtraces
- extra-libraries: elf dw
- if flag(libnuma)
- extra-libraries: numa
- if flag(libzstd)
- if flag(static-libzstd)
- if os(darwin)
- buildable: False
- else
- extra-libraries: :libzstd.a
- else
- extra-libraries: zstd
- if !flag(smp)
- cpp-options: -DNOSMP
-
- include-dirs: include
- 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
- ghcautoconf.h ghcconfig.h ghcplatform.h ghcversion.h
- -- ^ from include
- DerivedConstants.h
- rts/EventLogConstants.h
- rts/EventTypes.h
- -- ^ generated
- rts/ghc_ffi.h
- rts/Adjustor.h
- rts/ExecPage.h
- rts/BlockSignals.h
- rts/Bytecodes.h
- rts/Config.h
- rts/Constants.h
- rts/EventLogFormat.h
- rts/EventLogWriter.h
- rts/FileLock.h
- rts/Flags.h
- rts/ForeignExports.h
- rts/GetTime.h
- rts/Globals.h
- rts/Hpc.h
- rts/IOInterface.h
- rts/Libdw.h
- rts/LibdwPool.h
- rts/Linker.h
- rts/Main.h
- rts/Messages.h
- rts/NonMoving.h
- rts/OSThreads.h
- rts/Parallel.h
- rts/PrimFloat.h
- rts/Profiling.h
- rts/IPE.h
- rts/PosixSource.h
- rts/Signals.h
- rts/SpinLock.h
- rts/StableName.h
- rts/StablePtr.h
- rts/StaticPtrTable.h
- rts/TTY.h
- rts/Threads.h
- rts/Ticky.h
- rts/Time.h
- rts/Timer.h
- rts/TSANUtils.h
- rts/Types.h
- rts/Utils.h
- rts/prof/CCS.h
- rts/prof/Heap.h
- rts/prof/LDV.h
- rts/storage/Block.h
- rts/storage/ClosureMacros.h
- rts/storage/ClosureTypes.h
- rts/storage/Closures.h
- rts/storage/FunTypes.h
- rts/storage/Heap.h
- rts/storage/HeapAlloc.h
- rts/storage/GC.h
- rts/storage/InfoTables.h
- rts/storage/MBlock.h
- rts/storage/TSO.h
- rts/RtsToHsIface.h
- stg/DLL.h
- stg/MachRegs.h
- stg/MachRegs/arm32.h
- stg/MachRegs/arm64.h
- stg/MachRegs/loongarch64.h
- stg/MachRegs/ppc.h
- stg/MachRegs/riscv64.h
- stg/MachRegs/s390x.h
- stg/MachRegs/wasm32.h
- stg/MachRegs/x86.h
- stg/MachRegsForHost.h
- stg/MiscClosures.h
- stg/Prim.h
- stg/Regs.h
- stg/SMP.h
- stg/Ticky.h
- stg/Types.h
-
- if os(osx)
- ld-options: "-Wl,-search_paths_first"
- if !arch(x86_64) && !arch(aarch64)
- ld-options: -read_only_relocs warning
-
- cmm-sources: Apply.cmm
- Compact.cmm
- ContinuationOps.cmm
- Exception.cmm
- HeapStackCheck.cmm
- Jumps_D.cmm
- Jumps_V16.cmm
- Jumps_V32.cmm
- Jumps_V64.cmm
- PrimOps.cmm
- StgMiscClosures.cmm
- StgStartup.cmm
- StgStdThunks.cmm
- Updates.cmm
- -- AutoApply is generated
- AutoApply.cmm
- AutoApply_V16.cmm
- AutoApply_V32.cmm
- AutoApply_V64.cmm
-
- -- Adjustor stuff
- if flag(libffi-adjustors)
+ asm-sources: adjustor/NativeAmd64Asm.S
+ c-sources: adjustor/NativeAmd64.c
+ if !arch(x86_64) && !arch(i386)
c-sources: adjustor/LibffiAdjustor.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
-
- -- Use assembler STG entrypoint on architectures where it is used
- if arch(ppc) || arch(ppc64) || arch(s390x) || arch(riscv64) || arch(loongarch64)
- asm-sources: StgCRunAsm.S
-
- c-sources: Adjustor.c
- AllocArray.c
- adjustor/AdjustorPool.c
- ExecPage.c
- Arena.c
- BuiltinClosures.c
- Capability.c
- CheckUnload.c
- CheckVectorSupport.c
- CloneStack.c
- ClosureFlags.c
- ClosureSize.c
- Continuation.c
- Disassembler.c
- FileLock.c
- ForeignExports.c
- Globals.c
- Hash.c
- Heap.c
- Hpc.c
- HsFFI.c
- Inlines.c
- Interpreter.c
- IOManager.c
- LdvProfile.c
- Libdw.c
- LibdwPool.c
- Linker.c
- ReportMemoryMap.c
- Messages.c
- OldARMAtomic.c
- PathUtils.c
- Pool.c
- Printer.c
- ProfHeap.c
- ProfilerReport.c
- ProfilerReportJson.c
- Profiling.c
- IPE.c
- Proftimer.c
- RaiseAsync.c
- RetainerProfile.c
- RetainerSet.c
- RtsAPI.c
- RtsFlags.c
- RtsMain.c
- RtsMessages.c
- RtsStartup.c
- RtsSymbolInfo.c
- RtsSymbols.c
- RtsToHsIface.c
- RtsUtils.c
- STM.c
- Schedule.c
- Sparks.c
- SpinLock.c
- StableName.c
- StablePtr.c
- StaticPtrTable.c
- Stats.c
- StgCRun.c
- StgPrimFloat.c
- Task.c
- ThreadLabels.c
- ThreadPaused.c
- Threads.c
- Ticky.c
- Timer.c
- TopHandler.c
- Trace.c
- TraverseHeap.c
- TraverseHeapTest.c
- TSANUtils.c
- WSDeque.c
- Weak.c
- ZeroSlop.c
- eventlog/EventLog.c
- eventlog/EventLogWriter.c
- hooks/FlagDefaults.c
- hooks/LongGCSync.c
- hooks/MallocFail.c
- hooks/OnExit.c
- hooks/OutOfHeap.c
- hooks/StackOverflow.c
- linker/CacheFlush.c
- linker/Elf.c
- linker/InitFini.c
- linker/LoadArchive.c
- linker/LoadNativeObjPosix.c
- linker/M32Alloc.c
- linker/MMap.c
- linker/MachO.c
- linker/macho/plt.c
- linker/macho/plt_aarch64.c
- linker/ProddableBlocks.c
- linker/PEi386.c
- linker/SymbolExtras.c
- linker/elf_got.c
- linker/elf_plt.c
- linker/elf_plt_aarch64.c
- linker/elf_plt_riscv64.c
- linker/elf_plt_arm.c
- linker/elf_reloc.c
- linker/elf_reloc_aarch64.c
- linker/elf_reloc_riscv64.c
- linker/elf_tlsgd.c
- linker/elf_util.c
- sm/BlockAlloc.c
- sm/CNF.c
- sm/Compact.c
- sm/Evac.c
- sm/Evac_thr.c
- sm/GC.c
- sm/GCAux.c
- sm/GCUtils.c
- sm/MBlock.c
- sm/MarkWeak.c
- sm/NonMoving.c
- sm/NonMovingAllocate.c
- sm/NonMovingCensus.c
- sm/NonMovingMark.c
- sm/NonMovingScav.c
- sm/NonMovingShortcut.c
- sm/NonMovingSweep.c
- sm/Sanity.c
- sm/Scav.c
- sm/Scav_thr.c
- sm/Storage.c
- sm/Sweep.c
- fs.c
- prim/atomic.c
- prim/bitrev.c
- prim/bswap.c
- prim/clz.c
- prim/ctz.c
- prim/int64x2minmax.c
- prim/longlong.c
- prim/mulIntMayOflo.c
- prim/pdep.c
- prim/pext.c
- prim/popcnt.c
- prim/vectorQuotRem.c
- prim/word2float.c
+
+ if arch(ppc) || arch(ppc64) || arch(s390x) || arch(riscv64) || arch(loongarch64)
+ asm-sources: StgCRunAsm.S
+
+ if arch(wasm32)
+ cc-options: -fvisibility=default -fvisibility-inlines-hidden
+
+ c-sources: Adjustor.c
+ AllocArray.c
+ adjustor/AdjustorPool.c
+ ExecPage.c
+ Arena.c
+ BuiltinClosures.c
+ Capability.c
+ CheckUnload.c
+ CheckVectorSupport.c
+ CloneStack.c
+ ClosureFlags.c
+ ClosureSize.c
+ Continuation.c
+ Disassembler.c
+ FileLock.c
+ ForeignExports.c
+ Globals.c
+ Hash.c
+ Heap.c
+ Hpc.c
+ HsFFI.c
+ Inlines.c
+ Interpreter.c
+ IOManager.c
+ LdvProfile.c
+ Libdw.c
+ LibdwPool.c
+ Linker.c
+ ReportMemoryMap.c
+ Messages.c
+ OldARMAtomic.c
+ PathUtils.c
+ Pool.c
+ Printer.c
+ ProfHeap.c
+ ProfilerReport.c
+ ProfilerReportJson.c
+ Profiling.c
+ IPE.c
+ Proftimer.c
+ RaiseAsync.c
+ RetainerProfile.c
+ RetainerSet.c
+ RtsAPI.c
+ RtsFlags.c
+ RtsMain.c
+ RtsMessages.c
+ RtsStartup.c
+ RtsSymbolInfo.c
+ RtsSymbols.c
+ RtsToHsIface.c
+ RtsUtils.c
+ STM.c
+ Schedule.c
+ Sparks.c
+ SpinLock.c
+ StableName.c
+ StablePtr.c
+ StaticPtrTable.c
+ Stats.c
+ StgCRun.c
+ StgPrimFloat.c
+ Task.c
+ ThreadLabels.c
+ ThreadPaused.c
+ Threads.c
+ Ticky.c
+ Timer.c
+ TopHandler.c
+ Trace.c
+ TraverseHeap.c
+ TraverseHeapTest.c
+ TSANUtils.c
+ WSDeque.c
+ Weak.c
+ ZeroSlop.c
+ eventlog/EventLog.c
+ eventlog/EventLogWriter.c
+ hooks/FlagDefaults.c
+ hooks/LongGCSync.c
+ hooks/MallocFail.c
+ hooks/OnExit.c
+ hooks/OutOfHeap.c
+ hooks/StackOverflow.c
+ linker/CacheFlush.c
+ linker/Elf.c
+ linker/InitFini.c
+ linker/LoadArchive.c
+ linker/LoadNativeObjPosix.c
+ linker/M32Alloc.c
+ linker/MMap.c
+ linker/MachO.c
+ linker/macho/plt.c
+ linker/macho/plt_aarch64.c
+ linker/ProddableBlocks.c
+ linker/PEi386.c
+ linker/SymbolExtras.c
+ linker/elf_got.c
+ linker/elf_plt.c
+ linker/elf_plt_aarch64.c
+ linker/elf_plt_riscv64.c
+ linker/elf_plt_arm.c
+ linker/elf_reloc.c
+ linker/elf_reloc_aarch64.c
+ linker/elf_reloc_riscv64.c
+ linker/elf_tlsgd.c
+ linker/elf_util.c
+ sm/BlockAlloc.c
+ sm/CNF.c
+ sm/Compact.c
+ sm/Evac.c
+ sm/Evac_thr.c
+ sm/GC.c
+ sm/GCAux.c
+ sm/GCUtils.c
+ sm/MBlock.c
+ sm/MarkWeak.c
+ sm/NonMoving.c
+ sm/NonMovingAllocate.c
+ sm/NonMovingCensus.c
+ sm/NonMovingMark.c
+ sm/NonMovingScav.c
+ sm/NonMovingShortcut.c
+ sm/NonMovingSweep.c
+ sm/Sanity.c
+ sm/Scav.c
+ sm/Scav_thr.c
+ sm/Storage.c
+ sm/Sweep.c
-- I wish we had wildcards..., this would be:
-- *.c hooks/**/*.c sm/**/*.c eventlog/**/*.c linker/**/*.c
+ prim/atomic.c
+ prim/bitrev.c
+ prim/bswap.c
+ prim/clz.c
+ prim/ctz.c
+ prim/int64x2minmax.c
+ prim/longlong.c
+ prim/mulIntMayOflo.c
+ prim/pdep.c
+ prim/pext.c
+ prim/popcnt.c
+ prim/vectorQuotRem.c
+ prim/word2float.c
- if os(windows)
- c-sources: win32/AsyncMIO.c
- win32/AsyncWinIO.c
- win32/AwaitEvent.c
- win32/ConsoleHandler.c
- win32/GetEnv.c
- win32/GetTime.c
- win32/MIOManager.c
- win32/OSMem.c
- win32/OSThreads.c
- win32/ThrIOManager.c
- win32/Ticker.c
- win32/WorkQueue.c
- win32/veh_excn.c
- -- win32/**/*.c
- elif arch(wasm32)
- asm-sources: wasm/Wasm.S
- c-sources: wasm/StgRun.c
- wasm/GetTime.c
- wasm/OSMem.c
- wasm/OSThreads.c
- wasm/JSFFI.c
- wasm/JSFFIGlobals.c
- posix/Select.c
- cmm-sources: wasm/jsval.cmm
- wasm/blocker.cmm
- wasm/scheduler.cmm
- else
- c-sources: posix/GetEnv.c
- posix/GetTime.c
- posix/Ticker.c
- posix/OSMem.c
- posix/OSThreads.c
- posix/Select.c
- posix/Signals.c
- posix/TTY.c
- -- ticker/*.c
- -- We don't want to compile posix/ticker/*.c, these will be #included
- -- from Ticker.c
+ if os(windows)
+ c-sources: win32/AsyncMIO.c
+ win32/AsyncWinIO.c
+ win32/AwaitEvent.c
+ win32/ConsoleHandler.c
+ win32/GetEnv.c
+ win32/GetTime.c
+ win32/MIOManager.c
+ win32/OSMem.c
+ win32/OSThreads.c
+ win32/ThrIOManager.c
+ win32/Ticker.c
+ win32/WorkQueue.c
+ win32/veh_excn.c
+ elif arch(wasm32)
+ asm-sources: wasm/Wasm.S
+ -- Note: WasmGlobalRegs.S is NOT included in RTS build
+ -- It's compiled on-demand and injected during executable linking
+ -- See Note [WASM GlobalRegs Linking] in rts/wasm/WasmGlobalRegs.S
+ c-sources: wasm/StgRun.c
+ wasm/GetTime.c
+ wasm/OSMem.c
+ wasm/OSThreads.c
+ wasm/JSFFI.c
+ wasm/JSFFIGlobals.c
+ -- Note: Select.c included for wasm32
+ posix/Select.c
+ cmm-sources: wasm/jsval.cmm
+ wasm/blocker.cmm
+ wasm/scheduler.cmm
+ -- Posix-like
+ else
+ c-sources: posix/GetEnv.c
+ posix/GetTime.c
+ posix/Ticker.c
+ posix/OSMem.c
+ posix/OSThreads.c
+ posix/Select.c
+ posix/Signals.c
+ posix/TTY.c
+
+common rts-link-options
+ if flag(use-system-libffi)
+ extra-libraries: ffi
+ extra-libraries-static: ffi
+ if !flag(use-system-libffi) && !arch(javascript) && !arch(wasm32)
+ build-depends: libffi-clib
+
+ if os(linux)
+ extra-libraries: c
+ extra-libraries-static: c
+ if flag(librt)
+ extra-libraries: rt
+ extra-libraries-static: rt
+ if os(windows)
+ extra-libraries:
+ wsock32 gdi32 winmm
+ dbghelp
+ psapi
+ extra-libraries-static:
+ wsock32 gdi32 winmm
+ dbghelp
+ psapi
+ cpp-options: -D_WIN32_WINNT=0x06010000
+ cc-options: -D_WIN32_WINNT=0x06010000
+ if flag(need-atomic)
+ extra-libraries: atomic
+ extra-libraries-static: atomic
+ if flag(libbfd)
+ extra-libraries: bfd iberty
+ extra-libraries-static: bfd iberty
+ if flag(libdw)
+ extra-libraries: elf dw
+ extra-libraries-static: elf dw
+ if flag(libnuma)
+ extra-libraries: numa
+ extra-libraries-static: numa
+ if flag(libzstd)
+ if flag(static-libzstd)
+ if os(darwin)
+ buildable: False
+ else
+ extra-libraries: :libzstd.a
+ else
+ extra-libraries: zstd
+ extra-libraries-static: zstd
+
+ if os(osx)
+ ld-options: "-Wl,-search_paths_first"
+ if !arch(x86_64) && !arch(aarch64)
+ ld-options: -read_only_relocs warning
+ if !arch(x86_64) && !arch(aarch64)
+ ld-options: -read_only_relocs warning
+
+common rts-global-build-flags
+ ghc-options: -DCOMPILING_RTS -optc-DCOMPILING_RTS
+ cpp-options: -DCOMPILING_RTS
+ cmm-options: -DCOMPILING_RTS
+ cc-options: -DCOMPILING_RTS
+ if !flag(smp)
+ ghc-options: -DNOSMP -optc-DNOSMP
+ cpp-options: -DNOSMP
+ cmm-options: -DNOSMP
+ cc-options: -DNOSMP
+ if flag(dynamic)
+ ghc-options: -DDYNAMIC -optc-DDYNAMIC
+ cpp-options: -DDYNAMIC
+ cmm-options: -DDYNAMIC
+ cc-options: -DDYNAMIC
+ if flag(thread-sanitizer)
+ cc-options: -fsanitize=thread
+ ld-options: -fsanitize=thread
+ if !flag(use-system-libffi)
+ ghc-options: -optc-DINTERNAL_LIBFFI
+ cpp-options: -DINTERNAL_LIBFFI
+ cc-options: -DINTERNAL_LIBFFI
+
+common rts-debug-flags
+ ghc-options: -DDEBUG -optc-DDEBUG
+ cpp-options: -DDEBUG -fno-omit-frame-pointer -g3 -O0
+ cmm-options: -DDEBUG
+ cc-options: -DDEBUG -fno-omit-frame-pointer -g3 -O0
+
+common rts-threaded-flags
+ ghc-options: -DTHREADED_RTS -optc-DTHREADED_RTS
+ cpp-options: -DTHREADED_RTS
+ cmm-options: -DTHREADED_RTS
+ cc-options: -DTHREADED_RTS
+
+-- the _main_ library needs to deal with all the _configure_ time stuff.
+library
+ ghc-options: -this-unit-id rts -ghcversion-file=include/ghcversion.h -optc-DFS_NAMESPACE=rts
+ cmm-options: -this-unit-id rts
+
+ -- [The AutoApply story]
+ --
+ -- We use GenApply to generate the AutoApply[_V{16,32,64}].cmm files.
+ -- However cabal will run the ./configure script only for the main library.
+ -- To work around this shortcoming, we'll generate .cmm.h files (same
+ -- content as .cmm), and create AutoApply*.cmm files that just
+ --
+ -- #include
+ --
+ -- This way each sublib has it's own properly parameterized .cmm file, while
+ -- we only generate them once and stick them into the rts library.
+ --
+ -- This is a hack, and it would be great if sublibs had access to their
+ -- parent libraries auto-gen folders, however as sublibs are supposed to be
+ -- separate components, this is a non-trivial (impossible?) task to resolve.
+ autogen-includes:
+ ghcautoconf.h
+ ghcplatform.h
+ DerivedConstants.h
+ rts/EventLogConstants.h
+ rts/EventTypes.h
+ rts/AutoApply.cmm.h
+ rts/AutoApply_V16.cmm.h
+ rts/AutoApply_V32.cmm.h
+ rts/AutoApply_V64.cmm.h
+
+ install-includes:
+ ghcautoconf.h
+ ghcplatform.h
+ DerivedConstants.h
+ rts/EventLogConstants.h
+ rts/EventTypes.h
+ rts/AutoApply.cmm.h
+ rts/AutoApply_V16.cmm.h
+ rts/AutoApply_V32.cmm.h
+ rts/AutoApply_V64.cmm.h
+
+ install-includes:
+ -- Common headers for non-JS builds
+ Cmm.h HsFFI.h MachDeps.h Jumps.h Rts.h RtsAPI.h RtsSymbols.h Stg.h
+ ghcconfig.h ghcversion.h
+ rts/ghc_ffi.h
+ rts/Adjustor.h
+ rts/ExecPage.h
+ rts/BlockSignals.h
+ rts/Config.h
+ rts/Constants.h
+ rts/EventLogFormat.h
+ rts/EventLogWriter.h
+ rts/FileLock.h
+ rts/Flags.h
+ rts/ForeignExports.h
+ rts/GetTime.h
+ rts/Globals.h
+ rts/Hpc.h
+ rts/IOInterface.h
+ rts/Libdw.h
+ rts/LibdwPool.h
+ rts/Linker.h
+ rts/Main.h
+ rts/Messages.h
+ rts/NonMoving.h
+ rts/OSThreads.h
+ rts/Parallel.h
+ rts/PrimFloat.h
+ rts/Profiling.h
+ rts/IPE.h
+ rts/PosixSource.h
+ rts/Signals.h
+ rts/SpinLock.h
+ rts/StableName.h
+ rts/StablePtr.h
+ rts/StaticPtrTable.h
+ rts/TTY.h
+ rts/Threads.h
+ rts/Ticky.h
+ rts/Time.h
+ rts/Timer.h
+ rts/TSANUtils.h
+ rts/Types.h
+ rts/Utils.h
+ rts/prof/CCS.h
+ rts/prof/Heap.h
+ rts/prof/LDV.h
+ rts/storage/Block.h
+ rts/storage/ClosureMacros.h
+ rts/storage/Closures.h
+ rts/storage/Heap.h
+ rts/storage/HeapAlloc.h
+ rts/storage/GC.h
+ rts/storage/InfoTables.h
+ rts/storage/MBlock.h
+ rts/storage/TSO.h
+ rts/RtsToHsIface.h
+ stg/DLL.h
+ stg/MiscClosures.h
+ stg/Prim.h
+ stg/Regs.h
+ stg/SMP.h
+ stg/Ticky.h
+ stg/MachRegsForHost.h
+ stg/Types.h
+
+ include-dirs: include .
+
+ build-depends:
+ rts-headers,
+ rts-fs
+
+ if !flag(use-system-libffi) && !arch(javascript) && !arch(wasm32)
+ build-depends: libffi-clib
+
+common ghcjs
+ import: rts-base-config
+
+ -- Keep original JS specific settings for the main library
+ include-dirs: include
+ js-sources:
+ js/config.js
+ js/structs.js
+ js/arith.js
+ js/compact.js
+ js/debug.js
+ js/enum.js
+ js/environment.js
+ js/eventlog.js
+ js/gc.js
+ js/goog.js
+ js/hscore.js
+ js/md5.js
+ js/mem.js
+ js/node-exports.js
+ js/object.js
+ js/profiling.js
+ js/rts.js
+ js/stableptr.js
+ js/staticpointer.js
+ js/stm.js
+ js/string.js
+ js/thread.js
+ js/unicode.js
+ js/verify.js
+ js/weak.js
+ js/globals.js
+ js/time.js
+
+ -- Add JS specific install-includes again
+ install-includes: HsFFI.h MachDeps.h Rts.h RtsAPI.h Stg.h
+ ghcconfig.h
+ ghcversion.h
+ stg/MachRegsForHost.h
+ stg/Types.h
+
+-- this is basiclly the "vanilla" version
+library nonthreaded-nodebug
+ if arch(javascript)
+ import: ghcjs
+ else
+ import: rts-base-config, rts-cmm-sources-base, rts-c-sources-base, rts-link-options, rts-global-build-flags
+
+ visibility: public
+ ghc-options: -optc-DRtsWay="v"
+
+library threaded-nodebug
+ import: rts-base-config, rts-cmm-sources-base, rts-c-sources-base, rts-link-options, rts-global-build-flags, rts-threaded-flags
+ visibility: public
+ build-depends: rts
+ if arch(javascript)
+ buildable: False
+
+ ghc-options: -optc-DRtsWay="rts_thr"
+
+library nonthreaded-debug
+ import: rts-base-config, rts-cmm-sources-base, rts-c-sources-base, rts-link-options, rts-global-build-flags, rts-debug-flags
+ visibility: public
+ build-depends: rts
+ if arch(javascript)
+ buildable: False
+
+ ghc-options: -optc-DRtsWay="rts_v_debug"
+
+library threaded-debug
+ import: rts-base-config, rts-cmm-sources-base, rts-c-sources-base, rts-link-options, rts-global-build-flags, rts-threaded-flags, rts-debug-flags
+ visibility: public
+ build-depends: rts
+ if arch(javascript)
+ buildable: False
+
+ ghc-options: -optc-DRtsWay="rts_thr_debug"
+
+-- Note [Undefined symbols in the RTS]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- The RTS is built with a number of `-u` flags. This is to handle cyclic
+-- dependencies between the RTS and other libraries which we normally think of as
+-- downstream from the RTS. "Regular" dependencies from usages in those libraries
+-- to definitions in the RTS are handled normally. "Reverse" dependencies from
+-- usages in the RTS to definitions in those libraries get the `-u` flag in the
+-- RTS.
+--
+-- The symbols are specified literally, but follow C ABI conventions (as all 3 of
+-- C, C--, and Haskell do currently). Thus, we have to be careful to include a
+-- leading underscore or not based on those conventions for the given platform in
+-- question.
+--
+-- A tricky part is that different linkers have different policies regarding
+-- undefined symbols (not defined in the current binary, or found in a shared
+-- library that could be loaded at run time). GNU Binutils' linker is fine with
+-- undefined symbols by default, but Apple's "cctools" linker is not. To appease
+-- that linker we either need to do a blanket `-undefined dynamic_lookup` or
+-- whitelist each such symbol with an additional `-U` (see the man page for more
+-- details).
+--
+-- GHC already does `-undefined dynamic_lookup`, so we just do that for now, but
+-- we might try to get more precise with `-U` in the future.
+--
+-- Note that the RTS also `-u`s some atomics symbols that *are* defined --- and
+-- defined within the RTS! It is not immediately clear why this is needed. This
+-- dates back to c06e3f46d24ef69f3a3d794f5f604cb8c2a40cbc which mentions a build
+-- failure that it was suggested that this fix, but the precise reasoning is not
+-- explained.
diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index 5a47e7f20f91..a341b508d36f 100644
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -1171,20 +1171,20 @@ static void heapOverflow(void)
static void
new_gc_thread (uint32_t n, gc_thread *t)
{
+ // Note: gc_thread is allocated with stgCallocAlignedBytes which zeros
+ // all fields, so we only need to initialize non-zero values here.
+
uint32_t g;
gen_workspace *ws;
t->cap = getCapability(n);
#if defined(THREADED_RTS)
- t->id = 0;
- SEQ_CST_STORE(&t->wakeup, GC_THREAD_INACTIVE); // starts true, so we can wait for the
- // thread to start up, see wakeup_gc_threads
+ // GC_THREAD_INACTIVE is 0, but we use atomic store for proper synchronization
+ SEQ_CST_STORE(&t->wakeup, GC_THREAD_INACTIVE);
#endif
t->thread_index = n;
- t->free_blocks = NULL;
- t->gc_count = 0;
init_gc_thread(t);
@@ -1212,18 +1212,7 @@ new_gc_thread (uint32_t n, gc_thread *t)
}
ws->todo_q = newWSDeque(128);
- ws->todo_overflow = NULL;
- ws->n_todo_overflow = 0;
- ws->todo_large_objects = NULL;
ws->todo_seg = END_NONMOVING_TODO_LIST;
-
- ws->part_list = NULL;
- ws->n_part_blocks = 0;
- ws->n_part_words = 0;
-
- ws->scavd_list = NULL;
- ws->n_scavd_blocks = 0;
- ws->n_scavd_words = 0;
}
}
@@ -1252,7 +1241,7 @@ initGcThreads (uint32_t from USED_IF_THREADS, uint32_t to USED_IF_THREADS)
for (i = from; i < to; i++) {
gc_threads[i] =
- stgMallocAlignedBytes(sizeof(gc_thread) +
+ stgCallocAlignedBytes(sizeof(gc_thread) +
RtsFlags.GcFlags.generations * sizeof(gen_workspace),
alignof(gc_thread),
"alloc_gc_threads");
diff --git a/rts/wasm/Wasm.S b/rts/wasm/Wasm.S
index 4e6c8b5fa432..fa9ee21fc68a 100644
--- a/rts/wasm/Wasm.S
+++ b/rts/wasm/Wasm.S
@@ -1,175 +1,49 @@
+/* Note [WASM Assembly Organization]
+ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ * WASM assembly is split into multiple files:
+ *
+ * - Wasm.S (this file): Common WASM definitions and utilities
+ * - Always linked into the RTS
+ * - Contains shared definitions like W_ type macro
+ * - Contains other WASM-specific code (if needed in future)
+ *
+ * - WasmGlobalRegs.S: STG GlobalRegs definitions
+ * - NOT part of the RTS (not in rts.cabal)
+ * - Compiled on-demand when linking executables
+ * - See Note [WASM GlobalRegs Linking] in WasmGlobalRegs.S
+ * - See mkWasmGlobalRegsObj in compiler/GHC/Linker/Executable.hs
+ *
+ * Why the split?
+ * - RTS must NOT contain GlobalRegs (conflicts with dyld.mjs for GHCi)
+ * - Executables need GlobalRegs injected at link time
+ * - GHCi/libraries get GlobalRegs from dyld.mjs at runtime
+ *
+ * Historical context:
+ * - Previously, GlobalRegs were in this file with #if !defined(__PIC__) guards
+ * - Commit 98a32ec551dd (Oct 2024, Cheng Shao): Added guards for PIC mode
+ * - PR 142 removed the guards (incorrectly)
+ * - This implementation uses on-demand compilation for correct behavior
+ *
+ * See also:
+ * - Issue #134: https://github.com/stable-haskell/ghc/issues/134
+ * - rts/wasm/WasmGlobalRegs.S: GlobalRegs definitions and detailed documentation
+ */
+
#include "ghcconfig.h"
#include "rts/Constants.h"
#include "DerivedConstants.h"
+/* Type definition for word-sized WASM types
+ * W_ is i32 on 32-bit platforms, i64 on 64-bit platforms
+ */
#if SIZEOF_VOID_P == 4
#define W_ i32
#else
#define W_ i64
#endif
-#if !defined(__PIC__)
-
- .hidden __R1
- .globl __R1
- .section .data.__R1,"",@
- .globaltype __R1, W_
-__R1:
-
- .hidden __R2
- .globl __R2
- .section .data.__R2,"",@
- .globaltype __R2, W_
-__R2:
-
- .hidden __R3
- .globl __R3
- .section .data.__R3,"",@
- .globaltype __R3, W_
-__R3:
-
- .hidden __R4
- .globl __R4
- .section .data.__R4,"",@
- .globaltype __R4, W_
-__R4:
-
- .hidden __R5
- .globl __R5
- .section .data.__R5,"",@
- .globaltype __R5, W_
-__R5:
-
- .hidden __R6
- .globl __R6
- .section .data.__R6,"",@
- .globaltype __R6, W_
-__R6:
-
- .hidden __R7
- .globl __R7
- .section .data.__R7,"",@
- .globaltype __R7, W_
-__R7:
-
- .hidden __R8
- .globl __R8
- .section .data.__R8,"",@
- .globaltype __R8, W_
-__R8:
-
- .hidden __R9
- .globl __R9
- .section .data.__R9,"",@
- .globaltype __R9, W_
-__R9:
-
- .hidden __R10
- .globl __R10
- .section .data.__R10,"",@
- .globaltype __R10, W_
-__R10:
-
- .hidden __F1
- .globl __F1
- .section .data.__F1,"",@
- .globaltype __F1, f32
-__F1:
-
- .hidden __F2
- .globl __F2
- .section .data.__F2,"",@
- .globaltype __F2, f32
-__F2:
-
- .hidden __F3
- .globl __F3
- .section .data.__F3,"",@
- .globaltype __F3, f32
-__F3:
-
- .hidden __F4
- .globl __F4
- .section .data.__F4,"",@
- .globaltype __F4, f32
-__F4:
-
- .hidden __F5
- .globl __F5
- .section .data.__F5,"",@
- .globaltype __F5, f32
-__F5:
-
- .hidden __F6
- .globl __F6
- .section .data.__F6,"",@
- .globaltype __F6, f32
-__F6:
-
- .hidden __D1
- .globl __D1
- .section .data.__D1,"",@
- .globaltype __D1, f64
-__D1:
-
- .hidden __D2
- .globl __D2
- .section .data.__D2,"",@
- .globaltype __D2, f64
-__D2:
-
- .hidden __D3
- .globl __D3
- .section .data.__D3,"",@
- .globaltype __D3, f64
-__D3:
-
- .hidden __D4
- .globl __D4
- .section .data.__D4,"",@
- .globaltype __D4, f64
-__D4:
-
- .hidden __D5
- .globl __D5
- .section .data.__D5,"",@
- .globaltype __D5, f64
-__D5:
-
- .hidden __D6
- .globl __D6
- .section .data.__D6,"",@
- .globaltype __D6, f64
-__D6:
-
- .hidden __L1
- .globl __L1
- .section .data.__L1,"",@
- .globaltype __L1, i64
-__L1:
-
- .hidden __Sp
- .globl __Sp
- .section .data.__Sp,"",@
- .globaltype __Sp, W_
-__Sp:
-
- .hidden __SpLim
- .globl __SpLim
- .section .data.__SpLim,"",@
- .globaltype __SpLim, W_
-__SpLim:
-
- .hidden __Hp
- .globl __Hp
- .section .data.__Hp,"",@
- .globaltype __Hp, W_
-__Hp:
-
- .hidden __HpLim
- .globl __HpLim
- .section .data.__HpLim,"",@
- .globaltype __HpLim, W_
-__HpLim:
-
-#endif
+/* Future WASM-specific assembly code would go here
+ * Currently, only the W_ definition is needed in this file.
+ * All GlobalRegs have been moved to WasmGlobalRegs.S.
+ */
diff --git a/rts/wasm/WasmGlobalRegs.S b/rts/wasm/WasmGlobalRegs.S
new file mode 100644
index 000000000000..7d7ab0261e37
--- /dev/null
+++ b/rts/wasm/WasmGlobalRegs.S
@@ -0,0 +1,222 @@
+/* Note [WASM GlobalRegs Linking]
+ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ * WASM has unique requirements for STG GlobalRegs:
+ *
+ * 1. Executables (both static and dynamic):
+ * - Need GlobalRegs injected at final link time
+ * - This file (WasmGlobalRegs.S) is compiled on-demand by GHC during linking
+ * - GlobalRegs become part of the executable .wasm binary
+ * - See mkWasmGlobalRegsObj in compiler/GHC/Linker/Executable.hs
+ *
+ * 2. Libraries and GHCi (runtime dynamic linking):
+ * - GlobalRegs are supplied by dyld.mjs at runtime
+ * - This file is NOT compiled or linked
+ * - dyld.mjs provides them per WASM dynamic linking convention
+ * - Including GlobalRegs in libraries causes "GOT.mem" errors
+ *
+ * This on-demand compilation approach is cleaner than including GlobalRegs
+ * in the RTS because:
+ * - GlobalRegs are never in the RTS libraries (avoids conflicts with dyld.mjs)
+ * - Only executables get GlobalRegs (exactly when needed)
+ * - Clear separation: libraries use dyld.mjs, executables use this file
+ * - No conditional compilation or build-time flags needed
+ *
+ * Build strategy:
+ * - RTS is built WITHOUT this file (see rts/rts.cabal)
+ * - When linking an executable, GHC:
+ * 1. Reads this source file
+ * 2. Compiles it to WasmGlobalRegs.o in a temp directory
+ * 3. Adds WasmGlobalRegs.o to the linker command
+ * - Libraries and GHCi never see this file
+ *
+ * Historical context:
+ * - Originally, Wasm.S had #if !defined(__PIC__) guards around GlobalRegs
+ * - Commit 98a32ec551dd (Oct 2024, Cheng Shao): Added guards for PIC mode
+ * - PR 142 removed guards (incorrectly)
+ * - This implementation uses on-demand compilation for better control
+ *
+ * See also:
+ * - Issue #134: https://github.com/stable-haskell/ghc/issues/134
+ * - compiler/GHC/Linker/Executable.hs: mkWasmGlobalRegsObj function
+ * - compiler/GHC/Driver/Session.hs:3730-3742: WASM WayDyn handling
+ * - compiler/GHC/Runtime/Interpreter/Types.hs:161: ExtWasm dynamic requirement
+ * - compiler/GHC/Linker/Dynamic.hs:263: --experimental-pic flag
+ * - rts/wasm/Wasm.S: Common WASM definitions
+ */
+
+/* STG Global Registers
+ * --------------------
+ * These WASM globals represent the STG machine registers.
+ * Only linked into static executables, not dynamic RTS.
+ *
+ * Word-sized registers (Rn, Sp, SpLim, Hp, HpLim) use WASM type i32
+ * because this file targets wasm32 where the platform word is 32 bits.
+ * A hypothetical wasm64 target would use i64 instead.
+ *
+ * Note: we avoid CPP macros here (no #include, no #define W_) so that
+ * this file can be assembled directly as a .s file without preprocessing.
+ * See mkWasmGlobalRegsObj in compiler/GHC/Linker/Executable.hs.
+ */
+
+ .hidden __R1
+ .globl __R1
+ .section .data.__R1,"",@
+ .globaltype __R1, i32
+__R1:
+
+ .hidden __R2
+ .globl __R2
+ .section .data.__R2,"",@
+ .globaltype __R2, i32
+__R2:
+
+ .hidden __R3
+ .globl __R3
+ .section .data.__R3,"",@
+ .globaltype __R3, i32
+__R3:
+
+ .hidden __R4
+ .globl __R4
+ .section .data.__R4,"",@
+ .globaltype __R4, i32
+__R4:
+
+ .hidden __R5
+ .globl __R5
+ .section .data.__R5,"",@
+ .globaltype __R5, i32
+__R5:
+
+ .hidden __R6
+ .globl __R6
+ .section .data.__R6,"",@
+ .globaltype __R6, i32
+__R6:
+
+ .hidden __R7
+ .globl __R7
+ .section .data.__R7,"",@
+ .globaltype __R7, i32
+__R7:
+
+ .hidden __R8
+ .globl __R8
+ .section .data.__R8,"",@
+ .globaltype __R8, i32
+__R8:
+
+ .hidden __R9
+ .globl __R9
+ .section .data.__R9,"",@
+ .globaltype __R9, i32
+__R9:
+
+ .hidden __R10
+ .globl __R10
+ .section .data.__R10,"",@
+ .globaltype __R10, i32
+__R10:
+
+ .hidden __F1
+ .globl __F1
+ .section .data.__F1,"",@
+ .globaltype __F1, f32
+__F1:
+
+ .hidden __F2
+ .globl __F2
+ .section .data.__F2,"",@
+ .globaltype __F2, f32
+__F2:
+
+ .hidden __F3
+ .globl __F3
+ .section .data.__F3,"",@
+ .globaltype __F3, f32
+__F3:
+
+ .hidden __F4
+ .globl __F4
+ .section .data.__F4,"",@
+ .globaltype __F4, f32
+__F4:
+
+ .hidden __F5
+ .globl __F5
+ .section .data.__F5,"",@
+ .globaltype __F5, f32
+__F5:
+
+ .hidden __F6
+ .globl __F6
+ .section .data.__F6,"",@
+ .globaltype __F6, f32
+__F6:
+
+ .hidden __D1
+ .globl __D1
+ .section .data.__D1,"",@
+ .globaltype __D1, f64
+__D1:
+
+ .hidden __D2
+ .globl __D2
+ .section .data.__D2,"",@
+ .globaltype __D2, f64
+__D2:
+
+ .hidden __D3
+ .globl __D3
+ .section .data.__D3,"",@
+ .globaltype __D3, f64
+__D3:
+
+ .hidden __D4
+ .globl __D4
+ .section .data.__D4,"",@
+ .globaltype __D4, f64
+__D4:
+
+ .hidden __D5
+ .globl __D5
+ .section .data.__D5,"",@
+ .globaltype __D5, f64
+__D5:
+
+ .hidden __D6
+ .globl __D6
+ .section .data.__D6,"",@
+ .globaltype __D6, f64
+__D6:
+
+ .hidden __L1
+ .globl __L1
+ .section .data.__L1,"",@
+ .globaltype __L1, i64
+__L1:
+
+ .hidden __Sp
+ .globl __Sp
+ .section .data.__Sp,"",@
+ .globaltype __Sp, i32
+__Sp:
+
+ .hidden __SpLim
+ .globl __SpLim
+ .section .data.__SpLim,"",@
+ .globaltype __SpLim, i32
+__SpLim:
+
+ .hidden __Hp
+ .globl __Hp
+ .section .data.__Hp,"",@
+ .globaltype __Hp, i32
+__Hp:
+
+ .hidden __HpLim
+ .globl __HpLim
+ .section .data.__HpLim,"",@
+ .globaltype __HpLim, i32
+__HpLim:
diff --git a/testsuite/.gitignore b/testsuite/.gitignore
index 2c699cf04625..65095f055660 100644
--- a/testsuite/.gitignore
+++ b/testsuite/.gitignore
@@ -60,6 +60,10 @@ tmp.d
*.so
*bindisttest_install___dir_bin_ghc.mk
*bindisttest_install___dir_bin_ghc.exe.mk
+mk/*_ghcconfig*_bin_ghc*.mk
+mk/*_ghcconfig*_bin_ghc*.exe.mk
+mk/*_ghcconfig*_test___spaces_ghc*.mk
+mk/*_ghcconfig*_test___spaces_ghc*.exe.mk
mk/ghcconfig*_bin_ghc*.mk
mk/ghcconfig*_bin_ghc*.exe.mk
mk/ghcconfig*_test___spaces_ghc*.mk
diff --git a/testsuite/driver/_elffile.py b/testsuite/driver/_elffile.py
new file mode 100644
index 000000000000..f18a8f46bb73
--- /dev/null
+++ b/testsuite/driver/_elffile.py
@@ -0,0 +1,131 @@
+"""
+Copy pasted from https://github.com/pypa/packaging/blob/a85e63daecba56bbb829492624a844d306053504/src/packaging/_elffile.py
+
+License below:
+
+================
+
+Copyright (c) Donald Stufft and individual contributors.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ 1. Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+
+ 2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+"""
+
+from __future__ import annotations
+
+import enum
+import os
+import struct
+from typing import IO
+
+
+class ELFInvalid(ValueError):
+ pass
+
+
+class EIClass(enum.IntEnum):
+ C32 = 1
+ C64 = 2
+
+
+class EIData(enum.IntEnum):
+ Lsb = 1
+ Msb = 2
+
+
+class EMachine(enum.IntEnum):
+ I386 = 3
+ S390 = 22
+ Arm = 40
+ X8664 = 62
+ AArc64 = 183
+
+
+class ELFFile:
+ """
+ Representation of an ELF executable.
+ """
+
+ def __init__(self, f: IO[bytes]) -> None:
+ self._f = f
+
+ try:
+ ident = self._read("16B")
+ except struct.error as e:
+ raise ELFInvalid("unable to parse identification") from e
+ magic = bytes(ident[:4])
+ if magic != b"\x7fELF":
+ raise ELFInvalid(f"invalid magic: {magic!r}")
+
+ self.capacity = ident[4] # Format for program header (bitness).
+ self.encoding = ident[5] # Data structure encoding (endianness).
+
+ try:
+ # e_fmt: Format for program header.
+ # p_fmt: Format for section header.
+ # p_idx: Indexes to find p_type, p_offset, and p_filesz.
+ e_fmt, self._p_fmt, self._p_idx = {
+ (1, 1): ("HHIIIIIHHH", ">IIIIIIII", (0, 1, 4)), # 32-bit MSB.
+ (2, 1): ("HHIQQQIHHH", ">IIQQQQQQ", (0, 2, 5)), # 64-bit MSB.
+ }[(self.capacity, self.encoding)]
+ except KeyError as e:
+ raise ELFInvalid(
+ f"unrecognized capacity ({self.capacity}) or encoding ({self.encoding})"
+ ) from e
+
+ try:
+ (
+ _,
+ self.machine, # Architecture type.
+ _,
+ _,
+ self._e_phoff, # Offset of program header.
+ _,
+ self.flags, # Processor-specific flags.
+ _,
+ self._e_phentsize, # Size of section.
+ self._e_phnum, # Number of sections.
+ ) = self._read(e_fmt)
+ except struct.error as e:
+ raise ELFInvalid("unable to parse machine and section information") from e
+
+ def _read(self, fmt: str) -> tuple[int, ...]:
+ return struct.unpack(fmt, self._f.read(struct.calcsize(fmt)))
+
+ @property
+ def interpreter(self) -> str | None:
+ """
+ The path recorded in the ``PT_INTERP`` section header.
+ """
+ for index in range(self._e_phnum):
+ self._f.seek(self._e_phoff + self._e_phentsize * index)
+ try:
+ data = self._read(self._p_fmt)
+ except struct.error:
+ continue
+ if data[self._p_idx[0]] != 3: # Not PT_INTERP.
+ continue
+ self._f.seek(data[self._p_idx[1]])
+ return os.fsdecode(self._f.read(data[self._p_idx[2]])).strip("\0")
+ return None
diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py
index b3fcffa2f89c..489dcd1ca790 100644
--- a/testsuite/driver/runtests.py
+++ b/testsuite/driver/runtests.py
@@ -87,6 +87,7 @@ def get_compiler_info() -> TestConfig:
parser.add_argument("--broken-test", action="append", default=[], help="a test name to mark as broken for this run")
parser.add_argument("--test-env", default='local', help="Override default chosen test-env.")
parser.add_argument("--perf-baseline", type=GitRef, metavar='COMMIT', help="Baseline commit for performance comparsons.")
+parser.add_argument("--skip-uniques-test", action="append", help="skip uniques tests")
perf_group.add_argument("--skip-perf-tests", action="store_true", help="skip performance tests")
perf_group.add_argument("--only-perf-tests", action="store_true", help="Only do performance tests")
parser.add_argument("--ignore-perf-failures", choices=['increases','decreases','all'],
@@ -179,6 +180,10 @@ def get_compiler_info() -> TestConfig:
elif args.ignore_perf_failures == 'decreases':
config.ignore_perf_decreases = True
+# force skip uniques if not in a git checkout
+forceSkipUniquesTest = not inside_git_repo()
+config.skip_uniques_test = args.skip_uniques_test or forceSkipUniquesTest
+
if args.test_env:
config.test_env = args.test_env
@@ -553,6 +558,10 @@ async def run_aloneTests():
print(str_warn('Skipping All Performance Tests') + ' `git` exited with non-zero exit code.')
print(spacing + 'Git is required because performance test results are compared with ancestor git commits\' results (stored with git notes).')
print(spacing + 'You can still run the tests without git by specifying an output file with --metrics-file FILE.')
+ if forceSkipUniquesTest and not args.skip_uniques_test:
+ print()
+ print(str_warn('Skipping Uniques Test') + ' `git` exited with non-zero exit code.')
+ print(spacing + 'Git is required because the uniques test checks the source code files.')
# Warn of new metrics.
new_metrics = [metric for (change, metric, baseline) in t.metrics if change == MetricChange.NewMetric]
diff --git a/testsuite/driver/testglobals.py b/testsuite/driver/testglobals.py
index ab4f13aa0bd2..b1087ecadbee 100644
--- a/testsuite/driver/testglobals.py
+++ b/testsuite/driver/testglobals.py
@@ -138,7 +138,7 @@ def __init__(self):
# Are we cross-compiling?
self.cross = False
-
+
# Does the RTS linker only support loading shared libraries?
self.interp_force_dyn = False
@@ -206,6 +206,9 @@ def __init__(self):
# Should we skip performance tests
self.skip_perf_tests = False
+ # Should we skip uniques tests
+ self.skip_uniques_test = False
+
# Only do performance tests
self.only_perf_tests = False
diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py
index 2b9b5478b29d..a802a4708201 100644
--- a/testsuite/driver/testlib.py
+++ b/testsuite/driver/testlib.py
@@ -38,6 +38,8 @@
from threading import Timer
from collections import OrderedDict
+from _elffile import ELFFile
+
import asyncio
import contextvars
@@ -362,6 +364,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
@@ -647,7 +663,19 @@ def collect_size ( deviation, path ):
return collect_size_func(deviation, lambda: path)
def collect_size_func ( deviation, path_func ):
- return collect_generic_stat ( 'size', deviation, lambda way: os.path.getsize(in_testdir(path_func())) )
+ # Wrap path resolution to avoid passing None/invalid paths to Path APIs.
+ def current(_way):
+ p = path_func()
+ if p is None:
+ raise StatsException("No path returned for size collection")
+ # If p looks absolute, use it directly; else resolve relative to testdir
+ pth = Path(p)
+ if not pth.is_absolute():
+ pth = in_testdir(p)
+ if not pth.exists():
+ raise StatsException(f"Path not found for size collection: {pth}")
+ return os.path.getsize(pth)
+ return collect_generic_stat ( 'size', deviation, current )
def get_dir_size(path):
total = 0
@@ -660,7 +688,7 @@ def get_dir_size(path):
total += get_dir_size(entry.path)
return total
except FileNotFoundError:
- print("Exception: Could not find: " + path)
+ raise StatsException(f"Directory not found for size collection: {path}")
def collect_size_dir ( deviation, path ):
return collect_size_dir_func ( deviation, lambda: path )
@@ -692,7 +720,12 @@ def collect_size_ghc_pkg (deviation, library):
# same for collect_size and find_so
def collect_object_size (deviation, library, use_non_inplace=False):
if use_non_inplace:
- return collect_size_func(deviation, lambda: find_non_inplace_so(library))
+ try:
+ return collect_size_func(deviation, lambda: find_non_inplace_so(library))
+ except Exception as _:
+ # should we fail to find inplace, let's try to find non-inplace.
+ # FIXME: remove the whole inplace nonsense outright.
+ return collect_size_func(deviation, lambda: find_so(library))
else:
return collect_size_func(deviation, lambda: find_so(library))
@@ -709,21 +742,20 @@ def path_from_ghcPkg (library, field):
try:
result = subprocess.run(ghcPkgCmd, capture_output=True, shell=True)
-
# check_returncode throws an exception if the return code is not 0.
result.check_returncode()
-
- # if we get here then the call worked and we have the path we split by
- # whitespace and then return the path which becomes the second element
- # in the array
- return re.split(r'\s+', result.stdout.decode("utf-8"))[1]
+ out = result.stdout.decode("utf-8").strip()
+ # Expected format: ": " possibly spanning lines; grab text after first colon.
+ m = re.split(r"^\s*[^:]+:\s*", out, maxsplit=1, flags=re.MULTILINE)
+ if len(m) == 2:
+ val = m[1].strip().splitlines()[0].strip()
+ if val:
+ return val
+ raise StatsException(f"ghc-pkg returned no {field} for {library}. Output: {out}")
+ except subprocess.CalledProcessError as e:
+ raise StatsException(f"ghc-pkg failed for {library} {field}: {e}")
except Exception as e:
- message = f"""
- Attempt to find {field} of {library} using ghc-pkg failed.
- ghc-pkg path: {config.ghc_pkg}
- error" {e}
- """
- print(message)
+ raise StatsException(f"Error parsing ghc-pkg output for {library} {field}: {e}")
def _find_so(lib, directory, in_place):
@@ -758,8 +790,9 @@ def _find_so(lib, directory, in_place):
to_match = r'libHS{}-\d+(\.\d+)+-ghc\S+\.' + suffix
matches = []
- # wrap this in some exception handling, hadrian test will error out because
- # these files don't exist yet, so we pass when this occurs
+ # Robust error handling: raise a stats exception for missing directory or no match
+ if directory is None:
+ raise StatsException(f"No directory provided to find shared object for {lib}")
try:
for f in os.listdir(directory):
if f.endswith(suffix):
@@ -767,12 +800,22 @@ def _find_so(lib, directory, in_place):
match = re.match(pattern, f)
if match:
matches.append(match.group())
+ if not matches:
+ raise StatsException(f"Could not find shared object file for {lib} in {directory}")
return os.path.join(directory, matches[0])
- except:
- failBecause('Could not find shared object file: ' + lib)
+ except FileNotFoundError:
+ raise StatsException(f"Directory not found while searching shared object for {lib}: {directory}")
+ except Exception as e:
+ raise StatsException(f"Error while searching shared object for {lib} in {directory}: {e}")
def find_so(lib):
- return _find_so(lib,path_from_ghcPkg(lib, "dynamic-library-dirs"),True)
+ try:
+ return _find_so(lib,path_from_ghcPkg(lib, "dynamic-library-dirs"),True)
+ except Exception as _:
+ # if we fail to find the inplace so, fallback to trying to find the
+ # non-inplace so indead;
+ # FIXME: This whole inplace logic needs to be ripped out!
+ return _find_so(lib,path_from_ghcPkg(lib, "dynamic-library-dirs"),False)
def find_non_inplace_so(lib):
return _find_so(lib,path_from_ghcPkg(lib, "dynamic-library-dirs"),False)
@@ -1041,6 +1084,17 @@ def have_dynamic( ) -> bool:
''' Were libraries built in the dynamic way? '''
return config.have_dynamic
+def is_musl( ) -> bool:
+ ''' Whether we're on a musl system '''
+ try:
+ with open(sys.executable, "rb") as f:
+ ld = ELFFile(f).interpreter
+ except (OSError, TypeError, ValueError):
+ return False
+ if ld is None or "musl" not in ld:
+ return False
+ return True
+
def have_dynamic_prof( ) -> bool:
''' Were libraries built in the profiled dynamic way? '''
return config.have_profiling_dynamic
@@ -1376,9 +1430,13 @@ def normalizer(s: str) -> str:
def normalise_version_( *pkgs ):
def normalise_version__( str ):
+ # First strip the ghc-version_ prefix if present at the start of package names
+ # Use word boundary to ensure we only match actual package name prefixes
+ str_no_ghc_prefix = re.sub(r'\bghc-[0-9.]+_([a-zA-Z])', r'\1', str)
# (name)(-version)(-hash)(-components)
- return re.sub('(' + '|'.join(map(re.escape,pkgs)) + r')-[0-9.]+(-[0-9a-zA-Z+]+)?(-[0-9a-zA-Z]+)?',
- r'\1--', str)
+ ver_hash = re.sub('(' + '|'.join(map(re.escape,pkgs)) + r')-[0-9.]+(-[0-9a-zA-Z+]+)?(-[0-9a-zA-Z+]+)?',
+ r'\1--', str_no_ghc_prefix)
+ return re.sub(r'\bghc_([a-zA-Z-]+--)', r'\1', ver_hash)
return normalise_version__
def normalise_version( *pkgs ):
@@ -1586,6 +1644,7 @@ async def test_common_work(name: TestName, opts,
and (only_ways is None
or (only_ways is not None and way in only_ways)) \
and (config.cmdline_ways == [] or way in config.cmdline_ways) \
+ and (not (config.skip_uniques_test and name == "uniques")) \
and (not (config.skip_perf_tests and isStatsTest())) \
and (not (config.only_perf_tests and not isStatsTest())) \
and way not in getTestOpts().omit_ways
@@ -2896,6 +2955,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)
@@ -2986,6 +3050,9 @@ def normalise_errmsg(s: str) -> str:
s = re.sub('Failed to remove file (.*); error= (.*)$', '', s)
s = re.sub(r'DeleteFile "(.+)": permission denied \(Access is denied\.\)(.*)$', '', s)
+ # newer mac x86_64 ld emits these warnings when linking against libffi-clib
+ s = re.sub('.* warning: alignment .* of atom .* is too small and may result in unaligned pointers.*\n', '', s)
+
# filter out unsupported GNU_PROPERTY_TYPE (5), which is emitted by LLVM10
# and not understood by older binutils (ar, ranlib, ...)
s = modify_lines(s, lambda l: re.sub(r'^(.+)warning: (.+): unsupported GNU_PROPERTY_TYPE (?:\(5\) )?type: 0xc000000(.*)$', '', l))
@@ -2994,6 +3061,8 @@ def normalise_errmsg(s: str) -> str:
s = re.sub('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version','',s)
# ignore superfluous dylibs passed to the linker.
s = re.sub('ld: warning: .*, ignoring unexpected dylib file\n','',s)
+ # ignore macOS ld warning about reexported libraries (e.g. Homebrew llvm libunwind)
+ s = re.sub('ld: warning: reexported library with install name .* couldn.t be matched with any parent library and will be linked directly\n','',s)
# ignore LLVM Version mismatch garbage; this will just break tests.
s = re.sub('You are using an unsupported version of LLVM!.*\n','',s)
s = re.sub('Currently only [\\.0-9]+ is supported. System LLVM version: [\\.0-9]+.*\n','',s)
@@ -3108,6 +3177,8 @@ def normalise_output( s: str ) -> str:
s = re.sub('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version','',s)
# ignore superfluous dylibs passed to the linker.
s = re.sub('ld: warning: .*, ignoring unexpected dylib file\n','',s)
+ # ignore macOS ld warning about reexported libraries (e.g. Homebrew llvm libunwind)
+ s = re.sub('ld: warning: reexported library with install name .* couldn.t be matched with any parent library and will be linked directly\n','',s)
# ignore LLVM Version mismatch garbage; this will just break tests.
s = re.sub('You are using an unsupported version of LLVM!.*\n','',s)
s = re.sub('Currently only [\\.0-9]+ is supported. System LLVM version: [\\.0-9]+.*\n','',s)
@@ -3229,7 +3300,7 @@ async def runCmd(cmd: str,
# to invoke the Bourne shell
proc = await asyncio.create_subprocess_exec(timeout_prog, timeout, cmd,
- stdin=stdin_file,
+ stdin=stdin_file if stdin_file else asyncio.subprocess.PIPE,
stdout=asyncio.subprocess.PIPE,
stderr=hStdErr,
env=ghc_env
diff --git a/testsuite/ghc-config/ghc-config.hs b/testsuite/ghc-config/ghc-config.hs
index 6349c041f80c..f67a9091ff8e 100644
--- a/testsuite/ghc-config/ghc-config.hs
+++ b/testsuite/ghc-config/ghc-config.hs
@@ -10,6 +10,10 @@ main = do
info <- readProcess ghc ["+RTS", "--info"] ""
let fields = read info :: [(String,String)]
getGhcFieldOrFail fields "HostOS" "Host OS"
+ getGhcFieldOrFail fields "WORDSIZE" "Word size"
+ getGhcFieldOrFail fields "TARGETPLATFORM" "Host platform"
+ getGhcFieldOrFail fields "TargetOS_CPP" "Host OS"
+ getGhcFieldOrFail fields "TargetARCH_CPP" "Host architecture"
getGhcFieldOrFail fields "RTSWay" "RTS way"
-- support for old GHCs (pre 9.13): infer target platform by querying the rts...
@@ -46,6 +50,7 @@ main = do
getGhcFieldOrDefault fields "GhcLeadingUnderscore" "Leading underscore" "NO"
getGhcFieldOrDefault fields "GhcTablesNextToCode" "Tables next to code" "NO"
getGhcFieldProgWithDefault fields "AR" "ar command" "ar"
+ getGhcFieldProgWithDefault fields "RANLIB" "ranlib command" "ranlib"
getGhcFieldProgWithDefault fields "LLC" "LLVM llc command" "llc"
getGhcFieldProgWithDefault fields "TEST_CC" "C compiler command" "gcc"
getGhcFieldProgWithDefault fields "TEST_CC_OPTS" "C compiler flags" ""
diff --git a/testsuite/mk/boilerplate.mk b/testsuite/mk/boilerplate.mk
index 9ad8b3308e31..d98d21f83254 100644
--- a/testsuite/mk/boilerplate.mk
+++ b/testsuite/mk/boilerplate.mk
@@ -255,12 +255,25 @@ endif
# This way we cache the results for different values of $(TEST_HC)
$(TOP)/ghc-config/ghc-config : $(TOP)/ghc-config/ghc-config.hs
- "$(TEST_HC)" --make -o $@ $<
+ "$(TEST_HC)" $(EXTRA_HC_OPTS) --make -o $@ $<
empty=
space=$(empty) $(empty)
ifeq "$(ghc_config_mk)" ""
-ghc_config_mk = $(TOP)/mk/ghcconfig$(subst $(space),_,$(subst :,_,$(subst /,_,$(subst \,_,$(TEST_HC))))).mk
+sanitized_hc := $(subst $(space),_,$(subst :,_,$(subst /,_,$(subst \,_,$(TEST_HC)))))
+# Hash the TEST_HC binary to ensure we recompute ghcconfig when the compiler changes.
+# This prevents stale config values when switching between different GHC versions.
+test_hc_hash := $(shell \
+ if command -v openssl >/dev/null 2>&1; then \
+ openssl dgst -sha256 $(TEST_HC) | awk '{print substr($$2, 1, 8)}'; \
+ elif command -v sha256sum >/dev/null 2>&1; then \
+ sha256sum $(TEST_HC) | awk '{print substr($$1, 1, 8)}'; \
+ elif command -v shasum >/dev/null 2>&1; then \
+ shasum -a 256 $(TEST_HC) | awk '{print substr($$1, 1, 8)}'; \
+ else \
+ echo "no_hash"; \
+ fi)
+ghc_config_mk = $(TOP)/mk/$(test_hc_hash)_ghcconfig$(sanitized_hc).mk
$(ghc_config_mk) : $(TOP)/ghc-config/ghc-config
$(TOP)/ghc-config/ghc-config "$(TEST_HC)" >"$@"; if [ "$$?" != "0" ]; then $(RM) "$@"; exit 1; fi
diff --git a/testsuite/mk/test.mk b/testsuite/mk/test.mk
index 5f82342b5ab0..b7ffb7f6558e 100644
--- a/testsuite/mk/test.mk
+++ b/testsuite/mk/test.mk
@@ -221,6 +221,10 @@ ifeq "$(SKIP_PERF_TESTS)" "YES"
RUNTEST_OPTS += --skip-perf-tests
endif
+ifeq "$(SKIP_UNIQUES_TEST)" "YES"
+RUNTEST_OPTS += --skip-uniques-test
+endif
+
ifeq "$(ONLY_PERF_TESTS)" "YES"
RUNTEST_OPTS += --only-perf-tests
endif
diff --git a/testsuite/tests/backpack/cabal/bkpcabal08/bkpcabal08.stdout b/testsuite/tests/backpack/cabal/bkpcabal08/bkpcabal08.stdout
index b84fede1be9f..9253d5ea643d 100644
--- a/testsuite/tests/backpack/cabal/bkpcabal08/bkpcabal08.stdout
+++ b/testsuite/tests/backpack/cabal/bkpcabal08/bkpcabal08.stdout
@@ -4,8 +4,6 @@ Building library 'p' instantiated with
B =
for bkpcabal08-0.1.0.0...
[2 of 2] Compiling B[sig] ( p/B.hsig, nothing )
-Preprocessing library 'impl' for bkpcabal08-0.1.0.0...
-Building library 'impl' for bkpcabal08-0.1.0.0...
Preprocessing library 'q' for bkpcabal08-0.1.0.0...
Building library 'q' instantiated with
A =
@@ -14,6 +12,8 @@ for bkpcabal08-0.1.0.0...
[2 of 4] Compiling B[sig] ( q/B.hsig, nothing )
[3 of 4] Compiling M ( q/M.hs, nothing ) [A changed]
[4 of 4] Instantiating bkpcabal08-0.1.0.0-LjROTJ30vjpHLvYNUnY1dD-p
+Preprocessing library 'impl' for bkpcabal08-0.1.0.0...
+Building library 'impl' for bkpcabal08-0.1.0.0...
Preprocessing library 'q' for bkpcabal08-0.1.0.0...
Building library 'q' instantiated with
A = bkpcabal08-0.1.0.0-KxkxGUgMJM6Dqo87AQu6V5-impl:A
diff --git a/testsuite/tests/bytecode/T25090/Makefile b/testsuite/tests/bytecode/T25090/Makefile
index 8729cfc5e105..95f027f1e758 100644
--- a/testsuite/tests/bytecode/T25090/Makefile
+++ b/testsuite/tests/bytecode/T25090/Makefile
@@ -4,18 +4,18 @@ include $(TOP)/mk/test.mk
# Verify that the object files aren't linked by clobbering them.
T25090a:
- '$(TEST_HC)' -c -fbyte-code-and-object-code C.hs-boot
- '$(TEST_HC)' -c -fbyte-code-and-object-code B.hs
- '$(TEST_HC)' -c -fbyte-code-and-object-code C.hs
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -c -fbyte-code-and-object-code C.hs-boot
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -c -fbyte-code-and-object-code B.hs
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -c -fbyte-code-and-object-code C.hs
echo 'corrupt' > B.o
echo 'corrupt' > C.o
echo 'corrupt' > C.o-boot
- '$(TEST_HC)' -c -fbyte-code-and-object-code D.hs
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -c -fbyte-code-and-object-code D.hs
echo 'corrupt' > D.o
- '$(TEST_HC)' -c -fbyte-code-and-object-code -fprefer-byte-code A.hs
- '$(TEST_HC)' -fbyte-code-and-object-code -fprefer-byte-code A.o -o exe
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -c -fbyte-code-and-object-code -fprefer-byte-code A.hs
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -fbyte-code-and-object-code -fprefer-byte-code A.o -o exe
./exe
T25090b:
- '$(TEST_HC)' -fbyte-code-and-object-code -fprefer-byte-code A -o exe -v0
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -fbyte-code-and-object-code -fprefer-byte-code A -o exe -v0
./exe
diff --git a/testsuite/tests/bytecode/T25510/Makefile b/testsuite/tests/bytecode/T25510/Makefile
index 4501d59613e5..05b36894b35e 100644
--- a/testsuite/tests/bytecode/T25510/Makefile
+++ b/testsuite/tests/bytecode/T25510/Makefile
@@ -3,5 +3,5 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
T25510c:
- '$(TEST_HC)' $(ghcThWayFlags) -fhpc -fbyte-code-and-object-code -c T25510A.hs
- '$(TEST_HC)' $(ghcThWayFlags) -fhpc -fprefer-byte-code -c T25510B.hs
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) $(ghcThWayFlags) -fhpc -fbyte-code-and-object-code -c T25510A.hs
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) $(ghcThWayFlags) -fhpc -fprefer-byte-code -c T25510B.hs
diff --git a/testsuite/tests/cabal/cabal03/all.T b/testsuite/tests/cabal/cabal03/all.T
index 86c80c57df6d..fbab00cd4e89 100644
--- a/testsuite/tests/cabal/cabal03/all.T
+++ b/testsuite/tests/cabal/cabal03/all.T
@@ -1,5 +1,15 @@
+import re
+
+def drop_callstack(s):
+ # Remove dieProgress call stack blocks (Cabal commit eab5a10d0b...).
+ # Also remove the preceding blank line (if any) to avoid leaving an extra blank.
+ s = re.sub(r'(?ms)\n?\s*CallStack \(from HasCallStack\):\n(?:\s+.*\n)*', '\n', s)
+ # Collapse any runs of >1 blank line to a single newline.
+ return re.sub(r'\n{3,}', '\n\n', s)
+
test('cabal03',
[extra_files(['Setup.lhs', 'p/', 'q/', 'r/']),
- js_broken(22349)],
+ js_broken(22349),
+ normalise_errmsg_fun(drop_callstack)],
makefile_test,
[])
diff --git a/testsuite/tests/cabal/sigcabal01/Makefile b/testsuite/tests/cabal/sigcabal01/Makefile
index b0ce21696338..bf906509607c 100644
--- a/testsuite/tests/cabal/sigcabal01/Makefile
+++ b/testsuite/tests/cabal/sigcabal01/Makefile
@@ -10,7 +10,7 @@ sigcabal01:
$(MAKE) -s --no-print-directory clean
'$(GHC_PKG)' field containers id | sed 's/^.*: *//' > containers
'$(GHC_PKG)' init tmp.d
- '$(TEST_HC)' -v0 --make Setup
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -v0 --make Setup
cd p && $(SETUP) clean
cd p && ! $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --with-hc-pkg='$(GHC_PKG)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --prefix='$(PWD)/inst-p' --ghc-pkg-options="--enable-multi-instance"
cd p && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --with-hc-pkg='$(GHC_PKG)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --prefix='$(PWD)/inst-p' --instantiate-with="Map=Data.Map.Lazy@`cat ../containers`" --ghc-pkg-options="--enable-multi-instance"
diff --git a/testsuite/tests/codeGen/should_gen_asm/aarch64-shl-subword.asm b/testsuite/tests/codeGen/should_gen_asm/aarch64-shl-subword.asm
new file mode 100644
index 000000000000..f23745bf8dd7
--- /dev/null
+++ b/testsuite/tests/codeGen/should_gen_asm/aarch64-shl-subword.asm
@@ -0,0 +1 @@
+ubfm
diff --git a/testsuite/tests/codeGen/should_gen_asm/aarch64-shl-subword.hs b/testsuite/tests/codeGen/should_gen_asm/aarch64-shl-subword.hs
new file mode 100644
index 000000000000..078f2e46d7f5
--- /dev/null
+++ b/testsuite/tests/codeGen/should_gen_asm/aarch64-shl-subword.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE MagicHash #-}
+module ShlSubWord (shlW8) where
+
+import GHC.Exts
+import GHC.Word
+
+shlW8 :: Word8 -> Word8
+shlW8 (W8# w) = W8# (uncheckedShiftLWord8# w 4#)
diff --git a/testsuite/tests/codeGen/should_gen_asm/aarch64-sxtw-mul2.asm b/testsuite/tests/codeGen/should_gen_asm/aarch64-sxtw-mul2.asm
new file mode 100644
index 000000000000..d94c29a8ca30
--- /dev/null
+++ b/testsuite/tests/codeGen/should_gen_asm/aarch64-sxtw-mul2.asm
@@ -0,0 +1 @@
+sxtw
diff --git a/testsuite/tests/codeGen/should_gen_asm/aarch64-sxtw-mul2.cmm b/testsuite/tests/codeGen/should_gen_asm/aarch64-sxtw-mul2.cmm
new file mode 100644
index 000000000000..2e93c10ec2a8
--- /dev/null
+++ b/testsuite/tests/codeGen/should_gen_asm/aarch64-sxtw-mul2.cmm
@@ -0,0 +1,12 @@
+#include "Cmm.h"
+
+// Exercises MO_S_Mul2 W32, which calls signExtendReg W32 W64.
+// The generated assembly must contain an sxtw instruction.
+testMul2W32 (W_ buffer) {
+ I32 a, b, needed, hi, lo;
+ a = I32[buffer];
+ b = I32[buffer + 4];
+ (needed, hi, lo) = prim %mul2_32(a, b);
+ I32[buffer + 8] = lo;
+ return();
+}
diff --git a/testsuite/tests/codeGen/should_gen_asm/aarch64-sxtw.asm b/testsuite/tests/codeGen/should_gen_asm/aarch64-sxtw.asm
new file mode 100644
index 000000000000..d94c29a8ca30
--- /dev/null
+++ b/testsuite/tests/codeGen/should_gen_asm/aarch64-sxtw.asm
@@ -0,0 +1 @@
+sxtw
diff --git a/testsuite/tests/codeGen/should_gen_asm/aarch64-sxtw.hs b/testsuite/tests/codeGen/should_gen_asm/aarch64-sxtw.hs
new file mode 100644
index 000000000000..7b78fa5730af
--- /dev/null
+++ b/testsuite/tests/codeGen/should_gen_asm/aarch64-sxtw.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE MagicHash #-}
+module SignExtW32 (signExtW32) where
+
+import GHC.Exts
+import GHC.Int
+
+signExtW32 :: Int32 -> Int64
+signExtW32 (I32# x) = I64# (intToInt64# (int32ToInt# x))
diff --git a/testsuite/tests/codeGen/should_gen_asm/aarch64-ushr-subword.asm b/testsuite/tests/codeGen/should_gen_asm/aarch64-ushr-subword.asm
new file mode 100644
index 000000000000..a85c197f67ca
--- /dev/null
+++ b/testsuite/tests/codeGen/should_gen_asm/aarch64-ushr-subword.asm
@@ -0,0 +1 @@
+lsr
diff --git a/testsuite/tests/codeGen/should_gen_asm/aarch64-ushr-subword.hs b/testsuite/tests/codeGen/should_gen_asm/aarch64-ushr-subword.hs
new file mode 100644
index 000000000000..ff12a2819e7d
--- /dev/null
+++ b/testsuite/tests/codeGen/should_gen_asm/aarch64-ushr-subword.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE MagicHash #-}
+module UShrSubWord (ushrW8) where
+
+import GHC.Exts
+import GHC.Word
+
+ushrW8 :: Word8 -> Int -> Word8
+ushrW8 x n = x `shiftR` n
+ where shiftR (W8# w) (I# i) = W8# (wordToWord8# (word8ToWord# w `uncheckedShiftRL#` i))
diff --git a/testsuite/tests/codeGen/should_gen_asm/all.T b/testsuite/tests/codeGen/should_gen_asm/all.T
index f34affd5c86d..8c787be430d9 100644
--- a/testsuite/tests/codeGen/should_gen_asm/all.T
+++ b/testsuite/tests/codeGen/should_gen_asm/all.T
@@ -12,3 +12,13 @@ test('bytearray-memcpy-unroll', is_amd64_codegen, compile_grep_asm, ['hs', True,
test('T18137', [when(opsys('darwin'), skip), only_ways(llvm_ways)], compile_grep_asm, ['hs', False, '-fllvm -split-sections'])
test('T24941', [only_ways(['optasm'])], compile, ['-fregs-graph'])
+is_aarch64_codegen = [
+ unless(arch('aarch64'), skip),
+ when(unregisterised(), skip),
+]
+
+# AArch64-specific tests
+test('aarch64-sxtw', is_aarch64_codegen, compile_grep_asm, ['hs', True, '-O'])
+test('aarch64-sxtw-mul2', is_aarch64_codegen, compile_grep_asm, ['cmm', True, ''])
+test('aarch64-ushr-subword', is_aarch64_codegen, compile_grep_asm, ['hs', True, '-O'])
+test('aarch64-shl-subword', is_aarch64_codegen, compile_grep_asm, ['hs', True, '-O'])
diff --git a/testsuite/tests/codeGen/should_run/T24016.hs b/testsuite/tests/codeGen/should_run/T24016.hs
new file mode 100644
index 000000000000..d56dfb720c80
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/T24016.hs
@@ -0,0 +1,24 @@
+module Main (main) where
+
+data Command
+ = Command1
+ | Command2
+ | Command3
+ | Command4
+ | Command5
+ | Command6 -- Commenting this line works with -fPIC, uncommenting leads to a crash.
+
+main :: IO ()
+main = do
+ let x = case cmd of
+ Command1 -> 1 :: Int
+ Command2 -> 2
+ Command3 -> 3
+ Command4 -> 4
+ Command5 -> 5
+ Command6 -> 6
+ putStrLn (show x)
+
+{-# NOINLINE cmd #-}
+cmd :: Command
+cmd = Command6
diff --git a/testsuite/tests/codeGen/should_run/T24016.stdout b/testsuite/tests/codeGen/should_run/T24016.stdout
new file mode 100644
index 000000000000..1e8b31496214
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/T24016.stdout
@@ -0,0 +1 @@
+6
diff --git a/testsuite/tests/codeGen/should_run/T25374/all.T b/testsuite/tests/codeGen/should_run/T25374/all.T
index 1e4c3e9860b0..3676ebc33da6 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', [fragile(0), extra_hc_opts('+RTS -Di -RTS'), ignore_stderr, req_target_debug_rts], ghci_script, [''])
diff --git a/testsuite/tests/codeGen/should_run/T26537.hs b/testsuite/tests/codeGen/should_run/T26537.hs
new file mode 100644
index 000000000000..cfff07ebca83
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/T26537.hs
@@ -0,0 +1,72 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+import GHC.Exts
+
+type D8 = (# Double#, Double#, Double#, Double#, Double#, Double#, Double#, Double# #)
+type D64 = (# D8, D8, D8, D8, D8, D8, D8, D8 #)
+type D512 = (# D64, D64, D64, D64, D64, D64, D64, D64 #)
+
+unD# :: Double -> Double#
+unD# (D# x) = x
+
+mkD8 :: Double -> D8
+mkD8 x = (# unD# x, unD# (x + 1), unD# (x + 2), unD# (x + 3), unD# (x + 4), unD# (x + 5), unD# (x + 6), unD# (x + 7) #)
+{-# NOINLINE mkD8 #-}
+
+mkD64 :: Double -> D64
+mkD64 x = (# mkD8 x, mkD8 (x + 8), mkD8 (x + 16), mkD8 (x + 24), mkD8 (x + 32), mkD8 (x + 40), mkD8 (x + 48), mkD8 (x + 56) #)
+{-# NOINLINE mkD64 #-}
+
+mkD512 :: Double -> D512
+mkD512 x = (# mkD64 x, mkD64 (x + 64), mkD64 (x + 128), mkD64 (x + 192), mkD64 (x + 256), mkD64 (x + 320), mkD64 (x + 384), mkD64 (x + 448) #)
+{-# NOINLINE mkD512 #-}
+
+addD8 :: D8 -> D8 -> D8
+addD8 (# x0, x1, x2, x3, x4, x5, x6, x7 #) (# y0, y1, y2, y3, y4, y5, y6, y7 #) = (# x0 +## y0, x1 +## y1, x2 +## y2, x3 +## y3, x4 +## y4, x5 +## y5, x6 +## y6, x7 +## y7 #)
+{-# NOINLINE addD8 #-}
+
+addD64 :: D64 -> D64 -> D64
+addD64 (# x0, x1, x2, x3, x4, x5, x6, x7 #) (# y0, y1, y2, y3, y4, y5, y6, y7 #) = (# addD8 x0 y0, addD8 x1 y1, addD8 x2 y2, addD8 x3 y3, addD8 x4 y4, addD8 x5 y5, addD8 x6 y6, addD8 x7 y7 #)
+{-# NOINLINE addD64 #-}
+
+addD512 :: D512 -> D512 -> D512
+addD512 (# x0, x1, x2, x3, x4, x5, x6, x7 #) (# y0, y1, y2, y3, y4, y5, y6, y7 #) = (# addD64 x0 y0, addD64 x1 y1, addD64 x2 y2, addD64 x3 y3, addD64 x4 y4, addD64 x5 y5, addD64 x6 y6, addD64 x7 y7 #)
+{-# NOINLINE addD512 #-}
+
+toListD8 :: D8 -> [Double]
+toListD8 (# x0, x1, x2, x3, x4, x5, x6, x7 #) = [D# x0, D# x1, D# x2, D# x3, D# x4, D# x5, D# x6, D# x7]
+{-# NOINLINE toListD8 #-}
+
+toListD64 :: D64 -> [Double]
+toListD64 (# x0, x1, x2, x3, x4, x5, x6, x7 #) = concat [toListD8 x0, toListD8 x1, toListD8 x2, toListD8 x3, toListD8 x4, toListD8 x5, toListD8 x6, toListD8 x7]
+{-# NOINLINE toListD64 #-}
+
+toListD512 :: D512 -> [Double]
+toListD512 (# x0, x1, x2, x3, x4, x5, x6, x7 #) = concat [toListD64 x0, toListD64 x1, toListD64 x2, toListD64 x3, toListD64 x4, toListD64 x5, toListD64 x6, toListD64 x7]
+{-# NOINLINE toListD512 #-}
+
+data T = MkT D512 D64
+
+mkT :: Double -> T
+mkT x = MkT (mkD512 x) (mkD64 (x + 512))
+{-# NOINLINE mkT #-}
+
+addT :: T -> T -> T
+addT (MkT x0 x1) (MkT y0 y1) = MkT (addD512 x0 y0) (addD64 x1 y1)
+{-# NOINLINE addT #-}
+
+toListT :: T -> [Double]
+toListT (MkT x0 x1) = toListD512 x0 ++ toListD64 x1
+{-# NOINLINE toListT #-}
+
+main :: IO ()
+main = do
+ let n = 512 + 64
+ let !x = mkT 0
+ !y = mkT n
+ print $ toListT x
+ print $ toListT y
+ print $ toListT (addT x y)
+ print $ toListT x == [0..n-1]
+ print $ toListT y == [n..2*n-1]
+ print $ toListT (addT x y) == zipWith (+) [0..n-1] [n..2*n-1]
diff --git a/testsuite/tests/codeGen/should_run/T26537.stdout b/testsuite/tests/codeGen/should_run/T26537.stdout
new file mode 100644
index 000000000000..2f0f98964ed4
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/T26537.stdout
@@ -0,0 +1,6 @@
+[0.0,1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0,10.0,11.0,12.0,13.0,14.0,15.0,16.0,17.0,18.0,19.0,20.0,21.0,22.0,23.0,24.0,25.0,26.0,27.0,28.0,29.0,30.0,31.0,32.0,33.0,34.0,35.0,36.0,37.0,38.0,39.0,40.0,41.0,42.0,43.0,44.0,45.0,46.0,47.0,48.0,49.0,50.0,51.0,52.0,53.0,54.0,55.0,56.0,57.0,58.0,59.0,60.0,61.0,62.0,63.0,64.0,65.0,66.0,67.0,68.0,69.0,70.0,71.0,72.0,73.0,74.0,75.0,76.0,77.0,78.0,79.0,80.0,81.0,82.0,83.0,84.0,85.0,86.0,87.0,88.0,89.0,90.0,91.0,92.0,93.0,94.0,95.0,96.0,97.0,98.0,99.0,100.0,101.0,102.0,103.0,104.0,105.0,106.0,107.0,108.0,109.0,110.0,111.0,112.0,113.0,114.0,115.0,116.0,117.0,118.0,119.0,120.0,121.0,122.0,123.0,124.0,125.0,126.0,127.0,128.0,129.0,130.0,131.0,132.0,133.0,134.0,135.0,136.0,137.0,138.0,139.0,140.0,141.0,142.0,143.0,144.0,145.0,146.0,147.0,148.0,149.0,150.0,151.0,152.0,153.0,154.0,155.0,156.0,157.0,158.0,159.0,160.0,161.0,162.0,163.0,164.0,165.0,166.0,167.0,168.0,169.0,170.0,171.0,172.0,173.0,174.0,175.0,176.0,177.0,178.0,179.0,180.0,181.0,182.0,183.0,184.0,185.0,186.0,187.0,188.0,189.0,190.0,191.0,192.0,193.0,194.0,195.0,196.0,197.0,198.0,199.0,200.0,201.0,202.0,203.0,204.0,205.0,206.0,207.0,208.0,209.0,210.0,211.0,212.0,213.0,214.0,215.0,216.0,217.0,218.0,219.0,220.0,221.0,222.0,223.0,224.0,225.0,226.0,227.0,228.0,229.0,230.0,231.0,232.0,233.0,234.0,235.0,236.0,237.0,238.0,239.0,240.0,241.0,242.0,243.0,244.0,245.0,246.0,247.0,248.0,249.0,250.0,251.0,252.0,253.0,254.0,255.0,256.0,257.0,258.0,259.0,260.0,261.0,262.0,263.0,264.0,265.0,266.0,267.0,268.0,269.0,270.0,271.0,272.0,273.0,274.0,275.0,276.0,277.0,278.0,279.0,280.0,281.0,282.0,283.0,284.0,285.0,286.0,287.0,288.0,289.0,290.0,291.0,292.0,293.0,294.0,295.0,296.0,297.0,298.0,299.0,300.0,301.0,302.0,303.0,304.0,305.0,306.0,307.0,308.0,309.0,310.0,311.0,312.0,313.0,314.0,315.0,316.0,317.0,318.0,319.0,320.0,321.0,322.0,323.0,324.0,325.0,326.0,327.0,328.0,329.0,330.0,331.0,332.0,333.0,334.0,335.0,336.0,337.0,338.0,339.0,340.0,341.0,342.0,343.0,344.0,345.0,346.0,347.0,348.0,349.0,350.0,351.0,352.0,353.0,354.0,355.0,356.0,357.0,358.0,359.0,360.0,361.0,362.0,363.0,364.0,365.0,366.0,367.0,368.0,369.0,370.0,371.0,372.0,373.0,374.0,375.0,376.0,377.0,378.0,379.0,380.0,381.0,382.0,383.0,384.0,385.0,386.0,387.0,388.0,389.0,390.0,391.0,392.0,393.0,394.0,395.0,396.0,397.0,398.0,399.0,400.0,401.0,402.0,403.0,404.0,405.0,406.0,407.0,408.0,409.0,410.0,411.0,412.0,413.0,414.0,415.0,416.0,417.0,418.0,419.0,420.0,421.0,422.0,423.0,424.0,425.0,426.0,427.0,428.0,429.0,430.0,431.0,432.0,433.0,434.0,435.0,436.0,437.0,438.0,439.0,440.0,441.0,442.0,443.0,444.0,445.0,446.0,447.0,448.0,449.0,450.0,451.0,452.0,453.0,454.0,455.0,456.0,457.0,458.0,459.0,460.0,461.0,462.0,463.0,464.0,465.0,466.0,467.0,468.0,469.0,470.0,471.0,472.0,473.0,474.0,475.0,476.0,477.0,478.0,479.0,480.0,481.0,482.0,483.0,484.0,485.0,486.0,487.0,488.0,489.0,490.0,491.0,492.0,493.0,494.0,495.0,496.0,497.0,498.0,499.0,500.0,501.0,502.0,503.0,504.0,505.0,506.0,507.0,508.0,509.0,510.0,511.0,512.0,513.0,514.0,515.0,516.0,517.0,518.0,519.0,520.0,521.0,522.0,523.0,524.0,525.0,526.0,527.0,528.0,529.0,530.0,531.0,532.0,533.0,534.0,535.0,536.0,537.0,538.0,539.0,540.0,541.0,542.0,543.0,544.0,545.0,546.0,547.0,548.0,549.0,550.0,551.0,552.0,553.0,554.0,555.0,556.0,557.0,558.0,559.0,560.0,561.0,562.0,563.0,564.0,565.0,566.0,567.0,568.0,569.0,570.0,571.0,572.0,573.0,574.0,575.0]
+[576.0,577.0,578.0,579.0,580.0,581.0,582.0,583.0,584.0,585.0,586.0,587.0,588.0,589.0,590.0,591.0,592.0,593.0,594.0,595.0,596.0,597.0,598.0,599.0,600.0,601.0,602.0,603.0,604.0,605.0,606.0,607.0,608.0,609.0,610.0,611.0,612.0,613.0,614.0,615.0,616.0,617.0,618.0,619.0,620.0,621.0,622.0,623.0,624.0,625.0,626.0,627.0,628.0,629.0,630.0,631.0,632.0,633.0,634.0,635.0,636.0,637.0,638.0,639.0,640.0,641.0,642.0,643.0,644.0,645.0,646.0,647.0,648.0,649.0,650.0,651.0,652.0,653.0,654.0,655.0,656.0,657.0,658.0,659.0,660.0,661.0,662.0,663.0,664.0,665.0,666.0,667.0,668.0,669.0,670.0,671.0,672.0,673.0,674.0,675.0,676.0,677.0,678.0,679.0,680.0,681.0,682.0,683.0,684.0,685.0,686.0,687.0,688.0,689.0,690.0,691.0,692.0,693.0,694.0,695.0,696.0,697.0,698.0,699.0,700.0,701.0,702.0,703.0,704.0,705.0,706.0,707.0,708.0,709.0,710.0,711.0,712.0,713.0,714.0,715.0,716.0,717.0,718.0,719.0,720.0,721.0,722.0,723.0,724.0,725.0,726.0,727.0,728.0,729.0,730.0,731.0,732.0,733.0,734.0,735.0,736.0,737.0,738.0,739.0,740.0,741.0,742.0,743.0,744.0,745.0,746.0,747.0,748.0,749.0,750.0,751.0,752.0,753.0,754.0,755.0,756.0,757.0,758.0,759.0,760.0,761.0,762.0,763.0,764.0,765.0,766.0,767.0,768.0,769.0,770.0,771.0,772.0,773.0,774.0,775.0,776.0,777.0,778.0,779.0,780.0,781.0,782.0,783.0,784.0,785.0,786.0,787.0,788.0,789.0,790.0,791.0,792.0,793.0,794.0,795.0,796.0,797.0,798.0,799.0,800.0,801.0,802.0,803.0,804.0,805.0,806.0,807.0,808.0,809.0,810.0,811.0,812.0,813.0,814.0,815.0,816.0,817.0,818.0,819.0,820.0,821.0,822.0,823.0,824.0,825.0,826.0,827.0,828.0,829.0,830.0,831.0,832.0,833.0,834.0,835.0,836.0,837.0,838.0,839.0,840.0,841.0,842.0,843.0,844.0,845.0,846.0,847.0,848.0,849.0,850.0,851.0,852.0,853.0,854.0,855.0,856.0,857.0,858.0,859.0,860.0,861.0,862.0,863.0,864.0,865.0,866.0,867.0,868.0,869.0,870.0,871.0,872.0,873.0,874.0,875.0,876.0,877.0,878.0,879.0,880.0,881.0,882.0,883.0,884.0,885.0,886.0,887.0,888.0,889.0,890.0,891.0,892.0,893.0,894.0,895.0,896.0,897.0,898.0,899.0,900.0,901.0,902.0,903.0,904.0,905.0,906.0,907.0,908.0,909.0,910.0,911.0,912.0,913.0,914.0,915.0,916.0,917.0,918.0,919.0,920.0,921.0,922.0,923.0,924.0,925.0,926.0,927.0,928.0,929.0,930.0,931.0,932.0,933.0,934.0,935.0,936.0,937.0,938.0,939.0,940.0,941.0,942.0,943.0,944.0,945.0,946.0,947.0,948.0,949.0,950.0,951.0,952.0,953.0,954.0,955.0,956.0,957.0,958.0,959.0,960.0,961.0,962.0,963.0,964.0,965.0,966.0,967.0,968.0,969.0,970.0,971.0,972.0,973.0,974.0,975.0,976.0,977.0,978.0,979.0,980.0,981.0,982.0,983.0,984.0,985.0,986.0,987.0,988.0,989.0,990.0,991.0,992.0,993.0,994.0,995.0,996.0,997.0,998.0,999.0,1000.0,1001.0,1002.0,1003.0,1004.0,1005.0,1006.0,1007.0,1008.0,1009.0,1010.0,1011.0,1012.0,1013.0,1014.0,1015.0,1016.0,1017.0,1018.0,1019.0,1020.0,1021.0,1022.0,1023.0,1024.0,1025.0,1026.0,1027.0,1028.0,1029.0,1030.0,1031.0,1032.0,1033.0,1034.0,1035.0,1036.0,1037.0,1038.0,1039.0,1040.0,1041.0,1042.0,1043.0,1044.0,1045.0,1046.0,1047.0,1048.0,1049.0,1050.0,1051.0,1052.0,1053.0,1054.0,1055.0,1056.0,1057.0,1058.0,1059.0,1060.0,1061.0,1062.0,1063.0,1064.0,1065.0,1066.0,1067.0,1068.0,1069.0,1070.0,1071.0,1072.0,1073.0,1074.0,1075.0,1076.0,1077.0,1078.0,1079.0,1080.0,1081.0,1082.0,1083.0,1084.0,1085.0,1086.0,1087.0,1088.0,1089.0,1090.0,1091.0,1092.0,1093.0,1094.0,1095.0,1096.0,1097.0,1098.0,1099.0,1100.0,1101.0,1102.0,1103.0,1104.0,1105.0,1106.0,1107.0,1108.0,1109.0,1110.0,1111.0,1112.0,1113.0,1114.0,1115.0,1116.0,1117.0,1118.0,1119.0,1120.0,1121.0,1122.0,1123.0,1124.0,1125.0,1126.0,1127.0,1128.0,1129.0,1130.0,1131.0,1132.0,1133.0,1134.0,1135.0,1136.0,1137.0,1138.0,1139.0,1140.0,1141.0,1142.0,1143.0,1144.0,1145.0,1146.0,1147.0,1148.0,1149.0,1150.0,1151.0]
+[576.0,578.0,580.0,582.0,584.0,586.0,588.0,590.0,592.0,594.0,596.0,598.0,600.0,602.0,604.0,606.0,608.0,610.0,612.0,614.0,616.0,618.0,620.0,622.0,624.0,626.0,628.0,630.0,632.0,634.0,636.0,638.0,640.0,642.0,644.0,646.0,648.0,650.0,652.0,654.0,656.0,658.0,660.0,662.0,664.0,666.0,668.0,670.0,672.0,674.0,676.0,678.0,680.0,682.0,684.0,686.0,688.0,690.0,692.0,694.0,696.0,698.0,700.0,702.0,704.0,706.0,708.0,710.0,712.0,714.0,716.0,718.0,720.0,722.0,724.0,726.0,728.0,730.0,732.0,734.0,736.0,738.0,740.0,742.0,744.0,746.0,748.0,750.0,752.0,754.0,756.0,758.0,760.0,762.0,764.0,766.0,768.0,770.0,772.0,774.0,776.0,778.0,780.0,782.0,784.0,786.0,788.0,790.0,792.0,794.0,796.0,798.0,800.0,802.0,804.0,806.0,808.0,810.0,812.0,814.0,816.0,818.0,820.0,822.0,824.0,826.0,828.0,830.0,832.0,834.0,836.0,838.0,840.0,842.0,844.0,846.0,848.0,850.0,852.0,854.0,856.0,858.0,860.0,862.0,864.0,866.0,868.0,870.0,872.0,874.0,876.0,878.0,880.0,882.0,884.0,886.0,888.0,890.0,892.0,894.0,896.0,898.0,900.0,902.0,904.0,906.0,908.0,910.0,912.0,914.0,916.0,918.0,920.0,922.0,924.0,926.0,928.0,930.0,932.0,934.0,936.0,938.0,940.0,942.0,944.0,946.0,948.0,950.0,952.0,954.0,956.0,958.0,960.0,962.0,964.0,966.0,968.0,970.0,972.0,974.0,976.0,978.0,980.0,982.0,984.0,986.0,988.0,990.0,992.0,994.0,996.0,998.0,1000.0,1002.0,1004.0,1006.0,1008.0,1010.0,1012.0,1014.0,1016.0,1018.0,1020.0,1022.0,1024.0,1026.0,1028.0,1030.0,1032.0,1034.0,1036.0,1038.0,1040.0,1042.0,1044.0,1046.0,1048.0,1050.0,1052.0,1054.0,1056.0,1058.0,1060.0,1062.0,1064.0,1066.0,1068.0,1070.0,1072.0,1074.0,1076.0,1078.0,1080.0,1082.0,1084.0,1086.0,1088.0,1090.0,1092.0,1094.0,1096.0,1098.0,1100.0,1102.0,1104.0,1106.0,1108.0,1110.0,1112.0,1114.0,1116.0,1118.0,1120.0,1122.0,1124.0,1126.0,1128.0,1130.0,1132.0,1134.0,1136.0,1138.0,1140.0,1142.0,1144.0,1146.0,1148.0,1150.0,1152.0,1154.0,1156.0,1158.0,1160.0,1162.0,1164.0,1166.0,1168.0,1170.0,1172.0,1174.0,1176.0,1178.0,1180.0,1182.0,1184.0,1186.0,1188.0,1190.0,1192.0,1194.0,1196.0,1198.0,1200.0,1202.0,1204.0,1206.0,1208.0,1210.0,1212.0,1214.0,1216.0,1218.0,1220.0,1222.0,1224.0,1226.0,1228.0,1230.0,1232.0,1234.0,1236.0,1238.0,1240.0,1242.0,1244.0,1246.0,1248.0,1250.0,1252.0,1254.0,1256.0,1258.0,1260.0,1262.0,1264.0,1266.0,1268.0,1270.0,1272.0,1274.0,1276.0,1278.0,1280.0,1282.0,1284.0,1286.0,1288.0,1290.0,1292.0,1294.0,1296.0,1298.0,1300.0,1302.0,1304.0,1306.0,1308.0,1310.0,1312.0,1314.0,1316.0,1318.0,1320.0,1322.0,1324.0,1326.0,1328.0,1330.0,1332.0,1334.0,1336.0,1338.0,1340.0,1342.0,1344.0,1346.0,1348.0,1350.0,1352.0,1354.0,1356.0,1358.0,1360.0,1362.0,1364.0,1366.0,1368.0,1370.0,1372.0,1374.0,1376.0,1378.0,1380.0,1382.0,1384.0,1386.0,1388.0,1390.0,1392.0,1394.0,1396.0,1398.0,1400.0,1402.0,1404.0,1406.0,1408.0,1410.0,1412.0,1414.0,1416.0,1418.0,1420.0,1422.0,1424.0,1426.0,1428.0,1430.0,1432.0,1434.0,1436.0,1438.0,1440.0,1442.0,1444.0,1446.0,1448.0,1450.0,1452.0,1454.0,1456.0,1458.0,1460.0,1462.0,1464.0,1466.0,1468.0,1470.0,1472.0,1474.0,1476.0,1478.0,1480.0,1482.0,1484.0,1486.0,1488.0,1490.0,1492.0,1494.0,1496.0,1498.0,1500.0,1502.0,1504.0,1506.0,1508.0,1510.0,1512.0,1514.0,1516.0,1518.0,1520.0,1522.0,1524.0,1526.0,1528.0,1530.0,1532.0,1534.0,1536.0,1538.0,1540.0,1542.0,1544.0,1546.0,1548.0,1550.0,1552.0,1554.0,1556.0,1558.0,1560.0,1562.0,1564.0,1566.0,1568.0,1570.0,1572.0,1574.0,1576.0,1578.0,1580.0,1582.0,1584.0,1586.0,1588.0,1590.0,1592.0,1594.0,1596.0,1598.0,1600.0,1602.0,1604.0,1606.0,1608.0,1610.0,1612.0,1614.0,1616.0,1618.0,1620.0,1622.0,1624.0,1626.0,1628.0,1630.0,1632.0,1634.0,1636.0,1638.0,1640.0,1642.0,1644.0,1646.0,1648.0,1650.0,1652.0,1654.0,1656.0,1658.0,1660.0,1662.0,1664.0,1666.0,1668.0,1670.0,1672.0,1674.0,1676.0,1678.0,1680.0,1682.0,1684.0,1686.0,1688.0,1690.0,1692.0,1694.0,1696.0,1698.0,1700.0,1702.0,1704.0,1706.0,1708.0,1710.0,1712.0,1714.0,1716.0,1718.0,1720.0,1722.0,1724.0,1726.0]
+True
+True
+True
diff --git a/testsuite/tests/codeGen/should_run/aarch64-subword-ops.hs b/testsuite/tests/codeGen/should_run/aarch64-subword-ops.hs
new file mode 100644
index 000000000000..276947d22e72
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/aarch64-subword-ops.hs
@@ -0,0 +1,115 @@
+{-# LANGUAGE MagicHash #-}
+module Main where
+
+import GHC.Exts
+import GHC.Word
+import GHC.Int
+
+-- Uses sub-word primops directly so that the NCG sees MO_Shl W8,
+-- MO_U_Shr W8, MO_S_Shr W8 etc. (the Bits class widens to Word#/Int#).
+
+-- NOINLINE to prevent constant folding.
+
+-- MO_U_Shr W8/W16 variable shift
+{-# NOINLINE ushrW8 #-}
+ushrW8 :: Word8 -> Int -> Word8
+ushrW8 (W8# w) (I# i) = W8# (uncheckedShiftRLWord8# w i)
+
+{-# NOINLINE ushrW16 #-}
+ushrW16 :: Word16 -> Int -> Word16
+ushrW16 (W16# w) (I# i) = W16# (uncheckedShiftRLWord16# w i)
+
+-- MO_S_Shr W8/W16 variable shift
+{-# NOINLINE sshrI8 #-}
+sshrI8 :: Int8 -> Int -> Int8
+sshrI8 (I8# x) (I# i) = I8# (uncheckedShiftRAInt8# x i)
+
+{-# NOINLINE sshrI16 #-}
+sshrI16 :: Int16 -> Int -> Int16
+sshrI16 (I16# x) (I# i) = I16# (uncheckedShiftRAInt16# x i)
+
+-- MO_Shl W8/W16 variable shift
+{-# NOINLINE shlW8 #-}
+shlW8 :: Word8 -> Int -> Word8
+shlW8 (W8# w) (I# i) = W8# (uncheckedShiftLWord8# w i)
+
+{-# NOINLINE shlW16 #-}
+shlW16 :: Word16 -> Int -> Word16
+shlW16 (W16# w) (I# i) = W16# (uncheckedShiftLWord16# w i)
+
+-- quot exercising MO_U_Quot W8/W16
+{-# NOINLINE quotW8 #-}
+quotW8 :: Word8 -> Word8 -> Word8
+quotW8 (W8# x) (W8# y) = W8# (quotWord8# x y)
+
+{-# NOINLINE quotW16 #-}
+quotW16 :: Word16 -> Word16 -> Word16
+quotW16 (W16# x) (W16# y) = W16# (quotWord16# x y)
+
+-- Register clobbering: use a value both in a shift/quot and afterward.
+-- If the sign/zero extension clobbers the source register, the second
+-- use sees the wrong value.
+
+{-# NOINLINE sshrAndAdd8 #-}
+sshrAndAdd8 :: Int8 -> Int -> Int8
+sshrAndAdd8 a n = sshrI8 a n + a
+
+{-# NOINLINE sshrAndAdd16 #-}
+sshrAndAdd16 :: Int16 -> Int -> Int16
+sshrAndAdd16 a n = sshrI16 a n + a
+
+{-# NOINLINE quotAndAdd8 #-}
+quotAndAdd8 :: Word8 -> Word8 -> Word8
+quotAndAdd8 a b = quotW8 a b + a + b
+
+{-# NOINLINE quotAndAdd16 #-}
+quotAndAdd16 :: Word16 -> Word16 -> Word16
+quotAndAdd16 a b = quotW16 a b + a + b
+
+main :: IO ()
+main = do
+ putStrLn "-- MO_U_Shr variable shift"
+ print (ushrW8 0x80 1) -- 64
+ print (ushrW8 0xFF 4) -- 15
+ print (ushrW8 0x42 0) -- 66
+ print (ushrW16 0x8000 1) -- 16384
+ print (ushrW16 0xFFFF 8) -- 255
+ print (ushrW16 0x1234 0) -- 4660
+
+ putStrLn "-- MO_S_Shr variable shift"
+ print (sshrI8 (-1) 1) -- -1
+ print (sshrI8 (-128) 1) -- -64
+ print (sshrI8 127 1) -- 63
+ print (sshrI8 0x42 3) -- 8
+ print (sshrI16 (-1) 1) -- -1
+ print (sshrI16 (-32768) 1) -- -16384
+ print (sshrI16 32767 8) -- 127
+
+ putStrLn "-- MO_Shl variable shift"
+ print (shlW8 0x01 0) -- 1
+ print (shlW8 0x01 4) -- 16
+ print (shlW8 0xFF 1) -- 254
+ print (shlW8 0x42 3) -- 16
+ print (shlW16 0x0001 0) -- 1
+ print (shlW16 0x0001 8) -- 256
+ print (shlW16 0xFFFF 1) -- 65534
+ print (shlW16 0x1234 4) -- 9024
+
+ putStrLn "-- MO_U_Quot"
+ print (quotW8 255 10) -- 25
+ print (quotW8 200 7) -- 28
+ print (quotW8 1 1) -- 1
+ print (quotW16 65535 256) -- 255
+ print (quotW16 1000 3) -- 333
+
+ putStrLn "-- register clobbering: shift + reuse"
+ print (sshrAndAdd8 (-128) 1) -- 64 (wraps: -64 + -128 = -192 = 64 as Int8)
+ print (sshrAndAdd8 0x42 1) -- 99
+ print (sshrAndAdd16 (-32768) 1) -- 16384 (wraps)
+ print (sshrAndAdd16 0x1234 4) -- 4951
+
+ putStrLn "-- register clobbering: quot + reuse"
+ print (quotAndAdd8 200 7) -- 235
+ print (quotAndAdd8 255 10) -- 34 (wraps: 290 mod 256)
+ print (quotAndAdd16 1000 3) -- 1336
+ print (quotAndAdd16 65535 256) -- 510 (wraps: 66046 mod 65536)
diff --git a/testsuite/tests/codeGen/should_run/aarch64-subword-ops.stdout b/testsuite/tests/codeGen/should_run/aarch64-subword-ops.stdout
new file mode 100644
index 000000000000..f478e5c3890a
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/aarch64-subword-ops.stdout
@@ -0,0 +1,40 @@
+-- MO_U_Shr variable shift
+64
+15
+66
+16384
+255
+4660
+-- MO_S_Shr variable shift
+-1
+-64
+63
+8
+-1
+-16384
+127
+-- MO_Shl variable shift
+1
+16
+254
+16
+1
+256
+65534
+9024
+-- MO_U_Quot
+25
+28
+1
+255
+333
+-- register clobbering: shift + reuse
+64
+99
+16384
+4951
+-- register clobbering: quot + reuse
+235
+34
+1336
+510
diff --git a/testsuite/tests/codeGen/should_run/aarch64-sxtw-run.hs b/testsuite/tests/codeGen/should_run/aarch64-sxtw-run.hs
new file mode 100644
index 000000000000..4bc07518c241
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/aarch64-sxtw-run.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE MagicHash #-}
+import GHC.Exts
+import GHC.Int
+
+signExtW32 :: Int32 -> Int64
+signExtW32 (I32# x) = I64# (intToInt64# (int32ToInt# x))
+
+main :: IO ()
+main = do
+ print (signExtW32 (-1))
+ print (signExtW32 (-128))
+ print (signExtW32 0)
+ print (signExtW32 127)
+ print (signExtW32 (minBound :: Int32))
diff --git a/testsuite/tests/codeGen/should_run/aarch64-sxtw-run.stdout b/testsuite/tests/codeGen/should_run/aarch64-sxtw-run.stdout
new file mode 100644
index 000000000000..f600b5139d3d
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/aarch64-sxtw-run.stdout
@@ -0,0 +1,5 @@
+-1
+-128
+0
+127
+-2147483648
diff --git a/testsuite/tests/codeGen/should_run/aarch64-ushr-subword-run.hs b/testsuite/tests/codeGen/should_run/aarch64-ushr-subword-run.hs
new file mode 100644
index 000000000000..f8cfed4d19fd
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/aarch64-ushr-subword-run.hs
@@ -0,0 +1,9 @@
+import Data.Bits (shiftR)
+import Data.Word (Word8, Word16)
+
+main :: IO ()
+main = do
+ print (shiftR (0x80 :: Word8) 1)
+ print (shiftR (0xFF :: Word8) 4)
+ print (shiftR (0x8000 :: Word16) 1)
+ print (shiftR (0xFFFF :: Word16) 8)
diff --git a/testsuite/tests/codeGen/should_run/aarch64-ushr-subword-run.stdout b/testsuite/tests/codeGen/should_run/aarch64-ushr-subword-run.stdout
new file mode 100644
index 000000000000..bd801b540629
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/aarch64-ushr-subword-run.stdout
@@ -0,0 +1,4 @@
+64
+15
+16384
+255
diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T
index 7f37271f79a8..d95152486026 100644
--- a/testsuite/tests/codeGen/should_run/all.T
+++ b/testsuite/tests/codeGen/should_run/all.T
@@ -256,3 +256,10 @@ test('T24893', normal, compile_and_run, ['-O'])
test('CCallConv', [req_c], compile_and_run, ['CCallConv_c.c'])
test('T25364', normal, compile_and_run, [''])
test('T26061', normal, compile_and_run, [''])
+test('T24016', normal, compile_and_run, ['-O1 -fPIC'])
+test('T26537', [js_broken(26558), compile_timeout_multiplier(5)], compile_and_run, ['-O2 -fregs-graph'])
+
+# AArch64-specific runtime tests
+test('aarch64-sxtw-run', [unless(arch('aarch64'), skip)], compile_and_run, ['-O'])
+test('aarch64-ushr-subword-run', [unless(arch('aarch64'), skip)], compile_and_run, ['-O'])
+test('aarch64-subword-ops', [unless(arch('aarch64'), skip)], compile_and_run, ['-O'])
diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T
index 38025196e665..b8ca2415a419 100644
--- a/testsuite/tests/concurrent/should_run/all.T
+++ b/testsuite/tests/concurrent/should_run/all.T
@@ -260,6 +260,7 @@ test('T21651',
when(opsys('mingw32'),skip), # uses POSIX pipes
when(opsys('darwin'),extra_run_opts('8 12 2000 100')),
unless(opsys('darwin'),extra_run_opts('8 12 2000 200')), # darwin runners complain of too many open files
+ when(opsys('darwin'),fragile(21651)), # times out on aarch64-darwin CI runners
req_target_smp,
req_ghc_smp
],
diff --git a/testsuite/tests/dmdanal/should_run/Makefile b/testsuite/tests/dmdanal/should_run/Makefile
index dae01b4bb58c..df2e6baa954b 100644
--- a/testsuite/tests/dmdanal/should_run/Makefile
+++ b/testsuite/tests/dmdanal/should_run/Makefile
@@ -4,8 +4,8 @@ include $(TOP)/mk/test.mk
.PHONY: T16197
T16197:
- '$(TEST_HC)' -O0 -v0 T16197.hs
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -O0 -v0 T16197.hs
./T16197
rm T16197.o T16197.hi T16197
- '$(TEST_HC)' -O1 -v0 T16197.hs
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -O1 -v0 T16197.hs
./T16197
diff --git a/testsuite/tests/driver/T14482/Makefile b/testsuite/tests/driver/T14482/Makefile
index e8b1fd84cc4e..b2a66204492b 100644
--- a/testsuite/tests/driver/T14482/Makefile
+++ b/testsuite/tests/driver/T14482/Makefile
@@ -4,5 +4,5 @@ include $(TOP)/mk/test.mk
T14482:
rm -f *.o *.hi *.o-boot *.hi-boot C result
- '$(TEST_HC)' -M C.hs -dep-suffix "p_" -dep-suffix "q_" -dep-makefile result
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -M C.hs -dep-suffix "p_" -dep-suffix "q_" -dep-makefile result
cat result
diff --git a/testsuite/tests/driver/T18733/Makefile b/testsuite/tests/driver/T18733/Makefile
index 457b23a09ffa..87c761607875 100644
--- a/testsuite/tests/driver/T18733/Makefile
+++ b/testsuite/tests/driver/T18733/Makefile
@@ -4,9 +4,9 @@ include $(TOP)/mk/test.mk
T18733:
cp Library1.hs Library.hs
- '$(TEST_HC)' -v0 -o Main Library.hs Main.hs
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -v0 -o Main Library.hs Main.hs
./Main
cp Library2.hs Library.hs
- '$(TEST_HC)' -v0 -o Main Library.hs Main.hs
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -v0 -o Main Library.hs Main.hs
./Main
diff --git a/testsuite/tests/driver/T19744/Makefile b/testsuite/tests/driver/T19744/Makefile
index 58917564e304..96d4cb8ffa49 100644
--- a/testsuite/tests/driver/T19744/Makefile
+++ b/testsuite/tests/driver/T19744/Makefile
@@ -3,6 +3,6 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
T19744:
- '$(TEST_HC)' Mod.hs
- '$(TEST_HC)' Client.hs
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) Mod.hs
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) Client.hs
diff --git a/testsuite/tests/driver/T20604/T20604.stdout b/testsuite/tests/driver/T20604/T20604.stdout
index 45b3c357c37c..b956f200db27 100644
--- a/testsuite/tests/driver/T20604/T20604.stdout
+++ b/testsuite/tests/driver/T20604/T20604.stdout
@@ -1,3 +1,3 @@
A1
A
-addDependentFile "/home/hsyl20/projects/ghc/merge-ghc-prim/_build/stage1/lib/../lib/x86_64-linux-ghc-9.13.20241220/libHSghc-internal-9.1300.0-inplace-ghc9.13.20241220.so" b035bf4e19d2537a0af5c8861760eaf1
+HSghc-internal-
diff --git a/testsuite/tests/driver/T21035/Makefile b/testsuite/tests/driver/T21035/Makefile
index 3e426f7e7f81..b2eaa93f04fe 100644
--- a/testsuite/tests/driver/T21035/Makefile
+++ b/testsuite/tests/driver/T21035/Makefile
@@ -6,13 +6,13 @@ BASE_VERSION = $('$GHC_PKG' field base id --simple-output)
a.out: Main.o M.o
- '$(TEST_HC)' Main.o M.o -package-env -
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) Main.o M.o -package-env -
Main.o Main.hi: M.hi hsdep/pkgdb/package.cache hsdep/HsDep.hi hsdep/libHShsdep-0.1-ghc8.10.7.so
- '$(TEST_HC)' -c Main.hs hsdep/libHShsdep-0.1-ghc8.10.7.so -i. -package-env - -package-db hsdep/pkgdb
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -c Main.hs hsdep/libHShsdep-0.1-ghc8.10.7.so -i. -package-env - -package-db hsdep/pkgdb
M.o M.hi: M.hs hsdep-empty-lib/pkgdb/package.cache hsdep/HsDep.hi hsdep-empty-lib/libHShsdep-0.1-ghc8.10.7.so
- '$(TEST_HC)' -c M.hs hsdep/HsDep.o -package-env - -package-db hsdep-empty-lib/pkgdb
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -c M.hs hsdep/HsDep.o -package-env - -package-db hsdep-empty-lib/pkgdb
hsdep/pkgdb/package.cache: cat-hsdep-info.sh
mkdir -p hsdep/pkgdb
@@ -30,11 +30,11 @@ hsdep/libHShsdep-0.1-ghc8.10.7.so: hsdep/HsDep.dyn_o
hsdep-empty-lib/libHShsdep-0.1-ghc8.10.7.so:
mkdir -p hsdep-empty-lib
touch empty.c
- '$(TEST_HC)' -shared -dynamic -o hsdep-empty-lib/libHShsdep-0.1-ghc8.10.7.so empty.c
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -shared -dynamic -o hsdep-empty-lib/libHShsdep-0.1-ghc8.10.7.so empty.c
rm empty.c
hsdep/HsDep.dyn_hi hsdep/HsDep.dyn_o hsdep/HsDep.hi hsdep/HsDep.o: hsdep/HsDep.hs
- '$(TEST_HC)' -c -dynamic-too -this-unit-id hsdep-0.1 hsdep/HsDep.hs -dynhisuf dyn_hi -dynosuf dyn_o
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -c -dynamic-too -this-unit-id hsdep-0.1 hsdep/HsDep.hs -dynhisuf dyn_hi -dynosuf dyn_o
T21035: a.out
diff --git a/testsuite/tests/driver/T21097/Makefile b/testsuite/tests/driver/T21097/Makefile
index b90dcdb3ceab..c5f1ff900f96 100644
--- a/testsuite/tests/driver/T21097/Makefile
+++ b/testsuite/tests/driver/T21097/Makefile
@@ -4,4 +4,4 @@ include $(TOP)/mk/test.mk
T21097:
'$(GHC_PKG)' recache --package-db pkgdb
- - '$(TEST_HC)' -package-db pkgdb -v0 Test.hs; test $$? -eq 2
+ - '$(TEST_HC)' $(EXTRA_HC_OPTS) -package-db pkgdb -v0 Test.hs; test $$? -eq 2
diff --git a/testsuite/tests/driver/T21097b/Makefile b/testsuite/tests/driver/T21097b/Makefile
index 6455817a300f..4af7bf4b6c43 100644
--- a/testsuite/tests/driver/T21097b/Makefile
+++ b/testsuite/tests/driver/T21097b/Makefile
@@ -4,4 +4,4 @@ include $(TOP)/mk/test.mk
T21097b:
'$(GHC_PKG)' recache --package-db pkgdb
- '$(TEST_HC)' -no-global-package-db -no-user-package-db -package-db pkgdb -v0 Test.hs -ddump-mod-map
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -no-global-package-db -no-user-package-db -package-db pkgdb -v0 Test.hs -no-rts -ddump-mod-map
diff --git a/testsuite/tests/driver/T24731.hs b/testsuite/tests/driver/T24731.hs
new file mode 100644
index 000000000000..81aeb1b01c30
--- /dev/null
+++ b/testsuite/tests/driver/T24731.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T24731 where
+
+foo :: Int
+foo = $([|10|])
diff --git a/testsuite/tests/driver/T3007/Makefile b/testsuite/tests/driver/T3007/Makefile
index 6dfbef82799f..c4e92a08352a 100644
--- a/testsuite/tests/driver/T3007/Makefile
+++ b/testsuite/tests/driver/T3007/Makefile
@@ -14,10 +14,10 @@ T3007:
$(MAKE) -s --no-print-directory clean
'$(GHC_PKG)' init package.conf
cd A && '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup
- cd A && ./Setup configure -v0 --with-compiler='$(TEST_HC)' --with-hc-pkg='$(GHC_PKG)' --ghc-pkg-option=--global-package-db=../package.conf --ghc-pkg-option=--no-user-package-db --ghc-option=-package-db../package.conf
+ cd A && ./Setup configure -v0 --with-compiler='$(TEST_HC)' --ghc-options="$(EXTRA_HC_OPTS) " --with-hc-pkg='$(GHC_PKG)' --ghc-pkg-option=--global-package-db=../package.conf --ghc-pkg-option=--no-user-package-db --ghc-option=-package-db../package.conf
cd A && ./Setup build -v0
cd A && ./Setup register --inplace -v0
cd B && '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup
- cd B && ./Setup configure -v0 --with-compiler='$(TEST_HC)' --with-hc-pkg='$(GHC_PKG)' --ghc-pkg-option=--global-package-db=../package.conf --ghc-pkg-option=--no-user-package-db --ghc-option=-package-db../package.conf
+ cd B && ./Setup configure -v0 --with-compiler='$(TEST_HC)' --ghc-options="$(EXTRA_HC_OPTS) " --with-hc-pkg='$(GHC_PKG)' --ghc-pkg-option=--global-package-db=../package.conf --ghc-pkg-option=--no-user-package-db --ghc-option=-package-db../package.conf
cd B && ./Setup build -v0
diff --git a/testsuite/tests/driver/T7373/Makefile b/testsuite/tests/driver/T7373/Makefile
index d7017871bd15..0ca15b91b9c3 100644
--- a/testsuite/tests/driver/T7373/Makefile
+++ b/testsuite/tests/driver/T7373/Makefile
@@ -5,8 +5,8 @@ include $(TOP)/mk/test.mk
.PHONY: T7373
T7373:
echo '[]' > package.conf
- cd pkg && '$(TEST_HC)' -v0 --make Setup
- cd pkg && ./Setup configure -v0 --with-compiler='$(TEST_HC)' --ghc-pkg-options="--global-package-db ../package.conf" --ghc-options="-package-db ../package.conf"
+ cd pkg && '$(TEST_HC)' $(EXTRA_HC_OPTS) -v0 --make Setup
+ cd pkg && ./Setup configure -v0 --with-compiler='$(TEST_HC)' --ghc-pkg-options="--global-package-db ../package.conf" --ghc-options="-package-db ../package.conf $(EXTRA_HC_OPTS)"
cd pkg && ./Setup build -v0
cd pkg && ./Setup register --inplace -v0
# Pretend that B.hs hasn't been compiled yet, by removing the results
diff --git a/testsuite/tests/driver/T9562/Makefile b/testsuite/tests/driver/T9562/Makefile
index 423389d18b81..9a7dbdd93631 100644
--- a/testsuite/tests/driver/T9562/Makefile
+++ b/testsuite/tests/driver/T9562/Makefile
@@ -4,9 +4,9 @@ include $(TOP)/mk/test.mk
T9562:
rm -f *.o *.hi *.o-boot *.hi-boot Main
- '$(TEST_HC)' -c A.hs
- '$(TEST_HC)' -c B.hs-boot
- '$(TEST_HC)' -c C.hs
- '$(TEST_HC)' -c B.hs
- '$(TEST_HC)' -c D.hs
- ! ('$(TEST_HC)' Main.hs && ./Main)
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -c A.hs
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -c B.hs-boot
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -c C.hs
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -c B.hs
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -c D.hs
+ ! ('$(TEST_HC)' $(EXTRA_HC_OPTS) Main.hs && ./Main)
diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T
index 0c11cbb040da..66674ca80566 100644
--- a/testsuite/tests/driver/all.T
+++ b/testsuite/tests/driver/all.T
@@ -329,5 +329,6 @@ 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, [])
test('T26018', req_c, makefile_test, [])
+test('T24731', [only_ways(['ext-interp'])], compile, ['-fexternal-interpreter -pgmi ""'])
diff --git a/testsuite/tests/driver/boot-target/Makefile b/testsuite/tests/driver/boot-target/Makefile
index b153e4a135e7..f26dcf9598c4 100644
--- a/testsuite/tests/driver/boot-target/Makefile
+++ b/testsuite/tests/driver/boot-target/Makefile
@@ -1,8 +1,12 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
boot1:
- '$(TEST_HC)' -c A.hs-boot B.hs
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -c A.hs-boot B.hs
boot2:
- '$(TEST_HC)' A.hs-boot A.hs B.hs -v0
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) A.hs-boot A.hs B.hs -v0
boot3:
- '$(TEST_HC)' A.hs-boot B.hs -v0
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) A.hs-boot B.hs -v0
diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo004/Makefile b/testsuite/tests/driver/dynamicToo/dynamicToo004/Makefile
index cb25be52ad67..e3c5624066a0 100644
--- a/testsuite/tests/driver/dynamicToo/dynamicToo004/Makefile
+++ b/testsuite/tests/driver/dynamicToo/dynamicToo004/Makefile
@@ -21,16 +21,16 @@ dynamicToo004:
$(MAKE) -s --no-print-directory clean
"$(GHC_PKG)" init $(LOCAL_PKGCONF)
- "$(TEST_HC)" -v0 --make Setup.hs
+ "$(TEST_HC)" $(EXTRA_HC_OPTS) -v0 --make Setup.hs
# First make the vanilla pkg1
- cd pkg1 && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) --enable-library-vanilla --disable-shared
+ cd pkg1 && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --ghc-options="$(EXTRA_HC_OPTS)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) --enable-library-vanilla --disable-shared
cd pkg1 && ../Setup build
cd pkg1 && ../Setup register --inplace
# Then the dynamic pkg1. This has different code in A.hs, so we get
# a different hash.
- cd pkg1dyn && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) --disable-library-vanilla --enable-shared
+ cd pkg1dyn && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --ghc-options="$(EXTRA_HC_OPTS)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) --disable-library-vanilla --enable-shared
cd pkg1dyn && ../Setup build
# Now merge the dynamic outputs into the registered directory
@@ -39,13 +39,13 @@ dynamicToo004:
cp pkg1dyn/dist/build/libHSpkg1* pkg1/dist/build/
# Next compile pkg2 both ways, which will use -dynamic-too
- cd pkg2 && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) --enable-library-vanilla --enable-shared
+ cd pkg2 && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --ghc-options="$(EXTRA_HC_OPTS)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) --enable-library-vanilla --enable-shared
cd pkg2 && ../Setup build
cd pkg2 && ../Setup register --inplace
# And then compile a program using the library both ways
- "$(TEST_HC)" -package-db $(LOCAL_PKGCONF) --make prog -o progstatic
- "$(TEST_HC)" -package-db $(LOCAL_PKGCONF) --make prog -o progdynamic -dynamic -osuf dyn_o -hisuf dyn_hi
+ "$(TEST_HC)" $(EXTRA_HC_OPTS) -package-db $(LOCAL_PKGCONF) --make prog -o progstatic
+ "$(TEST_HC)" $(EXTRA_HC_OPTS) -package-db $(LOCAL_PKGCONF) --make prog -o progdynamic -dynamic -osuf dyn_o -hisuf dyn_hi
# Both should run, giving their respective outputs
echo static
diff --git a/testsuite/tests/driver/fully-static/Hello.hs b/testsuite/tests/driver/fully-static/Hello.hs
new file mode 100644
index 000000000000..56109fa8bfa3
--- /dev/null
+++ b/testsuite/tests/driver/fully-static/Hello.hs
@@ -0,0 +1,3 @@
+import Test
+
+main = print test
diff --git a/testsuite/tests/driver/fully-static/Makefile b/testsuite/tests/driver/fully-static/Makefile
new file mode 100644
index 000000000000..0a23c765310c
--- /dev/null
+++ b/testsuite/tests/driver/fully-static/Makefile
@@ -0,0 +1,19 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+LOCAL_PKGCONF=package.conf.d
+
+clean:
+ rm -f test/*.o test/*.hi test/*.a *.o *.hi Hello
+ rm -rf $(LOCAL_PKGCONF)
+
+.PHONY: fully-static
+fully-static:
+ @rm -rf $(LOCAL_PKGCONF)
+ "$(TEST_HC)" $(TEST_HC_OPTS) -this-unit-id test-1.0 -c test/Test.hs -staticlib -o test/libtest-1.0.a
+ "$(GHC_PKG)" init $(LOCAL_PKGCONF)
+ "$(GHC_PKG)" --no-user-package-db -f $(LOCAL_PKGCONF) register test/test.pkg -v0
+ "$(TEST_HC)" $(TEST_HC_OPTS) --make -fully-static -hide-all-packages -package-db $(LOCAL_PKGCONF)/ -package base -package-id test-1.0 Hello.hs
+ ./Hello
+ ldd Hello 2>&1 | grep -q "Not a valid dynamic program"
diff --git a/testsuite/tests/driver/fully-static/all.T b/testsuite/tests/driver/fully-static/all.T
new file mode 100644
index 000000000000..19f4346e591a
--- /dev/null
+++ b/testsuite/tests/driver/fully-static/all.T
@@ -0,0 +1,6 @@
+test('fully-static',
+ [ unless(is_musl(), skip)
+ , extra_files(['Hello.hs', 'test/'])
+ ],
+ makefile_test,
+ [])
diff --git a/testsuite/tests/driver/fully-static/fully-static.stdout b/testsuite/tests/driver/fully-static/fully-static.stdout
new file mode 100644
index 000000000000..3a437b9a5231
--- /dev/null
+++ b/testsuite/tests/driver/fully-static/fully-static.stdout
@@ -0,0 +1,3 @@
+[1 of 2] Compiling Main ( Hello.hs, Hello.o )
+[2 of 2] Linking Hello
+42
diff --git a/testsuite/tests/driver/fully-static/test/Test.hs b/testsuite/tests/driver/fully-static/test/Test.hs
new file mode 100644
index 000000000000..b4d7f27dce73
--- /dev/null
+++ b/testsuite/tests/driver/fully-static/test/Test.hs
@@ -0,0 +1,4 @@
+module Test where
+
+test :: Int
+test = 42
diff --git a/testsuite/tests/driver/fully-static/test/test.pkg b/testsuite/tests/driver/fully-static/test/test.pkg
new file mode 100644
index 000000000000..3efc00b02a91
--- /dev/null
+++ b/testsuite/tests/driver/fully-static/test/test.pkg
@@ -0,0 +1,9 @@
+name: test
+version: 1.0
+id: test-1.0
+key: test-1.0
+exposed-modules: Test
+import-dirs: ${pkgroot}/test
+library-dirs-static: ${pkgroot}/test
+extra-libraries-static: test-1.0
+exposed: True
diff --git a/testsuite/tests/driver/mostly-static/Hello.hs b/testsuite/tests/driver/mostly-static/Hello.hs
new file mode 100644
index 000000000000..c3586c6eb8ba
--- /dev/null
+++ b/testsuite/tests/driver/mostly-static/Hello.hs
@@ -0,0 +1,5 @@
+foreign import ccall "my_func" c_my_func :: IO Int
+
+main = do
+ x <- c_my_func
+ print x
diff --git a/testsuite/tests/driver/mostly-static/Makefile b/testsuite/tests/driver/mostly-static/Makefile
new file mode 100644
index 000000000000..9146a29bc874
--- /dev/null
+++ b/testsuite/tests/driver/mostly-static/Makefile
@@ -0,0 +1,29 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+UNAME := $(shell uname)
+ifeq ($(UNAME), Darwin)
+ LDD := otool -L
+else
+ LDD := ldd
+endif
+
+
+LOCAL_PKGCONF=package.conf.d
+
+clean:
+ rm -f test/*.o test/*.hi test/*.a *.o *.hi Hello
+ rm -rf $(LOCAL_PKGCONF)
+
+.PHONY: mostly-static
+mostly-static:
+ @rm -rf $(LOCAL_PKGCONF)
+ "$(TEST_CC)" -c "test/test.c" -o "test/test.o"
+ "$(AR)" qc "test/libtest-1.0.a" "test/test.o"
+ "$(RANLIB)" "test/libtest-1.0.a"
+ "$(GHC_PKG)" init $(LOCAL_PKGCONF)
+ "$(GHC_PKG)" --no-user-package-db -f $(LOCAL_PKGCONF) register test/test.pkg -v0
+ "$(TEST_HC)" $(TEST_HC_OPTS) --make -static-external -exclude-static-external=c,m,rt,dl,pthread,stdc++,atomic,gmp,ffi,iconv,wsock32,gdi32,winmm,dbghelp,psapi,user32,shell32,mingw32,kernel32,advapi32,mingwex,ws2_32,shlwapi,ole32,rpcrt4,ntdll,ucrt -hide-all-packages -package-db $(LOCAL_PKGCONF)/ -package base -package-id test-1.0 Hello.hs
+ ./Hello
+ $(LDD) Hello | grep libtest || true
diff --git a/testsuite/tests/driver/mostly-static/all.T b/testsuite/tests/driver/mostly-static/all.T
new file mode 100644
index 000000000000..627f6026c120
--- /dev/null
+++ b/testsuite/tests/driver/mostly-static/all.T
@@ -0,0 +1 @@
+test('mostly-static', [extra_files(['Hello.hs', 'test/'])], makefile_test, [])
diff --git a/testsuite/tests/driver/mostly-static/mostly-static.stdout b/testsuite/tests/driver/mostly-static/mostly-static.stdout
new file mode 100644
index 000000000000..3a437b9a5231
--- /dev/null
+++ b/testsuite/tests/driver/mostly-static/mostly-static.stdout
@@ -0,0 +1,3 @@
+[1 of 2] Compiling Main ( Hello.hs, Hello.o )
+[2 of 2] Linking Hello
+42
diff --git a/testsuite/tests/driver/mostly-static/test/test.c b/testsuite/tests/driver/mostly-static/test/test.c
new file mode 100644
index 000000000000..3026f3015f33
--- /dev/null
+++ b/testsuite/tests/driver/mostly-static/test/test.c
@@ -0,0 +1,3 @@
+int my_func(void) {
+ return 42;
+}
\ No newline at end of file
diff --git a/testsuite/tests/driver/mostly-static/test/test.h b/testsuite/tests/driver/mostly-static/test/test.h
new file mode 100644
index 000000000000..e578c7bada07
--- /dev/null
+++ b/testsuite/tests/driver/mostly-static/test/test.h
@@ -0,0 +1 @@
+int my_func(void);
\ No newline at end of file
diff --git a/testsuite/tests/driver/mostly-static/test/test.pkg b/testsuite/tests/driver/mostly-static/test/test.pkg
new file mode 100644
index 000000000000..a4422f5cfade
--- /dev/null
+++ b/testsuite/tests/driver/mostly-static/test/test.pkg
@@ -0,0 +1,10 @@
+name: test
+version: 1.0
+id: test-1.0
+key: test-1.0
+import-dirs: ${pkgroot}/test
+include-dirs: ${pkgroot}/test
+includes: test.h
+library-dirs-static: ${pkgroot}/test
+extra-libraries-static: test-1.0
+exposed: True
diff --git a/testsuite/tests/driver/recomp007/Makefile b/testsuite/tests/driver/recomp007/Makefile
index e38112e84641..d9cd4b6fa047 100644
--- a/testsuite/tests/driver/recomp007/Makefile
+++ b/testsuite/tests/driver/recomp007/Makefile
@@ -14,17 +14,17 @@ clean:
recomp007:
$(MAKE) -s --no-print-directory clean
"$(GHC_PKG)" init $(LOCAL_PKGCONF)
- "$(TEST_HC)" -v0 --make Setup.hs
+ "$(TEST_HC)" $(EXTRA_HC_OPTS) -v0 --make Setup.hs
$(MAKE) -s --no-print-directory prep.a1
$(MAKE) -s --no-print-directory prep.b
./b/dist/build/test/test
"$(GHC_PKG)" unregister --package-db=$(LOCAL_PKGCONF) a-1.0
$(MAKE) -s --no-print-directory prep.a2
- cd b && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) --ipid b
+ cd b && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --ghc-options="$(EXTRA_HC_OPTS) " --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) --ipid b
cd b && ../Setup build
./b/dist/build/test/test
prep.%:
- cd $* && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) --ipid $*
+ cd $* && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --ghc-options="$(EXTRA_HC_OPTS) " --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) --ipid $*
cd $* && ../Setup build -v0
cd $* && ../Setup register -v0 --inplace
diff --git a/testsuite/tests/driver/recompChangedPackage/Makefile b/testsuite/tests/driver/recompChangedPackage/Makefile
index 4583d6649e42..00bf6b8c01a8 100644
--- a/testsuite/tests/driver/recompChangedPackage/Makefile
+++ b/testsuite/tests/driver/recompChangedPackage/Makefile
@@ -17,7 +17,7 @@ recompChangedPackage:
(cd q; $(SETUP) register)
cp PLib1.hs PLib.hs
- '$(TEST_HC)' -package-db tmp.d Main.hs
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -package-db tmp.d Main.hs
./Main
# Now add PLib to q.. Main should be recompiled
@@ -33,5 +33,5 @@ recompChangedPackage:
(cd q; $(SETUP) copy)
(cd q; $(SETUP) register)
- '$(TEST_HC)' -package-db tmp.d Main.hs
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -package-db tmp.d Main.hs
./Main
diff --git a/testsuite/tests/driver/t23724/Makefile b/testsuite/tests/driver/t23724/Makefile
index 72499efcd230..76ad2bc76952 100644
--- a/testsuite/tests/driver/t23724/Makefile
+++ b/testsuite/tests/driver/t23724/Makefile
@@ -3,7 +3,7 @@ include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
SETUP='$(PWD)/Setup' -v0
-CONFIGURE=$(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(filter-out -rtsopts,$(TEST_HC_OPTS))' --package-db='$(PWD)/tmp.d' --prefix='$(PWD)/inst' $(VANILLA) $(PROF) $(DYN) --disable-optimisation
+CONFIGURE=$(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --with-ghc-pkg='$(GHC_PKG)' --ghc-options='$(filter-out -rtsopts,$(TEST_HC_OPTS))' --package-db='$(PWD)/tmp.d' --prefix='$(PWD)/inst' $(VANILLA) $(PROF) $(DYN) --disable-optimisation
recompPkgLink:
'$(GHC_PKG)' init tmp.d
diff --git a/testsuite/tests/dynlibs/Makefile b/testsuite/tests/dynlibs/Makefile
index f557a1238a14..ad2c3bd643cb 100644
--- a/testsuite/tests/dynlibs/Makefile
+++ b/testsuite/tests/dynlibs/Makefile
@@ -59,7 +59,7 @@ T5373:
.PHONY: T13702
T13702:
- '$(TEST_HC)' -v0 -dynamic -rdynamic -fPIC -pie T13702.hs
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -v0 -dynamic -rdynamic -fPIC -pie T13702.hs
./T13702
.PHONY: T18072
@@ -80,7 +80,7 @@ T18072debug:
-dynamic -fPIC -c T18072.hs
'$(TEST_HC)' $(filter-out -rtsopts,$(TEST_HC_OPTS)) -v0 -outputdir T18072debug \
-dynamic -shared -flink-rts -debug T18072debug/T18072.o -o T18072debug/T18072.so
- ldd T18072debug/T18072.so | grep libHSrts | grep _debug >/dev/null
+ ldd T18072debug/T18072.so | grep libHSrts | grep -e -debug- >/dev/null
.PHONY: T18072static
T18072static:
diff --git a/testsuite/tests/dynlibs/T19350/Makefile b/testsuite/tests/dynlibs/T19350/Makefile
index 6eac01756e3d..5801b5e8642a 100644
--- a/testsuite/tests/dynlibs/T19350/Makefile
+++ b/testsuite/tests/dynlibs/T19350/Makefile
@@ -6,15 +6,15 @@ LOCAL_PKGCONF=local.package.conf
T19350:
echo "Building libhello..."
- '$(TEST_HC)' -fPIC -c clib/lib.c -o clib/lib.o
- '$(TEST_HC)' -shared -no-hs-main clib/lib.o -o clib/libhello$(dllext)
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -fPIC -c clib/lib.c -o clib/lib.o
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -shared -no-hs-main clib/lib.o -o clib/libhello$(dllext)
rm -Rf $(LOCAL_PKGCONF)
"$(GHC_PKG)" init $(LOCAL_PKGCONF)
echo "Building T19350-lib..."
- cd lib && '$(TEST_HC)' -package Cabal Setup.hs
- x="$$(pwd)//clib" && cd lib && ./Setup configure -v0 --extra-lib-dirs="$$x" --extra-lib-dirs="$$x-install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) --disable-library-vanilla --enable-shared
+ cd lib && '$(TEST_HC)' $(EXTRA_HC_OPTS) -package Cabal Setup.hs
+ x="$$(pwd)//clib" && cd lib && ./Setup configure -v0 --extra-lib-dirs="$$x" --extra-lib-dirs="$$x-install" --with-compiler="$(TEST_HC)" --ghc-options="$(EXTRA_HC_OPTS) " --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) --disable-library-vanilla --enable-shared
cd lib && ./Setup build
cd lib && ./Setup register --inplace
diff --git a/testsuite/tests/ghc-api/T20757.hs b/testsuite/tests/ghc-api/T20757.hs
deleted file mode 100644
index b6af7815e886..000000000000
--- a/testsuite/tests/ghc-api/T20757.hs
+++ /dev/null
@@ -1,6 +0,0 @@
-module Main where
-
-import GHC.SysTools.BaseDir
-
-main :: IO ()
-main = findToolDir False "/" >>= print
diff --git a/testsuite/tests/ghc-api/T20757.stderr b/testsuite/tests/ghc-api/T20757.stderr
deleted file mode 100644
index ef11c47c4286..000000000000
--- a/testsuite/tests/ghc-api/T20757.stderr
+++ /dev/null
@@ -1,7 +0,0 @@
-T20757.exe: Uncaught exception ghc-9.13-inplace:GHC.Utils.Panic.GhcException:
-
-could not detect mingw toolchain in the following paths: ["/..//mingw","/..//..//mingw","/..//..//..//mingw"]
-
-HasCallStack backtrace:
- throwIO, called at compiler/GHC/Utils/Panic.hs:184:23 in ghc--:GHC.Utils.Panic
-
diff --git a/testsuite/tests/ghc-api/all.T b/testsuite/tests/ghc-api/all.T
index 564948bf56f5..fb4e9f804189 100644
--- a/testsuite/tests/ghc-api/all.T
+++ b/testsuite/tests/ghc-api/all.T
@@ -61,9 +61,6 @@ test('T19156', [ extra_run_opts('"' + config.libdir + '"')
],
compile_and_run,
['-package ghc'])
-test('T20757', [unless(opsys('mingw32'), skip), exit_code(1), normalise_version('ghc')],
- compile_and_run,
- ['-package ghc'])
test('PrimOpEffect_Sanity', normal, compile_and_run, ['-Wall -Werror -package ghc'])
test('T25577', [ extra_run_opts(f'"{config.libdir}"')
# doesn't work in wasm/js due to lack of pipe(2)
diff --git a/testsuite/tests/ghci/T13786/all.T b/testsuite/tests/ghci/T13786/all.T
index 6701a4dfbfb2..0b7e4d8d4663 100644
--- a/testsuite/tests/ghci/T13786/all.T
+++ b/testsuite/tests/ghci/T13786/all.T
@@ -1,4 +1,4 @@
test('T13786',
- [when(unregisterised(), fragile(17018)), req_c, when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))],
+ [when(unregisterised() or platform('x86_64-apple-darwin'), fragile(17018)), req_c],
makefile_test, [])
diff --git a/testsuite/tests/ghci/linking/Makefile b/testsuite/tests/ghci/linking/Makefile
index d239af05e98f..0d147a061de6 100644
--- a/testsuite/tests/ghci/linking/Makefile
+++ b/testsuite/tests/ghci/linking/Makefile
@@ -9,7 +9,7 @@ include $(TOP)/mk/test.mk
ghcilink001 :
$(RM) -rf dir001
mkdir dir001
- "$(TEST_HC)" -c f.c -o dir001/foo.o
+ "$(TEST_HC)" $(EXTRA_HC_OPTS) -c f.c -o dir001/foo.o
"$(AR)" cqs dir001/libfoo.a dir001/foo.o
echo "test" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) -Ldir001 -lfoo TestLink.hs
@@ -28,8 +28,8 @@ endif
ghcilink002 :
$(RM) -rf dir002
mkdir dir002
- "$(TEST_HC)" -c -dynamic f.c -o dir002/foo.o
- "$(TEST_HC)" -no-auto-link-packages -shared -v0 -o dir002/$(call DLL,foo) dir002/foo.o
+ "$(TEST_HC)" $(EXTRA_HC_OPTS) -c -dynamic f.c -o dir002/foo.o
+ "$(TEST_HC)" $(EXTRA_HC_OPTS) -no-auto-link-packages -shared -v0 -o dir002/$(call DLL,foo) dir002/foo.o
echo "test" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) -Ldir002 -lfoo TestLink.hs
# Test 3: ghci -package system-cxx-std-lib
@@ -64,7 +64,7 @@ ghcilink004 :
'$(GHC_PKG)' init $(LOCAL_PKGCONF004)
'$(GHC_PKG)' --no-user-package-db -f $(LOCAL_PKGCONF004) register $(PKG004) -v0
#
- "$(TEST_HC)" -c f.c -o dir004/foo.o
+ "$(TEST_HC)" $(EXTRA_HC_OPTS) -c f.c -o dir004/foo.o
"$(AR)" cqs dir004/libfoo.a dir004/foo.o
echo "test" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) -package-db $(LOCAL_PKGCONF004) -package test TestLink.hs
@@ -92,8 +92,8 @@ ghcilink005 :
'$(GHC_PKG)' init $(LOCAL_PKGCONF005)
'$(GHC_PKG)' --no-user-package-db -f $(LOCAL_PKGCONF005) register $(PKG005) -v0
#
- "$(TEST_HC)" -c -dynamic f.c -o dir005/foo.o
- "$(TEST_HC)" -no-auto-link-packages -shared -o dir005/$(call DLL,foo) dir005/foo.o
+ "$(TEST_HC)" $(EXTRA_HC_OPTS) -c -dynamic f.c -o dir005/foo.o
+ "$(TEST_HC)" $(EXTRA_HC_OPTS) -no-auto-link-packages -shared -o dir005/$(call DLL,foo) dir005/foo.o
echo "test" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) -package-db $(LOCAL_PKGCONF005) -package test TestLink.hs
# Test 6:
@@ -120,25 +120,25 @@ ghcilink006 :
.PHONY: T3333
T3333:
- "$(TEST_HC)" -c T3333.c -o T3333.o
+ "$(TEST_HC)" $(EXTRA_HC_OPTS) -c T3333.c -o T3333.o
echo "weak_test 10" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) T3333.hs T3333.o
.PHONY: T11531
T11531:
- "$(TEST_HC)" -dynamic -fPIC -c T11531.c -o T11531.o
+ "$(TEST_HC)" $(EXTRA_HC_OPTS) -dynamic -fPIC -c T11531.c -o T11531.o
- echo ":q" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) T11531.o T11531.hs 2>&1 | sed -e '/undefined symbol:/d' 1>&2
.PHONY: T14708
T14708:
$(RM) -rf T14708scratch
mkdir T14708scratch
- "$(TEST_HC)" -c add.c -o T14708scratch/add.o
+ "$(TEST_HC)" $(EXTRA_HC_OPTS) -c add.c -o T14708scratch/add.o
"$(AR)" cqs T14708scratch/libadd.a T14708scratch/add.o
-"$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) -LT14708scratch -ladd T14708.hs
.PHONY: T15729
T15729:
- "$(TEST_HC)" -fPIC -c T15729.c -o bss.o
+ "$(TEST_HC)" $(EXTRA_HC_OPTS) -fPIC -c T15729.c -o bss.o
echo "main" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) bss.o T15729.hs
.PHONY: big-obj
@@ -148,5 +148,5 @@ big-obj:
.PHONY: T25155
T25155:
- '$(TEST_HC)' T25155_iserv_main.c T25155_iserv.hs -package ghci -no-hs-main -v0 -o T25155_iserv
- '$(TEST_HC)' -fexternal-interpreter -pgmi ./T25155_iserv -v0 T25155.hs
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) T25155_iserv_main.c T25155_iserv.hs -package ghci -no-hs-main -v0 -o T25155_iserv
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -fexternal-interpreter -pgmi ./T25155_iserv -v0 T25155.hs
diff --git a/testsuite/tests/ghci/linking/T11531.stderr b/testsuite/tests/ghci/linking/T11531.stderr
index eb8c1545985f..f318949f05f2 100644
--- a/testsuite/tests/ghci/linking/T11531.stderr
+++ b/testsuite/tests/ghci/linking/T11531.stderr
@@ -7,5 +7,5 @@ the missing library using the -L/path/to/object/dir and -lmissinglibname
flags, or simply by naming the relevant files on the GHCi command line.
Alternatively, this link failure might indicate a bug in GHCi.
If you suspect the latter, please report this as a GHC bug:
- https://www.haskell.org/ghc/reportabug
+ https://github.com/stable-haskell/ghc/issues
diff --git a/testsuite/tests/ghci/linking/T25240/all.T b/testsuite/tests/ghci/linking/T25240/all.T
index d5cf63c3597f..0083c227772b 100644
--- a/testsuite/tests/ghci/linking/T25240/all.T
+++ b/testsuite/tests/ghci/linking/T25240/all.T
@@ -1,3 +1,3 @@
# skip on darwin because the leading underscores will make the test fail
-test('T25240', [when(leading_underscore(),skip), req_interp, extra_files(['T25240a.hs'])],
+test('T25240', [when(leading_underscore(),skip), fragile(0), req_interp, extra_files(['T25240a.hs'])],
makefile_test, ['T25240'])
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..a51a4e5b2e91 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',
@@ -34,9 +32,32 @@ test('T10955dyn',
],
makefile_test, ['compile_libAB_dyn'])
+# Note [T10458 and musl dynamic linking]
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# T10458 tests FFI with a dynamically loaded C library. When GHC is built
+# with DYNAMIC=1, GHCi's dynLoadObjs creates a temporary .so file that
+# links against the test's libAS.so using -rpath.
+#
+# Modern linkers emit DT_RUNPATH (not DT_RPATH) by default. Per the ELF ABI
+# specification, DT_RUNPATH is non-transitive: "One object's DT_RUNPATH
+# entry does not affect the search for any other object's dependencies."
+#
+# - glibc: Has non-spec-compliant "forgiving" behavior that sometimes
+# searches RUNPATH transitively
+# - musl: Correctly follows the ELF spec - RUNPATH is not inherited
+#
+# This test is skipped on musl with dynamic GHC because the ELF-compliant
+# behavior makes the test fail, and this is not a bug in GHC or musl.
+# The test still runs on:
+# - All platforms with static GHC (RTS linker used, no dlopen)
+# - glibc with dynamic GHC (non-compliant but working)
+#
+# See: https://bugs.launchpad.net/bugs/1253638
test('T10458',
[extra_files(['A.c']),
unless(doing_ghci, skip),
+ # Skip on musl with dynamic GHC: DT_RUNPATH is non-transitive per ELF spec
+ when(is_musl() and config.ghc_dynamic, skip),
pre_cmd('$MAKE -s --no-print-directory compile_libT10458'),
extra_hc_opts('-L"$PWD/T10458dir" -lAS')],
ghci_script, ['T10458.script'])
diff --git a/testsuite/tests/ghci/prog-mhu005/Makefile b/testsuite/tests/ghci/prog-mhu005/Makefile
index 0b94f46b7068..6da6a21e271c 100644
--- a/testsuite/tests/ghci/prog-mhu005/Makefile
+++ b/testsuite/tests/ghci/prog-mhu005/Makefile
@@ -5,3 +5,27 @@ include $(TOP)/mk/test.mk
.PHONY: prog-mhu005a
prog-mhu005a:
'$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) -v0 -fno-load-initial-targets -unit @unitA -unit @unitB < prog-mhu005a.script
+
+.PHONY: prog-mhu005b
+prog-mhu005b:
+ '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) -v0 -fimport-loaded-targets -unit @unitA -unit @unitB < prog-mhu005b.script
+
+.PHONY: prog-mhu005c
+prog-mhu005c:
+ '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) -v0 -fno-import-loaded-targets -unit @unitA -unit @unitB < prog-mhu005c.script
+
+.PHONY: prog-mhu005d
+prog-mhu005d:
+ '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) -v0 -fno-load-initial-targets -fno-import-loaded-targets -unit @unitA -unit @unitB < prog-mhu005d.script
+
+.PHONY: prog-mhu005e
+prog-mhu005e:
+ '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) -v0 -fno-load-initial-targets -fimport-loaded-targets -unit @unitA -unit @unitB < prog-mhu005e.script
+
+.PHONY: prog-mhu005f
+prog-mhu005f:
+ '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) -v0 -unit @unitA -unit @unitB < prog-mhu005f.script
+
+.PHONY: prog-mhu005g
+prog-mhu005g:
+ '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) -v0 -fno-load-initial-targets -fimport-loaded-targets -unit @unitA -unit @unitB < prog-mhu005g.script
diff --git a/testsuite/tests/ghci/prog-mhu005/all.T b/testsuite/tests/ghci/prog-mhu005/all.T
index 87aaecd61bba..b93188fce050 100644
--- a/testsuite/tests/ghci/prog-mhu005/all.T
+++ b/testsuite/tests/ghci/prog-mhu005/all.T
@@ -1,6 +1,44 @@
+
+proj_files = extra_files(['a/', 'b/', 'unitA', 'unitB'])
+
test('prog-mhu005a',
- [extra_files(['a/', 'b/', 'unitA', 'unitB',
- ]),
+ [proj_files,
cmd_prefix('ghciWayFlags=' + config.ghci_way_flags),
req_interp],
makefile_test, ['prog-mhu005a'])
+
+test('prog-mhu005b',
+ [proj_files,
+ cmd_prefix('ghciWayFlags=' + config.ghci_way_flags),
+ req_interp],
+ makefile_test, ['prog-mhu005b'])
+
+test('prog-mhu005c',
+ [proj_files,
+ cmd_prefix('ghciWayFlags=' + config.ghci_way_flags),
+ req_interp],
+ makefile_test, ['prog-mhu005c'])
+
+test('prog-mhu005d',
+ [proj_files,
+ cmd_prefix('ghciWayFlags=' + config.ghci_way_flags),
+ req_interp],
+ makefile_test, ['prog-mhu005d'])
+
+test('prog-mhu005e',
+ [proj_files,
+ cmd_prefix('ghciWayFlags=' + config.ghci_way_flags),
+ req_interp],
+ makefile_test, ['prog-mhu005e'])
+
+test('prog-mhu005f',
+ [proj_files,
+ cmd_prefix('ghciWayFlags=' + config.ghci_way_flags),
+ req_interp],
+ makefile_test, ['prog-mhu005f'])
+
+test('prog-mhu005g',
+ [proj_files,
+ cmd_prefix('ghciWayFlags=' + config.ghci_way_flags),
+ req_interp],
+ makefile_test, ['prog-mhu005g'])
diff --git a/testsuite/tests/ghci/prog-mhu005/prog-mhu005b.script b/testsuite/tests/ghci/prog-mhu005/prog-mhu005b.script
new file mode 100644
index 000000000000..95f46e36b82f
--- /dev/null
+++ b/testsuite/tests/ghci/prog-mhu005/prog-mhu005b.script
@@ -0,0 +1,5 @@
+:show imports
+"Can access all public and private symbols of A and B"
+baz
+foobar
+foo
diff --git a/testsuite/tests/ghci/prog-mhu005/prog-mhu005b.stdout b/testsuite/tests/ghci/prog-mhu005/prog-mhu005b.stdout
new file mode 100644
index 000000000000..285dea546b7e
--- /dev/null
+++ b/testsuite/tests/ghci/prog-mhu005/prog-mhu005b.stdout
@@ -0,0 +1,6 @@
+:module +*B -- added automatically
+:module +*A -- added automatically
+"Can access all public and private symbols of A and B"
+68
+18
+50
diff --git a/testsuite/tests/ghci/prog-mhu005/prog-mhu005c.script b/testsuite/tests/ghci/prog-mhu005/prog-mhu005c.script
new file mode 100644
index 000000000000..49259812900b
--- /dev/null
+++ b/testsuite/tests/ghci/prog-mhu005/prog-mhu005c.script
@@ -0,0 +1,5 @@
+:show imports
+"Can access all public and private symbols of B"
+baz
+foobar
+foo
diff --git a/testsuite/tests/ghci/prog-mhu005/prog-mhu005c.stderr b/testsuite/tests/ghci/prog-mhu005/prog-mhu005c.stderr
new file mode 100644
index 000000000000..da14cb0dfb41
--- /dev/null
+++ b/testsuite/tests/ghci/prog-mhu005/prog-mhu005c.stderr
@@ -0,0 +1,4 @@
+:3:1: error: [GHC-88464] Variable not in scope: baz
+
+:4:1: error: [GHC-88464] Variable not in scope: foobar
+
diff --git a/testsuite/tests/ghci/prog-mhu005/prog-mhu005c.stdout b/testsuite/tests/ghci/prog-mhu005/prog-mhu005c.stdout
new file mode 100644
index 000000000000..c0541af70cac
--- /dev/null
+++ b/testsuite/tests/ghci/prog-mhu005/prog-mhu005c.stdout
@@ -0,0 +1,3 @@
+:module +*B -- added automatically
+"Can access all public and private symbols of B"
+50
diff --git a/testsuite/tests/ghci/prog-mhu005/prog-mhu005d.script b/testsuite/tests/ghci/prog-mhu005/prog-mhu005d.script
new file mode 100644
index 000000000000..66d6a2e3f08c
--- /dev/null
+++ b/testsuite/tests/ghci/prog-mhu005/prog-mhu005d.script
@@ -0,0 +1,5 @@
+:show imports
+"No module is imported"
+baz
+foobar
+foo
diff --git a/testsuite/tests/ghci/prog-mhu005/prog-mhu005d.stderr b/testsuite/tests/ghci/prog-mhu005/prog-mhu005d.stderr
new file mode 100644
index 000000000000..5d447ff61aa6
--- /dev/null
+++ b/testsuite/tests/ghci/prog-mhu005/prog-mhu005d.stderr
@@ -0,0 +1,6 @@
+:3:1: error: [GHC-88464] Variable not in scope: baz
+
+:4:1: error: [GHC-88464] Variable not in scope: foobar
+
+:5:1: error: [GHC-88464] Variable not in scope: foo
+
diff --git a/testsuite/tests/ghci/prog-mhu005/prog-mhu005d.stdout b/testsuite/tests/ghci/prog-mhu005/prog-mhu005d.stdout
new file mode 100644
index 000000000000..90189697182b
--- /dev/null
+++ b/testsuite/tests/ghci/prog-mhu005/prog-mhu005d.stdout
@@ -0,0 +1,2 @@
+import (implicit) Prelude -- implicit
+"No module is imported"
diff --git a/testsuite/tests/ghci/prog-mhu005/prog-mhu005e.script b/testsuite/tests/ghci/prog-mhu005/prog-mhu005e.script
new file mode 100644
index 000000000000..66d6a2e3f08c
--- /dev/null
+++ b/testsuite/tests/ghci/prog-mhu005/prog-mhu005e.script
@@ -0,0 +1,5 @@
+:show imports
+"No module is imported"
+baz
+foobar
+foo
diff --git a/testsuite/tests/ghci/prog-mhu005/prog-mhu005e.stderr b/testsuite/tests/ghci/prog-mhu005/prog-mhu005e.stderr
new file mode 100644
index 000000000000..5d447ff61aa6
--- /dev/null
+++ b/testsuite/tests/ghci/prog-mhu005/prog-mhu005e.stderr
@@ -0,0 +1,6 @@
+:3:1: error: [GHC-88464] Variable not in scope: baz
+
+:4:1: error: [GHC-88464] Variable not in scope: foobar
+
+:5:1: error: [GHC-88464] Variable not in scope: foo
+
diff --git a/testsuite/tests/ghci/prog-mhu005/prog-mhu005e.stdout b/testsuite/tests/ghci/prog-mhu005/prog-mhu005e.stdout
new file mode 100644
index 000000000000..90189697182b
--- /dev/null
+++ b/testsuite/tests/ghci/prog-mhu005/prog-mhu005e.stdout
@@ -0,0 +1,2 @@
+import (implicit) Prelude -- implicit
+"No module is imported"
diff --git a/testsuite/tests/ghci/prog-mhu005/prog-mhu005f.script b/testsuite/tests/ghci/prog-mhu005/prog-mhu005f.script
new file mode 100644
index 000000000000..251fd98ed904
--- /dev/null
+++ b/testsuite/tests/ghci/prog-mhu005/prog-mhu005f.script
@@ -0,0 +1,5 @@
+:show imports
+"By default, only one modules is imported"
+baz
+foobar
+foo
diff --git a/testsuite/tests/ghci/prog-mhu005/prog-mhu005f.stderr b/testsuite/tests/ghci/prog-mhu005/prog-mhu005f.stderr
new file mode 100644
index 000000000000..da14cb0dfb41
--- /dev/null
+++ b/testsuite/tests/ghci/prog-mhu005/prog-mhu005f.stderr
@@ -0,0 +1,4 @@
+:3:1: error: [GHC-88464] Variable not in scope: baz
+
+:4:1: error: [GHC-88464] Variable not in scope: foobar
+
diff --git a/testsuite/tests/ghci/prog-mhu005/prog-mhu005f.stdout b/testsuite/tests/ghci/prog-mhu005/prog-mhu005f.stdout
new file mode 100644
index 000000000000..5628eb821955
--- /dev/null
+++ b/testsuite/tests/ghci/prog-mhu005/prog-mhu005f.stdout
@@ -0,0 +1,3 @@
+:module +*B -- added automatically
+"By default, only one modules is imported"
+50
diff --git a/testsuite/tests/ghci/prog-mhu005/prog-mhu005g.script b/testsuite/tests/ghci/prog-mhu005/prog-mhu005g.script
new file mode 100644
index 000000000000..742c82ff60d1
--- /dev/null
+++ b/testsuite/tests/ghci/prog-mhu005/prog-mhu005g.script
@@ -0,0 +1,24 @@
+:show imports
+"No module loaded"
+baz
+foobar
+foo
+"After reloading, all modules are added to the context"
+:reload
+:show imports
+baz
+foobar
+foo
+"Unload everything again"
+:reload none
+:show imports
+baz
+foobar
+foo
+"Load up one module, only B is in scope"
+:reload B
+:show imports
+baz
+foobar
+foo
+
diff --git a/testsuite/tests/ghci/prog-mhu005/prog-mhu005g.stderr b/testsuite/tests/ghci/prog-mhu005/prog-mhu005g.stderr
new file mode 100644
index 000000000000..f74b388b9688
--- /dev/null
+++ b/testsuite/tests/ghci/prog-mhu005/prog-mhu005g.stderr
@@ -0,0 +1,18 @@
+:3:1: error: [GHC-88464] Variable not in scope: baz
+
+:4:1: error: [GHC-88464] Variable not in scope: foobar
+
+:5:1: error: [GHC-88464] Variable not in scope: foo
+
+:15:1: error: [GHC-88464] Variable not in scope: baz
+
+:16:1: error: [GHC-88464]
+ Variable not in scope: foobar
+
+:17:1: error: [GHC-88464] Variable not in scope: foo
+
+:21:1: error: [GHC-88464] Variable not in scope: baz
+
+:22:1: error: [GHC-88464]
+ Variable not in scope: foobar
+
diff --git a/testsuite/tests/ghci/prog-mhu005/prog-mhu005g.stdout b/testsuite/tests/ghci/prog-mhu005/prog-mhu005g.stdout
new file mode 100644
index 000000000000..7ebbe128e1d2
--- /dev/null
+++ b/testsuite/tests/ghci/prog-mhu005/prog-mhu005g.stdout
@@ -0,0 +1,13 @@
+import (implicit) Prelude -- implicit
+"No module loaded"
+"After reloading, all modules are added to the context"
+:module +*B -- added automatically
+:module +*A -- added automatically
+68
+18
+50
+"Unload everything again"
+import (implicit) Prelude -- implicit
+"Load up one module, only B is in scope"
+:module +*B -- added automatically
+50
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/prog022/Makefile b/testsuite/tests/ghci/prog022/Makefile
index 30840bfdfbb0..0a727f0b16f2 100644
--- a/testsuite/tests/ghci/prog022/Makefile
+++ b/testsuite/tests/ghci/prog022/Makefile
@@ -2,9 +2,26 @@ TOP=../../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
-.PHONY: ghci.prog022a ghci.prog022b
+.PHONY: ghci.prog022a
ghci.prog022a:
'$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) -v0 -fno-load-initial-targets -i -i. A B < ghci.prog022a.script
+.PHONY: ghci.prog022b
ghci.prog022b:
'$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) -v0 -fno-load-initial-targets -i -i. A B < ghci.prog022b.script
+
+.PHONY: ghci.prog022c
+ghci.prog022c:
+ '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) -v0 -fimport-loaded-targets -i -i. A B < ghci.prog022c.script
+
+.PHONY: ghci.prog022d
+ghci.prog022d:
+ '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) -v0 -fno-load-initial-targets -fimport-loaded-targets -i -i. A B < ghci.prog022d.script
+
+.PHONY: ghci.prog022e
+ghci.prog022e:
+ '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) -v0 -fimport-loaded-targets -i -i. A B < ghci.prog022e.script
+
+.PHONY: ghci.prog022f
+ghci.prog022f:
+ '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) -v0 -fno-load-initial-targets -fimport-loaded-targets -i -i. A B < ghci.prog022f.script
diff --git a/testsuite/tests/ghci/prog022/all.T b/testsuite/tests/ghci/prog022/all.T
index 6a09fc16583f..503cb5c89800 100644
--- a/testsuite/tests/ghci/prog022/all.T
+++ b/testsuite/tests/ghci/prog022/all.T
@@ -10,3 +10,27 @@ test('ghci.prog022b',
extra_files(['A.hs', 'B.hs', 'ghci.prog022b.script'])
],
makefile_test, ['ghci.prog022b'])
+test('ghci.prog022c',
+ [req_interp,
+ cmd_prefix('ghciWayFlags=' + config.ghci_way_flags),
+ extra_files(['A.hs', 'B.hs', 'ghci.prog022c.script'])
+ ],
+ makefile_test, ['ghci.prog022c'])
+test('ghci.prog022d',
+ [req_interp,
+ cmd_prefix('ghciWayFlags=' + config.ghci_way_flags),
+ extra_files(['A.hs', 'B.hs', 'ghci.prog022d.script'])
+ ],
+ makefile_test, ['ghci.prog022d'])
+test('ghci.prog022e',
+ [req_interp,
+ cmd_prefix('ghciWayFlags=' + config.ghci_way_flags),
+ extra_files(['A.hs', 'B.hs', 'ghci.prog022e.script'])
+ ],
+ makefile_test, ['ghci.prog022e'])
+test('ghci.prog022f',
+ [req_interp,
+ cmd_prefix('ghciWayFlags=' + config.ghci_way_flags),
+ extra_files(['A.hs', 'B.hs', 'ghci.prog022f.script'])
+ ],
+ makefile_test, ['ghci.prog022f'])
diff --git a/testsuite/tests/ghci/prog022/ghci.prog022c.script b/testsuite/tests/ghci/prog022/ghci.prog022c.script
new file mode 100644
index 000000000000..a5dccd7eb843
--- /dev/null
+++ b/testsuite/tests/ghci/prog022/ghci.prog022c.script
@@ -0,0 +1,9 @@
+"All modules are star-imported"
+f 5
+g 5
+h 5
+"A is no longer star-imported, thus 'g' is not in scope"
+:m A B
+f 5
+g 5
+h 5
diff --git a/testsuite/tests/ghci/prog022/ghci.prog022c.stderr b/testsuite/tests/ghci/prog022/ghci.prog022c.stderr
new file mode 100644
index 000000000000..8673f684e52c
--- /dev/null
+++ b/testsuite/tests/ghci/prog022/ghci.prog022c.stderr
@@ -0,0 +1,3 @@
+:8:1: error: [GHC-88464]
+ Variable not in scope: g :: t0 -> t
+
diff --git a/testsuite/tests/ghci/prog022/ghci.prog022c.stdout b/testsuite/tests/ghci/prog022/ghci.prog022c.stdout
new file mode 100644
index 000000000000..303e344172ef
--- /dev/null
+++ b/testsuite/tests/ghci/prog022/ghci.prog022c.stdout
@@ -0,0 +1,7 @@
+"All modules are star-imported"
+[5]
+Just 5
+[5]
+"A is no longer star-imported, thus 'g' is not in scope"
+[5]
+[5]
diff --git a/testsuite/tests/ghci/prog022/ghci.prog022d.script b/testsuite/tests/ghci/prog022/ghci.prog022d.script
new file mode 100644
index 000000000000..55599d3aa39c
--- /dev/null
+++ b/testsuite/tests/ghci/prog022/ghci.prog022d.script
@@ -0,0 +1,4 @@
+"No module is star imported"
+f 5
+g 5
+h 5
diff --git a/testsuite/tests/ghci/prog022/ghci.prog022d.stderr b/testsuite/tests/ghci/prog022/ghci.prog022d.stderr
new file mode 100644
index 000000000000..c745c8d31c17
--- /dev/null
+++ b/testsuite/tests/ghci/prog022/ghci.prog022d.stderr
@@ -0,0 +1,9 @@
+:2:1: error: [GHC-88464]
+ Variable not in scope: f :: t0 -> t
+
+:3:1: error: [GHC-88464]
+ Variable not in scope: g :: t0 -> t
+
+:4:1: error: [GHC-88464]
+ Variable not in scope: h :: t0 -> t
+
diff --git a/testsuite/tests/ghci/prog022/ghci.prog022d.stdout b/testsuite/tests/ghci/prog022/ghci.prog022d.stdout
new file mode 100644
index 000000000000..f6d88a26190b
--- /dev/null
+++ b/testsuite/tests/ghci/prog022/ghci.prog022d.stdout
@@ -0,0 +1 @@
+"No module is star imported"
diff --git a/testsuite/tests/ghci/prog022/ghci.prog022e.script b/testsuite/tests/ghci/prog022/ghci.prog022e.script
new file mode 100644
index 000000000000..724f6082d74b
--- /dev/null
+++ b/testsuite/tests/ghci/prog022/ghci.prog022e.script
@@ -0,0 +1,13 @@
+"All modules are star imported"
+:show imports
+:m - A B
+"We can remove the imports"
+:show imports
+"Selectively star import B and then import A"
+"'g' is not in scope"
+:m + *B
+:m + A
+:show imports
+f 5
+g 5
+h 5
diff --git a/testsuite/tests/ghci/prog022/ghci.prog022e.stderr b/testsuite/tests/ghci/prog022/ghci.prog022e.stderr
new file mode 100644
index 000000000000..f47f3e3a9bdd
--- /dev/null
+++ b/testsuite/tests/ghci/prog022/ghci.prog022e.stderr
@@ -0,0 +1,3 @@
+:12:1: error: [GHC-88464]
+ Variable not in scope: g :: t0 -> t
+
diff --git a/testsuite/tests/ghci/prog022/ghci.prog022e.stdout b/testsuite/tests/ghci/prog022/ghci.prog022e.stdout
new file mode 100644
index 000000000000..10b29d78100b
--- /dev/null
+++ b/testsuite/tests/ghci/prog022/ghci.prog022e.stdout
@@ -0,0 +1,11 @@
+"All modules are star imported"
+:module +*A -- added automatically
+:module +*B -- added automatically
+"We can remove the imports"
+import (implicit) Prelude -- implicit
+"Selectively star import B and then import A"
+"'g' is not in scope"
+:module +*B
+import A
+[5]
+[5]
diff --git a/testsuite/tests/ghci/prog022/ghci.prog022f.script b/testsuite/tests/ghci/prog022/ghci.prog022f.script
new file mode 100644
index 000000000000..2a0b8cebe38b
--- /dev/null
+++ b/testsuite/tests/ghci/prog022/ghci.prog022f.script
@@ -0,0 +1,23 @@
+"No module is imported"
+:show imports
+f 5
+g 5
+h 5
+"Reload all modules"
+:reload
+:show imports
+f 5
+g 5
+h 5
+"Unload all modules"
+:reload none
+:show imports
+f 5
+g 5
+h 5
+"Reload up to A"
+:reload A
+:show imports
+f 5
+g 5
+h 5
diff --git a/testsuite/tests/ghci/prog022/ghci.prog022f.stderr b/testsuite/tests/ghci/prog022/ghci.prog022f.stderr
new file mode 100644
index 000000000000..85aa8a37e0b3
--- /dev/null
+++ b/testsuite/tests/ghci/prog022/ghci.prog022f.stderr
@@ -0,0 +1,21 @@
+:3:1: error: [GHC-88464]
+ Variable not in scope: f :: t0 -> t
+
+:4:1: error: [GHC-88464]
+ Variable not in scope: g :: t0 -> t
+
+:5:1: error: [GHC-88464]
+ Variable not in scope: h :: t0 -> t
+
+:15:1: error: [GHC-88464]
+ Variable not in scope: f :: t0 -> t
+
+:16:1: error: [GHC-88464]
+ Variable not in scope: g :: t0 -> t
+
+:17:1: error: [GHC-88464]
+ Variable not in scope: h :: t0 -> t
+
+:23:1: error: [GHC-88464]
+ Variable not in scope: h :: t0 -> t
+
diff --git a/testsuite/tests/ghci/prog022/ghci.prog022f.stdout b/testsuite/tests/ghci/prog022/ghci.prog022f.stdout
new file mode 100644
index 000000000000..36852ca36235
--- /dev/null
+++ b/testsuite/tests/ghci/prog022/ghci.prog022f.stdout
@@ -0,0 +1,14 @@
+"No module is imported"
+import (implicit) Prelude -- implicit
+"Reload all modules"
+:module +*A -- added automatically
+:module +*B -- added automatically
+[5]
+Just 5
+[5]
+"Unload all modules"
+import (implicit) Prelude -- implicit
+"Reload up to A"
+:module +*A -- added automatically
+[5]
+Just 5
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index 3a65b459e234..3910c0204cae 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/ghci/should_run/tc-plugin-ghci/Makefile b/testsuite/tests/ghci/should_run/tc-plugin-ghci/Makefile
index 9ee77373398b..447dcf2f7b8e 100644
--- a/testsuite/tests/ghci/should_run/tc-plugin-ghci/Makefile
+++ b/testsuite/tests/ghci/should_run/tc-plugin-ghci/Makefile
@@ -12,12 +12,12 @@ $(eval $(call canonicalise,HERE))
package.%:
$(MAKE) -s --no-print-directory clean.$*
mkdir pkg.$*
- "$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs
+ "$(TEST_HC)" $(EXTRA_HC_OPTS) -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs
"$(GHC_PKG)" init pkg.$*/local.package.conf
# The bogus extra-lib-dirs ensures the package is registered with multiple
# dynamic-library-directories which tests that the fix for #15475 works
- pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --ghc-option="$(RUN)" --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --extra-lib-dirs="$(HERE)" --package-db=pkg.$*/local.package.conf $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling)
+ pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --ghc-option="$(RUN)" --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --ghc-options="$(EXTRA_HC_OPTS) " --with-hc-pkg="$(GHC_PKG)" --extra-lib-dirs="$(HERE)" --package-db=pkg.$*/local.package.conf $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling)
pkg.$*/setup build --distdir pkg.$*/dist -v0
pkg.$*/setup install --distdir pkg.$*/dist -v0
diff --git a/testsuite/tests/haddock/haddock_testsuite/Makefile b/testsuite/tests/haddock/haddock_testsuite/Makefile
index 66c44d37a4e2..139100eaf454 100644
--- a/testsuite/tests/haddock/haddock_testsuite/Makefile
+++ b/testsuite/tests/haddock/haddock_testsuite/Makefile
@@ -17,6 +17,7 @@ haddockTest=$(TOP)/../utils/haddock/haddock-test/src/Test/Haddock.hs \
.PHONY: htmlTest
htmlTest:
'$(TEST_HC)' \
+ $(EXTRA_HC_OPTS) \
-odir . \
-hidir . \
-package Cabal \
@@ -32,6 +33,7 @@ htmlTest:
.PHONY: latexTest
latexTest:
'$(TEST_HC)' \
+ $(EXTRA_HC_OPTS) \
-odir . \
-hidir . \
-package Cabal \
@@ -47,6 +49,7 @@ latexTest:
.PHONY: hoogleTest
hoogleTest:
'$(TEST_HC)' \
+ $(EXTRA_HC_OPTS) \
-odir . \
-hidir . \
-package Cabal \
@@ -62,6 +65,7 @@ hoogleTest:
.PHONY: hypsrcTest
hypsrcTest:
'$(TEST_HC)' \
+ $(EXTRA_HC_OPTS) \
-odir . \
-hidir . \
-package Cabal \
diff --git a/testsuite/tests/hpc/Makefile b/testsuite/tests/hpc/Makefile
index 6dd6d8f8b8dd..7cc181181c8e 100644
--- a/testsuite/tests/hpc/Makefile
+++ b/testsuite/tests/hpc/Makefile
@@ -4,17 +4,17 @@ include $(TOP)/mk/test.mk
# Test that adding -fhpc triggers recompilation
T11798:
- "$(TEST_HC)" $(TEST_HC_ARGS) T11798
- "$(TEST_HC)" $(TEST_HC_ARGS) T11798 -fhpc
+ "$(TEST_HC)" $(TEST_HC_OPTS) T11798
+ "$(TEST_HC)" $(TEST_HC_OPTS) T11798 -fhpc
test -e .hpc/T11798.mix
T17073:
- LANG=ASCII "$(TEST_HC)" $(TEST_HC_ARGS) T17073.hs -fhpc -v0
+ LANG=ASCII "$(TEST_HC)" $(TEST_HC_OPTS) T17073.hs -fhpc -v0
./T17073
"$(HPC)" report T17073
"$(HPC)" version
LANG=ASCII "$(HPC)" markup T17073
T20568:
- "$(TEST_HC)" $(TEST_HC_ARGS) T20568.hs -fhpc -v0
+ "$(TEST_HC)" $(TEST_HC_OPTS) T20568.hs -fhpc -v0
./T20568
diff --git a/testsuite/tests/hpc/raytrace/tixs/Makefile b/testsuite/tests/hpc/raytrace/tixs/Makefile
index 009a9fceeaaf..dbbc3b671d22 100644
--- a/testsuite/tests/hpc/raytrace/tixs/Makefile
+++ b/testsuite/tests/hpc/raytrace/tixs/Makefile
@@ -4,7 +4,7 @@ include $(TOP)/mk/test.mk
build-tix:
rm -Rf .hpc *.o Main
- '$(TEST_HC)' -fhpc -i.. --make Main.hs
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -fhpc -i.. --make Main.hs
./Main
mv Main.tix hpc_sample.tix
diff --git a/testsuite/tests/hpc/simple/tixs/Makefile b/testsuite/tests/hpc/simple/tixs/Makefile
index 60332c95014a..c65b7b4d3978 100644
--- a/testsuite/tests/hpc/simple/tixs/Makefile
+++ b/testsuite/tests/hpc/simple/tixs/Makefile
@@ -8,7 +8,7 @@ include $(TOP)/mk/test.mk
build-tix:
rm -Rf .hpc hpc001.o a.out
- '$(TEST_HC)' -fhpc hpc001.hs
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -fhpc hpc001.hs
./a.out
mv a.out.tix hpc_sample.tix
diff --git a/testsuite/tests/indexed-types/should_fail/T13102/Makefile b/testsuite/tests/indexed-types/should_fail/T13102/Makefile
index b4cbff9205d8..534bf0317135 100644
--- a/testsuite/tests/indexed-types/should_fail/T13102/Makefile
+++ b/testsuite/tests/indexed-types/should_fail/T13102/Makefile
@@ -6,8 +6,8 @@ LOCAL_PKGCONF=local.package.conf
T13102:
"$(GHC_PKG)" init $(LOCAL_PKGCONF)
- cd orphan && "$(TEST_HC)" -v0 --make Setup.hs
- cd orphan && ./Setup configure -v0 --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF)
+ cd orphan && "$(TEST_HC)" $(EXTRA_HC_OPTS) -v0 --make Setup.hs
+ cd orphan && ./Setup configure -v0 --with-compiler="$(TEST_HC)" --ghc-options="$(EXTRA_HC_OPTS) " --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF)
cd orphan && ./Setup build -v0
cd orphan && ./Setup register -v0 --inplace
! "$(TEST_HC)" $(TEST_HC_OPTS) -c A.hs B.hs -package-db $(LOCAL_PKGCONF)
diff --git a/testsuite/tests/lib/integer/Makefile b/testsuite/tests/lib/integer/Makefile
index 86d3fc69c084..edb1f7d05f59 100644
--- a/testsuite/tests/lib/integer/Makefile
+++ b/testsuite/tests/lib/integer/Makefile
@@ -11,7 +11,7 @@ CHECK2 = grep -q -- '$1' folding.simpl || \
.PHONY: integerConstantFolding
integerConstantFolding:
- '$(TEST_HC)' -Wall -v0 -O --make integerConstantFolding -fforce-recomp -ddump-simpl -dno-debug-output > folding.simpl
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -Wall -v0 -O --make integerConstantFolding -fforce-recomp -ddump-simpl -dno-debug-output > folding.simpl
# All the 100nnn values should be constant-folded away
# -dno-debug-output suppresses a "Glomming" message
! grep -q '\<100[0-9][0-9][0-9]\>' folding.simpl || { echo "Unfolded values found"; grep '\<100[0-9][0-9][0-9]\>' folding.simpl; }
@@ -45,7 +45,7 @@ integerConstantFolding:
.PHONY: fromToInteger
fromToInteger:
- '$(TEST_HC)' -Wall -v0 -O -c fromToInteger.hs -fforce-recomp -ddump-simpl > fromToInteger.simpl
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -Wall -v0 -O -c fromToInteger.hs -fforce-recomp -ddump-simpl > fromToInteger.simpl
# Rules should eliminate all functions
-grep integerToInt fromToInteger.simpl
-grep smallInteger fromToInteger.simpl
@@ -54,7 +54,7 @@ fromToInteger:
.PHONY: IntegerConversionRules
IntegerConversionRules:
- '$(TEST_HC)' -Wall -v0 -O -c $@.hs -fforce-recomp -ddump-simpl > $@.simpl
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -Wall -v0 -O -c $@.hs -fforce-recomp -ddump-simpl > $@.simpl
-grep -q smallInteger $@.simpl && echo "smallInteger present"
-grep -q doubleFromInteger $@.simpl && echo "doubleFromInteger present"
-grep -q int2Double $@.simpl || echo "int2Double absent"
@@ -65,7 +65,7 @@ IntegerConversionRules:
.PHONY: naturalConstantFolding
naturalConstantFolding:
- '$(TEST_HC)' -Wall -v0 -O --make naturalConstantFolding -fforce-recomp -ddump-simpl -dno-debug-output > folding.simpl
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -Wall -v0 -O --make naturalConstantFolding -fforce-recomp -ddump-simpl -dno-debug-output > folding.simpl
# All the 100nnn values should be constant-folded away
# -dno-debug-output suppresses a "Glomming" message
! grep -q '\<100[0-9][0-9][0-9]\>' folding.simpl || { echo "Unfolded values found"; grep '\<100[0-9][0-9][0-9]\>' folding.simpl; }
diff --git a/testsuite/tests/llvm/should_run/subsections_via_symbols/Makefile b/testsuite/tests/llvm/should_run/subsections_via_symbols/Makefile
index 10147ed108f7..037da14224ba 100644
--- a/testsuite/tests/llvm/should_run/subsections_via_symbols/Makefile
+++ b/testsuite/tests/llvm/should_run/subsections_via_symbols/Makefile
@@ -8,6 +8,6 @@ HCINC = $(TOP)/../rts/include
.PHONY: subsections_via_symbols
subsections_via_symbols:
- '$(TEST_HC)' -o SubsectionsViaSymbols.o SubsectionsViaSymbols.hs $(HCFLAGS) -staticlib
- '$(TEST_HC)' -o subsections_via_symbols SubsectionsViaSymbols subsections_via_symbols.m $(HCFLAGS) -optl -dead_strip -no-hs-main
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -o SubsectionsViaSymbols.o SubsectionsViaSymbols.hs $(HCFLAGS) -staticlib
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -o subsections_via_symbols SubsectionsViaSymbols subsections_via_symbols.m $(HCFLAGS) -optl -dead_strip -no-hs-main
./subsections_via_symbols
diff --git a/testsuite/tests/numeric/should_run/Makefile b/testsuite/tests/numeric/should_run/Makefile
index 23f4456dcae5..e9396c0324f3 100644
--- a/testsuite/tests/numeric/should_run/Makefile
+++ b/testsuite/tests/numeric/should_run/Makefile
@@ -5,6 +5,6 @@ include $(TOP)/mk/test.mk
.PHONY: T7014
T7014:
rm -f T7014.simpl T7014.o T7014.hi
- '$(TEST_HC)' -Wall -v0 -O --make T7014.hs -fforce-recomp -ddump-simpl > T7014.simpl
+ '$(TEST_HC)' $(EXTRA_HC_OPTS) -Wall -v0 -O --make T7014.hs -fforce-recomp -ddump-simpl > T7014.simpl
! grep -Eq -f T7014.primops T7014.simpl
./T7014
diff --git a/testsuite/tests/package/T20010/all.T b/testsuite/tests/package/T20010/all.T
index d7b04b629f42..9c02e14214c3 100644
--- a/testsuite/tests/package/T20010/all.T
+++ b/testsuite/tests/package/T20010/all.T
@@ -1,4 +1,10 @@
# Test that GHC links to the C++ standard library as expected
# when the system-cxx-std-lib package is used.
test('T20010', req_c, makefile_test, [])
-test('T20010-ghci', [req_c, extra_files(['T20010_c.cpp', 'T20010.hs']), when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))], makefile_test, [])
+test('T20010-ghci', [req_c, extra_files(['T20010_c.cpp', 'T20010.hs']),
+ # this test is broken for dynamic builds. However, windows
+ # is dynamic, but not really, and works significanlty
+ # different from linux and darwin to not be broken when
+ # ghc claims to be dynamic.
+ unless(ghc_dynamic() and not opsys('mingw32'), expect_broken(20706))],
+ makefile_test, [])
diff --git a/testsuite/tests/parser/should_compile/T7476/Makefile b/testsuite/tests/parser/should_compile/T7476/Makefile
index be5b1a4046cc..14f871f13d18 100644
--- a/testsuite/tests/parser/should_compile/T7476/Makefile
+++ b/testsuite/tests/parser/should_compile/T7476/Makefile
@@ -5,6 +5,6 @@ include $(TOP)/mk/test.mk
.PHONY: T7476
T7476:
- "$(TEST_HC)" -v0 -ddump-minimal-imports T7476.hs
+ "$(TEST_HC)" $(EXTRA_HC_OPTS) -v0 -ddump-minimal-imports T7476.hs
cat Main.imports
diff --git a/testsuite/tests/patsyn/should_compile/T26465b.hs b/testsuite/tests/patsyn/should_compile/T26465b.hs
new file mode 100644
index 000000000000..ff77d7088843
--- /dev/null
+++ b/testsuite/tests/patsyn/should_compile/T26465b.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
+
+module T26465b where
+
+-- Variant of T26465 which should be accepted
+
+f :: Eq a => a -> Maybe a
+f _ = Nothing
+
+-- Monomorphism restriction bites
+-- Eq a[tau:0] => a[tau:0] -> Maybe a[tau:0]
+g = f
+
+pattern P x <- ( g -> Just x )
+
+x = g (1 :: Int)
diff --git a/testsuite/tests/patsyn/should_compile/T26465c.hs b/testsuite/tests/patsyn/should_compile/T26465c.hs
new file mode 100644
index 000000000000..16545510798e
--- /dev/null
+++ b/testsuite/tests/patsyn/should_compile/T26465c.hs
@@ -0,0 +1,45 @@
+
+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
+
+{-# LANGUAGE UnboxedSums, UnboxedTuples, MagicHash #-}
+
+module T26465c where
+
+-- Rep-poly variant of T26465b
+
+import Data.Kind
+ ( Constraint )
+import GHC.Exts
+ ( TYPE, Int#, isTrue#, (>=#) )
+
+
+type HasP :: forall r. TYPE r -> Constraint
+class HasP a where
+ getP :: a -> (# (# #) | (# #) #)
+ mk :: (# #) -> a
+
+instance HasP Int where
+ getP i = if i >= 0 then (# | (# #) #) else (# (# #) | #)
+ mk _ = 1
+instance HasP Int# where
+ getP i# = if isTrue# ( i# >=# 0# ) then (# | (# #) #) else (# (# #) | #)
+ mk _ = 1#
+
+g1 = getP
+g2 = getP
+
+m1 = mk
+m2 = mk
+
+-- NB: deliberately use no arguments to make this test harder (so that we run
+-- into the 'need_dummy_arg' logic of 'GHC.Tc.TyCl.PatSyn.mkPatSynBuilder').
+pattern P1 <- ( g1 -> (# | (# #) #) )
+ where P1 = m1 (# #)
+pattern P2 <- ( g2 -> (# | (# #) #) )
+ where P2 = m2 (# #)
+
+y1 :: Int -> Int
+y1 P1 = P1
+
+y2 :: Int# -> Int#
+y2 P2 = P2
diff --git a/testsuite/tests/patsyn/should_compile/T26465d.hs b/testsuite/tests/patsyn/should_compile/T26465d.hs
new file mode 100644
index 000000000000..9bc0c2841cf6
--- /dev/null
+++ b/testsuite/tests/patsyn/should_compile/T26465d.hs
@@ -0,0 +1,28 @@
+
+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
+
+{-# LANGUAGE UnboxedSums, UnboxedTuples, MagicHash #-}
+
+module T26465d where
+
+-- Should-fail variant of T26465c (but with -fdefer-type-errors)
+
+import Data.Kind
+ ( Constraint )
+import GHC.Exts
+ ( TYPE )
+
+type HasP :: forall r. TYPE r -> Constraint
+class HasP a where
+ getP :: a -> (# (# #) | (# #) #)
+ mk :: (# #) -> a
+
+g = getP
+m = mk
+
+-- NB: deliberately use no arguments to make this test harder (so that we run
+-- into the 'need_dummy_arg' logic of 'GHC.Tc.TyCl.PatSyn.mkPatSynBuilder').
+pattern P1 <- ( g -> (# | (# #) #) )
+ where P1 = m (# #)
+
+test P1 = P1
diff --git a/testsuite/tests/patsyn/should_compile/T26465d.stderr b/testsuite/tests/patsyn/should_compile/T26465d.stderr
new file mode 100644
index 000000000000..4975aa0cbb19
--- /dev/null
+++ b/testsuite/tests/patsyn/should_compile/T26465d.stderr
@@ -0,0 +1,10 @@
+T26465d.hs:20:5: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)]
+ • No instance for ‘HasP a0’ arising from a use of ‘getP’
+ • In the expression: getP
+ In an equation for ‘g’: g = getP
+
+T26465d.hs:21:5: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)]
+ • No instance for ‘HasP a0’ arising from a use of ‘mk’
+ • In the expression: mk
+ In an equation for ‘m’: m = mk
+
diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T
index 4994346cd59d..cfdb042f9bd2 100644
--- a/testsuite/tests/patsyn/should_compile/all.T
+++ b/testsuite/tests/patsyn/should_compile/all.T
@@ -73,6 +73,9 @@ test('T13752a', normal, compile, [''])
test('T13768', normal, compile, [''])
test('T14058', [extra_files(['T14058.hs', 'T14058a.hs'])],
multimod_compile, ['T14058', '-v0'])
+test('T26465b', normal, compile, [''])
+test('T26465c', normal, compile, [''])
+test('T26465d', normal, compile, ['-fdefer-type-errors'])
test('T14326', normal, compile, [''])
test('T14380', normal, compile, [''])
test('T14394', normal, ghci_script, ['T14394.script'])
diff --git a/testsuite/tests/patsyn/should_fail/T26465.hs b/testsuite/tests/patsyn/should_fail/T26465.hs
new file mode 100644
index 000000000000..1eba010f7550
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/T26465.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
+
+module T26465 where
+
+f :: Eq a => a -> Maybe a
+f _ = Nothing
+
+-- Monomorphism restriction bites
+-- Eq a[tau:0] => a[tau:0] -> Maybe a[tau:0]
+g = f
+
+pattern P x <- ( g -> Just x )
diff --git a/testsuite/tests/patsyn/should_fail/T26465.stderr b/testsuite/tests/patsyn/should_fail/T26465.stderr
new file mode 100644
index 000000000000..86b5e054f8ae
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/T26465.stderr
@@ -0,0 +1,15 @@
+T26465.hs:10:5: error: [GHC-39999]
+ • Ambiguous type variable ‘a0’ arising from a use of ‘f’
+ prevents the constraint ‘(Eq a0)’ from being solved.
+ Relevant bindings include
+ g :: a0 -> Maybe a0 (bound at T26465.hs:10:1)
+ Probable fix: use a type annotation to specify what ‘a0’ should be.
+ Potentially matching instances:
+ instance Eq Ordering -- Defined in ‘GHC.Internal.Classes’
+ instance Eq Integer -- Defined in ‘GHC.Internal.Bignum.Integer’
+ ...plus 24 others
+ ...plus five instances involving out-of-scope types
+ (use -fprint-potential-instances to see them all)
+ • In the expression: f
+ In an equation for ‘g’: g = f
+
diff --git a/testsuite/tests/patsyn/should_fail/all.T b/testsuite/tests/patsyn/should_fail/all.T
index 4a8e419acbc9..030734af0bc1 100644
--- a/testsuite/tests/patsyn/should_fail/all.T
+++ b/testsuite/tests/patsyn/should_fail/all.T
@@ -35,6 +35,7 @@ test('T12165', normal, compile_fail, [''])
test('T12819', normal, compile_fail, [''])
test('UnliftedPSBind', normal, compile_fail, [''])
test('T15695', normal, compile, ['']) # It has -fdefer-type-errors inside
+test('T26465', normal, compile_fail, [''])
test('T13349', normal, compile_fail, [''])
test('T13470', normal, compile_fail, [''])
test('T14112', normal, compile_fail, [''])
diff --git a/testsuite/tests/perf/compiler/T4007.stdout b/testsuite/tests/perf/compiler/T4007.stdout
index 2471d0c77f8d..0dd286f52072 100644
--- a/testsuite/tests/perf/compiler/T4007.stdout
+++ b/testsuite/tests/perf/compiler/T4007.stdout
@@ -1,6 +1,9 @@
Rule fired: Class op foldr (BUILTIN)
Rule fired: Class op return (BUILTIN)
Rule fired: unpack (GHC.Internal.Base)
+Rule fired: repeat (GHC.Internal.List)
+Rule fired: take (GHC.Internal.List)
+Rule fired: fold/build (GHC.Internal.Base)
Rule fired: fold/build (GHC.Internal.Base)
Rule fired: Class op >> (BUILTIN)
Rule fired: SPEC/T4007 sequence__c @IO @_ @_ (T4007)
diff --git a/testsuite/tests/perf/size/all.T b/testsuite/tests/perf/size/all.T
index 4c45cb4d11ff..e5fd683fce7b 100644
--- a/testsuite/tests/perf/size/all.T
+++ b/testsuite/tests/perf/size/all.T
@@ -84,7 +84,9 @@ test('mtl_so' ,[req_dynamic_ghc, js_skip, windows_skip, collect_obje
test('os_string_so' ,[req_dynamic_ghc, js_skip, windows_skip, collect_object_size(size_acceptance_threshold, "os-string")] , static_stats, [] )
test('parsec_so' ,[req_dynamic_ghc, js_skip, windows_skip, collect_object_size(size_acceptance_threshold, "parsec")] , static_stats, [] )
test('process_so' ,[req_dynamic_ghc, js_skip, windows_skip, collect_object_size(size_acceptance_threshold, "process")] , static_stats, [] )
-test('rts_so' ,[req_dynamic_ghc, js_skip, windows_skip, collect_object_size(size_acceptance_threshold, "rts", True)] , static_stats, [] )
+# after the rts-split, there is not signle rts anymore. The single rts package is just headers, and thus empty. We now have one rts per threaded/debug combination.
+# they are also sublibs, which means the regex in the test-driver doesn't work for this. Thus for now we disable this test.
+# test('rts_so' ,[req_dynamic_ghc, js_skip, windows_skip, collect_object_size(size_acceptance_threshold, "rts", True)] , static_stats, [] )
test('template_haskell_so',[req_dynamic_ghc, js_skip, windows_skip, collect_object_size(size_acceptance_threshold, "template-haskell")] , static_stats, [] )
# terminfo is not built in cross ghc so skip it
test('terminfo_so' ,[req_dynamic_ghc, when(config.cross, skip), windows_skip, collect_object_size(size_acceptance_threshold, "terminfo")], static_stats, [] )
diff --git a/testsuite/tests/plugins/all.T b/testsuite/tests/plugins/all.T
index a7bad499350a..fb671f93b8d6 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',
@@ -355,14 +355,13 @@ test('test-echo-in-line-many-args',
test('plugins-external',
[extra_files(['shared-plugin/']),
pre_cmd('$MAKE -s --no-print-directory -C shared-plugin package.plugins01 TOP={top}'),
- when(opsys('mingw32') or (opsys('linux') and not ghc_dynamic()), expect_broken(20706))],
+ unless(ghc_dynamic(), skip),
+ when(opsys('mingw32'), expect_broken(20706))],
makefile_test, [])
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/annotation-plugin/Makefile b/testsuite/tests/plugins/annotation-plugin/Makefile
index 7ce5b78e7598..620ff53c652d 100644
--- a/testsuite/tests/plugins/annotation-plugin/Makefile
+++ b/testsuite/tests/plugins/annotation-plugin/Makefile
@@ -11,8 +11,8 @@ $(eval $(call canonicalise,HERE))
package.%:
$(MAKE) -s --no-print-directory clean.$*
mkdir pkg.$*
- "$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs
+ "$(TEST_HC)" $(EXTRA_HC_OPTS) -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs
"$(GHC_PKG)" init pkg.$*/local.package.conf
- pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling) --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf
+ pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --ghc-options="$(EXTRA_HC_OPTS)" $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling) --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf
pkg.$*/setup build --distdir pkg.$*/dist -v0
pkg.$*/setup install --distdir pkg.$*/dist -v0
diff --git a/testsuite/tests/plugins/annotation-plugin/SayAnnNames.hs b/testsuite/tests/plugins/annotation-plugin/SayAnnNames.hs
index b33039ca7b46..cd4243a082b6 100644
--- a/testsuite/tests/plugins/annotation-plugin/SayAnnNames.hs
+++ b/testsuite/tests/plugins/annotation-plugin/SayAnnNames.hs
@@ -19,13 +19,14 @@ pass :: ModGuts -> CoreM ModGuts
pass g = do
dflags <- getDynFlags
mapM_ (printAnn dflags g) (mg_binds g) >> return g
- where printAnn :: DynFlags -> ModGuts -> CoreBind -> CoreM CoreBind
- printAnn dflags guts bndr@(NonRec b _) = do
+ where printAnn :: DynFlags -> ModGuts -> CoreBind -> CoreM ()
+ printAnn dflags guts (NonRec b _) = lookupAnn dflags guts b
+ printAnn dflags guts (Rec ps) = mapM_ (lookupAnn dflags guts . fst) ps
+
+ lookupAnn dflags guts b = do
anns <- annotationsOn guts b :: CoreM [SomeAnn]
unless (null anns) $ putMsgS $
"Annotated binding found: " ++ showSDoc dflags (ppr b)
- return bndr
- printAnn _ _ bndr = return bndr
annotationsOn :: Data a => ModGuts -> CoreBndr -> CoreM [a]
annotationsOn guts bndr = do
diff --git a/testsuite/tests/plugins/defaulting-plugin/Makefile b/testsuite/tests/plugins/defaulting-plugin/Makefile
index 7ce5b78e7598..620ff53c652d 100644
--- a/testsuite/tests/plugins/defaulting-plugin/Makefile
+++ b/testsuite/tests/plugins/defaulting-plugin/Makefile
@@ -11,8 +11,8 @@ $(eval $(call canonicalise,HERE))
package.%:
$(MAKE) -s --no-print-directory clean.$*
mkdir pkg.$*
- "$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs
+ "$(TEST_HC)" $(EXTRA_HC_OPTS) -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs
"$(GHC_PKG)" init pkg.$*/local.package.conf
- pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling) --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf
+ pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --ghc-options="$(EXTRA_HC_OPTS)" $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling) --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf
pkg.$*/setup build --distdir pkg.$*/dist -v0
pkg.$*/setup install --distdir pkg.$*/dist -v0
diff --git a/testsuite/tests/plugins/echo-plugin/Makefile b/testsuite/tests/plugins/echo-plugin/Makefile
index 7ce5b78e7598..620ff53c652d 100644
--- a/testsuite/tests/plugins/echo-plugin/Makefile
+++ b/testsuite/tests/plugins/echo-plugin/Makefile
@@ -11,8 +11,8 @@ $(eval $(call canonicalise,HERE))
package.%:
$(MAKE) -s --no-print-directory clean.$*
mkdir pkg.$*
- "$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs
+ "$(TEST_HC)" $(EXTRA_HC_OPTS) -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs
"$(GHC_PKG)" init pkg.$*/local.package.conf
- pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling) --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf
+ pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --ghc-options="$(EXTRA_HC_OPTS)" $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling) --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf
pkg.$*/setup build --distdir pkg.$*/dist -v0
pkg.$*/setup install --distdir pkg.$*/dist -v0
diff --git a/testsuite/tests/plugins/hole-fit-plugin/Makefile b/testsuite/tests/plugins/hole-fit-plugin/Makefile
index 7ce5b78e7598..620ff53c652d 100644
--- a/testsuite/tests/plugins/hole-fit-plugin/Makefile
+++ b/testsuite/tests/plugins/hole-fit-plugin/Makefile
@@ -11,8 +11,8 @@ $(eval $(call canonicalise,HERE))
package.%:
$(MAKE) -s --no-print-directory clean.$*
mkdir pkg.$*
- "$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs
+ "$(TEST_HC)" $(EXTRA_HC_OPTS) -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs
"$(GHC_PKG)" init pkg.$*/local.package.conf
- pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling) --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf
+ pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --ghc-options="$(EXTRA_HC_OPTS)" $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling) --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf
pkg.$*/setup build --distdir pkg.$*/dist -v0
pkg.$*/setup install --distdir pkg.$*/dist -v0
diff --git a/testsuite/tests/plugins/hooks-plugin/Makefile b/testsuite/tests/plugins/hooks-plugin/Makefile
index ef205569f9e0..0fcff871ceda 100644
--- a/testsuite/tests/plugins/hooks-plugin/Makefile
+++ b/testsuite/tests/plugins/hooks-plugin/Makefile
@@ -11,8 +11,8 @@ $(eval $(call canonicalise, HERE))
package.%:
$(MAKE) -s --no-print-directory clean.$*
mkdir pkg.$*
- "$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs
+ "$(TEST_HC)" $(EXTRA_HC_OPTS) -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs
"$(GHC_PKG)" init pkg.$*/local.package.conf
- pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling)
+ pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --ghc-options="$(EXTRA_HC_OPTS)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling)
pkg.$*/setup build --distdir pkg.$*/dist -v0
pkg.$*/setup install --distdir pkg.$*/dist -v0
diff --git a/testsuite/tests/plugins/late-plugin/LatePlugin.hs b/testsuite/tests/plugins/late-plugin/LatePlugin.hs
index 9e13cd33f34c..03fdf3dec9dd 100644
--- a/testsuite/tests/plugins/late-plugin/LatePlugin.hs
+++ b/testsuite/tests/plugins/late-plugin/LatePlugin.hs
@@ -43,8 +43,13 @@ editCoreBinding early modName pgm = do
pure $ go pgm
where
go :: [CoreBind] -> [CoreBind]
- go (b@(NonRec v e) : bs)
- | occNameString (getOccName v) == "testBinding" && exprType e `eqType` intTy =
- NonRec v (mkUncheckedIntExpr $ bool 222222 111111 early) : bs
- go (b:bs) = b : go bs
+ go (Rec ps : bs) = Rec (map (uncurry (go_bind (,))) ps) : go bs
+ go (NonRec v e : bs) = go_bind NonRec v e : go bs
go [] = []
+
+ go_bind c v e
+ | occNameString (getOccName v) == "testBinding"
+ , exprType e `eqType` intTy
+ = c v (mkUncheckedIntExpr $ bool 222222 111111 early)
+ | otherwise
+ = c v e
diff --git a/testsuite/tests/plugins/plugin-recomp/Makefile b/testsuite/tests/plugins/plugin-recomp/Makefile
index a3977179c903..a363398708c1 100644
--- a/testsuite/tests/plugins/plugin-recomp/Makefile
+++ b/testsuite/tests/plugins/plugin-recomp/Makefile
@@ -12,13 +12,13 @@ $(eval $(call canonicalise,HERE))
package.%:
$(MAKE) -s --no-print-directory clean.$*
mkdir pkg.$*
- "$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs
+ "$(TEST_HC)" $(EXTRA_HC_OPTS) -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs
"$(GHC_PKG)" init pkg.$*/local.package.conf
# The bogus extra-lib-dirs ensures the package is registered with multiple
# dynamic-library-directories which tests that the fix for #15475 works
- pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --ghc-option="$(RUN)" --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --extra-lib-dirs="$(HERE)" --package-db=pkg.$*/local.package.conf $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling)
+ pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --ghc-option="$(RUN)" --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --ghc-options="$(EXTRA_HC_OPTS)" --with-hc-pkg="$(GHC_PKG)" --extra-lib-dirs="$(HERE)" --package-db=pkg.$*/local.package.conf $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling)
# -dno-debug-output: Suppress warnings ("Simplifier bailing out ...") while
# building the plugin package. It's just too tedious to figure out what goes
# wrong and likely shows up in other tests as well.
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/plugins/simple-plugin/Simple/ReplacePlugin.hs b/testsuite/tests/plugins/simple-plugin/Simple/ReplacePlugin.hs
index b20f3fe80aae..d61630c0749c 100644
--- a/testsuite/tests/plugins/simple-plugin/Simple/ReplacePlugin.hs
+++ b/testsuite/tests/plugins/simple-plugin/Simple/ReplacePlugin.hs
@@ -51,5 +51,6 @@ fixGuts rep guts = pure $ guts { mg_binds = fmap fix_bind (mg_binds guts) }
Tick t e -> Tick t (fix_expr e)
Type t -> Type t
Coercion c -> Coercion c
+ Let b body -> Let (fix_bind b) (fix_expr body)
fix_alt (Alt c bs e) = Alt c bs (fix_expr e)
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 b76b94478e01..9f1788111392 100644
--- a/testsuite/tests/rts/all.T
+++ b/testsuite/tests/rts/all.T
@@ -2,6 +2,11 @@ test('testblockalloc',
[c_src, only_ways(['normal','threaded1']), extra_run_opts('+RTS -I0')],
compile_and_run, [''])
+test('numeric_version_eventlog_flush',
+ [ignore_stdout, req_ghc_with_threaded_rts],
+ run_command,
+ ['{compiler} --numeric-version +RTS -l --eventlog-flush-interval=1 -RTS'])
+
test('testmblockalloc',
[c_src, only_ways(['normal','threaded1']), extra_run_opts('+RTS -I0 -xr0.125T'),
when(arch('wasm32'), skip)], # MBlocks can't be freed on wasm32, see Note [Megablock allocator on wasm] in rts
@@ -241,6 +246,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):
@@ -282,7 +288,7 @@ test('T7040_ghci',
# Fragile when unregisterised; see #16085
when(unregisterised(), skip),
pre_cmd('$MAKE -s --no-print-directory T7040_ghci_setup ghciWayFlags=' + config.ghci_way_flags),
- when(opsys('linux') and not ghc_dynamic() and not arch('wasm32'), fragile(20706))],
+ when((opsys('linux') and not ghc_dynamic() and not arch('wasm32')) or platform('x86_64-apple-darwin'), fragile(20706))],
compile_and_run, ['T7040_ghci_c.o'])
test('T7227', [extra_run_opts('+RTS -tT7227.stat --machine-readable -RTS')],
@@ -413,7 +419,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
@@ -467,6 +473,8 @@ 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'])
@@ -501,6 +509,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'])
@@ -510,7 +519,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'])
@@ -520,12 +530,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'])
@@ -603,7 +612,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'])
@@ -623,7 +632,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/keep-cafs-fail.stdout b/testsuite/tests/rts/keep-cafs-fail.stdout
index 6eaf652de00b..00f4ed62a3bf 100644
--- a/testsuite/tests/rts/keep-cafs-fail.stdout
+++ b/testsuite/tests/rts/keep-cafs-fail.stdout
@@ -1,5 +1,5 @@
KeepCafsMain: internal error: Evaluated a CAF (0xaac9d8) that was GC'd!
(GHC version 8.7.20180910 for x86_64_unknown_linux)
- Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug
+ Please report this as a GHC bug: https://github.com/stable-haskell/ghc/issues
Aborted (core dumped)
exit(134)
diff --git a/testsuite/tests/rts/linker/T11223/T11223_link_order_a_b_2_fail.stderr b/testsuite/tests/rts/linker/T11223/T11223_link_order_a_b_2_fail.stderr
index 31430b6138c0..b0f806c82213 100644
--- a/testsuite/tests/rts/linker/T11223/T11223_link_order_a_b_2_fail.stderr
+++ b/testsuite/tests/rts/linker/T11223/T11223_link_order_a_b_2_fail.stderr
@@ -21,5 +21,5 @@ the missing library using the -L/path/to/object/dir and -lmissinglibname
flags, or simply by naming the relevant files on the GHCi command line.
Alternatively, this link failure might indicate a bug in GHCi.
If you suspect the latter, please report this as a GHC bug:
- https://www.haskell.org/ghc/reportabug
+ https://github.com/stable-haskell/ghc/issues
diff --git a/testsuite/tests/rts/linker/T11223/T11223_link_order_a_b_2_fail.stderr-ws-64-mingw32 b/testsuite/tests/rts/linker/T11223/T11223_link_order_a_b_2_fail.stderr-ws-64-mingw32
index 0cfc07c9626f..cd52cd3e7ccb 100644
--- a/testsuite/tests/rts/linker/T11223/T11223_link_order_a_b_2_fail.stderr-ws-64-mingw32
+++ b/testsuite/tests/rts/linker/T11223/T11223_link_order_a_b_2_fail.stderr-ws-64-mingw32
@@ -21,5 +21,5 @@ the missing library using the -L/path/to/object/dir and -lmissinglibname
flags, or simply by naming the relevant files on the GHCi command line.
Alternatively, this link failure might indicate a bug in GHCi.
If you suspect the latter, please report this as a GHC bug:
- https://www.haskell.org/ghc/reportabug
+ https://github.com/stable-haskell/ghc/issues
diff --git a/testsuite/tests/rts/linker/T11223/T11223_simple_duplicate_lib.stderr b/testsuite/tests/rts/linker/T11223/T11223_simple_duplicate_lib.stderr
index dd590e99f2f3..365a8358ec8b 100644
--- a/testsuite/tests/rts/linker/T11223/T11223_simple_duplicate_lib.stderr
+++ b/testsuite/tests/rts/linker/T11223/T11223_simple_duplicate_lib.stderr
@@ -21,5 +21,5 @@ the missing library using the -L/path/to/object/dir and -lmissinglibname
flags, or simply by naming the relevant files on the GHCi command line.
Alternatively, this link failure might indicate a bug in GHCi.
If you suspect the latter, please report this as a GHC bug:
- https://www.haskell.org/ghc/reportabug
+ https://github.com/stable-haskell/ghc/issues
diff --git a/testsuite/tests/rts/linker/T11223/T11223_simple_duplicate_lib.stderr-ws-64-mingw32 b/testsuite/tests/rts/linker/T11223/T11223_simple_duplicate_lib.stderr-ws-64-mingw32
index 1102d68be5d7..55ddacd5dfa6 100644
--- a/testsuite/tests/rts/linker/T11223/T11223_simple_duplicate_lib.stderr-ws-64-mingw32
+++ b/testsuite/tests/rts/linker/T11223/T11223_simple_duplicate_lib.stderr-ws-64-mingw32
@@ -21,5 +21,5 @@ the missing library using the -L/path/to/object/dir and -lmissinglibname
flags, or simply by naming the relevant files on the GHCi command line.
Alternatively, this link failure might indicate a bug in GHCi.
If you suspect the latter, please report this as a GHC bug:
- https://www.haskell.org/ghc/reportabug
+ https://github.com/stable-haskell/ghc/issues
diff --git a/testsuite/tests/rts/linker/T20494-obj.c b/testsuite/tests/rts/linker/T20494-obj.c
index ed073d6cfaf0..a792993aa154 100644
--- a/testsuite/tests/rts/linker/T20494-obj.c
+++ b/testsuite/tests/rts/linker/T20494-obj.c
@@ -1,8 +1,15 @@
#include
+#include
#define CONSTRUCTOR(prio) __attribute__((constructor(prio)))
#define DESTRUCTOR(prio) __attribute__((destructor(prio)))
+#if defined(_WIN32)
#define PRINT(str) printf(str); fflush(stdout)
+#else
+// don't use "stdout" variable here as it is not properly defined when loading
+// this object in a statically linked GHC.
+#define PRINT(str) dprintf(1,str); fsync(1)
+#endif
CONSTRUCTOR(1000) void constr_a(void) { PRINT("constr a\n"); }
CONSTRUCTOR(2000) void constr_b(void) { PRINT("constr b\n"); }
diff --git a/testsuite/tests/rts/linker/all.T b/testsuite/tests/rts/linker/all.T
index e88594b1025c..db593c1b0065 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,11 +152,12 @@ 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))],
- makefile_test, ['T20494'])
+test('T20494', [req_rts_linker], makefile_test, ['T20494'])
test('T20918',
[extra_files(['T20918_v.cc']),
diff --git a/testsuite/tests/simd/should_run/T26411.hs b/testsuite/tests/simd/should_run/T26411.hs
new file mode 100644
index 000000000000..cc1cca6866d4
--- /dev/null
+++ b/testsuite/tests/simd/should_run/T26411.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module Main where
+
+import GHC.Exts
+
+data DoubleX32 = DoubleX32
+ DoubleX2# DoubleX2# DoubleX2# DoubleX2#
+ DoubleX2# DoubleX2# DoubleX2# DoubleX2#
+ DoubleX2# DoubleX2# DoubleX2# DoubleX2#
+ DoubleX2# DoubleX2# DoubleX2# DoubleX2#
+
+doubleX32ToList :: DoubleX32 -> [Double]
+doubleX32ToList (DoubleX32 v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15)
+ = a v0 . a v1 . a v2 . a v3 . a v4 . a v5 . a v6 . a v7 . a v8 . a v9 . a v10 . a v11 . a v12 . a v13 . a v14 . a v15 $ []
+ where
+ a v xs = case unpackDoubleX2# v of
+ (# x0, x1 #) -> D# x0 : D# x1 : xs
+
+doubleX32FromList :: [Double] -> DoubleX32
+doubleX32FromList [D# x0, D# x1, D# x2, D# x3, D# x4, D# x5, D# x6, D# x7, D# x8, D# x9, D# x10, D# x11, D# x12, D# x13, D# x14, D# x15, D# x16, D# x17, D# x18, D# x19, D# x20, D# x21, D# x22, D# x23, D# x24, D# x25, D# x26, D# x27, D# x28, D# x29, D# x30, D# x31]
+ = DoubleX32
+ (packDoubleX2# (# x0, x1 #)) (packDoubleX2# (# x2, x3 #)) (packDoubleX2# (# x4, x5 #)) (packDoubleX2# (# x6, x7 #))
+ (packDoubleX2# (# x8, x9 #)) (packDoubleX2# (# x10, x11 #)) (packDoubleX2# (# x12, x13 #)) (packDoubleX2# (# x14, x15 #))
+ (packDoubleX2# (# x16, x17 #)) (packDoubleX2# (# x18, x19 #)) (packDoubleX2# (# x20, x21 #)) (packDoubleX2# (# x22, x23 #))
+ (packDoubleX2# (# x24, x25 #)) (packDoubleX2# (# x26, x27 #)) (packDoubleX2# (# x28, x29 #)) (packDoubleX2# (# x30, x31 #))
+
+negateDoubleX32 :: DoubleX32 -> DoubleX32
+negateDoubleX32 (DoubleX32 v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15)
+ = DoubleX32
+ (negateDoubleX2# v0) (negateDoubleX2# v1) (negateDoubleX2# v2) (negateDoubleX2# v3)
+ (negateDoubleX2# v4) (negateDoubleX2# v5) (negateDoubleX2# v6) (negateDoubleX2# v7)
+ (negateDoubleX2# v8) (negateDoubleX2# v9) (negateDoubleX2# v10) (negateDoubleX2# v11)
+ (negateDoubleX2# v12) (negateDoubleX2# v13) (negateDoubleX2# v14) (negateDoubleX2# v15)
+
+recipDoubleX2# :: DoubleX2# -> DoubleX2#
+recipDoubleX2# v = divideDoubleX2# (broadcastDoubleX2# 1.0##) v
+{-# INLINE recipDoubleX2# #-}
+
+recipDoubleX32 :: DoubleX32 -> DoubleX32
+recipDoubleX32 (DoubleX32 v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15)
+ = DoubleX32
+ (recipDoubleX2# v0) (recipDoubleX2# v1) (recipDoubleX2# v2) (recipDoubleX2# v3)
+ (recipDoubleX2# v4) (recipDoubleX2# v5) (recipDoubleX2# v6) (recipDoubleX2# v7)
+ (recipDoubleX2# v8) (recipDoubleX2# v9) (recipDoubleX2# v10) (recipDoubleX2# v11)
+ (recipDoubleX2# v12) (recipDoubleX2# v13) (recipDoubleX2# v14) (recipDoubleX2# v15)
+
+main :: IO ()
+main = do
+ let a = doubleX32FromList [0..31]
+ b = negateDoubleX32 a
+ c = recipDoubleX32 a
+ print $ doubleX32ToList b
+ putStrLn $ if doubleX32ToList b == map negate [0..31] then "OK" else "Wrong"
+ print $ doubleX32ToList c
+ putStrLn $ if doubleX32ToList c == map recip [0..31] then "OK" else "Wrong"
diff --git a/testsuite/tests/simd/should_run/T26411.stdout b/testsuite/tests/simd/should_run/T26411.stdout
new file mode 100644
index 000000000000..193fb1d560d2
--- /dev/null
+++ b/testsuite/tests/simd/should_run/T26411.stdout
@@ -0,0 +1,4 @@
+[-0.0,-1.0,-2.0,-3.0,-4.0,-5.0,-6.0,-7.0,-8.0,-9.0,-10.0,-11.0,-12.0,-13.0,-14.0,-15.0,-16.0,-17.0,-18.0,-19.0,-20.0,-21.0,-22.0,-23.0,-24.0,-25.0,-26.0,-27.0,-28.0,-29.0,-30.0,-31.0]
+OK
+[Infinity,1.0,0.5,0.3333333333333333,0.25,0.2,0.16666666666666666,0.14285714285714285,0.125,0.1111111111111111,0.1,9.090909090909091e-2,8.333333333333333e-2,7.692307692307693e-2,7.142857142857142e-2,6.666666666666667e-2,6.25e-2,5.8823529411764705e-2,5.555555555555555e-2,5.263157894736842e-2,5.0e-2,4.7619047619047616e-2,4.5454545454545456e-2,4.3478260869565216e-2,4.1666666666666664e-2,4.0e-2,3.8461538461538464e-2,3.7037037037037035e-2,3.571428571428571e-2,3.4482758620689655e-2,3.333333333333333e-2,3.225806451612903e-2]
+OK
diff --git a/testsuite/tests/simd/should_run/T26411b.hs b/testsuite/tests/simd/should_run/T26411b.hs
new file mode 100644
index 000000000000..782ac5da2f89
--- /dev/null
+++ b/testsuite/tests/simd/should_run/T26411b.hs
@@ -0,0 +1,73 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module Main (main) where
+
+import GHC.Exts
+
+data DoubleX32 = DoubleX32
+ DoubleX2# DoubleX2# DoubleX2# DoubleX2#
+ DoubleX2# DoubleX2# DoubleX2# DoubleX2#
+ DoubleX2# DoubleX2# DoubleX2# DoubleX2#
+ DoubleX2# DoubleX2# DoubleX2# DoubleX2#
+
+doubleX32ToList :: DoubleX32 -> [Double]
+doubleX32ToList (DoubleX32 v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15)
+ = a v0 . a v1 . a v2 . a v3 . a v4 . a v5 . a v6 . a v7 . a v8 . a v9 . a v10 . a v11 . a v12 . a v13 . a v14 . a v15 $ []
+ where
+ a v xs = case unpackDoubleX2# v of
+ (# x0, x1 #) -> D# x0 : D# x1 : xs
+{-# INLINE doubleX32ToList #-}
+
+doubleX32FromList :: [Double] -> DoubleX32
+doubleX32FromList [D# x0, D# x1, D# x2, D# x3, D# x4, D# x5, D# x6, D# x7, D# x8, D# x9, D# x10, D# x11, D# x12, D# x13, D# x14, D# x15, D# x16, D# x17, D# x18, D# x19, D# x20, D# x21, D# x22, D# x23, D# x24, D# x25, D# x26, D# x27, D# x28, D# x29, D# x30, D# x31]
+ = DoubleX32
+ (packDoubleX2# (# x0, x1 #)) (packDoubleX2# (# x2, x3 #)) (packDoubleX2# (# x4, x5 #)) (packDoubleX2# (# x6, x7 #))
+ (packDoubleX2# (# x8, x9 #)) (packDoubleX2# (# x10, x11 #)) (packDoubleX2# (# x12, x13 #)) (packDoubleX2# (# x14, x15 #))
+ (packDoubleX2# (# x16, x17 #)) (packDoubleX2# (# x18, x19 #)) (packDoubleX2# (# x20, x21 #)) (packDoubleX2# (# x22, x23 #))
+ (packDoubleX2# (# x24, x25 #)) (packDoubleX2# (# x26, x27 #)) (packDoubleX2# (# x28, x29 #)) (packDoubleX2# (# x30, x31 #))
+{-# NOINLINE doubleX32FromList #-}
+
+broadcastDoubleX32 :: Double -> DoubleX32
+broadcastDoubleX32 (D# x)
+ = let !v = broadcastDoubleX2# x
+ in DoubleX32 v v v v v v v v v v v v v v v v
+{-# INLINE broadcastDoubleX32 #-}
+
+negateDoubleX32 :: DoubleX32 -> DoubleX32
+negateDoubleX32 (DoubleX32 v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15)
+ = DoubleX32
+ (negateDoubleX2# v0) (negateDoubleX2# v1) (negateDoubleX2# v2) (negateDoubleX2# v3)
+ (negateDoubleX2# v4) (negateDoubleX2# v5) (negateDoubleX2# v6) (negateDoubleX2# v7)
+ (negateDoubleX2# v8) (negateDoubleX2# v9) (negateDoubleX2# v10) (negateDoubleX2# v11)
+ (negateDoubleX2# v12) (negateDoubleX2# v13) (negateDoubleX2# v14) (negateDoubleX2# v15)
+{-# NOINLINE negateDoubleX32 #-}
+
+recipDoubleX2# :: DoubleX2# -> DoubleX2#
+recipDoubleX2# v = divideDoubleX2# (broadcastDoubleX2# 1.0##) v
+{-# NOINLINE recipDoubleX2# #-}
+
+recipDoubleX32 :: DoubleX32 -> DoubleX32
+recipDoubleX32 (DoubleX32 v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15)
+ = DoubleX32
+ (recipDoubleX2# v0) (recipDoubleX2# v1) (recipDoubleX2# v2) (recipDoubleX2# v3)
+ (recipDoubleX2# v4) (recipDoubleX2# v5) (recipDoubleX2# v6) (recipDoubleX2# v7)
+ (recipDoubleX2# v8) (recipDoubleX2# v9) (recipDoubleX2# v10) (recipDoubleX2# v11)
+ (recipDoubleX2# v12) (recipDoubleX2# v13) (recipDoubleX2# v14) (recipDoubleX2# v15)
+{-# NOINLINE recipDoubleX32 #-}
+
+divideDoubleX32 :: DoubleX32 -> DoubleX32 -> DoubleX32
+divideDoubleX32 (DoubleX32 u0 u1 u2 u3 u4 u5 u6 u7 u8 u9 u10 u11 u12 u13 u14 u15) (DoubleX32 v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15)
+ = DoubleX32
+ (divideDoubleX2# u0 v0) (divideDoubleX2# u1 v1) (divideDoubleX2# u2 v2) (divideDoubleX2# u3 v3)
+ (divideDoubleX2# u4 v4) (divideDoubleX2# u5 v5) (divideDoubleX2# u6 v6) (divideDoubleX2# u7 v7)
+ (divideDoubleX2# u8 v8) (divideDoubleX2# u9 v9) (divideDoubleX2# u10 v10) (divideDoubleX2# u11 v11)
+ (divideDoubleX2# u12 v12) (divideDoubleX2# u13 v13) (divideDoubleX2# u14 v14) (divideDoubleX2# u15 v15)
+{-# INLINE divideDoubleX32 #-}
+
+main :: IO ()
+main = do
+ let a = doubleX32FromList [0..31]
+ b = divideDoubleX32 (broadcastDoubleX32 1.0) a
+ print $ doubleX32ToList b
+ putStrLn $ if doubleX32ToList b == map recip [0..31] then "OK" else "Wrong"
diff --git a/testsuite/tests/simd/should_run/T26411b.stdout b/testsuite/tests/simd/should_run/T26411b.stdout
new file mode 100644
index 000000000000..316c0c96716a
--- /dev/null
+++ b/testsuite/tests/simd/should_run/T26411b.stdout
@@ -0,0 +1,2 @@
+[Infinity,1.0,0.5,0.3333333333333333,0.25,0.2,0.16666666666666666,0.14285714285714285,0.125,0.1111111111111111,0.1,9.090909090909091e-2,8.333333333333333e-2,7.692307692307693e-2,7.142857142857142e-2,6.666666666666667e-2,6.25e-2,5.8823529411764705e-2,5.555555555555555e-2,5.263157894736842e-2,5.0e-2,4.7619047619047616e-2,4.5454545454545456e-2,4.3478260869565216e-2,4.1666666666666664e-2,4.0e-2,3.8461538461538464e-2,3.7037037037037035e-2,3.571428571428571e-2,3.4482758620689655e-2,3.333333333333333e-2,3.225806451612903e-2]
+OK
diff --git a/testsuite/tests/simd/should_run/T26542.hs b/testsuite/tests/simd/should_run/T26542.hs
new file mode 100644
index 000000000000..35a8b3403f82
--- /dev/null
+++ b/testsuite/tests/simd/should_run/T26542.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module Main where
+
+import GHC.Exts
+
+type D8# = (# DoubleX2#, Double#, DoubleX2#, Double#, DoubleX2# #)
+type D8 = (Double, Double, Double, Double, Double, Double, Double, Double)
+
+unD# :: Double -> Double#
+unD# (D# x) = x
+
+mkD8# :: Double -> D8#
+mkD8# x =
+ (# packDoubleX2# (# unD# x, unD# (x + 1) #)
+ , unD# (x + 2)
+ , packDoubleX2# (# unD# (x + 3), unD# (x + 4) #)
+ , unD# (x + 5)
+ , packDoubleX2# (# unD# (x + 6), unD# (x + 7) #)
+ #)
+{-# NOINLINE mkD8# #-}
+
+unD8# :: D8# -> D8
+unD8# (# v0, x2, v1, x5, v2 #) =
+ case unpackDoubleX2# v0 of
+ (# x0, x1 #) ->
+ case unpackDoubleX2# v1 of
+ (# x3, x4 #) ->
+ case unpackDoubleX2# v2 of
+ (# x6, x7 #) ->
+ (D# x0, D# x1, D# x2, D# x3, D# x4, D# x5, D# x6, D# x7)
+{-# NOINLINE unD8# #-}
+
+type D32# = (# D8#, D8#, D8#, D8# #)
+type D32 = (D8, D8, D8, D8)
+
+mkD32# :: Double -> D32#
+mkD32# x = (# mkD8# x, mkD8# (x + 8), mkD8# (x + 16), mkD8# (x + 24) #)
+{-# NOINLINE mkD32# #-}
+
+unD32# :: D32# -> D32
+unD32# (# x0, x1, x2, x3 #) =
+ (unD8# x0, unD8# x1, unD8# x2, unD8# x3)
+{-# NOINLINE unD32# #-}
+
+main :: IO ()
+main = do
+ let
+ !x = mkD32# 0
+ !ds = unD32# x
+ print ds
diff --git a/testsuite/tests/simd/should_run/T26542.stdout b/testsuite/tests/simd/should_run/T26542.stdout
new file mode 100644
index 000000000000..82a92efacec5
--- /dev/null
+++ b/testsuite/tests/simd/should_run/T26542.stdout
@@ -0,0 +1 @@
+((0.0,1.0,2.0,3.0,4.0,5.0,6.0,7.0),(8.0,9.0,10.0,11.0,12.0,13.0,14.0,15.0),(16.0,17.0,18.0,19.0,20.0,21.0,22.0,23.0),(24.0,25.0,26.0,27.0,28.0,29.0,30.0,31.0))
diff --git a/testsuite/tests/simd/should_run/T26550.hs b/testsuite/tests/simd/should_run/T26550.hs
new file mode 100644
index 000000000000..0c6e2c80c2ed
--- /dev/null
+++ b/testsuite/tests/simd/should_run/T26550.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module Main where
+
+import GHC.Exts
+
+type D3# = (# Double#, DoubleX2# #)
+
+unD# :: Double -> Double#
+unD# (D# x) = x
+
+mkD3# :: Double -> D3#
+mkD3# x =
+ (# unD# (x + 2)
+ , packDoubleX2# (# unD# (x + 3), unD# (x + 4) #)
+ #)
+{-# NOINLINE mkD3# #-}
+
+main :: IO ()
+main = do
+ let
+ !(# _ten, eleven_twelve #) = mkD3# 8
+ !(# eleven, twelve #) = unpackDoubleX2# eleven_twelve
+
+ putStrLn $ unlines
+ [ "eleven: " ++ show (D# eleven)
+ , "twelve: " ++ show (D# twelve)
+ ]
diff --git a/testsuite/tests/simd/should_run/T26550.stdout b/testsuite/tests/simd/should_run/T26550.stdout
new file mode 100644
index 000000000000..05f4f1bc8082
--- /dev/null
+++ b/testsuite/tests/simd/should_run/T26550.stdout
@@ -0,0 +1,3 @@
+eleven: 11.0
+twelve: 12.0
+
diff --git a/testsuite/tests/simd/should_run/all.T b/testsuite/tests/simd/should_run/all.T
index 9d9540731a3f..3df1ed2e5ad8 100644
--- a/testsuite/tests/simd/should_run/all.T
+++ b/testsuite/tests/simd/should_run/all.T
@@ -51,6 +51,11 @@ test('int64x2_shuffle_baseline', [], compile_and_run, [''])
test('T25658', [], compile_and_run, ['']) # #25658 is a bug with SSE2 code generation
test('T25659', [], compile_and_run, [''])
+# This test case uses SIMD instructions, even though the bug isn't in any way
+# tied to SIMD registers. It's useful to include it in this file so that
+# we re-use the logic for which architectures to run the test on.
+test('T26550', [], compile_and_run, ['-O1 -fno-worker-wrapper'])
+
# Ensure we set the CPU features we have available.
#
# This is especially important with the LLVM backend, as LLVM can otherwise
@@ -84,6 +89,7 @@ test('simd012', [], compile_and_run, [''])
test('simd013',
[ req_c
, unless(arch('x86_64'), skip) # because the C file uses Intel intrinsics
+ , extra_ways(["optasm"]) # #26526 demonstrated a bug in the optasm way
],
compile_and_run, ['simd013C.c'])
test('simd014',
@@ -130,6 +136,9 @@ test('T22187', [],compile,[''])
test('T22187_run', [],compile_and_run,[''])
test('T25062_V16', [], compile_and_run, [''])
test('T25561', [], compile_and_run, [''])
+test('T26542', [], compile_and_run, [''])
+test('T26411', [], compile_and_run, [''])
+test('T26411b', [], compile_and_run, ['-O'])
# Even if the CPU we run on doesn't support *executing* those tests we should try to
# compile them.
diff --git a/testsuite/tests/simplCore/should_compile/T15056.stderr b/testsuite/tests/simplCore/should_compile/T15056.stderr
index 75424c10ee3c..ba01161c0e02 100644
--- a/testsuite/tests/simplCore/should_compile/T15056.stderr
+++ b/testsuite/tests/simplCore/should_compile/T15056.stderr
@@ -5,4 +5,5 @@ Rule fired: Class op + (BUILTIN)
Rule fired: +# (BUILTIN)
Rule fired: Class op foldr (BUILTIN)
Rule fired: Class op enumFromTo (BUILTIN)
+Rule fired: eftInt (GHC.Internal.Enum)
Rule fired: fold/build (GHC.Internal.Base)
diff --git a/testsuite/tests/simplCore/should_compile/T15445.stderr b/testsuite/tests/simplCore/should_compile/T15445.stderr
index 5b87d1e21ea3..d7e1a8a97677 100644
--- a/testsuite/tests/simplCore/should_compile/T15445.stderr
+++ b/testsuite/tests/simplCore/should_compile/T15445.stderr
@@ -6,9 +6,11 @@ Rule fired: USPEC $fShowList @Int (GHC.Internal.Show)
Rule fired: Class op >> (BUILTIN)
Rule fired: USPEC plusTwoRec @Int (T15445a)
Rule fired: Class op enumFromTo (BUILTIN)
+Rule fired: eftInt (GHC.Internal.Enum)
Rule fired: Class op show (BUILTIN)
Rule fired: USPEC plusTwoRec @Int (T15445a)
Rule fired: Class op enumFromTo (BUILTIN)
+Rule fired: eftInt (GHC.Internal.Enum)
Rule fired: Class op show (BUILTIN)
Rule fired: eftIntList (GHC.Internal.Enum)
Rule fired: ># (BUILTIN)
diff --git a/testsuite/tests/simplCore/should_compile/T26323b.hs b/testsuite/tests/simplCore/should_compile/T26323b.hs
new file mode 100644
index 000000000000..a0e042f530fd
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T26323b.hs
@@ -0,0 +1,24 @@
+module T26323b where
+
+f :: Int -> Int
+f _ = 0
+{-# NOINLINE f #-}
+
+g :: Int -> Int
+g _ = 1
+{-# NOINLINE g #-}
+
+h :: Int -> Int
+h _ = 2
+{-# NOINLINE h #-}
+
+-- These two RULES loop, but that's OK because they are never active
+-- at the same time.
+{-# RULES "t1" [1] forall x. g x = f x #-}
+{-# RULES "t2" [~1] forall x. f x = g x #-}
+
+-- Make sure we don't fire "t1" and "t2" in a loop in the RHS of a never-active rule.
+{-# RULES "t" [~] forall x. h x = f x #-}
+
+test :: Int
+test = f 4 + g 5 + h 6
diff --git a/testsuite/tests/simplCore/should_compile/T26349.hs b/testsuite/tests/simplCore/should_compile/T26349.hs
new file mode 100644
index 000000000000..cf916c515240
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T26349.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE DeepSubsumption, RankNTypes #-}
+module T26349 where
+
+{-# SPECIALIZE INLINE mapTCMT :: (forall b. IO b -> IO b) -> IO a -> IO a #-}
+mapTCMT :: (forall b. m b -> n b) -> m a -> n a
+mapTCMT f m = f m
+
+{-
+ We'll check
+ tcExpr (mapTCMT) (Check ((forall b. IO b -> IO b) -> IO a_sk -> IO a_sk))
+-}
diff --git a/testsuite/tests/simplCore/should_compile/T26349.stderr b/testsuite/tests/simplCore/should_compile/T26349.stderr
new file mode 100644
index 000000000000..f1fbe0fa0b7e
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T26349.stderr
@@ -0,0 +1,10 @@
+T26349.hs:4:1: warning: [GHC-69441]
+ RULE left-hand side too complicated to desugar
+ Optimised lhs: / (ds :: forall b. IO b -> IO b) ->
+ mapTCMT @(*) @IO @IO @a ds
+ Orig lhs: (/ (@a) (ds :: forall b. IO b -> IO b) ->
+ mapTCMT @(*) @IO @IO @a (/ (@b) -> ds @b))
+ @a
+
+
+==================== Tidy Core rules ====================
diff --git a/testsuite/tests/simplCore/should_compile/T26615.hs b/testsuite/tests/simplCore/should_compile/T26615.hs
new file mode 100644
index 000000000000..b0c2b5e9e315
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T26615.hs
@@ -0,0 +1,6 @@
+module T26615 where
+
+import T26615a
+
+f :: HashMap String a -> HashMap String b -> Bool
+f = disjointSubtrees 0
diff --git a/testsuite/tests/simplCore/should_compile/T26615.stderr b/testsuite/tests/simplCore/should_compile/T26615.stderr
new file mode 100644
index 000000000000..487c89abe8c0
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T26615.stderr
@@ -0,0 +1,2574 @@
+[1 of 2] Compiling T26615a ( T26615a.hs, T26615a.o )
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+ = {terms: 1,209, types: 1,139, coercions: 18, joins: 17/29}
+
+-- RHS size: {terms: 6, types: 8, coercions: 0, joins: 0/0}
+unArray :: forall a. Array a -> SmallArray# a
+[GblId[[RecSel]],
+ Arity=1,
+ Str=<1!P(1L)>,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)}]
+unArray = \ (@a) (ds :: Array a) -> case ds of { Array ds1 -> ds1 }
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T26615a.$trModule4 :: Addr#
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 20 0}]
+T26615a.$trModule4 = "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T26615a.$trModule3 :: GHC.Internal.Types.TrName
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+T26615a.$trModule3 = GHC.Internal.Types.TrNameS T26615a.$trModule4
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T26615a.$trModule2 :: Addr#
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 30 0}]
+T26615a.$trModule2 = "T26615a"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T26615a.$trModule1 :: GHC.Internal.Types.TrName
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+T26615a.$trModule1 = GHC.Internal.Types.TrNameS T26615a.$trModule2
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+T26615a.$trModule :: GHC.Internal.Types.Module
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+T26615a.$trModule
+ = GHC.Internal.Types.Module T26615a.$trModule3 T26615a.$trModule1
+
+-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
+$krep :: GHC.Internal.Types.KindRep
+[GblId, Unf=OtherCon []]
+$krep
+ = GHC.Internal.Types.KindRepTyConApp
+ GHC.Internal.Types.$tc'Lifted
+ (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep)
+
+-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
+$krep1 :: GHC.Internal.Types.KindRep
+[GblId, Unf=OtherCon []]
+$krep1
+ = GHC.Internal.Types.KindRepTyConApp
+ GHC.Internal.Types.$tcWord
+ (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep)
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+$krep2 :: GHC.Internal.Types.KindRep
+[GblId, Unf=OtherCon []]
+$krep2 = GHC.Internal.Types.KindRepVar 1#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+$krep3 :: GHC.Internal.Types.KindRep
+[GblId, Unf=OtherCon []]
+$krep3 = GHC.Internal.Types.KindRepVar 0#
+
+-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0}
+$krep4 :: [GHC.Internal.Types.KindRep]
+[GblId, Unf=OtherCon []]
+$krep4
+ = GHC.Internal.Types.:
+ @GHC.Internal.Types.KindRep
+ $krep3
+ (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep)
+
+-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
+$krep5 :: [GHC.Internal.Types.KindRep]
+[GblId, Unf=OtherCon []]
+$krep5
+ = GHC.Internal.Types.: @GHC.Internal.Types.KindRep $krep $krep4
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+$krep6 :: GHC.Internal.Types.KindRep
+[GblId, Unf=OtherCon []]
+$krep6
+ = GHC.Internal.Types.KindRepTyConApp
+ GHC.Internal.Types.$tcSmallArray# $krep5
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tcLeaf2 :: Addr#
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 20 0}]
+T26615a.$tcLeaf2 = "Leaf"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tcLeaf1 :: GHC.Internal.Types.TrName
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+T26615a.$tcLeaf1 = GHC.Internal.Types.TrNameS T26615a.$tcLeaf2
+
+-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tcLeaf :: GHC.Internal.Types.TyCon
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+T26615a.$tcLeaf
+ = GHC.Internal.Types.TyCon
+ 13798714324392902582#Word64
+ 3237499036029031497#Word64
+ T26615a.$trModule
+ T26615a.$tcLeaf1
+ 0#
+ GHC.Internal.Types.krep$*->*->*
+
+-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0}
+$krep7 :: [GHC.Internal.Types.KindRep]
+[GblId, Unf=OtherCon []]
+$krep7
+ = GHC.Internal.Types.:
+ @GHC.Internal.Types.KindRep
+ $krep2
+ (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep)
+
+-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
+$krep8 :: [GHC.Internal.Types.KindRep]
+[GblId, Unf=OtherCon []]
+$krep8
+ = GHC.Internal.Types.: @GHC.Internal.Types.KindRep $krep3 $krep7
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+$krep9 :: GHC.Internal.Types.KindRep
+[GblId, Unf=OtherCon []]
+$krep9 = GHC.Internal.Types.KindRepTyConApp T26615a.$tcLeaf $krep8
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+$krep10 :: GHC.Internal.Types.KindRep
+[GblId, Unf=OtherCon []]
+$krep10 = GHC.Internal.Types.KindRepFun $krep2 $krep9
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'L1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep
+[GblId, Unf=OtherCon []]
+T26615a.$tc'L1 = GHC.Internal.Types.KindRepFun $krep3 $krep10
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'L3 :: Addr#
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 20 0}]
+T26615a.$tc'L3 = "'L"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'L2 :: GHC.Internal.Types.TrName
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+T26615a.$tc'L2 = GHC.Internal.Types.TrNameS T26615a.$tc'L3
+
+-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'L :: GHC.Internal.Types.TyCon
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+T26615a.$tc'L
+ = GHC.Internal.Types.TyCon
+ 8570419491837374712#Word64
+ 2090006989092642392#Word64
+ T26615a.$trModule
+ T26615a.$tc'L2
+ 2#
+ T26615a.$tc'L1
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tcArray2 :: Addr#
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 30 0}]
+T26615a.$tcArray2 = "Array"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tcArray1 :: GHC.Internal.Types.TrName
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+T26615a.$tcArray1 = GHC.Internal.Types.TrNameS T26615a.$tcArray2
+
+-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tcArray :: GHC.Internal.Types.TyCon
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+T26615a.$tcArray
+ = GHC.Internal.Types.TyCon
+ 10495761415291712389#Word64
+ 7580086293698619153#Word64
+ T26615a.$trModule
+ T26615a.$tcArray1
+ 0#
+ GHC.Internal.Types.krep$*Arr*
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+$krep11 :: GHC.Internal.Types.KindRep
+[GblId, Unf=OtherCon []]
+$krep11
+ = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep4
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'Array1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep
+[GblId, Unf=OtherCon []]
+T26615a.$tc'Array1 = GHC.Internal.Types.KindRepFun $krep6 $krep11
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'Array3 :: Addr#
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 30 0}]
+T26615a.$tc'Array3 = "'Array"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'Array2 :: GHC.Internal.Types.TrName
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+T26615a.$tc'Array2 = GHC.Internal.Types.TrNameS T26615a.$tc'Array3
+
+-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'Array :: GHC.Internal.Types.TyCon
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+T26615a.$tc'Array
+ = GHC.Internal.Types.TyCon
+ 12424115309881832159#Word64
+ 15542868641947707803#Word64
+ T26615a.$trModule
+ T26615a.$tc'Array2
+ 1#
+ T26615a.$tc'Array1
+
+-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0}
+$krep12 :: [GHC.Internal.Types.KindRep]
+[GblId, Unf=OtherCon []]
+$krep12
+ = GHC.Internal.Types.:
+ @GHC.Internal.Types.KindRep
+ $krep9
+ (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep)
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+$krep13 :: GHC.Internal.Types.KindRep
+[GblId, Unf=OtherCon []]
+$krep13
+ = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep12
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tcHashMap2 :: Addr#
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 30 0}]
+T26615a.$tcHashMap2 = "HashMap"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tcHashMap1 :: GHC.Internal.Types.TrName
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+T26615a.$tcHashMap1
+ = GHC.Internal.Types.TrNameS T26615a.$tcHashMap2
+
+-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tcHashMap :: GHC.Internal.Types.TyCon
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+T26615a.$tcHashMap
+ = GHC.Internal.Types.TyCon
+ 2021755758654901686#Word64
+ 8209241086311595496#Word64
+ T26615a.$trModule
+ T26615a.$tcHashMap1
+ 0#
+ GHC.Internal.Types.krep$*->*->*
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'Empty1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep
+[GblId, Unf=OtherCon []]
+T26615a.$tc'Empty1
+ = GHC.Internal.Types.KindRepTyConApp T26615a.$tcHashMap $krep8
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'Empty3 :: Addr#
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 30 0}]
+T26615a.$tc'Empty3 = "'Empty"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'Empty2 :: GHC.Internal.Types.TrName
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+T26615a.$tc'Empty2 = GHC.Internal.Types.TrNameS T26615a.$tc'Empty3
+
+-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'Empty :: GHC.Internal.Types.TyCon
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+T26615a.$tc'Empty
+ = GHC.Internal.Types.TyCon
+ 2520556399233147460#Word64
+ 17224648764450205443#Word64
+ T26615a.$trModule
+ T26615a.$tc'Empty2
+ 2#
+ T26615a.$tc'Empty1
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+$krep14 :: GHC.Internal.Types.KindRep
+[GblId, Unf=OtherCon []]
+$krep14 = GHC.Internal.Types.KindRepFun $krep9 T26615a.$tc'Empty1
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'Leaf1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep
+[GblId, Unf=OtherCon []]
+T26615a.$tc'Leaf1 = GHC.Internal.Types.KindRepFun $krep1 $krep14
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'Leaf3 :: Addr#
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 30 0}]
+T26615a.$tc'Leaf3 = "'Leaf"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'Leaf2 :: GHC.Internal.Types.TrName
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+T26615a.$tc'Leaf2 = GHC.Internal.Types.TrNameS T26615a.$tc'Leaf3
+
+-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'Leaf :: GHC.Internal.Types.TyCon
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+T26615a.$tc'Leaf
+ = GHC.Internal.Types.TyCon
+ 5773656560257991946#Word64
+ 17028074687139582545#Word64
+ T26615a.$trModule
+ T26615a.$tc'Leaf2
+ 2#
+ T26615a.$tc'Leaf1
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+$krep15 :: GHC.Internal.Types.KindRep
+[GblId, Unf=OtherCon []]
+$krep15 = GHC.Internal.Types.KindRepFun $krep13 T26615a.$tc'Empty1
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'Collision1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep
+[GblId, Unf=OtherCon []]
+T26615a.$tc'Collision1
+ = GHC.Internal.Types.KindRepFun $krep1 $krep15
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'Collision3 :: Addr#
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 40 0}]
+T26615a.$tc'Collision3 = "'Collision"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'Collision2 :: GHC.Internal.Types.TrName
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+T26615a.$tc'Collision2
+ = GHC.Internal.Types.TrNameS T26615a.$tc'Collision3
+
+-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'Collision :: GHC.Internal.Types.TyCon
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+T26615a.$tc'Collision
+ = GHC.Internal.Types.TyCon
+ 18175105753528304021#Word64
+ 13986842878006680511#Word64
+ T26615a.$trModule
+ T26615a.$tc'Collision2
+ 2#
+ T26615a.$tc'Collision1
+
+-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0}
+$krep16 :: [GHC.Internal.Types.KindRep]
+[GblId, Unf=OtherCon []]
+$krep16
+ = GHC.Internal.Types.:
+ @GHC.Internal.Types.KindRep
+ T26615a.$tc'Empty1
+ (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep)
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+$krep17 :: GHC.Internal.Types.KindRep
+[GblId, Unf=OtherCon []]
+$krep17
+ = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep16
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'Full1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep
+[GblId, Unf=OtherCon []]
+T26615a.$tc'Full1
+ = GHC.Internal.Types.KindRepFun $krep17 T26615a.$tc'Empty1
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'Full3 :: Addr#
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 30 0}]
+T26615a.$tc'Full3 = "'Full"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'Full2 :: GHC.Internal.Types.TrName
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+T26615a.$tc'Full2 = GHC.Internal.Types.TrNameS T26615a.$tc'Full3
+
+-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'Full :: GHC.Internal.Types.TyCon
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+T26615a.$tc'Full
+ = GHC.Internal.Types.TyCon
+ 12008762105994325570#Word64
+ 13514145886440831186#Word64
+ T26615a.$trModule
+ T26615a.$tc'Full2
+ 2#
+ T26615a.$tc'Full1
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'BitmapIndexed1 [InlPrag=[~]]
+ :: GHC.Internal.Types.KindRep
+[GblId, Unf=OtherCon []]
+T26615a.$tc'BitmapIndexed1
+ = GHC.Internal.Types.KindRepFun $krep1 T26615a.$tc'Full1
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'BitmapIndexed3 :: Addr#
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 50 0}]
+T26615a.$tc'BitmapIndexed3 = "'BitmapIndexed"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'BitmapIndexed2 :: GHC.Internal.Types.TrName
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+T26615a.$tc'BitmapIndexed2
+ = GHC.Internal.Types.TrNameS T26615a.$tc'BitmapIndexed3
+
+-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
+T26615a.$tc'BitmapIndexed :: GHC.Internal.Types.TyCon
+[GblId,
+ Unf=Unf{Src=, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+T26615a.$tc'BitmapIndexed
+ = GHC.Internal.Types.TyCon
+ 15226751910432948177#Word64
+ 957331387129868915#Word64
+ T26615a.$trModule
+ T26615a.$tc'BitmapIndexed2
+ 2#
+ T26615a.$tc'BitmapIndexed1
+
+-- RHS size: {terms: 98, types: 109, coercions: 0, joins: 3/4}
+T26615a.$wdisjointCollisions [InlPrag=INLINABLE[2]]
+ :: forall k a b.
+ Eq k =>
+ Word#
+ -> Array (Leaf k a) -> Word# -> SmallArray# (Leaf k b) -> Bool
+[GblId[StrictWorker([~, ~, !])],
+ Arity=5,
+ Str=<1L>,
+ Unf=Unf{Src=StableUser, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [30 0 20 0 0] 406 10
+ Tmpl= \ (@k)
+ (@a)
+ (@b)
+ ($dEq :: Eq k)
+ (ww [Occ=Once1] :: Word#)
+ (aryA [Occ=Once1!] :: Array (Leaf k a))
+ (ww1 [Occ=Once1] :: Word#)
+ (ww2 :: SmallArray# (Leaf k b)) ->
+ case aryA of aryA1 [Occ=Once1] { Array ipv [Occ=Once1] ->
+ let {
+ aryB [Occ=OnceL1] :: Array (Leaf k b)
+ [LclId, Unf=OtherCon []]
+ aryB = T26615a.Array @(Leaf k b) ww2 } in
+ case GHC.Internal.Classes.eqWord
+ (GHC.Internal.Types.W# ww) (GHC.Internal.Types.W# ww1)
+ of {
+ False -> GHC.Internal.Types.True;
+ True ->
+ joinrec {
+ foldr_ [Occ=LoopBreakerT[4]]
+ :: Array (Leaf k a) -> Int -> Int -> Bool -> Bool
+ [LclId[JoinId(4)(Nothing)],
+ Arity=4,
+ Str=,
+ Unf=OtherCon []]
+ foldr_ (ary [Occ=Once1!] :: Array (Leaf k a))
+ (n :: Int)
+ (i :: Int)
+ (z [Occ=Once2] :: Bool)
+ = case GHC.Internal.Classes.geInt i n of {
+ False ->
+ case i of { I# i# ->
+ case ary of wild3 [Occ=Once1] { Array ds [Occ=Once1] ->
+ case indexSmallArray# @Lifted @(Leaf k a) ds i# of
+ { (# ipv1 [Occ=Once1!] #) ->
+ case ipv1 of { L kA [Occ=Once1] _ [Occ=Dead] ->
+ join {
+ $j [Occ=OnceL1T[0]] :: Bool
+ [LclId[JoinId(0)(Nothing)]]
+ $j = jump foldr_ wild3 n (GHC.Internal.Types.I# (+# i# 1#)) z } in
+ joinrec {
+ lookupInArrayCont_ [Occ=LoopBreakerT[5]]
+ :: Eq k => k -> Array (Leaf k b) -> Int -> Int -> Bool
+ [LclId[JoinId(5)(Nothing)],
+ Arity=5,
+ Str=,
+ Unf=OtherCon []]
+ lookupInArrayCont_ _ [Occ=Dead]
+ (k1 [Occ=Once1] :: k)
+ (ary1 [Occ=Once1!] :: Array (Leaf k b))
+ (i1 [Occ=Once1!] :: Int)
+ (n1 [Occ=Once1!] :: Int)
+ = case k1 of k2 { __DEFAULT ->
+ case ary1 of ary2 [Occ=Once1] { Array ipv2 [Occ=Once1] ->
+ case i1 of i2 [Occ=Once1] { I# ipv3 ->
+ case n1 of n2 { I# _ [Occ=Dead] ->
+ case GHC.Internal.Classes.geInt i2 n2 of {
+ False ->
+ case indexSmallArray# @Lifted @(Leaf k b) ipv2 ipv3 of
+ { (# ipv5 [Occ=Once1!] #) ->
+ case ipv5 of { L kx [Occ=Once1] _ [Occ=Dead] ->
+ case == @k $dEq k2 kx of {
+ False ->
+ jump lookupInArrayCont_
+ $dEq k2 ary2 (GHC.Internal.Types.I# (+# ipv3 1#)) n2;
+ True -> GHC.Internal.Types.False
+ }
+ }
+ };
+ True -> jump $j
+ }
+ }
+ }
+ }
+ }; } in
+ jump lookupInArrayCont_
+ $dEq
+ kA
+ aryB
+ (GHC.Internal.Types.I# 0#)
+ (GHC.Internal.Types.I# (sizeofSmallArray# @Lifted @(Leaf k b) ww2))
+ }
+ }
+ }
+ };
+ True -> z
+ }; } in
+ jump foldr_
+ aryA1
+ (GHC.Internal.Types.I# (sizeofSmallArray# @Lifted @(Leaf k a) ipv))
+ (GHC.Internal.Types.I# 0#)
+ GHC.Internal.Types.True
+ }
+ }}]
+T26615a.$wdisjointCollisions
+ = \ (@k)
+ (@a)
+ (@b)
+ ($dEq :: Eq k)
+ (ww :: Word#)
+ (aryA :: Array (Leaf k a))
+ (ww1 :: Word#)
+ (ww2 :: SmallArray# (Leaf k b)) ->
+ case aryA of { Array ipv ->
+ case eqWord# ww ww1 of {
+ __DEFAULT -> GHC.Internal.Types.True;
+ 1# ->
+ let {
+ lvl2 :: Int#
+ [LclId]
+ lvl2 = sizeofSmallArray# @Lifted @(Leaf k b) ww2 } in
+ joinrec {
+ $s$wfoldr_ [InlPrag=[2],
+ Occ=LoopBreaker,
+ Dmd=SC(S,C(1,C(1,C(1,L))))]
+ :: Bool -> Int# -> Int# -> SmallArray# (Leaf k a) -> Bool
+ [LclId[JoinId(4)(Nothing)],
+ Arity=4,
+ Str=,
+ Unf=OtherCon []]
+ $s$wfoldr_ (sc :: Bool)
+ (sc1 :: Int#)
+ (sc2 :: Int#)
+ (sc3 :: SmallArray# (Leaf k a))
+ = case >=# sc1 sc2 of {
+ __DEFAULT ->
+ case indexSmallArray# @Lifted @(Leaf k a) sc3 sc1 of
+ { (# ipv1 #) ->
+ case ipv1 of { L kA ds1 ->
+ join {
+ $j :: Bool
+ [LclId[JoinId(0)(Nothing)]]
+ $j = jump $s$wfoldr_ sc (+# sc1 1#) sc2 sc3 } in
+ joinrec {
+ $wlookupInArrayCont_ [InlPrag=[2],
+ Occ=LoopBreaker,
+ Dmd=SC(S,C(1,C(1,C(1,L))))]
+ :: k -> SmallArray# (Leaf k b) -> Int# -> Int# -> Bool
+ [LclId[JoinId(4)(Just [!])],
+ Arity=4,
+ Str=<1L>,
+ Unf=OtherCon []]
+ $wlookupInArrayCont_ (k1 :: k)
+ (ww3 :: SmallArray# (Leaf k b))
+ (ww4 :: Int#)
+ (ww5 :: Int#)
+ = case k1 of k2 { __DEFAULT ->
+ case >=# ww4 ww5 of {
+ __DEFAULT ->
+ case indexSmallArray# @Lifted @(Leaf k b) ww3 ww4 of
+ { (# ipv2 #) ->
+ case ipv2 of { L kx v ->
+ case == @k $dEq k2 kx of {
+ False -> jump $wlookupInArrayCont_ k2 ww3 (+# ww4 1#) ww5;
+ True -> GHC.Internal.Types.False
+ }
+ }
+ };
+ 1# -> jump $j
+ }
+ }; } in
+ jump $wlookupInArrayCont_ kA ww2 0# lvl2
+ }
+ };
+ 1# -> sc
+ }; } in
+ jump $s$wfoldr_
+ GHC.Internal.Types.True
+ 0#
+ (sizeofSmallArray# @Lifted @(Leaf k a) ipv)
+ ipv
+ }
+ }
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+lvl :: Addr#
+[GblId, Unf=OtherCon []]
+lvl = "T26615a.hs:(26,1)-(65,59)|function disjointSubtrees"#
+
+-- RHS size: {terms: 2, types: 2, coercions: 0, joins: 0/0}
+lvl1 :: ()
+[GblId, Str=b, Cpr=b]
+lvl1
+ = GHC.Internal.Control.Exception.Base.patError @LiftedRep @() lvl
+
+Rec {
+-- RHS size: {terms: 133, types: 126, coercions: 0, joins: 1/2}
+T26615a.disjointSubtrees_$s$wdisjointSubtrees [InlPrag=INLINABLE[2],
+ Occ=LoopBreaker]
+ :: forall b a k.
+ Word#
+ -> SmallArray# (Leaf k a) -> Int# -> Eq k => HashMap k b -> Bool
+[GblId[StrictWorker([~, ~, ~, ~, !])],
+ Arity=5,
+ Str=