[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Add functions to check for weakly pinned arrays.
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Sep 3 20:49:21 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
768fe644 by Andreas Klebinger at 2024-09-03T13:15:20-04:00
Add functions to check for weakly pinned arrays.
This commit adds `isByteArrayWeaklyPinned#` and `isMutableByteArrayWeaklyPinned#` primops.
These check if a bytearray is *weakly* pinned. Which means it can still be explicitly moved
by the user via compaction but won't be moved by the RTS.
This moves us one more stop closer to nailing down #22255.
- - - - -
b16605e7 by Arsen Arsenović at 2024-09-03T13:16:05-04:00
ghc-toolchain: Don't leave stranded a.outs when testing for -g0
This happened because, when ghc-toolchain tests for -g0, it does so by
compiling an empty program. This compilation creates an a.out.
Since we create a temporary directory, lets place the test program
compilation in it also, so that it gets cleaned up.
Fixes: 25b0b40467d0a12601497117c0ad14e1fcab0b74
Closes: https://gitlab.haskell.org/ghc/ghc/-/issues/25203
- - - - -
83e70b14 by Torsten Schmits at 2024-09-03T13:16:41-04:00
Build foreign objects for TH with interpreter's way when loading from iface
Fixes #25211
When linking bytecode for TH from interface core bindings with
`-fprefer-byte-code`, foreign sources are loaded from the interface as
well and compiled to object code in an ad-hoc manner.
The results are then loaded by the interpreter, whose way may differ
from the current build's target way.
This patch ensures that foreign objects are compiled with the
interpreter's way.
- - - - -
2f10c710 by Cheng Shao at 2024-09-03T16:49:04-04:00
rts: fix checkClosure error message
This patch fixes an error message in checkClosure() when the closure
has already been evacuated. The previous logic was meant to print the
evacuated closure's type in the error message, but it was completely
wrong, given info was not really an info table, but a tagged pointer
that points to the closure's new address.
- - - - -
50ce9af1 by Sven Tennie at 2024-09-03T16:49:05-04:00
MO_AcquireFence: Less restrictive barrier
GCC and CLang translate the built-in `atomic_thread_fence(memory_order_acquire)`
to `dmb ishld`, which is a bit less restrictive than `dmb ish` (which
also implies stores.)
- - - - -
19 changed files:
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
- compiler/GHC/CmmToAsm/AArch64/Instr.hs
- compiler/GHC/CmmToAsm/AArch64/Ppr.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/StgToJS/Prim.hs
- compiler/GHC/Unit/Module/WholeCoreBindings.hs
- docs/users_guide/9.12.1-notes.rst
- docs/users_guide/exts/ffi.rst
- libraries/base/src/GHC/Base.hs
- libraries/base/src/GHC/Exts.hs
- libraries/ghc-prim/changelog.md
- rts/PrimOps.cmm
- rts/RtsSymbols.c
- rts/include/stg/MiscClosures.h
- rts/sm/Sanity.c
- testsuite/tests/rts/T13894.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs
Changes:
=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -1925,7 +1925,25 @@ primop MutableByteArrayIsPinnedOp "isMutableByteArrayPinned#" GenPrimOp
primop ByteArrayIsPinnedOp "isByteArrayPinned#" GenPrimOp
ByteArray# -> Int#
- {Determine whether a 'ByteArray#' is guaranteed not to move during GC.}
+ {Determine whether a 'ByteArray#' is guaranteed not to move.}
+ with out_of_line = True
+
+primop ByteArrayIsWeaklyPinnedOp "isByteArrayWeaklyPinned#" GenPrimOp
+ ByteArray# -> Int#
+ {Similar to 'isByteArrayPinned#'. Weakly pinned byte arrays are allowed
+ to be copied into compact regions by the user, potentially invalidating
+ the results of earlier calls to 'byteArrayContents#'.
+
+ See the section `Pinned Byte Arrays` in the user guide for more information.
+
+ This function also returns true for regular pinned bytearrays.
+ }
+ with out_of_line = True
+
+primop MutableByteArrayIsWeaklyPinnedOp "isMutableByteArrayWeaklyPinned#" GenPrimOp
+ MutableByteArray# s -> Int#
+ { 'isByteArrayWeaklyPinned#' but for mutable arrays.
+ }
with out_of_line = True
primop ByteArrayContents_Char "byteArrayContents#" GenPrimOp
=====================================
compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
=====================================
@@ -1990,9 +1990,13 @@ genCCall target dest_regs arg_regs = do
MO_SubIntC _w -> unsupported mop
-- Memory Ordering
- MO_AcquireFence -> return (unitOL DMBISH)
- MO_ReleaseFence -> return (unitOL DMBISH)
- MO_SeqCstFence -> return (unitOL DMBISH)
+ -- Set flags according to their C pendants (stdatomic.h):
+ -- atomic_thread_fence(memory_order_acquire); // -> dmb ishld
+ MO_AcquireFence -> return . unitOL $ DMBISH DmbLoad
+ -- atomic_thread_fence(memory_order_release); // -> dmb ish
+ MO_ReleaseFence -> return . unitOL $ DMBISH DmbLoadStore
+ -- atomic_thread_fence(memory_order_seq_cst); // -> dmb ish
+ MO_SeqCstFence -> return . unitOL $ DMBISH DmbLoadStore
MO_Touch -> return nilOL -- Keep variables live (when using interior pointers)
-- Prefetch
MO_Prefetch_Data _n -> return nilOL -- Prefetch hint.
=====================================
compiler/GHC/CmmToAsm/AArch64/Instr.hs
=====================================
@@ -134,7 +134,7 @@ regUsageOfInstr platform instr = case instr of
LDAR _ dst src -> usage (regOp src, regOp dst)
-- 8. Synchronization Instructions -------------------------------------------
- DMBISH -> usage ([], [])
+ DMBISH _ -> usage ([], [])
-- 9. Floating Point Instructions --------------------------------------------
FMOV dst src -> usage (regOp src, regOp dst)
@@ -281,7 +281,7 @@ patchRegsOfInstr instr env = case instr of
LDAR f o1 o2 -> LDAR f (patchOp o1) (patchOp o2)
-- 8. Synchronization Instructions -----------------------------------------
- DMBISH -> DMBISH
+ DMBISH c -> DMBISH c
-- 9. Floating Point Instructions ------------------------------------------
FMOV o1 o2 -> FMOV (patchOp o1) (patchOp o2)
@@ -649,7 +649,7 @@ data Instr
| BCOND Cond Target -- branch with condition. b.<cond>
-- 8. Synchronization Instructions -----------------------------------------
- | DMBISH
+ | DMBISH DMBISHFlags
-- 9. Floating Point Instructions
-- move to/from general purpose <-> floating, or floating to floating
| FMOV Operand Operand
@@ -672,6 +672,9 @@ data Instr
-- - fnmadd: d = - r1 * r2 - r3
| FMA FMASign Operand Operand Operand Operand
+data DMBISHFlags = DmbLoad | DmbLoadStore
+ deriving (Eq, Show)
+
instrCon :: Instr -> String
instrCon i =
case i of
=====================================
compiler/GHC/CmmToAsm/AArch64/Ppr.hs
=====================================
@@ -527,7 +527,8 @@ pprInstr platform instr = case instr of
LDAR _f o1 o2 -> op2 (text "\tldar") o1 o2
-- 8. Synchronization Instructions -------------------------------------------
- DMBISH -> line $ text "\tdmb ish"
+ DMBISH DmbLoadStore -> line $ text "\tdmb ish"
+ DMBISH DmbLoad -> line $ text "\tdmb ishld"
-- 9. Floating Point Instructions --------------------------------------------
FMOV o1 o2 -> op2 (text "\tfmov") o1 o2
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -1,5 +1,4 @@
{-# LANGUAGE LambdaCase #-}
-
{-# LANGUAGE NondecreasingIndentation #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiWayIf #-}
@@ -295,13 +294,13 @@ import Data.Time
import System.IO.Unsafe ( unsafeInterleaveIO )
import GHC.Iface.Env ( trace_if )
+import GHC.Platform.Ways
import GHC.Stg.InferTags.TagSig (seqTagSig)
import GHC.StgToCmm.Utils (IPEStats)
import GHC.Types.Unique.FM
import GHC.Types.Unique.DFM
import GHC.Cmm.Config (CmmConfig)
-
{- **********************************************************************
%* *
Initialisation
@@ -990,6 +989,27 @@ initModDetails hsc_env iface =
-- in make mode, since this HMI will go into the HPT.
genModDetails hsc_env' iface
+-- | Modify flags such that objects are compiled for the interpreter's way.
+-- This is necessary when building foreign objects for Template Haskell, since
+-- those are object code built outside of the pipeline, which means they aren't
+-- subject to the mechanism in 'enableCodeGenWhen' that requests dynamic build
+-- outputs for dependencies when the interpreter used for TH is dynamic but the
+-- main outputs aren't.
+-- Furthermore, the HPT only stores one set of objects with different names for
+-- bytecode linking in 'HomeModLinkable', so the usual hack for switching
+-- between ways in 'get_link_deps' doesn't work.
+compile_for_interpreter :: HscEnv -> (HscEnv -> IO a) -> IO a
+compile_for_interpreter hsc_env use =
+ use (hscUpdateFlags update hsc_env)
+ where
+ update dflags = dflags {
+ targetWays_ = adapt_way interpreterDynamic WayDyn $
+ adapt_way interpreterProfiled WayProf $
+ targetWays_ dflags
+ }
+
+ adapt_way want = if want (hscInterp hsc_env) then addWay else removeWay
+
-- | If the 'Linkable' contains Core bindings loaded from an interface, replace
-- them with a lazy IO thunk that compiles them to bytecode and foreign objects.
--
@@ -2063,9 +2083,10 @@ generateByteCode :: HscEnv
-> IO (CompiledByteCode, [FilePath])
generateByteCode hsc_env cgguts mod_location = do
(hasStub, comp_bc) <- hscInteractive hsc_env cgguts mod_location
- stub_o <- traverse (compileForeign hsc_env LangC) hasStub
- foreign_files_o <- traverse (uncurry (compileForeign hsc_env)) (cgi_foreign_files cgguts)
- pure (comp_bc, maybeToList stub_o ++ foreign_files_o)
+ compile_for_interpreter hsc_env $ \ i_env -> do
+ stub_o <- traverse (compileForeign i_env LangC) hasStub
+ foreign_files_o <- traverse (uncurry (compileForeign i_env)) (cgi_foreign_files cgguts)
+ pure (comp_bc, maybeToList stub_o ++ foreign_files_o)
generateFreshByteCode :: HscEnv
-> ModuleName
=====================================
compiler/GHC/StgToCmm/Prim.hs
=====================================
@@ -1668,10 +1668,12 @@ emitPrimOp cfg primop =
NewPinnedByteArrayOp_Char -> alwaysExternal
NewAlignedPinnedByteArrayOp_Char -> alwaysExternal
MutableByteArrayIsPinnedOp -> alwaysExternal
+ MutableByteArrayIsWeaklyPinnedOp -> alwaysExternal
DoubleDecode_2IntOp -> alwaysExternal
DoubleDecode_Int64Op -> alwaysExternal
FloatDecode_IntOp -> alwaysExternal
ByteArrayIsPinnedOp -> alwaysExternal
+ ByteArrayIsWeaklyPinnedOp -> alwaysExternal
ShrinkMutableByteArrayOp_Char -> alwaysExternal
ResizeMutableByteArrayOp_Char -> alwaysExternal
ShrinkSmallMutableArrayOp_Char -> alwaysExternal
=====================================
compiler/GHC/StgToJS/Prim.hs
=====================================
@@ -670,6 +670,8 @@ genPrim prof bound ty op = case op of
NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> pure $ PrimInline (newByteArray r l)
MutableByteArrayIsPinnedOp -> \[r] [_] -> pure $ PrimInline $ r |= one_
ByteArrayIsPinnedOp -> \[r] [_] -> pure $ PrimInline $ r |= one_
+ ByteArrayIsWeaklyPinnedOp -> \[r] [_] -> pure $ PrimInline $ r |= one_
+ MutableByteArrayIsWeaklyPinnedOp -> \[r] [_] -> pure $ PrimInline $ r |= one_
ByteArrayContents_Char -> \[a,o] [b] -> pure $ PrimInline $ mconcat [a |= b, o |= zero_]
MutableByteArrayContents_Char -> \[a,o] [b] -> pure $ PrimInline $ mconcat [a |= b, o |= zero_]
ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> pure $ PrimInline $ appS hdShrinkMutableByteArrayStr [a,n]
=====================================
compiler/GHC/Unit/Module/WholeCoreBindings.hs
=====================================
@@ -190,13 +190,9 @@ Even if that wasn't an issue, they are compiled for the session's 'Way', not its
associated module's, so the dynamic variant wouldn't be available when building
only static outputs.
-For now, this doesn't have much of an impact, since we're only supporting
-foreign imports initially, which produce very simple objects that can easily be
-handled by the linker when 'GHC.Linker.Loader.dynLoadObjs' creates a shared
-library from all object file inputs.
-However, for more complex circumstances, we should compile foreign stubs
-specially for TH according to the interpreter 'Way', or request dynamic products
-for TH dependencies like it happens for the conventional case.
+To mitigate this, we instead build foreign objects specially for the
+interpreter, updating the build flags in 'compile_for_interpreter' to use the
+interpreter's way.
Problem 4:
=====================================
docs/users_guide/9.12.1-notes.rst
=====================================
@@ -163,6 +163,12 @@ Runtime system
~~~~~~~~~~~~~~~~~~~~
- Usage of deprecated primops is now correctly reported (#19629).
+- New primops `isMutableByteArrayWeaklyPinned#` and `isByteArrayWeaklyPinned#`
+ to allow users to avoid copying large arrays safely when dealing with ffi.
+ See the users guide for more details on the different kinds of
+ pinned arrays in 9.12.
+
+ This need for this distinction originally surfaced in https://gitlab.haskell.org/ghc/ghc/-/issues/22255
``ghc`` library
=====================================
docs/users_guide/exts/ffi.rst
=====================================
@@ -1114,21 +1114,67 @@ Pinned Byte Arrays
A pinned byte array is one that the garbage collector is not allowed
to move. Consequently, it has a stable address that can be safely
-requested with ``byteArrayContents#``. Not that being pinned doesn't
-prevent the byteArray from being gc'ed in the same fashion a regular
-byte array would be.
+requested with ``byteArrayContents#``. As long as the array remains live
+the address returned by ``byteArrayContents#`` will remain valid. Note that
+being pinned doesn't prevent the byteArray from being gc'ed in the same fashion
+a regular byte array would be if there are no more references to the ``ByteArray#``.
There are a handful of primitive functions in :base-ref:`GHC.Exts.`
used to enforce or check for pinnedness: ``isByteArrayPinned#``,
-``isMutableByteArrayPinned#``, and ``newPinnedByteArray#``. A
-byte array can be pinned as a result of three possible causes:
+``isMutableByteArrayPinned#``, ``isByteArrayWeaklyPinned#``,
+``isMutableByteArrayWeaklyPinned#``, and ``newPinnedByteArray#``. A
+byte array can be pinned or weakly pinned as a result of three possible causes:
-1. It was allocated by ``newPinnedByteArray#``.
-2. It is large. Currently, GHC defines large object to be one
+1. It was allocated by ``newPinnedByteArray#``. This results in a regular pinned byte array.
+2. It is large, this results in a weakly pinned byte array. Currently, GHC defines large object to be one
that is at least as large as 80% of a 4KB block (i.e. at
least 3277 bytes).
-3. It has been copied into a compact region. The documentation
+3. It has been copied into a compact region, resulting in a weakly pinned array. The documentation
for ``ghc-compact`` and ``compact`` describes this process.
+The difference between a pinned array and a weakly pinned array is simply that
+trying to compact a pinned array will result in an exception. Trying to compact
+a weakly pinned array will succeed. However the result of earlier
+calls to ``byteArrayContents#`` is not updated during compaction, which means
+these results will still point to the address where the array was located originally,
+and not to the new address inside the compact region.
+
+This is particularly dangerous when an address to a byte arrays content is stored
+inside a datastructure along with a reference to the byte array.
+If the data structure is compacted later on the pointer won't be updated but the
+reference to the byte array will point to a copy inside the compact region.
+A common data type susceptible to this is `ForeignPtr` when used to represent a ByteArray#.
+
+Here is an example to illustrate this:
+
+.. code-block:: haskell
+
+ workWithArrayContents :: (ByteArray, Ptr Word8) -> (Ptr Word8 -> IO ()) -> IO ()
+ workWithArrayContents (arr@(ByteArray uarr),ptr) worker =
+ case () of
+ _
+ -- Conservative but safe
+ | isByteArrayPinned arr -> keepAliveUnlifted uarr (worker ptr)
+ -- Potentially dangerous, the program needs to ensures the Ptr points into the array.
+ | isByteArrayWeaklyPinned arr -> keepAliveUnlifted uarr (worker ptr)
+ | otherwise -> ... -- Otherwise we can't directly use it for safe FFI calls directly at all.
+
+ main :: IO ()
+ main = do
+ -- We create a large array, which causes it to be implicitly pinned
+ arr <- newByteArray 5000
+ arr@(ByteArray uarr) <- freezeByteArray arr 0 5000 -- Make it immutable
+ let ptr = byteArrayContents arr
+
+ -- Compacting a data structure that contains both an array and a ptr to
+ -- the arrays content's is dangerous and usually the wrong thing to do.
+ let foo = (arr, ptr)
+ foo_compacted <- compact foo
+
+ -- This is fine
+ workWithArrayContents foo do_work
+ -- This is unsound
+ workWithArrayContents (getCompact foo_compacted) do_work
+
.. [1] Prior to GHC 8.10, when passing an ``ArrayArray#`` argument
to a foreign function, the foreign function would see a pointer
to the ``StgMutArrPtrs`` rather than just the payload.
=====================================
libraries/base/src/GHC/Base.hs
=====================================
@@ -139,7 +139,8 @@ module GHC.Base
) where
import GHC.Internal.Base
-import GHC.Prim hiding (dataToTagLarge#, dataToTagSmall#, whereFrom#)
+import GHC.Prim hiding (dataToTagLarge#, dataToTagSmall#, whereFrom#,
+ isByteArrayWeaklyPinned#, isMutableByteArrayWeaklyPinned#)
-- Hide dataToTagLarge# because it is expected to break for
-- GHC-internal reasons in the near future, and shouldn't
-- be exposed from base (not even GHC.Exts)
=====================================
libraries/base/src/GHC/Exts.hs
=====================================
@@ -112,7 +112,9 @@ module GHC.Exts
import GHC.Internal.Exts
import GHC.Internal.ArrayArray
-import GHC.Prim hiding ( coerce, dataToTagSmall#, dataToTagLarge#, whereFrom# )
+import GHC.Prim hiding (
+ coerce, dataToTagSmall#, dataToTagLarge#, whereFrom#,
+ isByteArrayWeaklyPinned#, isMutableByteArrayWeaklyPinned# )
-- Hide dataToTag# ops because they are expected to break for
-- GHC-internal reasons in the near future, and shouldn't
-- be exposed from base (not even GHC.Exts)
=====================================
libraries/ghc-prim/changelog.md
=====================================
@@ -1,3 +1,12 @@
+## 0.13.0
+
+- Shipped with GHC 9.12.1
+
+- Add primops that allow users to distinguish weakly pinned byte arrays from unpinned ones.
+
+ isMutableByteArrayWeaklyPinned# :: MutableByteArray# s -> Int#
+ isByteArrayWeaklyPinned# :: ByteArray# s -> Int#
+
## 0.12.0
- Shipped with GHC 9.10.1
=====================================
rts/PrimOps.cmm
=====================================
@@ -215,12 +215,29 @@ stg_isByteArrayPinnedzh ( gcptr ba )
return (flags & BF_PINNED != 0);
}
+stg_isByteArrayWeaklyPinnedzh ( gcptr ba )
+// ByteArray# s -> Int#
+{
+ W_ bd, flags;
+ bd = Bdescr(ba);
+ // See #22255 and the primop docs.
+ flags = TO_W_(bdescr_flags(bd));
+
+ return (flags & (BF_PINNED | BF_COMPACT | BF_LARGE) != 0);
+}
+
stg_isMutableByteArrayPinnedzh ( gcptr mba )
// MutableByteArray# s -> Int#
{
jump stg_isByteArrayPinnedzh(mba);
}
+stg_isMutableByteArrayWeaklyPinnedzh ( gcptr mba )
+// MutableByteArray# s -> Int#
+{
+ jump stg_isByteArrayWeaklyPinnedzh(mba);
+}
+
/* Note [LDV profiling and resizing arrays]
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
* As far as the LDV profiler is concerned arrays are "inherently used" which
=====================================
rts/RtsSymbols.c
=====================================
@@ -656,6 +656,8 @@ extern char **environ;
SymI_HasDataProto(stg_newAlignedPinnedByteArrayzh) \
SymI_HasDataProto(stg_isByteArrayPinnedzh) \
SymI_HasDataProto(stg_isMutableByteArrayPinnedzh) \
+ SymI_HasDataProto(stg_isByteArrayWeaklyPinnedzh) \
+ SymI_HasDataProto(stg_isMutableByteArrayWeaklyPinnedzh) \
SymI_HasDataProto(stg_shrinkMutableByteArrayzh) \
SymI_HasDataProto(stg_resizzeMutableByteArrayzh) \
SymI_HasDataProto(stg_shrinkSmallMutableArrayzh) \
=====================================
rts/include/stg/MiscClosures.h
=====================================
@@ -454,6 +454,8 @@ RTS_FUN_DECL(stg_newPinnedByteArrayzh);
RTS_FUN_DECL(stg_newAlignedPinnedByteArrayzh);
RTS_FUN_DECL(stg_isByteArrayPinnedzh);
RTS_FUN_DECL(stg_isMutableByteArrayPinnedzh);
+RTS_FUN_DECL(stg_isByteArrayWeaklyPinnedzh);
+RTS_FUN_DECL(stg_isMutableByteArrayWeaklyPinnedzh);
RTS_FUN_DECL(stg_shrinkMutableByteArrayzh);
RTS_FUN_DECL(stg_resizzeMutableByteArrayzh);
RTS_FUN_DECL(stg_shrinkSmallMutableArrayzh);
=====================================
rts/sm/Sanity.c
=====================================
@@ -357,7 +357,8 @@ checkClosure( const StgClosure* p )
info = ACQUIRE_LOAD(&p->header.info);
if (IS_FORWARDING_PTR(info)) {
- barf("checkClosure: found EVACUATED closure %d", info->type);
+ ASSERT(LOOKS_LIKE_CLOSURE_PTR(info));
+ barf("checkClosure: found EVACUATED closure %u", GET_INFO((StgClosure*)UN_FORWARDING_PTR(info))->type);
}
#if defined(PROFILING)
=====================================
testsuite/tests/rts/T13894.hs
=====================================
@@ -6,6 +6,7 @@
import Control.Monad
import GHC.Exts
+import GHC.Internal.Exts (isMutableByteArrayWeaklyPinned#)
import GHC.IO
main :: IO ()
@@ -16,3 +17,10 @@ main = do
case isMutableByteArrayPinned# arr# of
n# -> (# s1, isTrue# n# #)
when pinned $ putStrLn "BAD"
+
+ weakly_pinned <- IO $ \s0 ->
+ case newByteArray# 1000000# s0 of
+ (# s1, arr# #) ->
+ case isMutableByteArrayWeaklyPinned# arr# of
+ n# -> (# s1, isTrue# n# #)
+ when (not weakly_pinned) $ putStrLn "BAD"
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs
=====================================
@@ -39,10 +39,10 @@ data CmmCpp = CmmCpp { cmmCppProgram :: Program
}
deriving (Show, Read, Eq, Ord)
-checkFlag :: String -> Program -> String -> M ()
-checkFlag conftest cpp flag = checking ("for "++flag++" support") $
+checkFlag :: String -> Program -> String -> [String] -> M ()
+checkFlag conftest cpp flag extra_args = checking ("for "++flag++" support") $
-- Werror to ensure that unrecognized warnings result in an error
- callProgram cpp ["-Werror", flag, conftest]
+ callProgram cpp $ ["-Werror", flag, conftest] ++ extra_args
-- tryFlag :: String -> Program -> String -> M [String]
-- tryFlag conftest cpp flag =
-- ([flag] <$ checkFlag conftest cpp flag) <|> return []
@@ -167,7 +167,7 @@ findCmmCpp progOpt cc = checking "for a Cmm preprocessor" $ do
cmmCppSupportsG0 <- withTempDir $ \dir -> do
let conftest = dir </> "conftest.c"
writeFile conftest "int main(void) {}"
- True <$ checkFlag conftest cpp "-g0" <|> return False
+ True <$ checkFlag conftest cpp "-g0" ["-o", dir </> "conftest"] <|> return False
-- Always add the -E flag to the CPP, regardless of the user options
let cmmCppProgram = foldr addFlagIfNew cpp ["-E"]
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/867611279614f3fd44f90c92404a7a08b7a0d0a0...50ce9af142800d839d5f988d7db06499dd86115c
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/867611279614f3fd44f90c92404a7a08b7a0d0a0...50ce9af142800d839d5f988d7db06499dd86115c
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240903/154b67f0/attachment-0001.html>
More information about the ghc-commits
mailing list