Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
c4d32493 by Sven Tennie at 2025-09-23T20:40:57-04:00
RV64: Fix: Add missing truncation to MO_S_Shr (#26248)
Sub-double word ( do
+ platform <- getPlatform
+ (reg_x, _, code_x) <- getSomeReg arg_reg
+ let dst_reg = getRegisterReg platform (CmmLocal dest_reg)
+ case w of
+ W64 -> return ( code_x `appOL` toOL
+ [
+ REVBD (OpReg w dst_reg) (OpReg w reg_x)
+ ])
+ W32 -> return ( code_x `appOL` toOL
+ [
+ REVB2W (OpReg w dst_reg) (OpReg w reg_x)
+ ])
+ _ -> return ( code_x `appOL` toOL
+ [
+ REVB2H (OpReg w dst_reg) (OpReg w reg_x)
+ ])
+ | otherwise -> unsupported (MO_BSwap w)
+
+ PrimTarget (MO_BRev w)
+ | w `elem` [W8, W16, W32, W64],
+ [arg_reg] <- arg_regs,
+ [dest_reg] <- dest_regs -> do
+ platform <- getPlatform
+ (reg_x, _, code_x) <- getSomeReg arg_reg
+ let dst_reg = getRegisterReg platform (CmmLocal dest_reg)
+ case w of
+ W8 -> return ( code_x `appOL` toOL
+ [
+ BITREV4B (OpReg W32 reg_x) (OpReg W32 reg_x),
+ AND (OpReg W64 dst_reg) (OpReg W64 reg_x) (OpImm (ImmInt 255))
+ ])
+ W16 -> return ( code_x `appOL` toOL
+ [
+ BITREV (OpReg W64 reg_x) (OpReg W64 reg_x),
+ SRL (OpReg W64 dst_reg) (OpReg W64 reg_x) (OpImm (ImmInt 48))
+ ])
+ _ -> return ( code_x `snocOL` BITREV (OpReg w dst_reg) (OpReg w reg_x))
+ | otherwise -> unsupported (MO_BRev w)
+
-- mop :: CallishMachOp (see GHC.Cmm.MachOp)
PrimTarget mop -> do
-- We'll need config to construct forien targets
@@ -1939,8 +1982,6 @@ genCCall target dest_regs arg_regs = do
MO_PopCnt w -> mkCCall (popCntLabel w)
MO_Pdep w -> mkCCall (pdepLabel w)
MO_Pext w -> mkCCall (pextLabel w)
- MO_BSwap w -> mkCCall (bSwapLabel w)
- MO_BRev w -> mkCCall (bRevLabel w)
-- or a possibly side-effecting machine operation
mo@(MO_AtomicRead w ord)
=====================================
compiler/GHC/CmmToAsm/LA64/Instr.hs
=====================================
@@ -126,8 +126,7 @@ regUsageOfInstr platform instr = case instr of
REVHD dst src1 -> usage (regOp src1, regOp dst)
BITREV4B dst src1 -> usage (regOp src1, regOp dst)
BITREV8B dst src1 -> usage (regOp src1, regOp dst)
- BITREVW dst src1 -> usage (regOp src1, regOp dst)
- BITREVD dst src1 -> usage (regOp src1, regOp dst)
+ BITREV dst src1 -> usage (regOp src1, regOp dst)
BSTRINS _ dst src1 src2 src3 -> usage (regOp src1 ++ regOp src2 ++ regOp src3, regOp dst)
BSTRPICK _ dst src1 src2 src3 -> usage (regOp src1 ++ regOp src2 ++ regOp src3, regOp dst)
MASKEQZ dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
@@ -309,8 +308,7 @@ patchRegsOfInstr instr env = case instr of
REVHD o1 o2 -> REVHD (patchOp o1) (patchOp o2)
BITREV4B o1 o2 -> BITREV4B (patchOp o1) (patchOp o2)
BITREV8B o1 o2 -> BITREV8B (patchOp o1) (patchOp o2)
- BITREVW o1 o2 -> BITREVW (patchOp o1) (patchOp o2)
- BITREVD o1 o2 -> BITREVD (patchOp o1) (patchOp o2)
+ BITREV o1 o2 -> BITREV (patchOp o1) (patchOp o2)
BSTRINS f o1 o2 o3 o4 -> BSTRINS f (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4)
BSTRPICK f o1 o2 o3 o4 -> BSTRPICK f (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4)
MASKEQZ o1 o2 o3 -> MASKEQZ (patchOp o1) (patchOp o2) (patchOp o3)
@@ -700,8 +698,7 @@ data Instr
| REVHD Operand Operand
| BITREV4B Operand Operand
| BITREV8B Operand Operand
- | BITREVW Operand Operand
- | BITREVD Operand Operand
+ | BITREV Operand Operand
| BSTRINS Format Operand Operand Operand Operand
| BSTRPICK Format Operand Operand Operand Operand
| MASKEQZ Operand Operand Operand
@@ -824,8 +821,7 @@ instrCon i =
REVHD{} -> "REVHD"
BITREV4B{} -> "BITREV4B"
BITREV8B{} -> "BITREV8B"
- BITREVW{} -> "BITREVW"
- BITREVD{} -> "BITREVD"
+ BITREV{} -> "BITREV"
BSTRINS{} -> "BSTRINS"
BSTRPICK{} -> "BSTRPICK"
MASKEQZ{} -> "MASKEQZ"
=====================================
compiler/GHC/CmmToAsm/LA64/Ppr.hs
=====================================
@@ -802,8 +802,9 @@ pprInstr platform instr = case instr of
-- BITREV.{W/D}
BITREV4B o1 o2 -> op2 (text "\tbitrev.4b") o1 o2
BITREV8B o1 o2 -> op2 (text "\tbitrev.8b") o1 o2
- BITREVW o1 o2 -> op2 (text "\tbitrev.w") o1 o2
- BITREVD o1 o2 -> op2 (text "\tbitrev.d") o1 o2
+ BITREV o1 o2
+ | OpReg W32 _ <- o2 -> op2 (text "\tbitrev.w") o1 o2
+ | OpReg W64 _ <- o2 -> op2 (text "\tbitrev.d") o1 o2
-- BSTRINS.{W/D}
BSTRINS II64 o1 o2 o3 o4 -> op4 (text "\tbstrins.d") o1 o2 o3 o4
BSTRINS II32 o1 o2 o3 o4 -> op4 (text "\tbstrins.w") o1 o2 o3 o4
=====================================
compiler/GHC/CmmToAsm/RV64/CodeGen.hs
=====================================
@@ -874,46 +874,18 @@ getRegister' config plat expr =
)
-- 2. Shifts. x << n, x >> n.
- CmmMachOp (MO_Shl w) [x, CmmLit (CmmInt n _)]
- | w == W32,
- 0 <= n,
- n < 32 -> do
- (reg_x, _format_x, code_x) <- getSomeReg x
- return
- $ Any
- (intFormat w)
- ( \dst ->
- code_x
- `snocOL` annExpr expr (SLL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))
- `appOL` truncateReg w w dst
- )
- CmmMachOp (MO_Shl w) [x, CmmLit (CmmInt n _)]
- | w == W64,
- 0 <= n,
- n < 64 -> do
- (reg_x, _format_x, code_x) <- getSomeReg x
- return
- $ Any
- (intFormat w)
- ( \dst ->
- code_x
- `snocOL` annExpr expr (SLL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))
- `appOL` truncateReg w w dst
- )
- CmmMachOp (MO_S_Shr w) [x, CmmLit (CmmInt n _)] | fitsIn12bitImm n -> do
- (reg_x, format_x, code_x) <- getSomeReg x
- (reg_x', code_x') <- signExtendReg (formatToWidth format_x) w reg_x
+ CmmMachOp (MO_Shl w) [x, CmmLit (CmmInt n _)] | fitsIn12bitImm n -> do
+ (reg_x, _format_x, code_x) <- getSomeReg x
return
$ Any
(intFormat w)
( \dst ->
code_x
- `appOL` code_x'
- `snocOL` annExpr expr (SRA (OpReg w dst) (OpReg w reg_x') (OpImm (ImmInteger n)))
+ `snocOL` annExpr expr (SLL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))
+ `appOL` truncateReg w w dst
)
- CmmMachOp (MO_S_Shr w) [x, y] -> do
+ CmmMachOp (MO_S_Shr w) [x, CmmLit (CmmInt n _)] | fitsIn12bitImm n -> do
(reg_x, format_x, code_x) <- getSomeReg x
- (reg_y, _format_y, code_y) <- getSomeReg y
(reg_x', code_x') <- signExtendReg (formatToWidth format_x) w reg_x
return
$ Any
@@ -921,72 +893,20 @@ getRegister' config plat expr =
( \dst ->
code_x
`appOL` code_x'
- `appOL` code_y
- `snocOL` annExpr expr (SRA (OpReg w dst) (OpReg w reg_x') (OpReg w reg_y))
+ `snocOL` annExpr expr (SRA (OpReg w dst) (OpReg w reg_x') (OpImm (ImmInteger n)))
+ `appOL` truncateReg w w dst
)
- CmmMachOp (MO_U_Shr 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
- `appOL` truncateReg (formatToWidth format_x) w reg_x
- `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))
- )
- CmmMachOp (MO_U_Shr 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
- `appOL` truncateReg (formatToWidth format_x) w reg_x
- `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))
- )
- CmmMachOp (MO_U_Shr w) [x, y] | w == W8 || w == W16 -> do
+ CmmMachOp (MO_U_Shr w) [x, CmmLit (CmmInt n _)] | fitsIn12bitImm n -> 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
`appOL` truncateReg (formatToWidth format_x) w reg_x
- `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))
+ `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))
+ `appOL` truncateReg w w dst
)
- CmmMachOp (MO_U_Shr w) [x, CmmLit (CmmInt n _)]
- | w == W32,
- 0 <= n,
- n < 32 -> do
- (reg_x, _format_x, code_x) <- getSomeReg x
- return
- $ Any
- (intFormat w)
- ( \dst ->
- code_x
- `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))
- )
- CmmMachOp (MO_U_Shr w) [x, CmmLit (CmmInt n _)]
- | w == W64,
- 0 <= n,
- n < 64 -> do
- (reg_x, _format_x, code_x) <- getSomeReg x
- return
- $ Any
- (intFormat w)
- ( \dst ->
- code_x
- `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))
- )
-
-- 3. Logic &&, ||
CmmMachOp (MO_And w) [CmmReg reg, CmmLit (CmmInt n _)]
| fitsIn12bitImm n ->
=====================================
compiler/GHC/CmmToLlvm/CodeGen.hs
=====================================
@@ -240,12 +240,25 @@ 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
+{- Note [LLVM PDep/PExt intrinsics]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Since x86 PDep/PExt instructions only exist for 32/64 bit widths
+we use the 32bit variant to compute the 8/16bit primops.
+To do so we extend/truncate the argument/result around the
+call.
+-}
+genCall (PrimTarget op@(MO_Pdep w)) [dst] args = do
+ cfg <- getConfig
+ if llvmCgBmiVersion cfg >= Just BMI2
+ then genCallMinimumTruncationCast W32 w op dst args
+ else genCallSimpleCast w op dst args
+genCall (PrimTarget op@(MO_Pext w)) [dst] args = do
+ cfg <- getConfig
+ if llvmCgBmiVersion cfg >= Just BMI2
+ then genCallMinimumTruncationCast W32 w op dst args
+ else genCallSimpleCast w op dst args
genCall (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n] = runStmtsDecls $ do
addrVar <- exprToVarW addr
@@ -641,8 +654,15 @@ genCallExtract _ _ _ _ =
-- from i32 to i8 explicitly as LLVM is strict about types.
genCallSimpleCast :: Width -> CallishMachOp -> CmmFormal -> [CmmActual]
-> LlvmM StmtData
-genCallSimpleCast specW op dst args = do
- let width = widthToLlvmInt specW
+genCallSimpleCast w = genCallMinimumTruncationCast w w
+
+-- Given the minimum machine bit-width to use and the logical bit-width of the
+-- value range, perform a type-cast truncation and extension before and after the
+-- specified operation, respectively.
+genCallMinimumTruncationCast :: Width -> Width -> CallishMachOp -> CmmFormal
+ -> [CmmActual] -> LlvmM StmtData
+genCallMinimumTruncationCast minW specW op dst args = do
+ let width = widthToLlvmInt $ max minW specW
argsW = const width <$> args
dstType = cmmToLlvmType $ localRegType dst
signage = cmmPrimOpRetValSignage op
@@ -945,9 +965,10 @@ cmmPrimOpFunctions mop = do
W256 -> fsLit "llvm.cttz.i256"
W512 -> fsLit "llvm.cttz.i512"
MO_Pdep w
+ -- See Note [LLVM PDep/PExt intrinsics]
| isBmi2Enabled -> case w of
- W8 -> fsLit "llvm.x86.bmi.pdep.8"
- W16 -> fsLit "llvm.x86.bmi.pdep.16"
+ W8 -> fsLit "llvm.x86.bmi.pdep.32"
+ W16 -> fsLit "llvm.x86.bmi.pdep.32"
W32 -> fsLit "llvm.x86.bmi.pdep.32"
W64 -> fsLit "llvm.x86.bmi.pdep.64"
W128 -> fsLit "llvm.x86.bmi.pdep.128"
@@ -963,8 +984,9 @@ cmmPrimOpFunctions mop = do
W512 -> fsLit "hs_pdep512"
MO_Pext w
| isBmi2Enabled -> case w of
- W8 -> fsLit "llvm.x86.bmi.pext.8"
- W16 -> fsLit "llvm.x86.bmi.pext.16"
+ -- See Note [LLVM PDep/PExt intrinsics]
+ W8 -> fsLit "llvm.x86.bmi.pext.32"
+ W16 -> fsLit "llvm.x86.bmi.pext.32"
W32 -> fsLit "llvm.x86.bmi.pext.32"
W64 -> fsLit "llvm.x86.bmi.pext.64"
W128 -> fsLit "llvm.x86.bmi.pext.128"
=====================================
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,22 @@ 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 performs some quick basic optimizations even with -O0.
+-- See Note [The simple optimiser] for details.
+--
+-- We could call it directly in the desugarer but we implement it as 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)
=====================================
compiler/GHC/Core/Opt/Pipeline/Types.hs
=====================================
@@ -58,8 +58,7 @@ data CoreToDo -- These are diff core-to-core passes,
| 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
=====================================
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
=====================================
docs/users_guide/exts/pragmas.rst
=====================================
@@ -486,17 +486,18 @@ behaviour:
optimisation level etc.
- Like ``INLINE``, the ``INLINABLE`` pragma retains a copy of the
- original RHS for inlining purposes, and persists it in the interface
+ RHS for inlining purposes, and persists it in the interface
file, regardless of the size of the RHS.
+ The RHS will be carefully optimised so that, when the function
+ inlines, GHC behaves as if the original RHS had been inlined.
- One way to use ``INLINABLE`` is in conjunction with the special
function ``inline`` (:ref:`special-ids`). The call ``inline f`` tries
very hard to inline ``f``. To make sure that ``f`` can be inlined, it
is a good idea to mark the definition of ``f`` as ``INLINABLE``, so
that GHC guarantees to expose an unfolding regardless of how big it
- is. Moreover, by annotating ``f`` as ``INLINABLE``, you ensure that
- ``f``\'s original RHS is inlined, rather than whatever random
- optimised version of ``f`` GHC's optimiser has produced.
+ is. You can also provide an explicit :ref:`phase-control` on the
+ ``INLINABLE`` pragma to ensure that RULES have a chance of firing first.
- The ``INLINABLE`` pragma also works with ``SPECIALISE``: if you mark
function ``f`` as ``INLINABLE``, then you can subsequently
=====================================
docs/users_guide/exts/scoped_type_variables.rst
=====================================
@@ -6,7 +6,7 @@ Lexically scoped type variables
===============================
.. extension:: ScopedTypeVariables
- :shortdesc: Lexically scope explicitly-introduced type variables.
+ :shortdesc: Lexically scoped explicitly-introduced type variables.
:implies: :extension:`ExplicitForAll`
=====================================
libraries/ghci/GHCi/Message.hs
=====================================
@@ -525,7 +525,7 @@ instance Binary (FunPtr a) where
put = put . castFunPtrToPtr
get = castPtrToFunPtr <$> get
-#if MIN_VERSION_ghc_internal(9,1500,0)
+#if MIN_VERSION_GLASGOW_HASKELL(9,12,2,20250919)
instance Binary Heap.HalfWord where
put x = put (fromIntegral x :: Word32)
get = fromIntegral <$> (get :: Get Word32)
=====================================
rts/CloneStack.h
=====================================
@@ -8,8 +8,8 @@
#pragma once
-extern StgClosure DLL_IMPORT_DATA_VARNAME(ghczminternal_GHCziInternalziStackziCloneStack_StackSnapshot_closure);
-#define StackSnapshot_constructor_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziStackziCloneStack_StackSnapshot_closure)
+extern StgClosure ghczminternal_GHCziInternalziStackziCloneStack_StackSnapshot_closure;
+#define StackSnapshot_constructor_closure (&(ghczminternal_GHCziInternalziStackziCloneStack_StackSnapshot_closure))
StgStack* cloneStack(Capability* capability, const StgStack* stack);
=====================================
rts/Prelude.h
=====================================
@@ -15,8 +15,8 @@
#define PRELUDE_INFO(i) extern W_(i)[]
#define PRELUDE_CLOSURE(i) extern W_(i)[]
#else
-#define PRELUDE_INFO(i) extern const StgInfoTable DLL_IMPORT_DATA_VARNAME(i)
-#define PRELUDE_CLOSURE(i) extern StgClosure DLL_IMPORT_DATA_VARNAME(i)
+#define PRELUDE_INFO(i) extern const StgInfoTable (i)
+#define PRELUDE_CLOSURE(i) extern StgClosure (i)
#endif
/* See Note [Wired-in exceptions are not CAFfy] in GHC.Core.Make. */
@@ -87,58 +87,58 @@ PRELUDE_INFO(ghczminternal_GHCziInternalziWord_W32zh_con_info);
PRELUDE_INFO(ghczminternal_GHCziInternalziWord_W64zh_con_info);
PRELUDE_INFO(ghczminternal_GHCziInternalziStable_StablePtr_con_info);
-#define Unit_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTuple_Z0T_closure)
-#define True_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_True_closure)
-#define False_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_False_closure)
-#define unpackCString_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziPack_unpackCString_closure)
-#define runFinalizerBatch_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziWeakziFinalizze_runFinalizzerBatch_closure)
+#define Unit_closure (&(ghczminternal_GHCziInternalziTuple_Z0T_closure))
+#define True_closure (&(ghczminternal_GHCziInternalziTypes_True_closure))
+#define False_closure (&(ghczminternal_GHCziInternalziTypes_False_closure))
+#define unpackCString_closure (&(ghczminternal_GHCziInternalziPack_unpackCString_closure))
+#define runFinalizerBatch_closure (&(ghczminternal_GHCziInternalziWeakziFinalizze_runFinalizzerBatch_closure))
#define mainIO_closure (&ZCMain_main_closure)
-#define runSparks_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziConcziSync_runSparks_closure)
-#define ensureIOManagerIsRunning_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziConcziIO_ensureIOManagerIsRunning_closure)
-#define interruptIOManager_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziConcziIO_interruptIOManager_closure)
-#define ioManagerCapabilitiesChanged_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziConcziIO_ioManagerCapabilitiesChanged_closure)
-#define runHandlersPtr_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziConcziSignal_runHandlersPtr_closure)
+#define runSparks_closure (&(ghczminternal_GHCziInternalziConcziSync_runSparks_closure))
+#define ensureIOManagerIsRunning_closure (&(ghczminternal_GHCziInternalziConcziIO_ensureIOManagerIsRunning_closure))
+#define interruptIOManager_closure (&(ghczminternal_GHCziInternalziConcziIO_interruptIOManager_closure))
+#define ioManagerCapabilitiesChanged_closure (&(ghczminternal_GHCziInternalziConcziIO_ioManagerCapabilitiesChanged_closure))
+#define runHandlersPtr_closure (&(ghczminternal_GHCziInternalziConcziSignal_runHandlersPtr_closure))
#if defined(mingw32_HOST_OS)
-#define processRemoteCompletion_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziEventziWindows_processRemoteCompletion_closure)
+#define processRemoteCompletion_closure (&(ghczminternal_GHCziInternalziEventziWindows_processRemoteCompletion_closure))
#endif
-#define runAllocationLimitHandler_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziAllocationLimitHandler_runAllocationLimitHandler_closure)
-
-#define flushStdHandles_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTopHandler_flushStdHandles_closure)
-#define runMainIO_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTopHandler_runMainIO_closure)
-
-#define stackOverflow_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_stackOverflow_closure)
-#define heapOverflow_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_heapOverflow_closure)
-#define allocationLimitExceeded_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_allocationLimitExceeded_closure)
-#define blockedIndefinitelyOnMVar_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_blockedIndefinitelyOnMVar_closure)
-#define blockedIndefinitelyOnSTM_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_blockedIndefinitelyOnSTM_closure)
-#define cannotCompactFunction_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_cannotCompactFunction_closure)
-#define cannotCompactPinned_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_cannotCompactPinned_closure)
-#define cannotCompactMutable_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_cannotCompactMutable_closure)
-#define nonTermination_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziControlziExceptionziBase_nonTermination_closure)
-#define nestedAtomically_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziControlziExceptionziBase_nestedAtomically_closure)
-#define absentSumFieldError_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziPrimziPanic_absentSumFieldError_closure)
-#define underflowException_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziExceptionziType_underflowException_closure)
-#define overflowException_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziExceptionziType_overflowException_closure)
-#define divZeroException_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziExceptionziType_divZZeroException_closure)
-
-#define blockedOnBadFD_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziEventziThread_blockedOnBadFD_closure)
-
-#define Czh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_Czh_con_info)
-#define Izh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_Izh_con_info)
-#define Fzh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_Fzh_con_info)
-#define Dzh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_Dzh_con_info)
-#define Wzh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_Wzh_con_info)
-#define W8zh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziWord_W8zh_con_info)
-#define W16zh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziWord_W16zh_con_info)
-#define W32zh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziWord_W32zh_con_info)
-#define W64zh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziWord_W64zh_con_info)
-#define I8zh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziInt_I8zh_con_info)
-#define I16zh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziInt_I16zh_con_info)
-#define I32zh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziInt_I32zh_con_info)
-#define I64zh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziInt_I64zh_con_info)
-#define I64zh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziInt_I64zh_con_info)
-#define Ptr_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziPtr_Ptr_con_info)
-#define FunPtr_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziPtr_FunPtr_con_info)
-#define StablePtr_static_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziStable_StablePtr_static_info)
-#define StablePtr_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziStable_StablePtr_con_info)
+#define runAllocationLimitHandler_closure (&(ghczminternal_GHCziInternalziAllocationLimitHandler_runAllocationLimitHandler_closure))
+
+#define flushStdHandles_closure (&(ghczminternal_GHCziInternalziTopHandler_flushStdHandles_closure))
+#define runMainIO_closure (&(ghczminternal_GHCziInternalziTopHandler_runMainIO_closure))
+
+#define stackOverflow_closure (&(ghczminternal_GHCziInternalziIOziException_stackOverflow_closure))
+#define heapOverflow_closure (&(ghczminternal_GHCziInternalziIOziException_heapOverflow_closure))
+#define allocationLimitExceeded_closure (&(ghczminternal_GHCziInternalziIOziException_allocationLimitExceeded_closure))
+#define blockedIndefinitelyOnMVar_closure (&(ghczminternal_GHCziInternalziIOziException_blockedIndefinitelyOnMVar_closure))
+#define blockedIndefinitelyOnSTM_closure (&(ghczminternal_GHCziInternalziIOziException_blockedIndefinitelyOnSTM_closure))
+#define cannotCompactFunction_closure (&(ghczminternal_GHCziInternalziIOziException_cannotCompactFunction_closure))
+#define cannotCompactPinned_closure (&(ghczminternal_GHCziInternalziIOziException_cannotCompactPinned_closure))
+#define cannotCompactMutable_closure (&(ghczminternal_GHCziInternalziIOziException_cannotCompactMutable_closure))
+#define nonTermination_closure (&(ghczminternal_GHCziInternalziControlziExceptionziBase_nonTermination_closure))
+#define nestedAtomically_closure (&(ghczminternal_GHCziInternalziControlziExceptionziBase_nestedAtomically_closure))
+#define absentSumFieldError_closure (&(ghczminternal_GHCziInternalziPrimziPanic_absentSumFieldError_closure))
+#define underflowException_closure (&(ghczminternal_GHCziInternalziExceptionziType_underflowException_closure))
+#define overflowException_closure (&(ghczminternal_GHCziInternalziExceptionziType_overflowException_closure))
+#define divZeroException_closure (&(ghczminternal_GHCziInternalziExceptionziType_divZZeroException_closure))
+
+#define blockedOnBadFD_closure (&(ghczminternal_GHCziInternalziEventziThread_blockedOnBadFD_closure))
+
+#define Czh_con_info (&(ghczminternal_GHCziInternalziTypes_Czh_con_info))
+#define Izh_con_info (&(ghczminternal_GHCziInternalziTypes_Izh_con_info))
+#define Fzh_con_info (&(ghczminternal_GHCziInternalziTypes_Fzh_con_info))
+#define Dzh_con_info (&(ghczminternal_GHCziInternalziTypes_Dzh_con_info))
+#define Wzh_con_info (&(ghczminternal_GHCziInternalziTypes_Wzh_con_info))
+#define W8zh_con_info (&(ghczminternal_GHCziInternalziWord_W8zh_con_info))
+#define W16zh_con_info (&(ghczminternal_GHCziInternalziWord_W16zh_con_info))
+#define W32zh_con_info (&(ghczminternal_GHCziInternalziWord_W32zh_con_info))
+#define W64zh_con_info (&(ghczminternal_GHCziInternalziWord_W64zh_con_info))
+#define I8zh_con_info (&(ghczminternal_GHCziInternalziInt_I8zh_con_info))
+#define I16zh_con_info (&(ghczminternal_GHCziInternalziInt_I16zh_con_info))
+#define I32zh_con_info (&(ghczminternal_GHCziInternalziInt_I32zh_con_info))
+#define I64zh_con_info (&(ghczminternal_GHCziInternalziInt_I64zh_con_info))
+#define I64zh_con_info (&(ghczminternal_GHCziInternalziInt_I64zh_con_info))
+#define Ptr_con_info (&(ghczminternal_GHCziInternalziPtr_Ptr_con_info))
+#define FunPtr_con_info (&(ghczminternal_GHCziInternalziPtr_FunPtr_con_info))
+#define StablePtr_static_info (&(ghczminternal_GHCziInternalziStable_StablePtr_static_info))
+#define StablePtr_con_info (&(ghczminternal_GHCziInternalziStable_StablePtr_con_info))
=====================================
rts/RtsSymbols.c
=====================================
@@ -1054,9 +1054,9 @@ RTS_ARM_OUTLINE_ATOMIC_SYMBOLS
#define SymI_HasDataProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
(void*)(&(vvv)), STRENGTH_NORMAL, SYM_TYPE_DATA },
#define SymE_HasProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
- (void*)DLL_IMPORT_DATA_REF(vvv), STRENGTH_NORMAL, SYM_TYPE_CODE },
+ (void*)(&(vvv)), STRENGTH_NORMAL, SYM_TYPE_CODE },
#define SymE_HasDataProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
- (void*)DLL_IMPORT_DATA_REF(vvv), STRENGTH_NORMAL, SYM_TYPE_DATA },
+ (void*)(&(vvv)), STRENGTH_NORMAL, SYM_TYPE_DATA },
#define SymI_NeedsProto(vvv) SymI_HasProto(vvv)
#define SymI_NeedsDataProto(vvv) SymI_HasDataProto(vvv)
=====================================
rts/include/Rts.h
=====================================
@@ -265,9 +265,9 @@ void _warnFail(const char *filename, unsigned int linenum);
#include "rts/LibdwPool.h"
/* Misc stuff without a home */
-DLL_IMPORT_RTS extern char **prog_argv; /* so we can get at these from Haskell */
-DLL_IMPORT_RTS extern int prog_argc;
-DLL_IMPORT_RTS extern char *prog_name;
+extern char **prog_argv; /* so we can get at these from Haskell */
+extern int prog_argc;
+extern char *prog_name;
void reportStackOverflow(StgTSO* tso);
void reportHeapOverflow(void);
=====================================
rts/include/RtsAPI.h
=====================================
@@ -587,8 +587,8 @@ void rts_done (void);
extern StgClosure ghczminternal_GHCziInternalziTopHandler_runIO_closure;
extern StgClosure ghczminternal_GHCziInternalziTopHandler_runNonIO_closure;
-#define runIO_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTopHandler_runIO_closure)
-#define runNonIO_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTopHandler_runNonIO_closure)
+#define runIO_closure (&(ghczminternal_GHCziInternalziTopHandler_runIO_closure))
+#define runNonIO_closure (&(ghczminternal_GHCziInternalziTopHandler_runNonIO_closure))
/* ------------------------------------------------------------------------ */
=====================================
rts/include/Stg.h
=====================================
@@ -332,7 +332,6 @@ external prototype return neither of these types to workaround #11395.
Other Stg stuff...
-------------------------------------------------------------------------- */
-#include "stg/DLL.h"
#include "stg/MachRegsForHost.h"
#include "stg/Regs.h"
#include "stg/Ticky.h"
=====================================
rts/include/rts/Flags.h
=====================================
@@ -358,7 +358,7 @@ typedef struct _RTS_FLAGS {
} RTS_FLAGS;
#if defined(COMPILING_RTS_MAIN)
-extern DLLIMPORT RTS_FLAGS RtsFlags;
+extern RTS_FLAGS RtsFlags;
#elif IN_STG_CODE
/* Note [RtsFlags is a pointer in STG code]
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
rts/include/rts/NonMoving.h
=====================================
@@ -19,10 +19,10 @@ struct StgThunk_;
struct Capability_;
/* This is called by the code generator */
-extern DLL_IMPORT_RTS
+extern
void updateRemembSetPushClosure_(StgRegTable *reg, struct StgClosure_ *p);
-extern DLL_IMPORT_RTS
+extern
void updateRemembSetPushThunk_(StgRegTable *reg, struct StgThunk_ *p);
// Forward declaration for unregisterised backend.
@@ -31,7 +31,7 @@ EF_(stg_copyArray_barrier);
// Note that RTS code should not condition on this directly by rather
// use the IF_NONMOVING_WRITE_BARRIER_ENABLED macro to ensure that
// the barrier is eliminated in the non-threaded RTS.
-extern StgWord DLL_IMPORT_DATA_VAR(nonmoving_write_barrier_enabled);
+extern StgWord nonmoving_write_barrier_enabled;
// A similar macro is defined in rts/include/Cmm.h for C-- code.
#if defined(THREADED_RTS)
=====================================
rts/include/rts/StableName.h
=====================================
@@ -29,4 +29,4 @@ typedef struct {
// free
} snEntry;
-extern DLL_IMPORT_RTS snEntry *stable_name_table;
+extern snEntry *stable_name_table;
=====================================
rts/include/rts/StablePtr.h
=====================================
@@ -26,7 +26,7 @@ typedef struct {
// otherwise.
} spEntry;
-extern DLL_IMPORT_RTS spEntry *stable_ptr_table;
+extern spEntry *stable_ptr_table;
ATTR_ALWAYS_INLINE EXTERN_INLINE
StgPtr deRefStablePtr(StgStablePtr sp)
=====================================
rts/include/stg/DLL.h deleted
=====================================
@@ -1,35 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2009
- *
- * Support for Windows DLLs.
- *
- * Do not #include this file directly: #include "Rts.h" instead.
- *
- * To understand the structure of the RTS headers, see the wiki:
- * https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes
- *
- * ---------------------------------------------------------------------------*/
-
-#pragma once
-
-# define DLL_IMPORT_DATA_REF(x) (&(x))
-# define DLL_IMPORT_DATA_VARNAME(x) x
-# define DLLIMPORT
-
-/* The view of the rts/include/ header files differ ever so
- slightly depending on whether the RTS is being compiled
- or not - so we're forced to distinguish between two.
- [oh, you want details :) : Data symbols defined by the RTS
- have to be accessed through an extra level of indirection
- when compiling generated .hc code compared to when the RTS
- sources are being processed. This is only the case when
- using Win32 DLLs. ]
-*/
-#if defined(COMPILING_RTS)
-#define DLL_IMPORT_RTS
-#define DLL_IMPORT_DATA_VAR(x) x
-#else
-#define DLL_IMPORT_RTS DLLIMPORT
-#define DLL_IMPORT_DATA_VAR(x) x
-#endif
=====================================
rts/include/stg/MiscClosures.h
=====================================
@@ -25,14 +25,14 @@
# define RTS_THUNK_INFO(i) extern const W_(i)[]
# define RTS_INFO(i) extern const W_(i)[]
# define RTS_CLOSURE(i) extern W_(i)[]
-# define RTS_FUN_DECL(f) extern DLL_IMPORT_RTS StgFunPtr f(void)
+# define RTS_FUN_DECL(f) extern StgFunPtr f(void)
#else
-# define RTS_RET_INFO(i) extern DLL_IMPORT_RTS const StgRetInfoTable i
-# define RTS_FUN_INFO(i) extern DLL_IMPORT_RTS const StgFunInfoTable i
-# define RTS_THUNK_INFO(i) extern DLL_IMPORT_RTS const StgThunkInfoTable i
-# define RTS_INFO(i) extern DLL_IMPORT_RTS const StgInfoTable i
-# define RTS_CLOSURE(i) extern DLL_IMPORT_RTS StgClosure i
-# define RTS_FUN_DECL(f) extern DLL_IMPORT_RTS StgFunPtr f(void)
+# define RTS_RET_INFO(i) extern const StgRetInfoTable i
+# define RTS_FUN_INFO(i) extern const StgFunInfoTable i
+# define RTS_THUNK_INFO(i) extern const StgThunkInfoTable i
+# define RTS_INFO(i) extern const StgInfoTable i
+# define RTS_CLOSURE(i) extern StgClosure i
+# define RTS_FUN_DECL(f) extern StgFunPtr f(void)
#endif
#if defined(TABLES_NEXT_TO_CODE)
@@ -274,11 +274,11 @@ RTS_CLOSURE(stg_NO_TREC_closure);
RTS_ENTRY(stg_NO_FINALIZER);
#if IN_STG_CODE
-extern DLL_IMPORT_RTS StgWordArray stg_CHARLIKE_closure;
-extern DLL_IMPORT_RTS StgWordArray stg_INTLIKE_closure;
+extern StgWordArray stg_CHARLIKE_closure;
+extern StgWordArray stg_INTLIKE_closure;
#else
-extern DLL_IMPORT_RTS StgIntCharlikeClosure stg_CHARLIKE_closure[];
-extern DLL_IMPORT_RTS StgIntCharlikeClosure stg_INTLIKE_closure[];
+extern StgIntCharlikeClosure stg_CHARLIKE_closure[];
+extern StgIntCharlikeClosure stg_INTLIKE_closure[];
#endif
/* StgStartup */
=====================================
rts/rts.cabal
=====================================
@@ -334,7 +334,6 @@ library
rts/storage/InfoTables.h
rts/storage/MBlock.h
rts/storage/TSO.h
- stg/DLL.h
stg/MachRegs.h
stg/MachRegs/arm32.h
stg/MachRegs/arm64.h
=====================================
testsuite/tests/llvm/should_run/T26065.hs
=====================================
@@ -0,0 +1,68 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+import Data.Char (toUpper)
+import GHC.Exts
+import GHC.Word
+import Numeric (showHex)
+
+pdep8 :: Word8 -> Word8 -> Word8
+pdep8 (W8# a) (W8# b) = W8# (wordToWord8# (pdep8# (word8ToWord# a) (word8ToWord# b)))
+{-# NOINLINE pdep8 #-}
+
+pdep16 :: Word16 -> Word16 -> Word16
+pdep16 (W16# a) (W16# b) = W16# (wordToWord16# (pdep16# (word16ToWord# a) (word16ToWord# b)))
+{-# NOINLINE pdep16 #-}
+
+pdep32 :: Word32 -> Word32 -> Word32
+pdep32 (W32# a) (W32# b) = W32# (wordToWord32# (pdep32# (word32ToWord# a) (word32ToWord# b)))
+{-# NOINLINE pdep32 #-}
+
+pdep64 :: Word64 -> Word64 -> Word64
+pdep64 (W64# a) (W64# b) = W64# (pdep64# a b)
+{-# NOINLINE pdep64 #-}
+
+pext8 :: Word8 -> Word8 -> Word8
+pext8 (W8# a) (W8# b) = W8# (wordToWord8# (pext8# (word8ToWord# a) (word8ToWord# b)))
+{-# NOINLINE pext8 #-}
+
+pext16 :: Word16 -> Word16 -> Word16
+pext16 (W16# a) (W16# b) = W16# (wordToWord16# (pext16# (word16ToWord# a) (word16ToWord# b)))
+{-# NOINLINE pext16 #-}
+
+pext32 :: Word32 -> Word32 -> Word32
+pext32 (W32# a) (W32# b) = W32# (wordToWord32# (pext32# (word32ToWord# a) (word32ToWord# b)))
+{-# NOINLINE pext32 #-}
+
+pext64 :: Word64 -> Word64 -> Word64
+pext64 (W64# a) (W64# b) = W64# (pext64# a b)
+{-# NOINLINE pext64 #-}
+
+valueSource :: Integral i => i
+valueSource = fromInteger 0xA7F7A7F7A7F7A7F7
+
+valueMask :: Integral i => i
+valueMask = fromInteger 0x5555555555555555
+
+printIntrinsicCall :: forall i. Integral i => String -> (i -> i -> i) -> IO ()
+printIntrinsicCall label f =
+ let op1 = valueSource
+ op2 = valueMask
+ pad s =
+ let hex :: Integral a => a -> String
+ hex = flip showHex ""
+ str = toUpper <$> hex s
+ len = length $ hex (maxBound :: Word64)
+ n = length str
+ in "0x" <> replicate (len - n) '0' <> str
+ in putStrLn $ unwords [ label, pad op1, pad op2, "=", pad (f op1 op2) ]
+
+main :: IO ()
+main = do
+ printIntrinsicCall "pdep8 " pdep8
+ printIntrinsicCall "pdep16" pdep16
+ printIntrinsicCall "pdep32" pdep32
+ printIntrinsicCall "pdep64" pdep64
+ printIntrinsicCall "pext8 " pext8
+ printIntrinsicCall "pext16" pext16
+ printIntrinsicCall "pext32" pext32
+ printIntrinsicCall "pext64" pext64
=====================================
testsuite/tests/llvm/should_run/T26065.stdout
=====================================
@@ -0,0 +1,8 @@
+pdep8 0x00000000000000F7 0x0000000000000055 = 0x0000000000000015
+pdep16 0x000000000000A7F7 0x0000000000005555 = 0x0000000000005515
+pdep32 0x00000000A7F7A7F7 0x0000000055555555 = 0x0000000044155515
+pdep64 0xA7F7A7F7A7F7A7F7 0x5555555555555555 = 0x4415551544155515
+pext8 0x00000000000000F7 0x0000000000000055 = 0x000000000000000F
+pext16 0x000000000000A7F7 0x0000000000005555 = 0x000000000000003F
+pext32 0x00000000A7F7A7F7 0x0000000055555555 = 0x0000000000003F3F
+pext64 0xA7F7A7F7A7F7A7F7 0x5555555555555555 = 0x000000003F3F3F3F
=====================================
testsuite/tests/llvm/should_run/all.T
=====================================
@@ -18,3 +18,8 @@ test('T22033', [normal, normalise_errmsg_fun(ignore_llvm_and_vortex)], compile_a
test('T25730', [req_c, unless(arch('x86_64'), skip), normalise_errmsg_fun(ignore_llvm_and_vortex)], compile_and_run, ['T25730C.c'])
# T25730C.c contains Intel instrinsics, so only run this test on x86
test('T20645', [normal, normalise_errmsg_fun(ignore_llvm_and_vortex), when(have_llvm(), extra_ways(["optllvm"]))], compile_and_run, [''])
+# T26065.c tests LLVM linking of Intel instrinsics, so only run this test on x86
+test('T26065', [normal, normalise_errmsg_fun(ignore_llvm_and_vortex), when(have_llvm(), extra_ways(["optllvm"])),
+ unless((arch('x86_64') or arch('i386')) and have_cpu_feature('bmi2'),skip)],
+ compile_and_run, ['-mbmi2'])
+
=====================================
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
=====================================
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
=====================================
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)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7668b4a87faa0d905f96a94f3f835ae...
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7668b4a87faa0d905f96a94f3f835ae...
You're receiving this email because of your account on gitlab.haskell.org.
