| ... |
... |
@@ -662,7 +662,7 @@ opRegWidth w = pprPanic "opRegWidth" (text "Unsupported width" <+> ppr w) |
|
662
|
662
|
-- in between operations.
|
|
663
|
663
|
--
|
|
664
|
664
|
-- IMPORTANT: this invariant only holds within a single expression tree as
|
|
665
|
|
--- generated by the NCG (via truncateReg after each sub-word operation). It
|
|
|
665
|
+-- generated by the NCG (via truncateRegInplace after each sub-word operation). It
|
|
666
|
666
|
-- does NOT hold at function entry points or across basic block boundaries,
|
|
667
|
667
|
-- because the GHC calling convention does not guarantee that callers
|
|
668
|
668
|
-- zero-extend sub-word arguments. Therefore, any operation that is sensitive
|
| ... |
... |
@@ -688,7 +688,7 @@ opRegWidth w = pprPanic "opRegWidth" (text "Unsupported width" <+> ppr w) |
|
688
|
688
|
-- Next we compute `c`: The `%not` requires no extension of its operands, but
|
|
689
|
689
|
-- we must still truncate the result back down to 8-bits. Finally the `%shrl`
|
|
690
|
690
|
-- requires no extension and no truncate since we can assume that
|
|
691
|
|
--- `c` is zero-extended (it was produced by a truncateReg in the same block).
|
|
|
691
|
+-- `c` is zero-extended (it was produced by a truncateRegInplace in the same block).
|
|
692
|
692
|
--
|
|
693
|
693
|
-- TODO:
|
|
694
|
694
|
-- Don't use Width in Operands
|
| ... |
... |
@@ -931,7 +931,7 @@ getRegister' config plat expr |
|
931
|
931
|
let w' = opRegWidth w
|
|
932
|
932
|
in code `snocOL`
|
|
933
|
933
|
MVN (OpReg w' dst) (OpReg w' reg) `appOL`
|
|
934
|
|
- truncateReg w' w dst -- See Note [Signed arithmetic on AArch64]
|
|
|
934
|
+ truncateRegInplace w' w dst -- See Note [Signed arithmetic on AArch64]
|
|
935
|
935
|
|
|
936
|
936
|
MO_S_Neg w -> negate code w reg
|
|
937
|
937
|
MO_F_Neg w -> return $ Any fmt (\dst -> code `snocOL` NEG fmt (OpReg w dst) (OpReg w reg))
|
| ... |
... |
@@ -1064,7 +1064,7 @@ getRegister' config plat expr |
|
1064
|
1064
|
code `appOL`
|
|
1065
|
1065
|
code_sx `snocOL`
|
|
1066
|
1066
|
NEG fmt (OpReg w' dst) (OpReg w' reg') `appOL`
|
|
1067
|
|
- truncateReg w' w dst
|
|
|
1067
|
+ truncateRegInplace w' w dst
|
|
1068
|
1068
|
|
|
1069
|
1069
|
ss_conv from to reg code =
|
|
1070
|
1070
|
let w' = opRegWidth (max from to)
|
| ... |
... |
@@ -1073,7 +1073,7 @@ getRegister' config plat expr |
|
1073
|
1073
|
SBFM (OpReg w' dst) (OpReg w' reg) (OpImm (ImmInt 0)) (toImm (min from to)) `appOL`
|
|
1074
|
1074
|
-- At this point an 8- or 16-bit value would be sign-extended
|
|
1075
|
1075
|
-- to 32-bits. Truncate back down the final width.
|
|
1076
|
|
- truncateReg w' to dst
|
|
|
1076
|
+ truncateRegInplace w' to dst
|
|
1077
|
1077
|
|
|
1078
|
1078
|
-- Dyadic machops:
|
|
1079
|
1079
|
--
|
| ... |
... |
@@ -1220,7 +1220,7 @@ getRegister' config plat expr |
|
1220
|
1220
|
code_y `appOL`
|
|
1221
|
1221
|
op (OpReg w dst) (OpReg w reg_x) op_y)
|
|
1222
|
1222
|
|
|
1223
|
|
- -- A (potentially signed) integer operation.
|
|
|
1223
|
+ -- A (potentially signed) integer operation that can have immediate arguments.
|
|
1224
|
1224
|
-- In the case of 8- and 16-bit signed arithmetic we must first
|
|
1225
|
1225
|
-- sign-extend both arguments to 32-bits.
|
|
1226
|
1226
|
-- See Note [Signed arithmetic on AArch64].
|
| ... |
... |
@@ -1230,6 +1230,7 @@ getRegister' config plat expr |
|
1230
|
1230
|
-- compute x<m> <- x
|
|
1231
|
1231
|
-- compute x<o> <- y
|
|
1232
|
1232
|
-- <OP> x<n>, x<m>, x<o>
|
|
|
1233
|
+ let w' = opRegWidth w
|
|
1233
|
1234
|
(reg_x, format_x, code_x) <- getSomeReg x
|
|
1234
|
1235
|
(op_y, format_y, code_y) <- case y of
|
|
1235
|
1236
|
CmmLit (CmmInt n w)
|
| ... |
... |
@@ -1241,12 +1242,11 @@ getRegister' config plat expr |
|
1241
|
1242
|
massertPpr (isIntFormat format_x && isIntFormat format_y) $ text "intOp: non-int"
|
|
1242
|
1243
|
-- This is the width of the registers on which the operation
|
|
1243
|
1244
|
-- should be performed.
|
|
1244
|
|
- let w' = opRegWidth w
|
|
1245
|
1245
|
return $ Any (intFormat w) $ \dst ->
|
|
1246
|
1246
|
code_x `appOL`
|
|
1247
|
1247
|
code_y `appOL`
|
|
1248
|
1248
|
op (OpReg w' dst) (OpReg w' reg_x) (op_y) `appOL`
|
|
1249
|
|
- truncateReg w' w dst -- truncate back to the operand's original width
|
|
|
1249
|
+ truncateRegInplace w' w dst -- truncate back to the operand's original width
|
|
1250
|
1250
|
|
|
1251
|
1251
|
-- A (potentially signed) integer operation.
|
|
1252
|
1252
|
-- In the case of 8- and 16-bit signed arithmetic we must first
|
| ... |
... |
@@ -1263,7 +1263,8 @@ getRegister' config plat expr |
|
1263
|
1263
|
-- should be performed.
|
|
1264
|
1264
|
let w' = opRegWidth w
|
|
1265
|
1265
|
signExt r
|
|
1266
|
|
- | not is_signed = return (r, nilOL)
|
|
|
1266
|
+ -- See Note [Signed arithmetic on AArch64] and #27430
|
|
|
1267
|
+ | not is_signed = truncateReg w w' r
|
|
1267
|
1268
|
| otherwise = signExtendReg w w' r
|
|
1268
|
1269
|
(reg_x_sx, code_x_sx) <- signExt reg_x
|
|
1269
|
1270
|
(reg_y_sx, code_y_sx) <- signExt reg_y
|
| ... |
... |
@@ -1274,7 +1275,7 @@ getRegister' config plat expr |
|
1274
|
1275
|
code_x_sx `appOL`
|
|
1275
|
1276
|
code_y_sx `appOL`
|
|
1276
|
1277
|
op (OpReg w' dst) (OpReg w' reg_x_sx) (OpReg w' reg_y_sx) `appOL`
|
|
1277
|
|
- truncateReg w' w dst -- truncate back to the operand's original width
|
|
|
1278
|
+ truncateRegInplace w' w dst -- truncate back to the operand's original width
|
|
1278
|
1279
|
|
|
1279
|
1280
|
floatOp w op = do
|
|
1280
|
1281
|
(reg_fx, format_x, code_fx) <- getFloatReg x
|
| ... |
... |
@@ -1904,10 +1905,28 @@ signExtendReg w w' r = |
|
1904
|
1905
|
r' <- getNewRegNat (intFormat w')
|
|
1905
|
1906
|
return (r', unitOL $ instr (OpReg w' r') (OpReg w r))
|
|
1906
|
1907
|
|
|
1907
|
|
--- | Instructions to truncate the value in the given register from width @w@
|
|
|
1908
|
+-- | Instructions to truncate (zero extend) the value in the given register from width @w@
|
|
|
1909
|
+-- down to width @w'@ into a new register. Or return the original register if it's a noop.
|
|
|
1910
|
+truncateReg :: Width -> Width -> Reg -> NatM (Reg, OrdList Instr)
|
|
|
1911
|
+truncateReg w w' r = do
|
|
|
1912
|
+ case w' of
|
|
|
1913
|
+ W64 -> noop
|
|
|
1914
|
+ W32
|
|
|
1915
|
+ | w' == W32 -> noop
|
|
|
1916
|
+ | otherwise -> trunc MOV
|
|
|
1917
|
+ W16 -> trunc UXTH
|
|
|
1918
|
+ W8 -> trunc UXTB
|
|
|
1919
|
+ _ -> panic "intOp"
|
|
|
1920
|
+ where
|
|
|
1921
|
+ noop = return (r, nilOL)
|
|
|
1922
|
+ trunc instr = do
|
|
|
1923
|
+ r' <- getNewRegNat (intFormat w')
|
|
|
1924
|
+ return (r', unitOL $ instr (OpReg w' r') (OpReg w r))
|
|
|
1925
|
+
|
|
|
1926
|
+-- | Instructions to truncate (zero extend) the value in the given register from width @w@
|
|
1908
|
1927
|
-- down to width @w'@.
|
|
1909
|
|
-truncateReg :: Width -> Width -> Reg -> OrdList Instr
|
|
1910
|
|
-truncateReg w w' r =
|
|
|
1928
|
+truncateRegInplace :: Width -> Width -> Reg -> OrdList Instr
|
|
|
1929
|
+truncateRegInplace w w' r =
|
|
1911
|
1930
|
case w of
|
|
1912
|
1931
|
W64 -> nilOL
|
|
1913
|
1932
|
W32
|
| ... |
... |
@@ -2352,7 +2371,7 @@ genCCall target dest_regs arg_regs = do |
|
2352
|
2371
|
-- product, and hi gets the overflow (sign extension bits).
|
|
2353
|
2372
|
SMULL (OpReg w' lo) (OpReg W32 reg_a) (OpReg W32 reg_b) `snocOL`
|
|
2354
|
2373
|
ASR (OpReg w' hi) (OpReg w' lo) (OpImm (ImmInt $ widthInBits w)) `appOL`
|
|
2355
|
|
- truncateReg w' w lo `snocOL`
|
|
|
2374
|
+ truncateRegInplace w' w lo `snocOL`
|
|
2356
|
2375
|
-- CMN (compare negative) tests hi + lo' == 0, i.e. hi == -lo'.
|
|
2357
|
2376
|
-- lo' = LSR(lo, w-1) gives 1 if lo is negative, 0 if positive.
|
|
2358
|
2377
|
-- No overflow iff hi is the sign extension of lo:
|
| ... |
... |
@@ -2362,7 +2381,7 @@ genCCall target dest_regs arg_regs = do |
|
2362
|
2381
|
-- NE to set nd = 1 when overflow occurred.
|
|
2363
|
2382
|
CMN (OpReg w' hi) (OpRegShift w' lo SLSR (widthInBits w - 1)) `snocOL`
|
|
2364
|
2383
|
CSET (OpReg w' nd) NE `appOL`
|
|
2365
|
|
- truncateReg w' w hi
|
|
|
2384
|
+ truncateRegInplace w' w hi
|
|
2366
|
2385
|
-- Can't handle > 64 bit operands
|
|
2367
|
2386
|
| otherwise -> unsupported (MO_S_Mul2 w)
|
|
2368
|
2387
|
PrimTarget (MO_U_Mul2 w)
|
| ... |
... |
@@ -2412,7 +2431,7 @@ genCCall target dest_regs arg_regs = do |
|
2412
|
2431
|
(OpImm (ImmInt $ widthInBits w)) -- lsb
|
|
2413
|
2432
|
(OpImm (ImmInt $ widthInBits w)) -- width to extract
|
|
2414
|
2433
|
`appOL`
|
|
2415
|
|
- truncateReg W64 w lo
|
|
|
2434
|
+ truncateRegInplace W64 w lo
|
|
2416
|
2435
|
)
|
|
2417
|
2436
|
| otherwise -> unsupported (MO_U_Mul2 w)
|
|
2418
|
2437
|
PrimTarget (MO_Clz w)
|
| ... |
... |
@@ -2898,6 +2917,7 @@ genCCall target dest_regs arg_regs = do |
|
2898
|
2917
|
|
|
2899
|
2918
|
passArguments _ _ _ _ _ _ _ = pprPanic "passArguments" (text "invalid state")
|
|
2900
|
2919
|
|
|
|
2920
|
+ -- readResults gpArgs fpArgs dest_regs reg_acc code_acc
|
|
2901
|
2921
|
readResults :: [Reg] -> [Reg] -> [LocalReg] -> [Reg]-> InstrBlock -> NatM (InstrBlock)
|
|
2902
|
2922
|
readResults _ _ [] _ accumCode = return accumCode
|
|
2903
|
2923
|
readResults [] _ _ _ _ = do
|
| ... |
... |
@@ -2915,7 +2935,14 @@ genCCall target dest_regs arg_regs = do |
|
2915
|
2935
|
r_dst = getRegisterReg platform (CmmLocal dst)
|
|
2916
|
2936
|
if isFloatFormat format || isVecFormat format
|
|
2917
|
2937
|
then readResults (gpReg:gpRegs) fpRegs dsts (fpReg:accumRegs) (accumCode `snocOL` MOV (OpReg w r_dst) (OpReg w fpReg))
|
|
2918
|
|
- else readResults gpRegs (fpReg:fpRegs) dsts (gpReg:accumRegs) (accumCode `snocOL` MOV (OpReg w r_dst) (OpReg w gpReg))
|
|
|
2938
|
+ else do
|
|
|
2939
|
+ -- See [Signed arithmetic on AArch64]
|
|
|
2940
|
+ -- Strictly speaking we don't have to here but err on the side of caution.
|
|
|
2941
|
+ let !mov_instr = case w of
|
|
|
2942
|
+ W8 -> UXTB
|
|
|
2943
|
+ W16 -> UXTH
|
|
|
2944
|
+ _ -> MOV
|
|
|
2945
|
+ readResults gpRegs (fpReg:fpRegs) dsts (gpReg:accumRegs) (accumCode `snocOL` mov_instr (OpReg w r_dst) (OpReg w gpReg))
|
|
2919
|
2946
|
|
|
2920
|
2947
|
unaryFloatOp w op arg_reg dest_reg = do
|
|
2921
|
2948
|
platform <- getPlatform
|