+   defined_bits     = Nothing -- The number of bits the operation is defined for (if not all bits)

+    with defined_bits = 16

+    with defined_bits = 32

+    with defined_bits = 8

+    with defined_bits = 16

+    with defined_bits = 32

+-- Handle Clz, Ctz, BRev, BSwap, Pdep, Pext, and PopCnt that need to only

+-- convert arg and return types

+genCall (PrimTarget op@(MO_Clz w)) [dst] args =

+    genCallSimpleCast w op dst args

+genCall (PrimTarget op@(MO_Ctz w)) [dst] args =

+    genCallSimpleCast w op dst args

+genCall (PrimTarget op@(MO_BRev w)) [dst] args =

+    genCallSimpleCast w op dst args

+genCall (PrimTarget op@(MO_BSwap w)) [dst] args =

+    genCallSimpleCast w op dst args

+genCall (PrimTarget op@(MO_Pdep w)) [dst] args =

+    genCallSimpleCast w op dst args

+genCall (PrimTarget op@(MO_Pext w)) [dst] args =

+    genCallSimpleCast w op dst args

+genCall (PrimTarget op@(MO_PopCnt w)) [dst] args =

+    genCallSimpleCast w op dst args

+genCallSimpleCast :: Width -> CallishMachOp -> CmmFormal -> [CmmActual]

+                  -> LlvmM StmtData

+genCallSimpleCast specW op dst args = do

+    let width   = widthToLlvmInt specW

+        argsW   = const width <$> args

+        dstType = cmmToLlvmType $ localRegType dst

+        signage = cmmPrimOpRetValSignage op

+

+    fname                 <- cmmPrimOpFunctions op

+    (fptr, _, top3)       <- getInstrinct fname width argsW

+    (dstV, _dst_ty)       <- getCmmReg (CmmLocal dst)

+    let (_, arg_hints)     = foreignTargetHints $ PrimTarget op

+    let args_hints         = zip args arg_hints

+    (argsV, stmts2, top2) <- arg_vars args_hints ([], nilOL, [])

+    (argsV', stmts4)      <- castVars signage $ zip argsV argsW

+    (retV, s1)            <- doExpr width $ Call StdCall fptr argsV' []

+    (retV', stmts5)       <- castVar signage retV dstType

+    let s2                 = Store retV' dstV Nothing []

+                s1 `snocOL` stmts5 `snocOL` s2

+    -- Some bit-wise operations /must/ always treat the input and output values

+    -- as 'Unsigned' in order to return the expected result values when pre/post-

+    -- operation bit-width truncation and/or extension occur. For example,

+    -- consider the Bit-Reverse operation:

+    --

+    -- If the result of a Bit-Reverse is treated as signed,

+    -- an positive input can result in an negative output, i.e.:

+    --

+    --   identity(0x03) = 0x03 = 00000011

+    --   breverse(0x03) = 0xC0 = 11000000

+    --

+    -- Now if an extension is performed after the operation to

+    -- promote a smaller bit-width value into a larger bit-width

+    -- type, it is expected that the /bit-wise/ operations will

+    -- not be treated /numerically/ as signed.

+    --

+    -- To illustrate the difference, consider how a signed extension

+    -- for the type i16 to i32 differs for out values above:

+    --   ext_zeroed(i32, breverse(0x03)) = 0x00C0 = 0000000011000000

+    --   ext_signed(i32, breverse(0x03)) = 0xFFC0 = 1111111111000000

+    --

+    -- Here we can see that the former output is the expected result

+    -- of a bit-wise operation which needs to be promoted to a larger

+    -- bit-width type. The latter output is not desirable when we must

+    -- constraining a value into a range of i16 within an i32 type.

+    --

+    -- Hence we always treat the "signage" as unsigned for Bit-Reverse!

+    --

+    -- The same reasoning applied to Bit-Reverse above applies to the other

+    -- bit-wise operations; do not sign extend a possibly negated number!

+    MO_BRev   _ -> Unsigned

+    MO_BSwap  _ -> Unsigned

+    MO_Clz    _ -> Unsigned

+    MO_Ctz    _ -> Unsigned

+    MO_Pdep   _ -> Unsigned

+    MO_Pext   _ -> Unsigned

+    MO_PopCnt _ -> Unsigned

+

+    -- All other cases, default to preserving the numeric sign when extending.

+import GHC.Types.Unique.Map (UniqMap)

+import qualified GHC.Types.Unique.Map as UniqMap

+type BCEnv = UniqMap Id StackDepth -- To find vars on the stack

+         p_init    = UniqMap.listToUniqMap (zip all_args (mkStackOffsets 0 szsb_args))

+                       v `UniqMap.elemUniqMap` p]

+        body_code <- schemeE d2 s (UniqMap.addToUniqMap p x d2) body

+         p' = UniqMap.addListToUniqMap p $ zipEqual xs offsets

+        p_alts = UniqMap.addToUniqMap p bndr d_bndr

+                 p' = UniqMap.addListToUniqMap p_alts

+                 p' = UniqMap.addListToUniqMap p_alts

+          rel_slots = IntSet.toAscList $ UniqMap.nonDetFoldUniqMap go IntSet.empty p

+          go (var, offset) !acc

+            | isUnboxedTupleType (idType var) || isUnboxedSumType (idType var)

+            = acc

+            | isFollowableArg (idArgRep platform var)

+            = fromIntegral (bytesToWords platform (d - offset)) `IntSet.insert` acc

+            | otherwise = acc

+lookupBCEnv_maybe v env = UniqMap.lookupUniqMap env v

+-- | Some archs like wasm32/js used to report have_llvm=True because

+-- they are based on LLVM related toolchains like wasi-sdk/emscripten,

+-- but these targets don't really support the LLVM backend, and the

+-- optllvm test way doesn't work. We used to special-case wasm32/js to

+-- avoid auto-adding optllvm way in testsuite/config/ghc, but this is

+-- still problematic if someone writes a new LLVM-related test and

+-- uses something like when(have_llvm(), extra_ways(["optllvm"])). So

+-- better just enforce have_llvm=False for these targets here.

+allowHaveLLVM :: String -> Bool

+allowHaveLLVM = not . (`elem` ["wasm32", "javascript"])

+    let have_llvm = allowHaveLLVM arch && all isJust [llc_cmd, llvm_as_cmd]

+    have_llvm <- (allowHaveLLVM arch &&) <$> liftIO (isJust <$> findExecutable llc_cmd)

+Subproject commit 7c51059557b68d29820a0a87cebfa6fe73c8adf5

+// When dealing with values of bit-width shorter than uint64_t, ensure to

+// cast the return value to correctly truncate the undefined upper bits.

+// This is *VERY* important when GHC is using the LLVM backend!

+  return (StgWord) ((StgWord32) hs_pdep64(src, mask));

+  return (StgWord) ((StgWord16) hs_pdep64(src, mask));

+  return (StgWord) ((StgWord8) hs_pdep64(src, mask));

+static StgWord64

+hs_pext(const unsigned char bit_width, const StgWord64 src, const StgWord64 mask)

+  for (int bit = 0; bit != bit_width; ++bit) {

+StgWord64

+hs_pext64(const StgWord64 src, const StgWord64 mask)

+{

+  return hs_pext(64, src, mask);

+}

+

+// When dealing with values of bit-width shorter than uint64_t, ensure to

+// cast the return value to correctly truncate the undefined upper bits.

+// This is *VERY* important when GHC is using the LLVM backend!

+hs_pext32(const StgWord src, const StgWord mask)

+  return (StgWord) ((StgWord32) hs_pext(32, src, mask));

+hs_pext16(const StgWord src, const StgWord mask)

+  return (StgWord) ((StgWord16) hs_pext(16, src, mask));

+hs_pext8(const StgWord src, const StgWord mask)

+  return (StgWord) ((StgWord8) hs_pext(8, src, mask));

+if not config.unregisterised and config.have_llvm:

+-- Minimal reproducer for https://gitlab.haskell.org/ghc/ghc/-/issues/20645

+{-# LANGUAGE MagicHash #-}

+{-# LANGUAGE ExtendedLiterals #-}

+import GHC.Exts

+import GHC.Word

+import Numeric (showHex)

+

+opaqueInt8# :: Int8# -> Int8#

+opaqueInt8# x = x

+{-# OPAQUE opaqueInt8# #-}

+

+main :: IO ()

+main = let !x = opaqueInt8# 109#Int8

+           !y = opaqueInt8#   1#Int8

+       in putStrLn $ flip showHex "" (W# ( pext8#

+              (word8ToWord# (int8ToWord8# (0#Int8 `subInt8#` x     )))

+              (word8ToWord# (int8ToWord8# (y      `subInt8#` 4#Int8)))

+          ))

+49

+test('T20645', [normal, normalise_errmsg_fun(ignore_llvm_and_vortex), when(have_llvm(), extra_ways(["optllvm"]))], compile_and_run, [''])

+import Data.Bits (Bits((.&.), bit))

+-- | A special data-type for representing functions where,

+-- since only some number of the lower bits are defined,

+-- testing for strict equality in the undefined upper bits is not appropriate!

+-- Without using this data-type, false-positive failures will be reported

+-- when the undefined bit regions do not match, even though the equality of bits

+-- in this undefined region has no bearing on correctness.

+data LowerBitsAreDefined =

+    LowerBitsAreDefined

+    { definedLowerWidth :: Word

+    -- ^ The (strictly-non-negative) number of least-significant bits

+    -- for which the attached function is defined.

+    , undefinedBehavior :: (Word# -> Word#)

+    -- ^ Function with undefined behavior for some of its most significant bits.

+    }

+

+instance TestPrimop LowerBitsAreDefined where

+  testPrimop s l r = Property s $ \ (uWord#-> x0) ->

+    let -- Create a mask to unset all bits in the undefined area,

+        -- leaving set bits only in the area of defined behavior.

+        -- Since the upper bits are undefined,

+        -- if the function defines behavior for the lower N bits,

+        -- then /only/ the lower N bits are preserved,

+        -- and the upper WORDSIZE - N bits are discarded.

+        mask = bit (fromEnum (definedLowerWidth r)) - 1

+        valL = wWord# (undefinedBehavior l x0) .&. mask

+        valR = wWord# (undefinedBehavior r x0) .&. mask

+    in  valL === valR

+  , testPrimop "byteSwap16#" (16 `LowerBitsAreDefined` Primop.byteSwap16#) (16 `LowerBitsAreDefined` Wrapper.byteSwap16#)

+  , testPrimop "byteSwap32#" (32 `LowerBitsAreDefined` Primop.byteSwap32#) (32 `LowerBitsAreDefined` Wrapper.byteSwap32#)

+  , testPrimop "bitReverse8#" (8 `LowerBitsAreDefined` Primop.bitReverse8#) (8 `LowerBitsAreDefined` Wrapper.bitReverse8#)

+  , testPrimop "bitReverse16#" (16 `LowerBitsAreDefined` Primop.bitReverse16#) (16 `LowerBitsAreDefined` Wrapper.bitReverse16#)

+  , testPrimop "bitReverse32#" (32 `LowerBitsAreDefined` Primop.bitReverse32#) (32 `LowerBitsAreDefined` Wrapper.bitReverse32#)

+    <0>         "defined_bits"      { mkT TDefinedBits }

+import Control.Applicative (asum)

+       then error ("Usage: genprimopcode command < primops.txt > ...\n"

+                   ++ unlines

+                        [ ""

+                        , "Nota Bene:  Be sure to manually run primops.txt through the C Pre-Processor"

+                        , "            before sending the input stream to STDIN, i.e:"

+                        , ""

+                        , "                cpp -P -w primops.txt | genprimopcode command" ]

+           opt (OptionDefinedBits bc) = "defined_bits = " ++ show bc

+         getAltRhs (OptionDefinedBits bc) = show bc

+            qualOp qualification =

+              let qName = wrap qualification poName

+              in  case mb_defined_bits po of

+                    Nothing -> qName

+                    Just bs -> concat ["(", show bs, " `LowerBitsAreDefined` ", qName, ")"]

+        in Just $ intercalate " " [testPrimOpHow, "\"" ++ poName ++ "\"", qualOp "Primop", qualOp "Wrapper"]

+    mb_defined_bits :: Entry -> Maybe Word

+    mb_defined_bits op@(PrimOpSpec{}) =

+      let opOpts = opts op

+          getDefBits :: Option -> Maybe Word

+          getDefBits (OptionDefinedBits x) = x

+          getDefBits _ = Nothing

+      in  asum $ getDefBits <$> opOpts

+    mb_defined_bits _ = Nothing

+

+

+    defined_bits     { TDefinedBits }

+pOption : lowerName        '=' false                  { OptionFalse   $1     }

+        | lowerName        '=' true                   { OptionTrue    $1     }

+        | lowerName        '=' pStuffBetweenBraces    { OptionString  $1  $3 }

+        | lowerName        '=' integer                { OptionInteger $1  $3 }

+        | vector           '=' pVectorTemplate        { OptionVector      $3 }

+        | fixity           '=' pInfix                 { OptionFixity      $3 }

+        | effect           '=' pEffect                { OptionEffect      $3 }

+        | defined_bits     '=' pGoodBits              { OptionDefinedBits $3 }

+pGoodBits :: { Maybe Word }

+pGoodBits : integer { Just $ toEnum $1 }

+          | nothing { Nothing }

+

+           | TDefinedBits

+   | OptionDefinedBits (Maybe Word) -- defined_bits = Just 16 | Nothing

+get_attrib_name (OptionDefinedBits _) = "defined_bits"