Andreas Klebinger pushed to branch wip/andreask/arm-ffi at Glasgow Haskell Compiler / GHC Commits: cf9115be by Andreas Klebinger at 2026-07-03T14:12:08+02:00 Tiny arm64 codegen refactor. Rename truncateReg to make it clear it changes the register. (cherry picked from commit 294c609842069a4474356baf99e43cdfdb604e50) - - - - - 1 changed file: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -662,7 +662,7 @@ opRegWidth w = pprPanic "opRegWidth" (text "Unsupported width" <+> ppr w) -- in between operations. -- -- IMPORTANT: this invariant only holds within a single expression tree as --- generated by the NCG (via truncateReg after each sub-word operation). It +-- generated by the NCG (via truncateRegInplace after each sub-word operation). It -- does NOT hold at function entry points or across basic block boundaries, -- because the GHC calling convention does not guarantee that callers -- zero-extend sub-word arguments. Therefore, any operation that is sensitive @@ -688,7 +688,7 @@ opRegWidth w = pprPanic "opRegWidth" (text "Unsupported width" <+> ppr w) -- Next we compute `c`: The `%not` requires no extension of its operands, but -- we must still truncate the result back down to 8-bits. Finally the `%shrl` -- requires no extension and no truncate since we can assume that --- `c` is zero-extended (it was produced by a truncateReg in the same block). +-- `c` is zero-extended (it was produced by a truncateRegInplace in the same block). -- -- TODO: -- Don't use Width in Operands @@ -931,7 +931,7 @@ getRegister' config plat expr let w' = opRegWidth w in code `snocOL` MVN (OpReg w' dst) (OpReg w' reg) `appOL` - truncateReg w' w dst -- See Note [Signed arithmetic on AArch64] + truncateRegInplace w' w dst -- See Note [Signed arithmetic on AArch64] MO_S_Neg w -> negate code w reg MO_F_Neg w -> return $ Any fmt (\dst -> code `snocOL` NEG fmt (OpReg w dst) (OpReg w reg)) @@ -1064,7 +1064,7 @@ getRegister' config plat expr code `appOL` code_sx `snocOL` NEG fmt (OpReg w' dst) (OpReg w' reg') `appOL` - truncateReg w' w dst + truncateRegInplace w' w dst ss_conv from to reg code = let w' = opRegWidth (max from to) @@ -1073,7 +1073,7 @@ getRegister' config plat expr SBFM (OpReg w' dst) (OpReg w' reg) (OpImm (ImmInt 0)) (toImm (min from to)) `appOL` -- At this point an 8- or 16-bit value would be sign-extended -- to 32-bits. Truncate back down the final width. - truncateReg w' to dst + truncateRegInplace w' to dst -- Dyadic machops: -- @@ -1220,7 +1220,7 @@ getRegister' config plat expr code_y `appOL` op (OpReg w dst) (OpReg w reg_x) op_y) - -- A (potentially signed) integer operation. + -- A (potentially signed) integer operation that can have immediate arguments. -- In the case of 8- and 16-bit signed arithmetic we must first -- sign-extend both arguments to 32-bits. -- See Note [Signed arithmetic on AArch64]. @@ -1230,6 +1230,7 @@ getRegister' config plat expr -- compute x<m> <- x -- compute x<o> <- y -- <OP> x<n>, x<m>, x<o> + let w' = opRegWidth w (reg_x, format_x, code_x) <- getSomeReg x (op_y, format_y, code_y) <- case y of CmmLit (CmmInt n w) @@ -1241,12 +1242,11 @@ getRegister' config plat expr massertPpr (isIntFormat format_x && isIntFormat format_y) $ text "intOp: non-int" -- This is the width of the registers on which the operation -- should be performed. - let w' = opRegWidth w return $ Any (intFormat w) $ \dst -> code_x `appOL` code_y `appOL` op (OpReg w' dst) (OpReg w' reg_x) (op_y) `appOL` - truncateReg w' w dst -- truncate back to the operand's original width + truncateRegInplace w' w dst -- truncate back to the operand's original width -- A (potentially signed) integer operation. -- In the case of 8- and 16-bit signed arithmetic we must first @@ -1263,7 +1263,8 @@ getRegister' config plat expr -- should be performed. let w' = opRegWidth w signExt r - | not is_signed = return (r, nilOL) + -- See Note [Signed arithmetic on AArch64] and #27430 + | not is_signed = truncateReg w w' r | otherwise = signExtendReg w w' r (reg_x_sx, code_x_sx) <- signExt reg_x (reg_y_sx, code_y_sx) <- signExt reg_y @@ -1274,7 +1275,7 @@ getRegister' config plat expr code_x_sx `appOL` code_y_sx `appOL` op (OpReg w' dst) (OpReg w' reg_x_sx) (OpReg w' reg_y_sx) `appOL` - truncateReg w' w dst -- truncate back to the operand's original width + truncateRegInplace w' w dst -- truncate back to the operand's original width floatOp w op = do (reg_fx, format_x, code_fx) <- getFloatReg x @@ -1904,10 +1905,28 @@ signExtendReg w w' r = r' <- getNewRegNat (intFormat w') return (r', unitOL $ instr (OpReg w' r') (OpReg w r)) --- | Instructions to truncate the value in the given register from width @w@ +-- | Instructions to truncate (zero extend) the value in the given register from width @w@ +-- down to width @w'@ into a new register. Or return the original register if it's a noop. +truncateReg :: Width -> Width -> Reg -> NatM (Reg, OrdList Instr) +truncateReg w w' r = do + case w' of + W64 -> noop + W32 + | w' == W32 -> noop + | otherwise -> trunc MOV + W16 -> trunc UXTH + W8 -> trunc UXTB + _ -> panic "intOp" + where + noop = return (r, nilOL) + trunc instr = do + r' <- getNewRegNat (intFormat w') + return (r', unitOL $ instr (OpReg w' r') (OpReg w r)) + +-- | Instructions to truncate (zero extend) the value in the given register from width @w@ -- down to width @w'@. -truncateReg :: Width -> Width -> Reg -> OrdList Instr -truncateReg w w' r = +truncateRegInplace :: Width -> Width -> Reg -> OrdList Instr +truncateRegInplace w w' r = case w of W64 -> nilOL W32 @@ -2352,7 +2371,7 @@ genCCall target dest_regs arg_regs = do -- product, and hi gets the overflow (sign extension bits). SMULL (OpReg w' lo) (OpReg W32 reg_a) (OpReg W32 reg_b) `snocOL` ASR (OpReg w' hi) (OpReg w' lo) (OpImm (ImmInt $ widthInBits w)) `appOL` - truncateReg w' w lo `snocOL` + truncateRegInplace w' w lo `snocOL` -- CMN (compare negative) tests hi + lo' == 0, i.e. hi == -lo'. -- lo' = LSR(lo, w-1) gives 1 if lo is negative, 0 if positive. -- No overflow iff hi is the sign extension of lo: @@ -2362,7 +2381,7 @@ genCCall target dest_regs arg_regs = do -- NE to set nd = 1 when overflow occurred. CMN (OpReg w' hi) (OpRegShift w' lo SLSR (widthInBits w - 1)) `snocOL` CSET (OpReg w' nd) NE `appOL` - truncateReg w' w hi + truncateRegInplace w' w hi -- Can't handle > 64 bit operands | otherwise -> unsupported (MO_S_Mul2 w) PrimTarget (MO_U_Mul2 w) @@ -2412,7 +2431,7 @@ genCCall target dest_regs arg_regs = do (OpImm (ImmInt $ widthInBits w)) -- lsb (OpImm (ImmInt $ widthInBits w)) -- width to extract `appOL` - truncateReg W64 w lo + truncateRegInplace W64 w lo ) | otherwise -> unsupported (MO_U_Mul2 w) PrimTarget (MO_Clz w) @@ -2898,6 +2917,7 @@ genCCall target dest_regs arg_regs = do passArguments _ _ _ _ _ _ _ = pprPanic "passArguments" (text "invalid state") + -- readResults gpArgs fpArgs dest_regs reg_acc code_acc readResults :: [Reg] -> [Reg] -> [LocalReg] -> [Reg]-> InstrBlock -> NatM (InstrBlock) readResults _ _ [] _ accumCode = return accumCode readResults [] _ _ _ _ = do @@ -2915,7 +2935,14 @@ genCCall target dest_regs arg_regs = do r_dst = getRegisterReg platform (CmmLocal dst) if isFloatFormat format || isVecFormat format then readResults (gpReg:gpRegs) fpRegs dsts (fpReg:accumRegs) (accumCode `snocOL` MOV (OpReg w r_dst) (OpReg w fpReg)) - else readResults gpRegs (fpReg:fpRegs) dsts (gpReg:accumRegs) (accumCode `snocOL` MOV (OpReg w r_dst) (OpReg w gpReg)) + else do + -- See [Signed arithmetic on AArch64] + -- Strictly speaking we don't have to here but err on the side of caution. + let !mov_instr = case w of + W8 -> UXTB + W16 -> UXTH + _ -> MOV + readResults gpRegs (fpReg:fpRegs) dsts (gpReg:accumRegs) (accumCode `snocOL` mov_instr (OpReg w r_dst) (OpReg w gpReg)) unaryFloatOp w op arg_reg dest_reg = do platform <- getPlatform View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cf9115be6576c7e99cf0f5b2fc38ebcc... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cf9115be6576c7e99cf0f5b2fc38ebcc... You're receiving this email because of your account on gitlab.haskell.org.