Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 537bd233 by Peng Fan at 2025-06-12T14:27:02-04:00 NCG/LA64: Optimize code generation and reduce build-directory size. 1. makeFarBranches: Prioritize fewer instruction sequences. 2. Prefer instructions with immediate numbers to reduce register moves, e.g. andi,ori,xori,addi. 3. Ppr: Remove unnecessary judgments. 4. genJump: Avoid "ld+jr" as much as possible. 5. BCOND and BCOND1: Implement conditional jumps with two jump ranges, with limited choice of the shortest. 6. Implement FSQRT, CLT, CTZ. 7. Remove unnecessary code. - - - - - 4 changed files: - compiler/GHC/CmmToAsm/LA64.hs - compiler/GHC/CmmToAsm/LA64/CodeGen.hs - compiler/GHC/CmmToAsm/LA64/Instr.hs - compiler/GHC/CmmToAsm/LA64/Ppr.hs Changes: ===================================== compiler/GHC/CmmToAsm/LA64.hs ===================================== @@ -32,7 +32,7 @@ ncgLA64 config = maxSpillSlots = LA64.maxSpillSlots config, allocatableRegs = LA64.allocatableRegs platform, ncgAllocMoreStack = LA64.allocMoreStack platform, - ncgMakeFarBranches = \_p _i bs -> pure bs, + ncgMakeFarBranches = LA64.makeFarBranches, extractUnwindPoints = const [], invertCondBranches = \_ _ -> id } ===================================== compiler/GHC/CmmToAsm/LA64/CodeGen.hs ===================================== @@ -6,6 +6,7 @@ module GHC.CmmToAsm.LA64.CodeGen ( cmmTopCodeGen , generateJumpTableForInstr + , makeFarBranches ) where @@ -31,7 +32,7 @@ import GHC.CmmToAsm.Monad getNewLabelNat, getNewRegNat, getPicBaseMaybeNat, - getPlatform, + getPlatform ) import GHC.CmmToAsm.PIC import GHC.CmmToAsm.LA64.Cond @@ -53,10 +54,10 @@ import GHC.Utils.Constants (debugIsOn) import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic -import GHC.Cmm.Dataflow.Label() import GHC.Utils.Monad import Control.Monad -import GHC.Types.Unique.DSM() +import GHC.Cmm.Dataflow.Label +import GHC.Types.Unique.DSM -- [General layout of an NCG] cmmTopCodeGen :: @@ -449,14 +450,6 @@ getRegister e = do getRegister' :: NCGConfig -> Platform -> CmmExpr -> NatM Register -- OPTIMIZATION WARNING: CmmExpr rewrites --- Maybe we can do more? --- 1. Rewrite: Reg + (-i) => Reg - i -getRegister' config plat (CmmMachOp (MO_Add w0) [x, CmmLit (CmmInt i w1)]) | i < 0 - = getRegister' config plat (CmmMachOp (MO_Sub w0) [x, CmmLit (CmmInt (-i) w1)]) - --- 2. Rewrite: Reg - (-i) => Reg + i -getRegister' config plat (CmmMachOp (MO_Sub w0) [x, CmmLit (CmmInt i w1)]) | i < 0 - = getRegister' config plat (CmmMachOp (MO_Add w0) [x, CmmLit (CmmInt (-i) w1)]) -- Generic case. getRegister' config plat expr = @@ -616,20 +609,38 @@ getRegister' config plat expr = x -> pprPanic ("getRegister' (monadic CmmMachOp): " ++ show x) (pdoc plat expr) where -- In the case of 32- or 16- or 8-bit values we need to sign-extend to 64-bits - negate code w reg = do + negate code w reg + | w `elem` [W8, W16] = do return $ Any (intFormat w) $ \dst -> - code `appOL` - signExtend w W64 reg reg `snocOL` + code `snocOL` + EXT (OpReg W64 reg) (OpReg w reg) `snocOL` NEG (OpReg W64 dst) (OpReg W64 reg) `appOL` truncateReg W64 w dst + | otherwise = do + return $ Any (intFormat w) $ \dst -> + code `snocOL` + NEG (OpReg W64 dst) (OpReg w reg) - ss_conv from to reg code = + ss_conv from to reg code + | from `elem` [W8, W16] || to `elem` [W8, W16] = do return $ Any (intFormat to) $ \dst -> - code `appOL` - signExtend from W64 reg dst `appOL` + code `snocOL` + EXT (OpReg W64 dst) (OpReg (min from to) reg) `appOL` -- At this point an 8- or 16-bit value would be sign-extended -- to 64-bits. Truncate back down the final width. truncateReg W64 to dst + | from == W32 && to == W64 = do + return $ Any (intFormat to) $ \dst -> + code `snocOL` + SLL (OpReg to dst) (OpReg from reg) (OpImm (ImmInt 0)) + | from == to = do + return $ Any (intFormat from) $ \dst -> + code `snocOL` MOV (OpReg from dst) (OpReg from reg) + | otherwise = do + return $ Any (intFormat to) $ \dst -> + code `appOL` + signExtend from W64 reg dst `appOL` + truncateReg W64 to dst -- Dyadic machops: @@ -646,337 +657,532 @@ getRegister' config plat expr = CmmMachOp (MO_Add _) [expr'@(CmmReg (CmmGlobal _r)), CmmLit (CmmInt 0 _)] -> getRegister' config plat expr' CmmMachOp (MO_Sub _) [expr'@(CmmReg (CmmGlobal _r)), CmmLit (CmmInt 0 _)] -> getRegister' config plat expr' - CmmMachOp (MO_Add w) [x, CmmLit (CmmInt n _)] - | w `elem` [W8, W16, W32] - , fitsInNbits 12 (fromIntegral n) -> do - (reg_x, format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) ( \dst -> - code_x `appOL` - signExtend (formatToWidth format_x) W64 reg_x reg_x `snocOL` - annExpr expr (ADD (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInt (fromIntegral n) ))) `appOL` - truncateReg W64 w dst - ) - - CmmMachOp (MO_Sub w) [x, CmmLit (CmmInt n _)] - | w `elem` [W8, W16, W32] - , fitsInNbits 12 (fromIntegral n) -> do - (reg_x, format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) ( \dst -> - code_x `appOL` - signExtend (formatToWidth format_x) W64 reg_x reg_x `snocOL` - annExpr expr (SUB (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInt (fromIntegral n) ))) `appOL` - truncateReg W64 w dst - ) - - CmmMachOp (MO_Add w) [CmmReg reg, CmmLit (CmmInt n _)] - | w `elem` [W8, W16, W32] - , fitsInNbits 12 (fromIntegral n) -> do - let w' = formatToWidth (cmmTypeFormat (cmmRegType reg)) - r' = getRegisterReg plat reg - return $ Any (intFormat w) ( \dst -> - signExtend w' W64 r' r' `snocOL` - annExpr expr (ADD (OpReg W64 dst) (OpReg w' r') (OpImm (ImmInt (fromIntegral n) ))) `appOL` - truncateReg W64 w dst - ) - - CmmMachOp (MO_Sub w) [CmmReg reg, CmmLit (CmmInt n _)] - | w `elem` [W8, W16, W32] - , fitsInNbits 12 (fromIntegral n) -> do - let w' = formatToWidth (cmmTypeFormat (cmmRegType reg)) - r' = getRegisterReg plat reg - return $ Any (intFormat w) ( \dst -> - signExtend w' W64 r' r' `snocOL` - annExpr expr (SUB (OpReg W64 dst) (OpReg w' r') (OpImm (ImmInt (fromIntegral n) ))) `appOL` - truncateReg W64 w dst - ) + CmmMachOp (MO_Add w) [x, CmmLit (CmmInt n _)] | fitsInNbits 12 (fromIntegral n) -> do + if w `elem` [W8, W16] + then do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> + code_x `snocOL` + annExpr expr (EXT (OpReg W64 reg_x) (OpReg w reg_x)) `snocOL` + ADD (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n)) + ) + else do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (ADD (OpReg W64 dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) + + CmmMachOp (MO_Sub w) [x, CmmLit (CmmInt n _)] | fitsInNbits 12 (fromIntegral n) -> do + if w `elem` [W8, W16] + then do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> + code_x `snocOL` + annExpr expr (EXT (OpReg W64 reg_x) (OpReg w reg_x)) `snocOL` + SUB (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n)) + ) + else do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (SUB (OpReg W64 dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) CmmMachOp (MO_U_Quot w) [x, y] - | w `elem` [W8, W16, W32] -> 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` - truncateReg (formatToWidth format_x) W64 reg_x `appOL` - code_y `appOL` - truncateReg (formatToWidth format_y) W64 reg_y `snocOL` - annExpr expr (DIVU (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) `appOL` - truncateReg W64 w dst - ) + | w `elem` [W8, W16] -> 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 w W64 reg_x `appOL` + truncateReg w W64 reg_y `snocOL` + annExpr expr (DIVU (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) -- 2. Shifts. - CmmMachOp (MO_Shl w) [x, y] - | w `elem` [W8, W16, W32] -> 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` - signExtend (formatToWidth format_x) W64 reg_x reg_x `appOL` - code_y `appOL` - signExtend (formatToWidth format_y) W64 reg_y reg_y `snocOL` - annExpr expr (SLL (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) `appOL` - truncateReg W64 w dst - ) - - CmmMachOp (MO_Shl w) [x, CmmLit (CmmInt n _)] - | w `elem` [W8, W16, W32] - , 0 <= n, n < fromIntegral (widthInBits w) -> do - (reg_x, format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) ( \dst -> - code_x `appOL` - signExtend (formatToWidth format_x) W64 reg_x reg_x `snocOL` - annExpr expr (SLL (OpReg W64 dst) (OpReg w reg_x) (OpImm (ImmInt (fromIntegral n) ))) `appOL` - truncateReg W64 w dst - ) + CmmMachOp (MO_Shl w) [x, y] -> + case y of + CmmLit (CmmInt n _) | w `elem` [W8, W16], 0 <= n, n < fromIntegral (widthInBits w) -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> + code_x `snocOL` + annExpr expr (EXT (OpReg W64 reg_x) (OpReg w reg_x)) `snocOL` + SLL (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n)) + ) + CmmLit (CmmInt n _) | 0 <= n, n < fromIntegral (widthInBits w) -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (SLL (OpReg W64 dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) + + _ | w `elem` [W8, W16] -> 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 `snocOL` + annExpr expr (EXT (OpReg W64 reg_x) (OpReg w reg_x)) `snocOL` + EXT (OpReg W64 reg_y) (OpReg w reg_y) `snocOL` + SLL (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y) + ) + _ -> 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 `snocOL` + annExpr expr (SLL (OpReg W64 dst) (OpReg w reg_x) (OpReg w reg_y)) + ) -- MO_S_Shr: signed-shift-right - CmmMachOp (MO_S_Shr w) [x, y] - | w `elem` [W8, W16, W32] -> 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` - signExtend (formatToWidth format_x) W64 reg_x reg_x `appOL` - code_y `appOL` - signExtend (formatToWidth format_y) W64 reg_y reg_y `snocOL` - annExpr expr (SRA (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) `appOL` - truncateReg W64 w dst - ) - CmmMachOp (MO_S_Shr w) [x, CmmLit (CmmInt n _)] - | w `elem` [W8, W16, W32] - , fitsInNbits 12 (fromIntegral n) -> do - (reg_x, format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) (\dst -> - code_x `appOL` - signExtend (formatToWidth format_x) W64 reg_x reg_x `snocOL` - annExpr expr (SRA (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInt (fromIntegral n) ))) `appOL` - truncateReg W64 w dst - ) + CmmMachOp (MO_S_Shr w) [x, y] -> + case y of + CmmLit (CmmInt n _) | w `elem` [W8, W16], 0 <= n, n < fromIntegral (widthInBits w) -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> + code_x `snocOL` + annExpr expr (EXT (OpReg W64 reg_x) (OpReg w reg_x)) `snocOL` + SRA (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n)) + ) + CmmLit (CmmInt n _) | 0 <= n, n < fromIntegral (widthInBits w) -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (SRA (OpReg W64 dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) + + _ | w `elem` [W8, W16] -> 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 `snocOL` + annExpr expr (EXT (OpReg W64 reg_x) (OpReg w reg_x)) `snocOL` + EXT (OpReg W64 reg_y) (OpReg w reg_y) `snocOL` + SRA (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y) + ) + _ -> 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 `snocOL` + annExpr expr (SRA (OpReg W64 dst) (OpReg w reg_x) (OpReg w reg_y)) + ) -- MO_U_Shr: unsigned-shift-right - CmmMachOp (MO_U_Shr w) [x, y] - | w `elem` [W8, W16, W32] -> 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` - truncateReg (formatToWidth format_x) W64 reg_x `appOL` - code_y `appOL` - truncateReg (formatToWidth format_y) W64 reg_y `snocOL` - annExpr expr (SRL (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) `appOL` - truncateReg W64 w dst - ) - CmmMachOp (MO_U_Shr w) [x, CmmLit (CmmInt n _)] - | w `elem` [W8, W16, W32] - , 0 <= n, n < fromIntegral (widthInBits w) -> do - (reg_x, format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) ( \dst -> - code_x `appOL` - truncateReg (formatToWidth format_x) W64 reg_x `snocOL` - annExpr expr (SRL (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInt (fromIntegral n) ))) `appOL` - truncateReg W64 w dst - ) + CmmMachOp (MO_U_Shr w) [x, y] -> + case y of + CmmLit (CmmInt n _) | w `elem` [W8, W16], 0 <= n, n < fromIntegral (widthInBits w) -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> + code_x `appOL` + truncateReg w W64 reg_x `snocOL` + annExpr expr (SRL (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n))) + ) + CmmLit (CmmInt n _) | 0 <= n, n < fromIntegral (widthInBits w) -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (SRL (OpReg W64 dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) + + _ | w `elem` [W8, W16] -> 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 w W64 reg_x `appOL` + truncateReg w W64 reg_y `snocOL` + annExpr expr (SRL (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + _ -> 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 `snocOL` + annExpr expr (SRL (OpReg W64 dst) (OpReg w reg_x) (OpReg w reg_y)) + ) -- 3. Logic &&, || -- andi Instr's Imm-operand is zero-extended. - CmmMachOp (MO_And w) [x, y] - | w `elem` [W8, W16, W32] -> 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` - truncateReg (formatToWidth format_x) W64 reg_x `appOL` - code_y `appOL` - truncateReg (formatToWidth format_y) W64 reg_y `snocOL` - annExpr expr (AND (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) `appOL` - truncateReg W64 w dst - ) + CmmMachOp (MO_And w) [x, y] -> + case y of + CmmLit (CmmInt n _) | w `elem` [W8, W16, W32], (n :: Integer) >= 0, (n :: Integer) <= 4095 -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> + code_x `appOL` + truncateReg w W64 reg_x `snocOL` + annExpr expr (AND (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n))) + ) - CmmMachOp (MO_And w) [x, CmmLit (CmmInt n _)] - | w `elem` [W8, W16, W32] -> do - (reg_x, format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) ( \dst -> - code_x `appOL` - truncateReg (formatToWidth format_x) W64 reg_x `snocOL` - annExpr expr (AND (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInt (fromIntegral n) ))) `appOL` - truncateReg W64 w dst - ) + CmmLit (CmmInt n _) | (n :: Integer) >= 0, (n :: Integer) <= 4095 -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (AND (OpReg W64 dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) + + CmmLit (CmmInt n _) | w `elem` [W8, W16, W32] -> do + (reg_x, _format_x, code_x) <- getSomeReg x + tmp <- getNewRegNat II64 + return $ Any (intFormat w) (\dst -> + code_x `appOL` + truncateReg w W64 reg_x `snocOL` + annExpr expr (MOV (OpReg W64 tmp) (OpImm (ImmInteger n))) `snocOL` + AND (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 tmp) + ) - CmmMachOp (MO_Or w) [x, y] - | w `elem` [W8, W16, W32] -> 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` - truncateReg (formatToWidth format_x) W64 reg_x `appOL` - code_y `appOL` - truncateReg (formatToWidth format_y) W64 reg_y `snocOL` - annExpr expr (OR (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) `appOL` - truncateReg W64 w dst - ) + CmmLit (CmmInt n _) -> do + (reg_x, _format_x, code_x) <- getSomeReg x + tmp <- getNewRegNat II64 + return $ Any (intFormat w) (\dst -> + code_x `snocOL` + annExpr expr (MOV (OpReg W64 tmp) (OpImm (ImmInteger n))) `snocOL` + AND (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 tmp) + ) - CmmMachOp (MO_Or w) [x, CmmLit (CmmInt n _)] - | w `elem` [W8, W16, W32] -> do - (reg_x, format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) ( \dst -> - code_x `appOL` - truncateReg (formatToWidth format_x) W64 reg_x `snocOL` - annExpr expr (OR (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInt (fromIntegral n) ))) `appOL` - truncateReg W64 w dst - ) + _ | w `elem` [W8, W16, W32] -> 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 w W64 reg_x `appOL` + truncateReg w W64 reg_y `snocOL` + annExpr expr (AND (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) - CmmMachOp (MO_Xor w) [x, y] - | w `elem` [W8, W16, W32] -> 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` - truncateReg (formatToWidth format_x) W64 reg_x `appOL` - code_y `appOL` - truncateReg (formatToWidth format_y) W64 reg_y `snocOL` - annExpr expr (XOR (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) `appOL` - truncateReg W64 w dst - ) + _ -> 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 `snocOL` + annExpr expr (AND (OpReg W64 dst) (OpReg w reg_x) (OpReg w reg_y)) + ) - CmmMachOp (MO_Xor w) [x, CmmLit (CmmInt n _)] - | w `elem` [W8, W16, W32] -> do - (reg_x, format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) ( \dst -> - code_x `appOL` - truncateReg (formatToWidth format_x) W64 reg_x `snocOL` - annExpr expr (XOR (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInt (fromIntegral n) ))) `appOL` - truncateReg W64 w dst - ) + -- ori Instr's Imm-operand is zero-extended. + CmmMachOp (MO_Or w) [x, y] -> + case y of + CmmLit (CmmInt n _) | w `elem` [W8, W16, W32], (n :: Integer) >= 0, (n :: Integer) <= 4095 -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> + code_x `appOL` + truncateReg w W64 reg_x `snocOL` + annExpr expr (OR (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n))) + ) + + CmmLit (CmmInt n _) | (n :: Integer) >= 0, (n :: Integer) <= 4095 -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (OR (OpReg W64 dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) + + CmmLit (CmmInt n _) | w `elem` [W8, W16, W32] -> do + (reg_x, _format_x, code_x) <- getSomeReg x + tmp <- getNewRegNat II64 + return $ Any (intFormat w) (\dst -> + code_x `appOL` + truncateReg w W64 reg_x `snocOL` + annExpr expr (MOV (OpReg W64 tmp) (OpImm (ImmInteger n))) `snocOL` + OR (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 tmp) + ) + + CmmLit (CmmInt n _) -> do + (reg_x, _format_x, code_x) <- getSomeReg x + tmp <- getNewRegNat II64 + return $ Any (intFormat w) (\dst -> + code_x `snocOL` + annExpr expr (MOV (OpReg W64 tmp) (OpImm (ImmInteger n))) `snocOL` + OR (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 tmp) + ) + + _ | w `elem` [W8, W16, W32] -> 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 w W64 reg_x `appOL` + truncateReg w W64 reg_y `snocOL` + annExpr expr (OR (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + + _ -> 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 `snocOL` + annExpr expr (OR (OpReg W64 dst) (OpReg w reg_x) (OpReg w reg_y)) + ) + + -- xori Instr's Imm-operand is zero-extended. + CmmMachOp (MO_Xor w) [x, y] -> + case y of + CmmLit (CmmInt n _) | w `elem` [W8, W16, W32], (n :: Integer) >= 0, (n :: Integer) <= 4095 -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> + code_x `appOL` + truncateReg w W64 reg_x `snocOL` + annExpr expr (XOR (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n))) + ) + + CmmLit (CmmInt n _) | (n :: Integer) >= 0, (n :: Integer) <= 4095 -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (XOR (OpReg W64 dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) + + CmmLit (CmmInt n _) | w `elem` [W8, W16, W32] -> do + (reg_x, _format_x, code_x) <- getSomeReg x + tmp <- getNewRegNat II64 + return $ Any (intFormat w) (\dst -> + code_x `appOL` + truncateReg w W64 reg_x `snocOL` + annExpr expr (MOV (OpReg W64 tmp) (OpImm (ImmInteger n))) `snocOL` + XOR (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 tmp) + ) + + CmmLit (CmmInt n _) -> do + (reg_x, _format_x, code_x) <- getSomeReg x + tmp <- getNewRegNat II64 + return $ Any (intFormat w) (\dst -> + code_x `snocOL` + annExpr expr (MOV (OpReg W64 tmp) (OpImm (ImmInteger n))) `snocOL` + XOR (OpReg W64 dst) (OpReg w reg_x) (OpReg W64 tmp) + ) + + _ | w `elem` [W8, W16, W32] -> 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 w W64 reg_x `appOL` + truncateReg w W64 reg_y `snocOL` + annExpr expr (XOR (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + + _ -> 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 `snocOL` + annExpr expr (XOR (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) -- CSET commands register operand being W64. CmmMachOp (MO_Eq w) [x, y] | w `elem` [W8, W16, W32] -> 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` - signExtend (formatToWidth format_x) W64 reg_x reg_x `appOL` - code_y `appOL` - signExtend (formatToWidth format_y) W64 reg_y reg_y `snocOL` - annExpr expr (CSET EQ (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) `appOL` - truncateReg W64 w dst - ) + (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` + signExtend w W64 reg_x reg_x `appOL` + signExtend w W64 reg_y reg_y `snocOL` + annExpr expr (CSET EQ (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + | otherwise -> 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 `snocOL` + annExpr expr (CSET EQ (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) CmmMachOp (MO_Ne w) [x, y] | w `elem` [W8, W16, W32] -> 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` - signExtend (formatToWidth format_x) W64 reg_x reg_x `appOL` - code_y `appOL` - signExtend (formatToWidth format_y) W64 reg_y reg_y `snocOL` - annExpr expr (CSET NE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) `appOL` - truncateReg W64 w dst - ) + (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` + signExtend w W64 reg_x reg_x `appOL` + signExtend w W64 reg_y reg_y `snocOL` + annExpr expr (CSET NE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + | otherwise -> 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 `snocOL` + annExpr expr (CSET NE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + + CmmMachOp (MO_S_Lt w) [x, CmmLit (CmmInt n _)] + | w `elem` [W8, W16, W32] + , fitsInNbits 12 (fromIntegral n) -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) ( \dst -> + code_x `appOL` + signExtend w W64 reg_x reg_x `snocOL` + annExpr expr (SSLT (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n))) + ) + | fitsInNbits 12 (fromIntegral n) -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) ( \dst -> code_x `snocOL` annExpr expr (SSLT (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n)))) + + CmmMachOp (MO_U_Lt w) [x, CmmLit (CmmInt n _)] + | w `elem` [W8, W16, W32] + , fitsInNbits 12 (fromIntegral n) -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) ( \dst -> + code_x `appOL` + truncateReg w W64 reg_x `snocOL` + annExpr expr (SSLTU (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n))) + ) + | fitsInNbits 12 (fromIntegral n) -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) ( \dst -> code_x `snocOL` annExpr expr (SSLTU (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n)))) CmmMachOp (MO_S_Lt w) [x, y] | w `elem` [W8, W16, W32] -> 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` - signExtend (formatToWidth format_x) W64 reg_x reg_x `appOL` - code_y `appOL` - signExtend (formatToWidth format_y) W64 reg_y reg_y `snocOL` - annExpr expr (CSET SLT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) `appOL` - truncateReg W64 w dst - ) + (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` + signExtend w W64 reg_x reg_x `appOL` + signExtend w W64 reg_y reg_y `snocOL` + annExpr expr (CSET SLT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + | otherwise -> 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 `snocOL` + annExpr expr (CSET SLT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) CmmMachOp (MO_S_Le w) [x, y] | w `elem` [W8, W16, W32] -> 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` - signExtend (formatToWidth format_x) W64 reg_x reg_x `appOL` - code_y `appOL` - signExtend (formatToWidth format_y) W64 reg_y reg_y `snocOL` - annExpr expr (CSET SLE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) `appOL` - truncateReg W64 w dst - ) + (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` + signExtend w W64 reg_x reg_x `appOL` + signExtend w W64 reg_y reg_y `snocOL` + annExpr expr (CSET SLE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + | otherwise -> 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 `snocOL` + annExpr expr (CSET SLE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) CmmMachOp (MO_S_Ge w) [x, y] | w `elem` [W8, W16, W32] -> 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` - signExtend (formatToWidth format_x) W64 reg_x reg_x `appOL` - code_y `appOL` - signExtend (formatToWidth format_y) W64 reg_y reg_y `snocOL` - annExpr expr (CSET SGE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) `appOL` - truncateReg W64 w dst - ) + (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` + signExtend w W64 reg_x reg_x `appOL` + signExtend w W64 reg_y reg_y `snocOL` + annExpr expr (CSET SGE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + | otherwise -> 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 `snocOL` + annExpr expr (CSET SGE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) CmmMachOp (MO_S_Gt w) [x, y] | w `elem` [W8, W16, W32] -> 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` - signExtend (formatToWidth format_x) W64 reg_x reg_x `appOL` - code_y `appOL` - signExtend (formatToWidth format_y) W64 reg_y reg_y `snocOL` - annExpr expr (CSET SGT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) `appOL` - truncateReg W64 w dst - ) + (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` + signExtend w W64 reg_x reg_x `appOL` + signExtend w W64 reg_y reg_y `snocOL` + annExpr expr (CSET SGT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + | otherwise -> 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 `snocOL` + annExpr expr (CSET SGT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) CmmMachOp (MO_U_Lt w) [x, y] | w `elem` [W8, W16, W32] -> 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` - truncateReg (formatToWidth format_x) W64 reg_x `appOL` - code_y `appOL` - truncateReg (formatToWidth format_y) W64 reg_y `snocOL` - annExpr expr (CSET ULT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) `appOL` - truncateReg W64 w dst - ) + (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 w W64 reg_x `appOL` + truncateReg w W64 reg_y `snocOL` + annExpr expr (CSET ULT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + | otherwise -> 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 `snocOL` + annExpr expr (CSET ULT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) CmmMachOp (MO_U_Le w) [x, y] | w `elem` [W8, W16, W32] -> 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` - truncateReg (formatToWidth format_x) W64 reg_x `appOL` - code_y `appOL` - truncateReg (formatToWidth format_y) W64 reg_y `snocOL` - annExpr expr (CSET ULE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) `appOL` - truncateReg W64 w dst - ) + (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 w W64 reg_x `appOL` + truncateReg w W64 reg_y `snocOL` + annExpr expr (CSET ULE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + | otherwise -> 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 `snocOL` + annExpr expr (CSET ULE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) CmmMachOp (MO_U_Ge w) [x, y] | w `elem` [W8, W16, W32] -> 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` - truncateReg (formatToWidth format_x) W64 reg_x `appOL` - code_y `appOL` - truncateReg (formatToWidth format_y) W64 reg_y `snocOL` - annExpr expr (CSET UGE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) `appOL` - truncateReg W64 w dst - ) + (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 w W64 reg_x `appOL` + truncateReg w W64 reg_y `snocOL` + annExpr expr (CSET UGE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + | otherwise -> 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 `snocOL` + annExpr expr (CSET UGE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) CmmMachOp (MO_U_Gt w) [x, y] | w `elem` [W8, W16, W32] -> 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` - truncateReg (formatToWidth format_x) W64 reg_x `appOL` - code_y `appOL` - truncateReg (formatToWidth format_y) W64 reg_y `snocOL` - annExpr expr (CSET UGT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) `appOL` - truncateReg W64 w dst - ) + (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 w W64 reg_x `appOL` + truncateReg w W64 reg_y `snocOL` + annExpr expr (CSET UGT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + | otherwise -> 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 `snocOL` + annExpr expr (CSET UGT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) -- Generic binary case. @@ -1044,21 +1250,6 @@ getRegister' config plat expr = MO_U_Quot w -> intOp False w (\d x y -> annExpr expr (DIVU d x y)) MO_U_Rem w -> intOp False w (\d x y -> annExpr expr (MODU d x y)) - MO_Eq w -> intOp False w (\d x y -> annExpr expr (CSET EQ d x y)) - MO_Ne w -> intOp False w (\d x y -> annExpr expr (CSET NE d x y)) - - -- Signed comparisons - MO_S_Ge w -> intOp True w (\d x y -> annExpr expr (CSET SGE d x y)) - MO_S_Le w -> intOp True w (\d x y -> annExpr expr (CSET SLE d x y)) - MO_S_Gt w -> intOp True w (\d x y -> annExpr expr (CSET SGT d x y)) - MO_S_Lt w -> intOp True w (\d x y -> annExpr expr (CSET SLT d x y)) - - -- Unsigned comparisons - MO_U_Ge w -> intOp False w (\d x y -> annExpr expr (CSET UGE d x y)) - MO_U_Le w -> intOp False w (\d x y -> annExpr expr (CSET ULE d x y)) - MO_U_Gt w -> intOp False w (\d x y -> annExpr expr (CSET UGT d x y)) - MO_U_Lt w -> intOp False w (\d x y -> annExpr expr (CSET ULT d x y)) - -- Floating point arithmetic MO_F_Add w -> floatOp w (\d x y -> unitOL $ annExpr expr (ADD d x y)) MO_F_Sub w -> floatOp w (\d x y -> unitOL $ annExpr expr (SUB d x y)) @@ -1075,15 +1266,6 @@ getRegister' config plat expr = MO_F_Gt w -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET FGT d x y)) MO_F_Lt w -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET FLT d x y)) - MO_Shl w -> intOp False w (\d x y -> annExpr expr (SLL d x y)) - MO_U_Shr w -> intOp False w (\d x y -> annExpr expr (SRL d x y)) - MO_S_Shr w -> intOp True w (\d x y -> annExpr expr (SRA d x y)) - - -- Bitwise operations - MO_And w -> intOp False w (\d x y -> annExpr expr (AND d x y)) - MO_Or w -> intOp False w (\d x y -> annExpr expr (OR d x y)) - MO_Xor w -> intOp False w (\d x y -> annExpr expr (XOR d x y)) - op -> pprPanic "getRegister' (unhandled dyadic CmmMachOp): " $ pprMachOp op <+> text "in" <+> pdoc plat expr -- Generic ternary case. @@ -1148,8 +1330,7 @@ getRegister' config plat expr = code_y `snocOL` MULW (OpReg W64 tmp1) (OpReg W64 reg_x) (OpReg W64 reg_y) `snocOL` ADD (OpReg W64 tmp2) (OpReg W32 tmp1) (OpImm (ImmInt 0)) `snocOL` - CSET NE (OpReg W64 dst) (OpReg W64 tmp1) (OpReg W64 tmp2) `appOL` - truncateReg W64 W32 dst + CSET NE (OpReg W64 dst) (OpReg W64 tmp1) (OpReg W64 tmp2) ) -- General case @@ -1193,8 +1374,7 @@ getRegister' config plat expr = -- extract valid result via result's width -- slli.w for W32, otherwise ext.w.[b, h] extract w tmp2 tmp1 `snocOL` - CSET NE (OpReg W64 dst) (OpReg W64 tmp1) (OpReg W64 tmp2) `appOL` - truncateReg W64 w dst + CSET NE (OpReg W64 dst) (OpReg W64 tmp1) (OpReg W64 tmp2) ) -- Should it be happened? @@ -1210,11 +1390,10 @@ signExtend w w' r r' | w > w' = pprPanic "Sign-extend Error: not a sign extension, but a truncation." $ ppr w <> text "->" <+> ppr w' | w > W64 || w' > W64 = pprPanic "Sign-extend Error: from/to register width greater than 64-bit." $ ppr w <> text "->" <+> ppr w' | w == W64 && w' == W64 && r == r' = nilOL - | w == W64 && w' == W64 = unitOL $ MOV (OpReg w' r') (OpReg w r) | w == W32 && w' == W64 = unitOL $ SLL (OpReg W64 r') (OpReg w r) (OpImm (ImmInt 0)) -- Sign-extend W8 and W16 to W64. | w `elem` [W8, W16] = unitOL $ EXT (OpReg W64 r') (OpReg w r) - | w == W32 && w' == W32 = unitOL $ MOV (OpReg w' r') (OpReg w r) + | w == w' = unitOL $ MOV (OpReg w' r') (OpReg w r) | otherwise = pprPanic "signExtend: Unexpected width: " $ ppr w <> text "->" <+> ppr w' -- | Instructions to truncate the value in the given register from width @w@ @@ -1321,12 +1500,19 @@ assignReg_FltCode = assignReg_IntCode -- Jumps genJump :: CmmExpr{-the branch target-} -> NatM InstrBlock --- `b label` may be optimal, but not the right one in some scenarios. --- genJump expr@(CmmLit (CmmLabel lbl)) --- = return $ unitOL (annExpr expr (J (TLabel lbl))) genJump expr = do - (target, _format, code) <- getSomeReg expr - return (code `appOL` unitOL (annExpr expr (J (TReg target)))) + case expr of + (CmmLit (CmmLabel lbl)) -> do + return $ unitOL (annExpr expr (TAIL36 (OpReg W64 tmpReg) (TLabel lbl))) + (CmmLit (CmmBlock bid)) -> do + return $ unitOL (annExpr expr (TAIL36 (OpReg W64 tmpReg) (TBlock bid))) + _ -> do + (target, _format, code) <- getSomeReg expr + -- I'd like to do more. + return $ COMMENT (text "genJump for unknow expr: " <+> (text (show expr))) `consOL` + (code `appOL` + unitOL (annExpr expr (J (TReg target))) + ) -- ----------------------------------------------------------------------------- -- Unconditional branches @@ -1369,65 +1555,47 @@ genCondJump bid expr = do -- Generic case. CmmMachOp mop [x, y] -> do - - let ubcond w cmp | w `elem` [W8, W16, W32] = do + let ubcond w cmp = do (reg_x, format_x, code_x) <- getSomeReg x (reg_y, format_y, code_y) <- getSomeReg y - reg_t <- getNewRegNat (intFormat W64) - return $ - code_x `appOL` - truncateReg (formatToWidth format_x) W64 reg_x `appOL` - code_y `appOL` - truncateReg (formatToWidth format_y) W64 reg_y `snocOL` - MOV (OpReg W64 reg_t) (OpImm (ImmInt 12)) `snocOL` - BCOND cmp (OpReg W64 reg_x) (OpReg W64 reg_y) (TBlock bid) (OpReg W64 reg_t) - ubcond _w cmp = do - (reg_x, _format_x, code_x) <- getSomeReg x - (reg_y, _format_y, code_y) <- getSomeReg y - reg_t <- getNewRegNat (intFormat W64) - return $ - code_x `appOL` - code_y `snocOL` - MOV (OpReg W64 reg_t) (OpImm (ImmInt 12)) `snocOL` - BCOND cmp (OpReg W64 reg_x) (OpReg W64 reg_y) (TBlock bid) (OpReg W64 reg_t) - - - sbcond w cmp | w `elem` [W8, W16, W32] = do + return $ case w of + w | w `elem` [W8, W16, W32] -> + code_x `appOL` + truncateReg (formatToWidth format_x) W64 reg_x `appOL` + code_y `appOL` + truncateReg (formatToWidth format_y) W64 reg_y `snocOL` + BCOND1 cmp (OpReg W64 reg_x) (OpReg W64 reg_y) (TBlock bid) + _ -> + code_x `appOL` + code_y `snocOL` + BCOND1 cmp (OpReg W64 reg_x) (OpReg W64 reg_y) (TBlock bid) + + sbcond w cmp = do (reg_x, format_x, code_x) <- getSomeReg x (reg_y, format_y, code_y) <- getSomeReg y - reg_t <- getNewRegNat (intFormat W64) - return $ - code_x `appOL` - signExtend (formatToWidth format_x) W64 reg_x reg_x `appOL` - code_y `appOL` - signExtend (formatToWidth format_y) W64 reg_y reg_y `snocOL` - MOV (OpReg W64 reg_t) (OpImm (ImmInt 13)) `snocOL` - BCOND cmp (OpReg W64 reg_x) (OpReg W64 reg_y) (TBlock bid) (OpReg W64 reg_t) - - sbcond _w cmp = do - (reg_x, _format_x, code_x) <- getSomeReg x - (reg_y, _format_y, code_y) <- getSomeReg y - reg_t <- getNewRegNat (intFormat W64) - return $ - code_x `appOL` - code_y `snocOL` - MOV (OpReg W64 reg_t) (OpImm (ImmInt 13)) `snocOL` - BCOND cmp (OpReg W64 reg_x) (OpReg W64 reg_y) (TBlock bid) (OpReg W64 reg_t) - + return $ case w of + w | w `elem` [W8, W16, W32] -> + code_x `appOL` + signExtend (formatToWidth format_x) W64 reg_x reg_x `appOL` + code_y `appOL` + signExtend (formatToWidth format_y) W64 reg_y reg_y `snocOL` + BCOND1 cmp (OpReg W64 reg_x) (OpReg W64 reg_y) (TBlock bid) + _ -> + code_x `appOL` + code_y `snocOL` + BCOND1 cmp (OpReg W64 reg_x) (OpReg W64 reg_y) (TBlock bid) fbcond w cmp = do (reg_fx, _format_fx, code_fx) <- getFloatReg x (reg_fy, _format_fy, code_fy) <- getFloatReg y rst <- OpReg W64 <$> getNewRegNat II64 oneReg <- OpReg W64 <$> getNewRegNat II64 - reg_t <- getNewRegNat (intFormat W64) return $ code_fx `appOL` code_fy `snocOL` - MOV (OpReg W64 reg_t) (OpImm (ImmInt 14)) `snocOL` CSET cmp rst (OpReg w reg_fx) (OpReg w reg_fy) `snocOL` MOV oneReg (OpImm (ImmInt 1)) `snocOL` - BCOND EQ rst oneReg (TBlock bid) (OpReg W64 reg_t) + BCOND1 EQ rst oneReg (TBlock bid) case mop of @@ -1437,15 +1605,12 @@ genCondJump bid expr = do MO_F_Ge w -> fbcond w FGE MO_F_Lt w -> fbcond w FLT MO_F_Le w -> fbcond w FLE - MO_Eq w -> sbcond w EQ MO_Ne w -> sbcond w NE - MO_S_Gt w -> sbcond w SGT MO_S_Ge w -> sbcond w SGE MO_S_Lt w -> sbcond w SLT MO_S_Le w -> sbcond w SLE - MO_U_Gt w -> ubcond w UGT MO_U_Ge w -> ubcond w UGE MO_U_Lt w -> ubcond w ULT @@ -1454,7 +1619,6 @@ genCondJump bid expr = do _ -> pprPanic "LA64.genCondJump: " (text $ show expr) - -- | Generate conditional branching instructions -- This is basically an "if with else" statement. genCondBranch :: @@ -1513,16 +1677,14 @@ genCCall target dest_regs arg_regs = do -- be a foreign procedure with an address expr -- and a calling convention. ForeignTarget expr _cconv -> do --- (call_target, call_target_code) <- case expr of --- -- if this is a label, let's just directly to it. This will produce the --- -- correct CALL relocation for BL. --- (CmmLit (CmmLabel lbl)) -> pure (TLabel lbl, nilOL) --- -- if it's not a label, let's compute the expression into a --- -- register and jump to that. --- _ -> do - (call_target_reg, call_target_code) <- do - (reg, _format, reg_code) <- getSomeReg expr - pure (reg, reg_code) + (call_target, call_target_code) <- case expr of + -- if this is a label, let's just directly to it. + (CmmLit (CmmLabel lbl)) -> pure (TLabel lbl, nilOL) + -- if it's not a label, let's compute the expression into a + -- register and jump to that. + _ -> do + (reg, _format, reg_code) <- getSomeReg expr + pure (TReg reg, reg_code) -- compute the code and register logic for all arg_regs. -- this will give us the format information to match on. arg_regs' <- mapM getSomeReg arg_regs @@ -1562,8 +1724,7 @@ genCCall target dest_regs arg_regs = do call_target_code -- compute the label (possibly into a register) `appOL` moveStackDown (stackSpaceWords) `appOL` passArgumentsCode -- put the arguments into x0, ... - -- `snocOL` BL call_target passRegs -- branch and link (C calls aren't tail calls, but return) - `snocOL` BL (TReg call_target_reg) passRegs -- branch and link (C calls aren't tail calls, but return) + `snocOL` CALL call_target passRegs -- branch and link (C calls aren't tail calls, but return) `appOL` readResultsCode -- parse the results into registers `appOL` moveStackUp (stackSpaceWords) return code @@ -1571,11 +1732,79 @@ genCCall target dest_regs arg_regs = do PrimTarget MO_F32_Fabs | [arg_reg] <- arg_regs, [dest_reg] <- dest_regs -> unaryFloatOp W32 (\d x -> unitOL $ FABS d x) arg_reg dest_reg + | otherwise -> panic "mal-formed MO_F32_Fabs" PrimTarget MO_F64_Fabs | [arg_reg] <- arg_regs, [dest_reg] <- dest_regs -> unaryFloatOp W64 (\d x -> unitOL $ FABS d x) arg_reg dest_reg + | otherwise -> panic "mal-formed MO_F64_Fabs" + + PrimTarget MO_F32_Sqrt + | [arg_reg] <- arg_regs, [dest_reg] <- dest_regs -> + unaryFloatOp W32 (\d x -> unitOL $ FSQRT d x) arg_reg dest_reg + | otherwise -> panic "mal-formed MO_F32_Sqrt" + PrimTarget MO_F64_Sqrt + | [arg_reg] <- arg_regs, [dest_reg] <- dest_regs -> + unaryFloatOp W64 (\d x -> unitOL $ FSQRT d x) arg_reg dest_reg + | otherwise -> panic "mal-formed MO_F64_Sqrt" + + PrimTarget (MO_Clz w) + | w `elem` [W32, W64], + [arg_reg] <- arg_regs, + [dest_reg] <- dest_regs -> do + platform <- getPlatform + (reg_x, _format_x, code_x) <- getSomeReg arg_reg + let dst_reg = getRegisterReg platform (CmmLocal dest_reg) + return ( code_x `snocOL` + CLZ (OpReg w dst_reg) (OpReg w reg_x) + ) + | w `elem` [W8, W16], + [arg_reg] <- arg_regs, + [dest_reg] <- dest_regs -> do + platform <- getPlatform + (reg_x, _format_x, code_x) <- getSomeReg arg_reg + let dst_reg = getRegisterReg platform (CmmLocal dest_reg) + return ( code_x `appOL` toOL + [ + MOV (OpReg W64 dst_reg) (OpImm (ImmInt 1)), + SLL (OpReg W64 dst_reg) (OpReg W64 dst_reg) (OpImm (ImmInt (31-shift))), + SLL (OpReg W64 reg_x) (OpReg W64 reg_x) (OpImm (ImmInt (32-shift))), + OR (OpReg W64 dst_reg) (OpReg W64 dst_reg) (OpReg W64 reg_x), + CLZ (OpReg W64 dst_reg) (OpReg W32 dst_reg) + ] + ) + | otherwise -> unsupported (MO_Clz w) + where + shift = widthToInt w + + PrimTarget (MO_Ctz w) + | w `elem` [W32, W64], + [arg_reg] <- arg_regs, + [dest_reg] <- dest_regs -> do + platform <- getPlatform + (reg_x, _format_x, code_x) <- getSomeReg arg_reg + let dst_reg = getRegisterReg platform (CmmLocal dest_reg) + return ( code_x `snocOL` + CTZ (OpReg w dst_reg) (OpReg w reg_x) + ) + | w `elem` [W8, W16], + [arg_reg] <- arg_regs, + [dest_reg] <- dest_regs -> do + platform <- getPlatform + (reg_x, _format_x, code_x) <- getSomeReg arg_reg + let dst_reg = getRegisterReg platform (CmmLocal dest_reg) + return ( code_x `appOL` toOL + [ + MOV (OpReg W64 dst_reg) (OpImm (ImmInt 1)), + SLL (OpReg W64 dst_reg) (OpReg W64 dst_reg) (OpImm (ImmInt shift)), + BSTRPICK II64 (OpReg W64 reg_x) (OpReg W64 reg_x) (OpImm (ImmInt (shift-1))) (OpImm (ImmInt 0)), + OR (OpReg W64 dst_reg) (OpReg W64 dst_reg) (OpReg W64 reg_x), + CTZ (OpReg W64 dst_reg) (OpReg W64 dst_reg) + ] + ) + | otherwise -> unsupported (MO_Ctz w) + where + shift = (widthToInt w) - -- or a possibly side-effecting machine operation -- mop :: CallishMachOp (see GHC.Cmm.MachOp) PrimTarget mop -> do -- We'll need config to construct forien targets @@ -1603,8 +1832,6 @@ genCCall target dest_regs arg_regs = do MO_F64_Log1P -> mkCCall "log1p" MO_F64_Exp -> mkCCall "exp" MO_F64_ExpM1 -> mkCCall "expm1" - MO_F64_Fabs -> mkCCall "fabs" - MO_F64_Sqrt -> mkCCall "sqrt" -- 32 bit float ops MO_F32_Pwr -> mkCCall "powf" @@ -1625,8 +1852,6 @@ genCCall target dest_regs arg_regs = do MO_F32_Log1P -> mkCCall "log1pf" MO_F32_Exp -> mkCCall "expf" MO_F32_ExpM1 -> mkCCall "expm1f" - MO_F32_Fabs -> mkCCall "fabsf" - MO_F32_Sqrt -> mkCCall "sqrtf" -- 64-bit primops MO_I64_ToI -> mkCCall "hs_int64ToInt" @@ -1715,11 +1940,10 @@ 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_Clz w -> mkCCall (clzLabel w) - MO_Ctz w -> mkCCall (ctzLabel 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) | [p_reg] <- arg_regs , [dst_reg] <- dest_regs -> do @@ -1891,3 +2115,122 @@ genCCall target dest_regs arg_regs = do let dst = getRegisterReg platform (CmmLocal dest_reg) let code = code_fx `appOL` op (OpReg w dst) (OpReg w reg_fx) pure code + +data BlockInRange = InRange | NotInRange BlockId + +genCondFarJump :: (MonadGetUnique m) => Cond -> Operand -> Operand -> BlockId -> m InstrBlock +genCondFarJump cond op1 op2 far_target = do + return $ toOL [ ann (text "Conditional far jump to: " <> ppr far_target) + $ BCOND cond op1 op2 (TBlock far_target) + ] + +makeFarBranches :: + Platform -> + LabelMap RawCmmStatics -> + [NatBasicBlock Instr] -> + UniqDSM [NatBasicBlock Instr] + +makeFarBranches {- only used when debugging -} _platform statics basic_blocks = do + -- All offsets/positions are counted in multiples of 4 bytes (the size of LoongArch64 instructions) + -- That is an offset of 1 represents a 4-byte/one instruction offset. + let (func_size, lblMap) = foldl' calc_lbl_positions (0, mapEmpty) basic_blocks + if func_size < max_cond_jump_dist + then pure basic_blocks + else do + (_, blocks) <- mapAccumLM (replace_blk lblMap) 0 basic_blocks + pure $ concat blocks + where + max_cond_jump_dist = 2 ^ (15 :: Int) - 8 :: Int + -- Currently all inline info tables fit into 64 bytes. + max_info_size = 16 :: Int + long_bc_jump_dist = 2 :: Int + + -- Replace out of range conditional jumps with unconditional jumps. + replace_blk :: LabelMap Int -> Int -> GenBasicBlock Instr -> UniqDSM (Int, [GenBasicBlock Instr]) + replace_blk !m !pos (BasicBlock lbl instrs) = do + -- Account for a potential info table before the label. + let !block_pos = pos + infoTblSize_maybe lbl + (!pos', instrs') <- mapAccumLM (replace_jump m) block_pos instrs + let instrs'' = concat instrs' + -- We might have introduced new labels, so split the instructions into basic blocks again if neccesary. + let (top, split_blocks, no_data) = foldr mkBlocks ([], [], []) instrs'' + -- There should be no data in the instruction stream at this point + massert (null no_data) + + let final_blocks = BasicBlock lbl top : split_blocks + pure (pos', final_blocks) + + replace_jump :: LabelMap Int -> Int -> Instr -> UniqDSM (Int, [Instr]) + replace_jump !m !pos instr = do + case instr of + ANN ann instr -> do + replace_jump m pos instr >>= \case + (idx, instr' : instrs') -> pure (idx, ANN ann instr' : instrs') + (idx, []) -> pprPanic "replace_jump" (text "empty return list for " <+> ppr idx) + + BCOND1 cond op1 op2 t -> + case target_in_range m t pos of + InRange -> pure (pos + 1, [instr]) + NotInRange far_target -> do + jmp_code <- genCondFarJump cond op1 op2 far_target + pure (pos + long_bc_jump_dist, fromOL jmp_code) + + _ -> pure (pos + instr_size instr, [instr]) + + target_in_range :: LabelMap Int -> Target -> Int -> BlockInRange + target_in_range m target src = + case target of + (TReg{}) -> InRange + (TBlock bid) -> block_in_range m src bid + (TLabel clbl) + | Just bid <- maybeLocalBlockLabel clbl + -> block_in_range m src bid + | otherwise + -> InRange + + block_in_range :: LabelMap Int -> Int -> BlockId -> BlockInRange + block_in_range m src_pos dest_lbl = + case mapLookup dest_lbl m of + Nothing -> + pprTrace "not in range" (ppr dest_lbl) $ NotInRange dest_lbl + Just dest_pos -> + if abs (dest_pos - src_pos) < max_cond_jump_dist + then InRange + else NotInRange dest_lbl + + calc_lbl_positions :: (Int, LabelMap Int) -> GenBasicBlock Instr -> (Int, LabelMap Int) + calc_lbl_positions (pos, m) (BasicBlock lbl instrs) = + let !pos' = pos + infoTblSize_maybe lbl + in foldl' instr_pos (pos', mapInsert lbl pos' m) instrs + + instr_pos :: (Int, LabelMap Int) -> Instr -> (Int, LabelMap Int) + instr_pos (pos, m) instr = (pos + instr_size instr, m) + + infoTblSize_maybe bid = + case mapLookup bid statics of + Nothing -> 0 :: Int + Just _info_static -> max_info_size + + instr_size :: Instr -> Int + instr_size i = case i of + COMMENT {} -> 0 + MULTILINE_COMMENT {} -> 0 + ANN _ instr -> instr_size instr + LOCATION {} -> 0 + DELTA {} -> 0 + -- At this point there should be no NEWBLOCK in the instruction stream (pos, mapInsert bid pos m) + NEWBLOCK {} -> panic "mkFarBranched - Unexpected" + LDATA {} -> panic "mkFarBranched - Unexpected" + PUSH_STACK_FRAME -> 4 + POP_STACK_FRAME -> 4 + CSET {} -> 2 + LD _ _ (OpImm (ImmIndex _ _)) -> 3 + LD _ _ (OpImm (ImmCLbl _)) -> 2 + SCVTF {} -> 2 + FCVTZS {} -> 4 + BCOND {} -> long_bc_jump_dist + CALL (TReg _) _ -> 1 + CALL {} -> 2 + CALL36 {} -> 2 + TAIL36 {} -> 2 + _ -> 1 ===================================== compiler/GHC/CmmToAsm/LA64/Instr.hs ===================================== @@ -143,9 +143,16 @@ regUsageOfInstr platform instr = case instr of J_TBL _ _ t -> usage ([t], []) B t -> usage (regTarget t, []) BL t ps -> usage (regTarget t ++ ps, callerSavedRegisters) + CALL t ps -> usage (regTarget t ++ ps, callerSavedRegisters) CALL36 t -> usage (regTarget t, []) TAIL36 r t -> usage (regTarget t, regOp r) - BCOND _ j d t tmp -> usage (regTarget t ++ regOp j ++ regOp d ++ regOp tmp, regOp tmp) + -- Here two kinds of BCOND and BCOND1 are implemented, mainly because we want + -- to distinguish between two kinds of conditional jumps with different jump + -- ranges, corresponding to 2 and 1 instruction implementations respectively. + -- + -- BCOND1 is selected by default. + BCOND1 _ j d t -> usage (regTarget t ++ regOp j ++ regOp d, []) + BCOND _ j d t -> usage (regTarget t ++ regOp j ++ regOp d, []) BEQZ j t -> usage (regTarget t ++ regOp j, []) BNEZ j t -> usage (regTarget t ++ regOp j, []) -- 5. Common Memory Access Instructions -------------------------------------- @@ -157,6 +164,7 @@ regUsageOfInstr platform instr = case instr of STX _ dst src -> usage (regOp src ++ regOp dst, []) LDPTR _ dst src -> usage (regOp src, regOp dst) STPTR _ dst src -> usage (regOp src ++ regOp dst, []) + PRELD _hint src -> usage (regOp src, []) -- 6. Bound Check Memory Access Instructions --------------------------------- -- LDCOND dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) -- STCOND dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) @@ -176,6 +184,7 @@ regUsageOfInstr platform instr = case instr of SCVTF dst src -> usage (regOp src, regOp dst) FCVTZS dst src1 src2 -> usage (regOp src2, regOp src1 ++ regOp dst) FABS dst src -> usage (regOp src, regOp dst) + FSQRT dst src -> usage (regOp src, regOp dst) FMA _ dst src1 src2 src3 -> usage (regOp src1 ++ regOp src2 ++ regOp src3, regOp dst) _ -> panic $ "regUsageOfInstr: " ++ instrCon instr @@ -317,9 +326,11 @@ patchRegsOfInstr instr env = case instr of J_TBL ids mbLbl t -> J_TBL ids mbLbl (env t) B t -> B (patchTarget t) BL t ps -> BL (patchTarget t) ps + CALL t ps -> CALL (patchTarget t) ps CALL36 t -> CALL36 (patchTarget t) TAIL36 r t -> TAIL36 (patchOp r) (patchTarget t) - BCOND c j d t tmp -> BCOND c (patchOp j) (patchOp d) (patchTarget t) (patchOp tmp) + BCOND1 c j d t -> BCOND1 c (patchOp j) (patchOp d) (patchTarget t) + BCOND c j d t -> BCOND c (patchOp j) (patchOp d) (patchTarget t) BEQZ j t -> BEQZ (patchOp j) (patchTarget t) BNEZ j t -> BNEZ (patchOp j) (patchTarget t) -- 5. Common Memory Access Instructions -------------------------------------- @@ -332,6 +343,7 @@ patchRegsOfInstr instr env = case instr of STX f o1 o2 -> STX f (patchOp o1) (patchOp o2) LDPTR f o1 o2 -> LDPTR f (patchOp o1) (patchOp o2) STPTR f o1 o2 -> STPTR f (patchOp o1) (patchOp o2) + PRELD o1 o2 -> PRELD (patchOp o1) (patchOp o2) -- 6. Bound Check Memory Access Instructions --------------------------------- -- LDCOND o1 o2 o3 -> LDCOND (patchOp o1) (patchOp o2) (patchOp o3) -- STCOND o1 o2 o3 -> STCOND (patchOp o1) (patchOp o2) (patchOp o3) @@ -350,6 +362,7 @@ patchRegsOfInstr instr env = case instr of FMAXA o1 o2 o3 -> FMAXA (patchOp o1) (patchOp o2) (patchOp o3) FNEG o1 o2 -> FNEG (patchOp o1) (patchOp o2) FABS o1 o2 -> FABS (patchOp o1) (patchOp o2) + FSQRT o1 o2 -> FSQRT (patchOp o1) (patchOp o2) FMA s o1 o2 o3 o4 -> FMA s (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) _ -> panic $ "patchRegsOfInstr: " ++ instrCon instr @@ -381,8 +394,10 @@ isJumpishInstr instr = case instr of J_TBL {} -> True B {} -> True BL {} -> True + CALL {} -> True CALL36 {} -> True TAIL36 {} -> True + BCOND1 {} -> True BCOND {} -> True BEQZ {} -> True BNEZ {} -> True @@ -395,9 +410,11 @@ jumpDestsOfInstr (J t) = [id | TBlock id <- [t]] jumpDestsOfInstr (J_TBL ids _mbLbl _r) = catMaybes ids jumpDestsOfInstr (B t) = [id | TBlock id <- [t]] jumpDestsOfInstr (BL t _) = [id | TBlock id <- [t]] +jumpDestsOfInstr (CALL t _) = [id | TBlock id <- [t]] jumpDestsOfInstr (CALL36 t) = [id | TBlock id <- [t]] jumpDestsOfInstr (TAIL36 _ t) = [id | TBlock id <- [t]] -jumpDestsOfInstr (BCOND _ _ _ t _) = [id | TBlock id <- [t]] +jumpDestsOfInstr (BCOND1 _ _ _ t) = [id | TBlock id <- [t]] +jumpDestsOfInstr (BCOND _ _ _ t) = [id | TBlock id <- [t]] jumpDestsOfInstr (BEQZ _ t) = [id | TBlock id <- [t]] jumpDestsOfInstr (BNEZ _ t) = [id | TBlock id <- [t]] jumpDestsOfInstr _ = [] @@ -413,9 +430,11 @@ patchJumpInstr instr patchF = J_TBL ids mbLbl r -> J_TBL (map (fmap patchF) ids) mbLbl r B (TBlock bid) -> B (TBlock (patchF bid)) BL (TBlock bid) ps -> BL (TBlock (patchF bid)) ps + CALL (TBlock bid) ps -> CALL (TBlock (patchF bid)) ps CALL36 (TBlock bid) -> CALL36 (TBlock (patchF bid)) TAIL36 r (TBlock bid) -> TAIL36 r (TBlock (patchF bid)) - BCOND c o1 o2 (TBlock bid) tmp -> BCOND c o1 o2 (TBlock (patchF bid)) tmp + BCOND1 c o1 o2 (TBlock bid) -> BCOND1 c o1 o2 (TBlock (patchF bid)) + BCOND c o1 o2 (TBlock bid) -> BCOND c o1 o2 (TBlock (patchF bid)) BEQZ j (TBlock bid) -> BEQZ j (TBlock (patchF bid)) BNEZ j (TBlock bid) -> BNEZ j (TBlock (patchF bid)) _ -> panic $ "patchJumpInstr: " ++ instrCon instr @@ -501,9 +520,9 @@ canFallthroughTo insn bid = J (TBlock target) -> bid == target J_TBL targets _ _ -> all isTargetBid targets B (TBlock target) -> bid == target - CALL36 (TBlock target) -> bid == target TAIL36 _ (TBlock target) -> bid == target - BCOND _ _ _ (TBlock target) _ -> bid == target + BCOND1 _ _ _ (TBlock target) -> bid == target + BCOND _ _ _ (TBlock target) -> bid == target _ -> False where isTargetBid target = case target of @@ -589,7 +608,6 @@ allocMoreStack platform slots proc@(CmmProc info lbl live (ListGraph code)) = do insert_dealloc insn r = case insn of J {} -> dealloc ++ (insn : r) - J_TBL {} -> dealloc ++ (insn : r) ANN _ e -> insert_dealloc e r _other | jumpDestsOfInstr insn /= [] -> patchJumpInstr insn retarget : r @@ -697,9 +715,11 @@ data Instr | J_TBL [Maybe BlockId] (Maybe CLabel) Reg | B Target | BL Target [Reg] + | CALL Target [Reg] | CALL36 Target | TAIL36 Operand Target - | BCOND Cond Operand Operand Target Operand + | BCOND1 Cond Operand Operand Target + | BCOND Cond Operand Operand Target | BEQZ Operand Target | BNEZ Operand Target -- 5. Common Memory Access Instructions -------------------------------------- @@ -711,6 +731,7 @@ data Instr | STX Format Operand Operand | LDPTR Format Operand Operand | STPTR Format Operand Operand + | PRELD Operand Operand -- 6. Bound Check Memory Access Instructions --------------------------------- -- 7. Atomic Memory Access Instructions -------------------------------------- -- 8. Barrier Instructions --------------------------------------------------- @@ -726,6 +747,7 @@ data Instr | FMINA Operand Operand Operand | FNEG Operand Operand | FABS Operand Operand + | FSQRT Operand Operand -- Floating-point fused multiply-add instructions -- fmadd : d = r1 * r2 + r3 -- fnmsub: d = r1 * r2 - r3 @@ -809,8 +831,10 @@ instrCon i = J_TBL{} -> "J_TBL" B{} -> "B" BL{} -> "BL" + CALL{} -> "CALL" CALL36{} -> "CALL36" TAIL36{} -> "TAIL36" + BCOND1{} -> "BCOND1" BCOND{} -> "BCOND" BEQZ{} -> "BEQZ" BNEZ{} -> "BNEZ" @@ -822,6 +846,7 @@ instrCon i = STX{} -> "STX" LDPTR{} -> "LDPTR" STPTR{} -> "STPTR" + PRELD{} -> "PRELD" DBAR{} -> "DBAR" IBAR{} -> "IBAR" FCVT{} -> "FCVT" @@ -833,6 +858,7 @@ instrCon i = FMINA{} -> "FMINA" FNEG{} -> "FNEG" FABS{} -> "FABS" + FSQRT{} -> "FSQRT" FMA variant _ _ _ _ -> case variant of FMAdd -> "FMADD" @@ -979,6 +1005,8 @@ widthFromOpReg (OpReg W32 _) = W32 widthFromOpReg (OpReg W64 _) = W64 widthFromOpReg _ = W64 -lessW64 :: Width -> Bool -lessW64 w | w == W8 || w == W16 || w == W32 = True -lessW64 _ = False +ldFormat :: Format -> Format +ldFormat f + | f `elem` [II8, II16, II32, II64] = II64 + | f `elem` [FF32, FF64] = FF64 + | otherwise = pprPanic "unsupported ldFormat: " (text $ show f) ===================================== compiler/GHC/CmmToAsm/LA64/Ppr.hs ===================================== @@ -1,4 +1,3 @@ - module GHC.CmmToAsm.LA64.Ppr (pprNatCmmDecl, pprInstr) where import GHC.Prelude hiding (EQ) @@ -437,32 +436,28 @@ pprInstr platform instr = case instr of -- ADD.{W/D}, SUB.{W/D} -- ADDI.{W/D}, ADDU16I.D ADD o1 o2 o3 - | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 && isSingleOp o1 && isSingleOp o2 && isSingleOp o3 -> op3 (text "\tfadd.s") o1 o2 o3 - | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 && isDoubleOp o1 && isDoubleOp o2 && isDoubleOp o3 -> op3 (text "\tfadd.d") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tadd.w") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tadd.d") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, isImmOp o3, (OpImm (ImmInteger i)) <- o3, fitsInNbits 12 (fromIntegral i) -> op3 (text "\taddi.w") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, isImmOp o3, (OpImm (ImmInt i)) <- o3, fitsInNbits 12 (fromIntegral i) -> op3 (text "\taddi.w") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, isImmOp o3, (OpImm (ImmInteger i)) <- o3, fitsInNbits 12 (fromIntegral i) -> op3 (text "\taddi.d") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, isImmOp o3, (OpImm (ImmInt i)) <- o3, fitsInNbits 12 (fromIntegral i) -> op3 (text "\taddi.d") o1 o2 o3 + | isFloatOp o2 && isFloatOp o3 && isSingleOp o2 && isSingleOp o3 -> op3 (text "\tfadd.s") o1 o2 o3 + | isFloatOp o2 && isFloatOp o3 && isDoubleOp o2 && isDoubleOp o3 -> op3 (text "\tfadd.d") o1 o2 o3 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tadd.w") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tadd.d") o1 o2 o3 + | OpReg W32 _ <- o2, isImmOp o3 -> op3 (text "\taddi.w") o1 o2 o3 + | OpReg W64 _ <- o2, isImmOp o3 -> op3 (text "\taddi.d") o1 o2 o3 | otherwise -> pprPanic "LA64.ppr: ADD error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) -- TODO: Not complete. -- Here we should add addu16i.d for optimizations of accelerating GOT accession -- with ldptr.w/d, stptr.w/d SUB o1 o2 o3 - | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 && isSingleOp o1 && isSingleOp o2 && isSingleOp o3 -> op3 (text "\tfsub.s") o1 o2 o3 - | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 && isDoubleOp o1 && isDoubleOp o2 && isDoubleOp o3 -> op3 (text "\tfsub.d") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tsub.w") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tsub.d") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, isImmOp o3, (OpImm (ImmInteger i)) <- o3, fitsInNbits 12 (fromIntegral i) -> op3 (text "\taddi.w") o1 o2 (negOp o3) - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, isImmOp o3, (OpImm (ImmInt i)) <- o3, fitsInNbits 12 (fromIntegral i) -> op3 (text "\taddi.w") o1 o2 (negOp o3) - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, isImmOp o3, (OpImm (ImmInteger i)) <- o3, fitsInNbits 12 (fromIntegral i) -> op3 (text "\taddi.d") o1 o2 (negOp o3) - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, isImmOp o3, (OpImm (ImmInt i)) <- o3, fitsInNbits 12 (fromIntegral i) -> op3 (text "\taddi.d") o1 o2 (negOp o3) + | isFloatOp o2 && isFloatOp o3 && isSingleOp o2 && isSingleOp o3 -> op3 (text "\tfsub.s") o1 o2 o3 + | isFloatOp o2 && isFloatOp o3 && isDoubleOp o2 && isDoubleOp o3 -> op3 (text "\tfsub.d") o1 o2 o3 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tsub.w") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tsub.d") o1 o2 o3 + | OpReg W32 _ <- o2, isImmOp o3 -> op3 (text "\taddi.w") o1 o2 (negOp o3) + | OpReg W64 _ <- o2, isImmOp o3 -> op3 (text "\taddi.d") o1 o2 (negOp o3) | otherwise -> pprPanic "LA64.ppr: SUB error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) -- ALSL.{W[U]/D} ALSL o1 o2 o3 o4 - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, OpReg W32 _ <- o3, isImmOp o4 -> op4 (text "\talsl.w") o1 o2 o3 o4 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, OpReg W64 _ <- o3, isImmOp o4 -> op4 (text "\talsl.d") o1 o2 o3 o4 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3, isImmOp o4 -> op4 (text "\talsl.w") o1 o2 o3 o4 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3, isImmOp o4 -> op4 (text "\talsl.d") o1 o2 o3 o4 | otherwise -> pprPanic "LA64.ppr: ALSL error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) ALSLU o1 o2 o3 o4 -> op4 (text "\talsl.wu") o1 o2 o3 o4 -- LoongArch-Assembler should implement following pesudo instructions, here we can directly use them. @@ -491,14 +486,12 @@ pprInstr platform instr = case instr of -- SSLT[U] -- SSLT[U]I SSLT o1 o2 o3 - | OpReg W64 _ <- o1, isImmOp o3, (OpImm (ImmInteger i)) <- o3, fitsInNbits 12 (fromIntegral i) -> op3 (text "\tslti") o1 o2 o3 - | OpReg W64 _ <- o1, isImmOp o3, (OpImm (ImmInt i)) <- o3, fitsInNbits 12 (fromIntegral i) -> op3 (text "\tslti") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tslt") o1 o2 o3 + | isImmOp o3 -> op3 (text "\tslti") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tslt") o1 o2 o3 | otherwise -> pprPanic "LA64.ppr: SSLT error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) SSLTU o1 o2 o3 - | OpReg W64 _ <- o1, isImmOp o3, (OpImm (ImmInteger i)) <- o3, fitsInNbits 12 (fromIntegral i) -> op3 (text "\tsltui") o1 o2 o3 - | OpReg W64 _ <- o1, isImmOp o3, (OpImm (ImmInt i)) <- o3, fitsInNbits 12 (fromIntegral i) -> op3 (text "\tsltui") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tsltu") o1 o2 o3 + | isImmOp o3 -> op3 (text "\tsltui") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tsltu") o1 o2 o3 | otherwise -> pprPanic "LA64.ppr: SSLTU error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) -- PCADDI, PCADDU121, PCADDU18l, PCALAU12I PCADDI o1 o2 -> op2 (text "\tpcaddi") o1 o2 @@ -511,19 +504,16 @@ pprInstr platform instr = case instr of -- AND, OR, NOR, XOR, ANDN, ORN -- ANDI, ORI, XORI: zero-extention AND o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tand") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, (OpImm (ImmInteger i)) <- o3, isUnsignOp (fromIntegral i), fitsInNbits 13 (fromIntegral i) -> op3 (text "\tandi") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, (OpImm (ImmInt i)) <- o3, isUnsignOp (fromIntegral i), fitsInNbits 13 (fromIntegral i) -> op3 (text "\tandi") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tand") o1 o2 o3 + | OpReg W64 _ <- o2, isImmOp o3 -> op3 (text "\tandi") o1 o2 o3 | otherwise -> pprPanic "LA64.ppr: AND error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) OR o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tor") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, (OpImm (ImmInteger i)) <- o3, isUnsignOp (fromIntegral i), fitsInNbits 13 (fromIntegral i) -> op3 (text "\tori") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, (OpImm (ImmInt i)) <- o3, isUnsignOp (fromIntegral i), fitsInNbits 13 (fromIntegral i) -> op3 (text "\tori") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tor") o1 o2 o3 + | OpReg W64 _ <- o2, isImmOp o3 -> op3 (text "\tori") o1 o2 o3 | otherwise -> pprPanic "LA64.ppr: OR error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) XOR o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\txor") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, (OpImm (ImmInteger i)) <- o3, isUnsignOp (fromIntegral i), fitsInNbits 13 (fromIntegral i) -> op3 (text "\txori") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, (OpImm (ImmInt i)) <- o3, isUnsignOp (fromIntegral i), fitsInNbits 13 (fromIntegral i) -> op3 (text "\txori") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\txor") o1 o2 o3 + | OpReg W64 _ <- o2, isImmOp o3 -> op3 (text "\txori") o1 o2 o3 | otherwise -> pprPanic "LA64.ppr: XOR error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) NOR o1 o2 o3 -> op3 (text "\tnor") o1 o2 o3 ANDN o1 o2 o3 -> op3 (text "\tandn") o1 o2 o3 @@ -535,10 +525,10 @@ pprInstr platform instr = case instr of NOP -> line $ text "\tnop" -- NEG o1 o2, alias for "sub o1, r0, o2" NEG o1 o2 - | isFloatOp o1 && isFloatOp o2 && isSingleOp o1 && isSingleOp o2 -> op2 (text "\tfneg.s") o1 o2 - | isFloatOp o1 && isFloatOp o2 && isDoubleOp o1 && isDoubleOp o2 -> op2 (text "\tfneg.d") o1 o2 - | OpReg W64 _ <- o1, OpReg W32 _ <- o2 -> op3 (text "\tsub.w" ) o1 zero o2 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2 -> op3 (text "\tsub.d" ) o1 zero o2 + | isFloatOp o2 && isSingleOp o2 -> op2 (text "\tfneg.s") o1 o2 + | isFloatOp o2 && isDoubleOp o2 -> op2 (text "\tfneg.d") o1 o2 + | OpReg W32 _ <- o2 -> op3 (text "\tsub.w" ) o1 zero o2 + | OpReg W64 _ <- o2 -> op3 (text "\tsub.d" ) o1 zero o2 | otherwise -> pprPanic "LA64.ppr: NEG error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2) -- Here we can do more simplitcations. -- To be honest, floating point instructions are too scarce, so maybe @@ -552,22 +542,12 @@ pprInstr platform instr = case instr of | isFloatOp o1 && not (isFloatOp o2) && isDoubleOp o1 -> op2 (text "\tmovgr2fr.d") o1 o2 | not (isFloatOp o1) && isFloatOp o2 && isSingleOp o2 -> op2 (text "\tmovfr2gr.s") o1 o2 | not (isFloatOp o1) && isFloatOp o2 && isDoubleOp o2 -> op2 (text "\tmovfr2gr.d") o1 o2 - | OpReg W64 _ <- o1, isImmOp o2, (OpImm (ImmInteger i)) <- o2, fitsInNbits 12 (fromIntegral i) -> + | isImmOp o2, (OpImm (ImmInt i)) <- o2, fitsInNbits 12 (fromIntegral i) -> lines_ [text "\taddi.d" <+> pprOp platform o1 <> comma <+> pprOp platform x0 <+> comma <> pprOp platform o2] - | OpReg W64 _ <- o1, isImmOp o2, (OpImm (ImmInt i)) <- o2, fitsInNbits 12 (fromIntegral i) -> + | isImmOp o2, (OpImm (ImmInteger i)) <- o2, fitsInNbits 12 (fromIntegral i) -> lines_ [text "\taddi.d" <+> pprOp platform o1 <> comma <+> pprOp platform x0 <+> comma <> pprOp platform o2] - | OpReg _ _ <- o1, isImmOp o2, (OpImm (ImmInteger i)) <- o2, fitsInNbits 12 (fromIntegral i) -> - lines_ [ - text "\taddi.d" <+> pprOp platform o1 <> comma <+> pprOp platform x0 <+> comma <> pprOp platform o2, - text "\tbstrpick.d" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> pprOp platform (OpImm (ImmInt ((widthToInt $ widthFromOpReg o1) - 1) )) <+> text ", 0" - ] - | OpReg _ _ <- o1, isImmOp o2, (OpImm (ImmInt i)) <- o2, fitsInNbits 12 (fromIntegral i) -> - lines_ [ - text "\taddi.d" <+> pprOp platform o1 <> comma <+> pprOp platform x0 <+> comma <> pprOp platform o2, - text "\tbstrpick.d" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> pprOp platform (OpImm (ImmInt ((widthToInt $ widthFromOpReg o1) - 1) )) <+> text ", 0" - ] - | OpReg W64 _ <- o1, OpReg W64 _ <- o2 -> op2 (text "\tmove") o1 o2 - | OpReg _ _ <- o1, OpReg _ _ <- o2 -> + | OpReg W64 _ <- o2 -> op2 (text "\tmove") o1 o2 + | OpReg _ _ <- o2 -> lines_ [ text "\tbstrpick.d" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform (OpImm (ImmInt ((widthToInt (min (widthFromOpReg o1) (widthFromOpReg o2))) - 1))) <+> text ", 0" ] @@ -690,18 +670,18 @@ pprInstr platform instr = case instr of _ -> pprPanic "LA64.ppr: CSET error: " (pprCond cond <+> pprOp platform dst <> comma <+> (ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2) where - subFor o1 o2 | (OpReg W64 _) <- dst, (OpReg W64 _) <- o1, (OpImm _) <- o2 = + subFor o1 o2 | (OpReg W64 _) <- dst, (OpImm _) <- o2 = text "\taddi.d" <+> pprOp platform dst <> comma <+> pprOp platform o1 <> comma <+> pprOp platform (negOp o2) - | (OpReg W64 _) <- dst, (OpReg W64 _) <- o1,(OpReg W64 _) <- o2 = + | (OpReg W64 _) <- dst, (OpReg W64 _) <- o2 = text "\tsub.d" <+> pprOp platform dst <> comma <+> pprOp platform o1 <> comma <+> pprOp platform o2 | otherwise = pprPanic "LA64.ppr: unknown subFor format: " ((ppr (widthFromOpReg dst)) <+> pprOp platform dst <+> (ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2) - sltFor o1 o2 | (OpReg W64 _) <- dst, (OpReg W64 _) <- o1, (OpImm _) <- o2 = text "\tslti" - | (OpReg W64 _) <- dst, (OpReg W64 _) <- o1, (OpReg W64 _) <- o2 = text "\tslt" + sltFor o1 o2 | (OpReg W64 _) <- dst, (OpImm _) <- o2 = text "\tslti" + | (OpReg W64 _) <- dst, (OpReg W64 _) <- o2 = text "\tslt" | otherwise = pprPanic "LA64.ppr: unknown sltFor format: " ((ppr (widthFromOpReg dst)) <+> pprOp platform dst <+> (ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2) - sltuFor o1 o2 | (OpReg W64 _) <- dst, (OpReg W64 _) <- o1, (OpImm _) <- o2 = text "\tsltui" - | (OpReg W64 _) <- dst, (OpReg W64 _) <- o1, (OpReg W64 _) <- o2 = text "\tsltu" + sltuFor o1 o2 | (OpReg W64 _) <- dst, (OpImm _) <- o2 = text "\tsltui" + | (OpReg W64 _) <- dst, (OpReg W64 _) <- o2 = text "\tsltu" | otherwise = pprPanic "LA64.ppr: unknown sltuFor format: " ((ppr (widthFromOpReg dst)) <+> pprOp platform dst <+> (ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2) -- MUL.{W/D}, MULH, {W[U]/D[U]}, 'h' means high 32bit. @@ -709,41 +689,41 @@ pprInstr platform instr = case instr of MUL o1 o2 o3 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 && isSingleOp o1 && isSingleOp o2 && isSingleOp o3 -> op3 (text "\tfmul.s") o1 o2 o3 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 && isDoubleOp o1 && isDoubleOp o2 && isDoubleOp o3 -> op3 (text "\tfmul.d") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tmul.w") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tmul.d") o1 o2 o3 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tmul.w") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tmul.d") o1 o2 o3 | otherwise -> pprPanic "LA64.ppr: MUL error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) MULW o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tmulw.d.w") o1 o2 o3 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tmulw.d.w") o1 o2 o3 | otherwise -> pprPanic "LA64.ppr: MULW error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) MULWU o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tmulw.d.wu") o1 o2 o3 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tmulw.d.wu") o1 o2 o3 | otherwise -> pprPanic "LA64.ppr: MULWU error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) MULH o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tmulh.w") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, OpReg W64 _ <- o2 -> op3 (text "\tmulh.d") o1 o2 o3 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tmulh.w") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o2 -> op3 (text "\tmulh.d") o1 o2 o3 | otherwise -> pprPanic "LA64.ppr: MULH error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) MULHU o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tmulh.wu") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tmulh.du") o1 o2 o3 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tmulh.wu") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tmulh.du") o1 o2 o3 | otherwise -> pprPanic "LA64.ppr: MULHU error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) -- DIV.{W[U]/D[U]}, MOD.{W[U]/D[U]} DIV o1 o2 o3 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 && isSingleOp o1 && isSingleOp o2 && isSingleOp o3 -> op3 (text "\tfdiv.s") o1 o2 o3 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 && isDoubleOp o1 && isDoubleOp o2 && isDoubleOp o3 -> op3 (text "\tfdiv.d") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tdiv.w") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tdiv.d") o1 o2 o3 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tdiv.w") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tdiv.d") o1 o2 o3 | otherwise -> pprPanic "LA64.ppr: DIV error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) DIVU o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tdiv.wu") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tdiv.du") o1 o2 o3 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tdiv.wu") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tdiv.du") o1 o2 o3 | otherwise -> pprPanic "LA64.ppr: DIVU error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) MOD o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tmod.w") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tmod.d") o1 o2 o3 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tmod.w") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tmod.d") o1 o2 o3 | otherwise -> pprPanic "LA64.ppr: MOD error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) MODU o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tmod.wu") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tmod.du") o1 o2 o3 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tmod.wu") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tmod.du") o1 o2 o3 | otherwise -> pprPanic "LA64.ppr: MODU error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) -- 2. Bit-shift Instuctions -------------------------------------------------- -- SLL.W, SRL.W, SRA.W, ROTR.W @@ -751,58 +731,42 @@ pprInstr platform instr = case instr of -- SLLI.W, SRLI.W, SRAI.W, ROTRI.W -- SLLI.D, SRLI.D, SRAI.D, ROTRI.D SLL o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tsll.w") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tsll.d") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, (OpImm (ImmInteger i)) <- o3, 0 <= i, i < 32 -> - lines_ [text "\tslli.w" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3] - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, (OpImm (ImmInt i)) <- o3, 0 <= i, i < 32 -> + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tsll.w") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tsll.d") o1 o2 o3 + | OpReg W32 _ <- o2, isImmOp o3 -> lines_ [text "\tslli.w" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3] - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, (OpImm (ImmInteger i)) <- o3, 0 <= i, i < 64 -> - lines_ [text "\tslli.d" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3] - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, (OpImm (ImmInt i)) <- o3, 0 <= i, i < 64 -> + | OpReg W64 _ <- o2, isImmOp o3 -> lines_ [text "\tslli.d" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3] | otherwise -> pprPanic "LA64.ppr: SLL error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) SRL o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tsrl.w") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tsrl.d") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, (OpImm (ImmInteger i)) <- o3, 0 <= i, i < 32 -> - lines_ [text "\tsrli.w" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3] - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, (OpImm (ImmInt i)) <- o3, 0 <= i, i < 32 -> + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tsrl.w") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tsrl.d") o1 o2 o3 + | OpReg W32 _ <- o2, isImmOp o3 -> lines_ [text "\tsrli.w" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3] - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, (OpImm (ImmInteger i)) <- o3, 0 <= i, i < 64 -> - lines_ [text "\tsrli.d" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3] - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, (OpImm (ImmInt i)) <- o3, 0 <= i, i < 64 -> + | OpReg W64 _ <- o2, isImmOp o3 -> lines_ [text "\tsrli.d" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3] | otherwise -> pprPanic "LA64.ppr: SRL error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) SRA o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tsra.w") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tsra.d") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, (OpImm (ImmInteger i)) <- o3, 0 <= i, i < 32 -> - lines_ [text "\tsrai.w" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3] - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, (OpImm (ImmInt i)) <- o3, 0 <= i, i < 32 -> + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tsra.w") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tsra.d") o1 o2 o3 + | OpReg W32 _ <- o2, isImmOp o3 -> lines_ [text "\tsrai.w" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3] - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, (OpImm (ImmInteger i)) <- o3, 0 <= i, i < 64 -> - lines_ [text "\tsrai.d" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3] - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, (OpImm (ImmInt i)) <- o3, 0 <= i, i < 64 -> + | OpReg W64 _ <- o2, isImmOp o3 -> lines_ [text "\tsrai.d" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3] | otherwise -> pprPanic "LA64.ppr: SRA error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) ROTR o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\trotr.w") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\trotr.d") o1 o2 o3 - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, (OpImm (ImmInteger i)) <- o3, 0 <= i, i < 32 -> - lines_ [text "\trotri.w" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3] - | OpReg W64 _ <- o1, OpReg W32 _ <- o2, (OpImm (ImmInt i)) <- o3, 0 <= i, i < 32 -> + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\trotr.w") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\trotr.d") o1 o2 o3 + | OpReg W32 _ <- o2, isImmOp o3 -> lines_ [text "\trotri.w" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3] - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, (OpImm (ImmInteger i)) <- o3, 0 <= i, i < 64 -> - lines_ [text "\trotri.d" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3] - | OpReg W64 _ <- o1, OpReg W64 _ <- o2, (OpImm (ImmInt i)) <- o3, 0 <= i, i < 64 -> + | OpReg W64 _ <- o2, isImmOp o3 -> lines_ [text "\trotri.d" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3] | otherwise -> pprPanic "LA64.ppr: ROTR error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) -- 3. Bit-manupulation Instructions ------------------------------------------ -- EXT.W{B/H} EXT o1 o2 - | OpReg W64 _ <- o1, OpReg W8 _ <- o2 -> op2 (text "\text.w.b") o1 o2 - | OpReg W64 _ <- o1, OpReg W16 _ <- o2 -> op2 (text "\text.w.h") o1 o2 + | OpReg W8 _ <- o2 -> op2 (text "\text.w.b") o1 o2 + | OpReg W16 _ <- o2 -> op2 (text "\text.w.h") o1 o2 | otherwise -> pprPanic "LA64.ppr: EXT error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2) -- CL{O/Z}.{W/D}, CT{O/Z}.{W/D} CLO o1 o2 @@ -823,8 +787,8 @@ pprInstr platform instr = case instr of | otherwise -> pprPanic "LA64.ppr: CTZ error" (pprOp platform o1 <+> pprOp platform o2) -- BYTEPICK.{W/D} rd, rj, rk, sa2/sa3 BYTEPICK o1 o2 o3 o4 - | OpReg W64 _ <- o1, OpReg W32 _ <- o2 -> op4 (text "\tbytepick.w") o1 o2 o3 o4 - | OpReg W64 _ <- o1, OpReg W64 _ <- o2 -> op4 (text "\tbytepick.d") o1 o2 o3 o4 + | OpReg W32 _ <- o2 -> op4 (text "\tbytepick.w") o1 o2 o3 o4 + | OpReg W64 _ <- o2 -> op4 (text "\tbytepick.d") o1 o2 o3 o4 | otherwise -> pprPanic "LA64.ppr: BYTEPICK error" (pprOp platform o1 <+> pprOp platform o2 <+> pprOp platform o3 <+> pprOp platform o4) -- REVB.{2H/4H/2W/D} REVB2H o1 o2 -> op2 (text "\trevb.2h") o1 o2 @@ -857,7 +821,7 @@ pprInstr platform instr = case instr of -- BL -- JIRL -- jr rd = jirl $zero, rd, 0: Commonly used for subroutine return. - J (TReg r) -> line $ text "\tjirl" <+> text "$r1" <> comma <+> pprReg W64 r <> comma <+> text " 0" + J (TReg r) -> line $ text "\tjirl" <+> text "$r0" <> comma <+> pprReg W64 r <> comma <+> text " 0" J_TBL _ _ r -> pprInstr platform (B (TReg r)) B (TBlock bid) -> line $ text "\tb" <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) @@ -868,71 +832,89 @@ pprInstr platform instr = case instr of BL (TLabel lbl) _ -> line $ text "\tbl" <+> pprAsmLabel platform lbl BL (TReg r) _ -> line $ text "\tjirl" <+> text "$r1" <> comma <+> pprReg W64 r <> comma <+> text " 0" + CALL (TBlock bid) _ -> line $ text "\tcall36" <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + CALL (TLabel lbl) _ -> line $ text "\tcall36" <+> pprAsmLabel platform lbl + CALL (TReg r) _ -> line $ text "\tjirl" <+> text "$r1" <> comma <+> pprReg W64 r <> comma <+> text " 0" + CALL36 (TBlock bid) -> line $ text "\tcall36" <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) CALL36 (TLabel lbl) -> line $ text "\tcall36" <+> pprAsmLabel platform lbl - CALL36 _ -> panic "LA64.ppr: CALL36: Unexpected pattern!" + CALL36 _ -> panic "LA64.ppr: CALL36: Not to registers!" TAIL36 r (TBlock bid) -> line $ text "\ttail36" <+> pprOp platform r <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) TAIL36 r (TLabel lbl) -> line $ text "\ttail36" <+> pprOp platform r <> comma <+> pprAsmLabel platform lbl - TAIL36 _ _ -> panic "LA64.ppr: TAIL36: Unexpected pattern!" + TAIL36 _ _ -> panic "LA64.ppr: TAIL36: Not to registers!" - BCOND c j d (TLabel lbl) _t -> case c of - _ -> line $ text "\t" <> pprBcond c <+> pprOp platform j <> comma <+> pprOp platform d <> comma <+> pprAsmLabel platform lbl + BCOND1 c j d (TBlock bid) -> case c of + SLE -> + line $ text "\tbge" <+> pprOp platform d <> comma <+> pprOp platform j <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + SGT -> + line $ text "\tblt" <+> pprOp platform d <> comma <+> pprOp platform j <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + ULE -> + line $ text "\tbgeu" <+> pprOp platform d <> comma <+> pprOp platform j <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + UGT -> + line $ text "\tbltu" <+> pprOp platform d <> comma <+> pprOp platform j <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + _ -> line $ text "\t" <> pprBcond c <+> pprOp platform j <> comma <+> pprOp platform d <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) - BCOND c j d (TBlock bid) t -> case c of + BCOND1 _ _ _ (TLabel _) -> panic "LA64.ppr: BCOND1: No conditional branching to TLabel!" + + BCOND1 _ _ _ (TReg _) -> panic "LA64.ppr: BCOND1: No conditional branching to registers!" + + -- Reuse t8(IP) register + BCOND c j d (TBlock bid) -> case c of SLE -> lines_ [ - text "\tslt" <+> pprOp platform t <> comma <+> pprOp platform d <> comma <+> pprOp platform j, - text "\tbeqz" <+> pprOp platform t <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + text "\tslt $t8, " <+> pprOp platform d <> comma <+> pprOp platform j, + text "\tbeqz $t8, " <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) ] SGT -> lines_ [ - text "\tslt" <+> pprOp platform t <> comma <+> pprOp platform d <> comma <+> pprOp platform j, - text "\tbnez" <+> pprOp platform t <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + text "\tslt $t8, " <+> pprOp platform d <> comma <+> pprOp platform j, + text "\tbnez $t8, " <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) ] ULE -> lines_ [ - text "\tsltu" <+> pprOp platform t <> comma <+> pprOp platform d <> comma <+> pprOp platform j, - text "\tbeqz" <+> pprOp platform t <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + text "\tsltu $t8, " <+> pprOp platform d <> comma <+> pprOp platform j, + text "\tbeqz $t8, " <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) ] UGT -> lines_ [ - text "\tsltu" <+> pprOp platform t <> comma <+> pprOp platform d <> comma <+> pprOp platform j, - text "\tbnez" <+> pprOp platform t <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + text "\tsltu $t8, " <+> pprOp platform d <> comma <+> pprOp platform j, + text "\tbnez $t8, " <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) ] EQ -> lines_ [ - text "\tsub.d" <+> pprOp platform t <> comma <+> pprOp platform j <> comma <+> pprOp platform d, - text "\tbeqz" <+> pprOp platform t <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + text "\tsub.d $t8, " <+> pprOp platform j <> comma <+> pprOp platform d, + text "\tbeqz $t8, " <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) ] NE -> lines_ [ - text "\tsub.d" <+> pprOp platform t <> comma <+> pprOp platform j <> comma <+> pprOp platform d, - text "\tbnez" <+> pprOp platform t <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + text "\tsub.d $t8, " <+> pprOp platform j <> comma <+> pprOp platform d, + text "\tbnez $t8, " <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) ] SLT -> lines_ [ - text "\tslt" <+> pprOp platform t <> comma <+> pprOp platform j <> comma <+> pprOp platform d, - text "\tbnez" <+> pprOp platform t <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + text "\tslt $t8, " <+> pprOp platform j <> comma <+> pprOp platform d, + text "\tbnez $t8, " <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) ] SGE -> lines_ [ - text "\tslt" <+> pprOp platform t <> comma <+> pprOp platform j <> comma <+> pprOp platform d, - text "\tbeqz" <+> pprOp platform t <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + text "\tslt $t8, " <+> pprOp platform j <> comma <+> pprOp platform d, + text "\tbeqz $t8, " <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) ] ULT -> lines_ [ - text "\tsltu" <+> pprOp platform t <> comma <+> pprOp platform j <> comma <+> pprOp platform d, - text "\tbnez" <+> pprOp platform t <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + text "\tsltu $t8, " <+> pprOp platform j <> comma <+> pprOp platform d, + text "\tbnez $t8, " <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) ] UGE -> lines_ [ - text "\tsltu" <+> pprOp platform t <> comma <+> pprOp platform j <> comma <+> pprOp platform d, - text "\tbeqz" <+> pprOp platform t <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + text "\tsltu $t8, " <+> pprOp platform j <> comma <+> pprOp platform d, + text "\tbeqz $t8, " <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) ] + _ -> panic "LA64.ppr: BCOND: Unsupported cond!" - _ -> line $ text "\t" <> pprBcond c <+> pprOp platform j <> comma <+> pprOp platform d <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + BCOND _ _ _ (TLabel _) -> panic "LA64.ppr: BCOND: No conditional branching to TLabel!" - BCOND _ _ _ (TReg _) _ -> panic "LA64.ppr: BCOND: No conditional branching to registers!" + BCOND _ _ _ (TReg _) -> panic "LA64.ppr: BCOND: No conditional branching to registers!" BEQZ j (TBlock bid) -> line $ text "\tbeqz" <+> pprOp platform j <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) @@ -951,12 +933,34 @@ pprInstr platform instr = case instr of -- LD: load, ST: store, x: offset in register, u: load unsigned imm. -- LD format dst src: 'src' means final address, not single register or immdiate. -- Load symbol's address + LD _fmt o1 (OpImm (ImmIndex lbl' off)) | Just (_, lbl) <- dynamicLinkerLabelInfo lbl' -> + lines_ [ text "\tpcalau12i" <+> pprOp platform o1 <> comma <+> text "%got_pc_hi20(" <> pprAsmLabel platform lbl <> text ")" + , text "\tld.d" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text "%got_pc_lo12(" <> pprAsmLabel platform lbl <> text ")" + , text "\taddi.d" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> int off + ] + LD _fmt o1 (OpImm (ImmIndex lbl off)) | isForeignLabel lbl -> + lines_ [ text "\tpcalau12i" <+> pprOp platform o1 <> comma <+> text "%got_pc_hi20(" <> pprAsmLabel platform lbl <> text ")" + , text "\tld.d" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text "%got_pc_lo12(" <> pprAsmLabel platform lbl <> text ")" + , text "\taddi.d" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> int off + ] LD _fmt o1 (OpImm (ImmIndex lbl off)) -> - lines_ [ text "\tla.global" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl - , text "\taddi.d" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> int off + lines_ [ text "\tpcalau12i" <+> pprOp platform o1 <> comma <+> text "%pc_hi20(" <> pprAsmLabel platform lbl <> text ")" + , text "\taddi.d" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text "%pc_lo12(" <> pprAsmLabel platform lbl <> text ")" + , text "\taddi.d" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> int off + ] + + LD _fmt o1 (OpImm (ImmCLbl lbl')) | Just (_, lbl) <- dynamicLinkerLabelInfo lbl' -> + lines_ [ text "\tpcalau12i" <+> pprOp platform o1 <> comma <+> text "%got_pc_hi20(" <> pprAsmLabel platform lbl <> text ")" + , text "\tld.d" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text "%got_pc_lo12(" <> pprAsmLabel platform lbl <> text ")" + ] + LD _fmt o1 (OpImm (ImmCLbl lbl)) | isForeignLabel lbl -> + lines_ [ text "\tpcalau12i" <+> pprOp platform o1 <> comma <+> text "%got_pc_hi20(" <> pprAsmLabel platform lbl <> text ")" + , text "\tld.d" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text "%got_pc_lo12(" <> pprAsmLabel platform lbl <> text ")" ] LD _fmt o1 (OpImm (ImmCLbl lbl)) -> - line $ text "\tla.global" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl + lines_ [ text "\tpcalau12i" <+> pprOp platform o1 <> comma <+> text "%pc_hi20(" <> pprAsmLabel platform lbl <> text ")" + , text "\taddi.d" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text "%pc_lo12(" <> pprAsmLabel platform lbl <> text ")" + ] LD II8 o1 o2 -> op2 (text "\tld.b") o1 o2 LD II16 o1 o2 -> op2 (text "\tld.h") o1 o2 @@ -1005,6 +1009,8 @@ pprInstr platform instr = case instr of STX II64 o1 o2 -> op2 (text "\tstx.d") o1 o2 STX FF32 o1 o2 -> op2 (text "\tfstx.s") o1 o2 STX FF64 o1 o2 -> op2 (text "\tfstx.d") o1 o2 + + PRELD h o1@(OpAddr (AddrRegImm _ _)) -> op2 (text "\tpreld") h o1 -- 6. Bound Check Memory Access Instructions --------------------------------- -- LD{GT/LE}.{B/H/W/D}, ST{GT/LE}.{B/H/W/D} -- 7. Atomic Memory Access Instructions -------------------------------------- @@ -1092,6 +1098,7 @@ pprInstr platform instr = case instr of FMAXA o1 o2 o3 -> op3 (text "fmaxa." <> if isSingleOp o2 then text "s" else text "d") o1 o2 o3 FABS o1 o2 -> op2 (text "fabs." <> if isSingleOp o2 then text "s" else text "d") o1 o2 FNEG o1 o2 -> op2 (text "fneg." <> if isSingleOp o2 then text "s" else text "d") o1 o2 + FSQRT o1 o2 -> op2 (text "fsqrt." <> if isSingleOp o2 then text "s" else text "d") o1 o2 FMA variant d o1 o2 o3 -> let fma = case variant of FMAdd -> text "\tfmadd." <+> floatPrecission d View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/537bd233635df7304239e0e6084d6830... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/537bd233635df7304239e0e6084d6830... You're receiving this email because of your account on gitlab.haskell.org.