Andreas Klebinger pushed to branch wip/andreask/arm-ffi at Glasgow Haskell Compiler / GHC

Commits:

1 changed file:

Changes:

  • compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
    ... ... @@ -358,43 +358,6 @@ data Register
    358 358
             = Fixed Format Reg InstrBlock
    
    359 359
             | Any   Format (Reg -> InstrBlock)
    
    360 360
     
    
    361
    -registerFormat :: Register -> Format
    
    362
    -registerFormat reg = case reg of { Fixed format _ _ -> format; Any format _ -> format }
    
    363
    --- | Sometimes we need to change the Format of a register. Primarily during
    
    364
    --- conversion. When shrinking the register below machine word size we zero the high
    
    365
    --- bits. See Note [Signed arithmetic on AArch64]
    
    366
    -
    
    367
    -swizzleRegisterRep :: Width -> Format -> Register -> Register
    
    368
    -swizzleRegisterRep old_width format reg
    
    369
    -  -- APK: Currently this assertion doesn't always hold.
    
    370
    -  -- This seems problematic but will have to be fixed another time.
    
    371
    -  | (reg_width /= old_width)
    
    372
    -  , pprTrace "Missmatched widths" (ppr (old_width, format, reg)) False
    
    373
    -  = undefined
    
    374
    -
    
    375
    -  | old_width == formatToWidth format =
    
    376
    -    reg
    
    377
    -  -- The CMM needs to expect garbage in high bits so this is fine.
    
    378
    -  | old_width < f_width || format >= II32 =
    
    379
    -    reg
    
    380
    -  | otherwise = truncateSmaller reg
    
    381
    -  where
    
    382
    -    f_width = formatToWidth format
    
    383
    -    reg_width = formatToWidth (registerFormat reg)
    
    384
    -    trunc_instr = case f_width of
    
    385
    -      W8 -> UXTB
    
    386
    -      W16 -> UXTH
    
    387
    -      _ -> panic "unexpected width"
    
    388
    -    truncateSmaller (Fixed _fmt_in reg old_code) =
    
    389
    -      let reg_code = old_code `snocOL`
    
    390
    -                    trunc_instr (OpReg old_width reg) (OpReg W32 reg)
    
    391
    -      in Fixed format reg reg_code
    
    392
    -    truncateSmaller (Any _fmt_in codefn)     =
    
    393
    -      let reg_code = \reg ->
    
    394
    -            codefn reg `snocOL`
    
    395
    -                          trunc_instr (OpReg old_width reg) (OpReg W32 reg)
    
    396
    -      in Any format reg_code
    
    397
    -
    
    398 361
     -- | Grab the Reg for a CmmReg
    
    399 362
     getRegisterReg :: Platform -> CmmReg -> Reg
    
    400 363
     
    
    ... ... @@ -983,7 +946,13 @@ getRegister' config plat expr
    983 946
               where fmt = intFormat w
    
    984 947
     
    
    985 948
             -- Conversions
    
    986
    -        MO_XX_Conv from to -> swizzleRegisterRep from (intFormat to) <$> getRegister e
    
    949
    +        MO_XX_Conv from to
    
    950
    +          | to >= W32 || to > from ->
    
    951
    +              -- We don't care about garbage high bits when upcasting this way.
    
    952
    +              pure $ Fixed (intFormat to) reg code
    
    953
    +          | otherwise -> do
    
    954
    +              (trunc_reg, code_trunc) <- truncateReg from to reg
    
    955
    +              return $ Fixed (intFormat to) trunc_reg (code `appOL` code_trunc)
    
    987 956
     
    
    988 957
             -- Vector
    
    989 958
             MO_V_Broadcast l w -> return $ Any fmt (\dst -> code `snocOL` DUP fmt (OpReg vw dst) (OpScalarAsVec w reg))
    
    ... ... @@ -1929,7 +1898,7 @@ signExtendReg w w' r =
    1929 1898
             | otherwise -> extend SXTW
    
    1930 1899
           W16           -> extend SXTH
    
    1931 1900
           W8            -> extend SXTB
    
    1932
    -      _             -> panic "intOp"
    
    1901
    +      _             -> panic "signExtendReg:unexpectedWidth"
    
    1933 1902
       where
    
    1934 1903
         noop = return (r, nilOL)
    
    1935 1904
         extend instr = do
    
    ... ... @@ -1939,20 +1908,20 @@ signExtendReg w w' r =
    1939 1908
     -- | Instructions to truncate (zero extend) the value in the given register from width @w@
    
    1940 1909
     -- down to width @w'@ into a new register. Or return the original register if it's a noop.
    
    1941 1910
     truncateReg :: Width -> Width -> Reg -> NatM (Reg, OrdList Instr)
    
    1942
    -truncateReg w w' r = do
    
    1943
    -    case w' of
    
    1911
    +truncateReg w_from w_to r = do
    
    1912
    +    case w_to of
    
    1944 1913
           W64 -> noop
    
    1945 1914
           W32
    
    1946
    -        | w' == W32 -> noop
    
    1915
    +        | w_from == W32 -> noop
    
    1947 1916
             | otherwise -> trunc MOV
    
    1948 1917
           W16           -> trunc UXTH
    
    1949 1918
           W8            -> trunc UXTB
    
    1950
    -      _             -> panic "intOp"
    
    1919
    +      _             -> panic "truncateReg:unexpectedWidth"
    
    1951 1920
       where
    
    1952 1921
         noop = return (r, nilOL)
    
    1953 1922
         trunc instr = do
    
    1954
    -        r' <- getNewRegNat (intFormat w')
    
    1955
    -        return (r', unitOL $ instr (OpReg w' r') (OpReg w r))
    
    1923
    +        r' <- getNewRegNat (intFormat w_to)
    
    1924
    +        return (r', unitOL $ instr (OpReg W32 r') (OpReg W32 r))
    
    1956 1925
     
    
    1957 1926
     -- | Instructions to truncate (zero extend) the value in the given register from width @w@
    
    1958 1927
     -- down to width @w'@.