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.