[Git][ghc/ghc][wip/angerman/aarch64-ncg] 4 commits: Overflow guard
Moritz Angermann
gitlab at gitlab.haskell.org
Sun Jul 12 13:44:17 UTC 2020
Moritz Angermann pushed to branch wip/angerman/aarch64-ncg at Glasgow Haskell Compiler / GHC
Commits:
3ef94e59 by Moritz Angermann at 2020-07-12T08:27:37+00:00
Overflow guard
- - - - -
36cab9a9 by Moritz Angermann at 2020-07-12T08:28:00+00:00
More annotations.
- - - - -
826a9426 by Moritz Angermann at 2020-07-12T08:29:18+00:00
Revert "Overflow guard"
They are Integers not Ints.
This reverts commit 3ef94e593a2848cf2bdc4251f5be34536642675f.
Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com>
- - - - -
ce9cbc92 by Moritz Angermann at 2020-07-12T13:43:59+00:00
Add CmmAssign and CmmStore comments
- - - - -
2 changed files:
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
- compiler/GHC/CmmToAsm/AArch64/Instr.hs
Changes:
=====================================
compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
=====================================
@@ -445,28 +445,28 @@ getRegister' config plat expr
-- XXX hand CmmInt 0 special, use wzr or xzr.
CmmInt i W8 -> do
- return (Any (intFormat W8) (\dst -> unitOL $ MOV (OpReg W8 dst) (OpImm (ImmInteger (narrowS W8 i)))))
+ return (Any (intFormat W8) (\dst -> unitOL $ ANN (text $ show expr) (MOV (OpReg W8 dst) (OpImm (ImmInteger (narrowS W8 i))))))
CmmInt i W16 -> do
- return (Any (intFormat W16) (\dst -> unitOL $ MOV (OpReg W16 dst) (OpImm (ImmInteger (narrowS W16 i)))))
+ return (Any (intFormat W16) (\dst -> unitOL $ ANN (text $ show expr) (MOV (OpReg W16 dst) (OpImm (ImmInteger (narrowS W16 i))))))
-- We need to be careful to not shorten this for negative literals.
-- Those need the upper bits set. We'd either have to explicitly sign
-- or figure out something smarter. MNV dst XZR
CmmInt i w | is16bit i, i >= 0 -> do
- return (Any (intFormat w) (\dst -> unitOL $ MOV (OpReg W16 dst) (OpImm (ImmInteger i))))
+ return (Any (intFormat w) (\dst -> unitOL $ ANN (text $ show expr) (MOV (OpReg W16 dst) (OpImm (ImmInteger i)))))
CmmInt i w | is32bit i, i >= 0 -> do
let half0 = fromIntegral (fromIntegral i :: Word16)
half1 = fromIntegral (fromIntegral (i `shiftR` 16) :: Word16)
- return (Any (intFormat w) (\dst -> toOL [ COMMENT (text "CmmInt" <+> integer i <+> text (show w))
- , MOV (OpReg W32 dst) (OpImm (ImmInt half0))
+ return (Any (intFormat w) (\dst -> toOL [ ANN (text $ show expr)
+ $ MOV (OpReg W32 dst) (OpImm (ImmInt half0))
, MOVK (OpReg W32 dst) (OpImmShift (ImmInt half1) SLSL 16)
]))
-- fallback for W32
CmmInt i W32 -> do
let half0 = fromIntegral (fromIntegral i :: Word16)
half1 = fromIntegral (fromIntegral (i `shiftR` 16) :: Word16)
- return (Any (intFormat W32) (\dst -> toOL [ COMMENT (ppr expr)
- , MOV (OpReg W32 dst) (OpImm (ImmInt half0))
+ return (Any (intFormat W32) (\dst -> toOL [ ANN (text $ show expr)
+ $ MOV (OpReg W32 dst) (OpImm (ImmInt half0))
, MOVK (OpReg W32 dst) (OpImmShift (ImmInt half1) SLSL 16)
]))
-- anything else
@@ -475,20 +475,20 @@ getRegister' config plat expr
half1 = fromIntegral (fromIntegral (i `shiftR` 16) :: Word16)
half2 = fromIntegral (fromIntegral (i `shiftR` 32) :: Word16)
half3 = fromIntegral (fromIntegral (i `shiftR` 48) :: Word16)
- return (Any (intFormat W64) (\dst -> toOL [ COMMENT (ppr expr)
- , MOV (OpReg W64 dst) (OpImm (ImmInt half0))
+ return (Any (intFormat W64) (\dst -> toOL [ ANN (text $ show expr)
+ $ MOV (OpReg W64 dst) (OpImm (ImmInt half0))
, MOVK (OpReg W64 dst) (OpImmShift (ImmInt half1) SLSL 16)
, MOVK (OpReg W64 dst) (OpImmShift (ImmInt half2) SLSL 32)
, MOVK (OpReg W64 dst) (OpImmShift (ImmInt half3) SLSL 48)
]))
CmmInt i rep -> do
(op, imm_code) <- litToImm' lit
- return (Any (intFormat rep) (\dst -> imm_code `snocOL` MOV (OpReg rep dst) op))
+ return (Any (intFormat rep) (\dst -> imm_code `snocOL` ANN (text $ show expr) (MOV (OpReg rep dst) op)))
-- floatToBytes (fromRational f)
CmmFloat 0 w -> do
(op, imm_code) <- litToImm' lit
- return (Any (floatFormat w) (\dst -> imm_code `snocOL` MOV (OpReg w dst) op))
+ return (Any (floatFormat w) (\dst -> imm_code `snocOL` ANN (text $ show expr) (MOV (OpReg w dst) op)))
CmmFloat f W8 -> pprPanic "getRegister' (CmmLit:CmmFloat), no support for bytes" (ppr expr)
CmmFloat f W16 -> pprPanic "getRegister' (CmmLit:CmmFloat), no support for halfs" (ppr expr)
@@ -497,7 +497,8 @@ getRegister' config plat expr
half0 = fromIntegral (fromIntegral word :: Word16)
half1 = fromIntegral (fromIntegral (word `shiftR` 16) :: Word16)
tmp <- getNewRegNat (intFormat W32)
- return (Any (floatFormat W32) (\dst -> toOL [ MOV (OpReg W32 tmp) (OpImm (ImmInt half0))
+ return (Any (floatFormat W32) (\dst -> toOL [ ANN (text $ show expr)
+ $ MOV (OpReg W32 tmp) (OpImm (ImmInt half0))
, MOVK (OpReg W32 tmp) (OpImmShift (ImmInt half1) SLSL 16)
, MOV (OpReg W32 dst) (OpReg W32 tmp)
]))
@@ -508,7 +509,8 @@ getRegister' config plat expr
half2 = fromIntegral (fromIntegral (word `shiftR` 32) :: Word16)
half3 = fromIntegral (fromIntegral (word `shiftR` 48) :: Word16)
tmp <- getNewRegNat (intFormat W64)
- return (Any (floatFormat W64) (\dst -> toOL [ MOV (OpReg W64 tmp) (OpImm (ImmInt half0))
+ return (Any (floatFormat W64) (\dst -> toOL [ ANN (text $ show expr)
+ $ MOV (OpReg W64 tmp) (OpImm (ImmInt half0))
, MOVK (OpReg W64 tmp) (OpImmShift (ImmInt half1) SLSL 16)
, MOVK (OpReg W64 tmp) (OpImmShift (ImmInt half2) SLSL 32)
, MOVK (OpReg W64 tmp) (OpImmShift (ImmInt half3) SLSL 48)
@@ -804,12 +806,10 @@ assignMem_IntCode rep addrE srcE
(src_reg, _format, code) <- getSomeReg srcE
Amode addr addr_code <- getAmode addrE
let AddrReg r1 = addr
- return $ unitOL (COMMENT $ text "RHS:" <+> ppr srcE)
- `appOL` code
- `appOL` unitOL (COMMENT $ text "LHS:" <+> ppr addrE)
+ return $ COMMENT (text "CmmStore" <+> parens (text (show addrE)) <+> parens (text (show srcE)))
+ `consOL` (code
`appOL` addr_code
- `snocOL` COMMENT (text "Store:" <+> ppr r1 <+> text "<-" <+> ppr src_reg)
- `snocOL` STR rep (OpReg (formatToWidth rep) src_reg) (OpAddr addr)
+ `snocOL` STR rep (OpReg (formatToWidth rep) src_reg) (OpAddr addr))
assignReg_IntCode _ reg src
= do
@@ -819,8 +819,8 @@ assignReg_IntCode _ reg src
p = showSDocUnsafe . ppr
r <- getRegister src
return $ case r of
- Any _ code -> code dst
- Fixed format freg fcode -> fcode `snocOL` MOV (OpReg (formatToWidth format) dst) (OpReg (formatToWidth format) freg)
+ Any _ code -> COMMENT (text "CmmAssign" <+> parens (text (show reg)) <+> parens (text (show src))) `consOL` code dst
+ Fixed format freg fcode -> COMMENT (text "CmmAssign" <+> parens (text (show reg)) <+> parens (text (show src))) `consOL` (fcode `snocOL` MOV (OpReg (formatToWidth format) dst) (OpReg (formatToWidth format) freg))
-- Let's treat Floating point stuff
-- as integer code for now. Opaque.
=====================================
compiler/GHC/CmmToAsm/AArch64/Instr.hs
=====================================
@@ -331,7 +331,7 @@ aarch64_mkSpillInstr
-> Instr
aarch64_mkSpillInstr config reg delta slot
- = STR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 31) (ImmInt $ off - delta)))
+ = ANN (text "Spill") $ STR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 31) (ImmInt $ off - delta)))
where
fmt = case reg of
RegReal (RealRegSingle n) | n < 32 -> II64
@@ -346,7 +346,7 @@ aarch64_mkLoadInstr
-> Instr
aarch64_mkLoadInstr config reg delta slot
- = LDR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 31) (ImmInt $ off - delta)))
+ = ANN (text "Reload") $ LDR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 31) (ImmInt $ off - delta)))
where
fmt = case reg of
RegReal (RealRegSingle n) | n < 32 -> II64
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1feaa00a0df65e15c4f170a54e14d4d1f1e5fc6a...ce9cbc92c945c350dc3cc605bc7b78c97a133719
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1feaa00a0df65e15c4f170a54e14d4d1f1e5fc6a...ce9cbc92c945c350dc3cc605bc7b78c97a133719
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200712/bb48ecc1/attachment-0001.html>
More information about the ghc-commits
mailing list