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

Commits:

1 changed file:

Changes:

  • compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
    1 1 
     {-# language GADTs, LambdaCase #-}
    2 2 
     {-# LANGUAGE OverloadedStrings #-}
    3 
    +{-# LANGUAGE MultiWayIf #-}
    4 
    +{-# LANGUAGE PatternSynonyms #-}
    5 
    +{-# LANGUAGE ViewPatterns #-}
    3 6
    4 7 
     module GHC.CmmToAsm.AArch64.CodeGen (
    5 8 
           cmmTopCodeGen
    ... ... @@ -923,18 +926,23 @@ getRegister' config plat expr
    923 926 
         -- XX Conversion
    924 927 
         CmmMachOp (MO_XX_Conv from to) [e] -> do
    925 928 
           register <- getRegister e
    926 
    -      if to >= W32 || to > from
    927 
    -        then case register of
    928 
    -          -- Reuse computation, casting width.
    929 
    -          Any _fmt code       -> pure $ Any (intFormat to) code
    930 
    -          Fixed _fmt reg code -> pure $ Fixed (intFormat to) reg code
    931 
    -        else case register of
    932 
    -          Any _fmt code ->
    933 
    -            pure $ Any (intFormat to) $ \dst -> do
    934 
    -              code dst `appOL` truncateSubwordRegInplace to dst
    935 
    -          Fixed _fmt reg code -> do
    936 
    -              (trunc_reg, trunc_code) <- truncateSubwordReg to reg
    937 
    -              pure $ Fixed (intFormat to) trunc_reg (code `appOL` trunc_code)
    929 
    +      -- if to >= W32 || to > from
    930 
    +      --   -- don't do anything in the word case or
    931 
    +      --   -- when the target register width is larger
    932 
    +      --   -- than the origin register width; e.g.
    933 
    +      --   -- mangoiv: what we the tradeoff to not truncate here, too?
    934 
    +      --   then case register of
    935 
    +      --     -- Reuse computation, casting width.
    936 
    +      --     Any _fmt code       -> pure $ Any (intFormat to) code
    937 
    +      --     Fixed _fmt reg code -> pure $ Fixed (intFormat to) reg code
    938 
    +      --   else
    939 
    +      case register of
    940 
    +        Any _fmt code ->
    941 
    +          pure $ Any (intFormat to) $ \dst -> do
    942 
    +            code dst `appOL` instrsNonclobberedCode (truncateSubwordReg SNeverClobbers to dst)
    943 
    +        Fixed _fmt reg code -> do
    944 
    +            (trunc_reg, trunc_code) <- instrsWithUnclobberedReg $ truncateSubwordReg SMayClobberSubwordArgReg to reg
    945 
    +            pure $ Fixed (intFormat to) trunc_reg (code `appOL` trunc_code)
    938 946 
         CmmMachOp op [e] -> do
    939 947 
           (reg, _format, code) <- getSomeReg e
    940 948 
           case op of
    ... ... @@ -1233,7 +1241,7 @@ getRegister' config plat expr
    1233 1241 
               -- sign-extend both arguments to 32-bits.
    1234 1242 
               -- See Note [Signed arithmetic on AArch64].
    1235 1243 
               intOpImm :: Bool -> Width -> (Operand -> Operand -> Operand -> OrdList Instr) -> (Integer -> Width -> Maybe Operand) -> NatM (Register)
    1236 
    -          intOpImm {- is signed -} True  w op _encode_imm = intOp True w op
    1244 
    +          intOpImm True  w op _encode_imm = intOp True w op {- is signed -}
    1237 1245 
               intOpImm                 False w op  encode_imm = do
    1238 1246 
                   -- compute x<m> <- x
    1239 1247 
                   -- compute x<o> <- y
    ... ... @@ -1914,38 +1922,91 @@ signExtendReg w w' r =
    1914 1922 
             r' <- getNewRegNat (intFormat w')
    1915 1923 
             return (r', unitOL $ instr (OpReg w' r') (OpReg w r))
    1916 1924
    1925 
    +-- | Whether the argument register may be clobbered
    1926 
    +--   'NeverClobbers' is an optimization
    1927 
    +data ArgumentClobbering
    1928 
    +  = NeverClobbers
    1929 
    +  | MayClobberArgReg
    1930 
    +
    1931 
    +-- TODO(mangoiv): come up with better names for these two data strucutes
    1932 
    +
    1933 
    +data SArgumentClobbering (a :: ArgumentClobbering) where
    1934 
    +  SMayClobberSubwordArgReg :: SArgumentClobbering MayClobberArgReg
    1935 
    +  -- ^ the usual case: the register that holds a subword argument may be
    1936 
    +  --   clobbered by the truncation operation; >=W32 is not affected since
    1937 
    +  --   it is a noop
    1938 
    +
    1939 
    +  SAlwaysAllocateReg :: SArgumentClobbering MayClobberArgReg
    1940 
    +  -- ^ subwords may be clobbered, but >=W32 want to allocate a new register
    1941 
    +  --   anyway; to avoid having to allocate twice in the subword case, we
    1942 
    +  --   always allocate a new register
    1943 
    +  --   This is at worst a pessimisation of allocating one more registeer
    1944 
    +  --   in case we don't actually need this.
    1945 
    +
    1946 
    +  SNeverClobbers :: SArgumentClobbering NeverClobbers
    1947 
    +  -- ^ if we are sure that the register is fresh and clobbering doesn't
    1948 
    +  --   matter, we don't have to allocate a new register, ever
    1949 
    +
    1950 
    +
    1951 
    +data SArgumentClobbered (a :: ArgumentClobbering) where
    1952 
    +  SNeverClobbered ::  OrdList Instr -> SArgumentClobbered NeverClobbers
    1953 
    +  -- ^ just returns the instructions; since we never clobber, this is pure since
    1954 
    +  --   we never have to return a new register
    1955 
    +
    1956 
    +  SUnclobbered :: NatM (Reg, OrdList Instr) -> SArgumentClobbered MayClobberArgReg
    1957 
    +  -- ^ return code to allocate a new register and instructions that may depend on it, that is:
    1958 
    +  --   - a new register if we pass a subword register with the potential to be clobbered
    1959 
    +  --   - the input register if we pass a word sized argument with no need to always allocate
    1960 
    +  --     a new register
    1961 
    +  --   - a new register if we were to always create a new register
    1962 
    +
    1963 
    +instrsWithUnclobberedReg :: SArgumentClobbered MayClobberArgReg -> NatM (Reg, OrdList Instr)
    1964 
    +instrsWithUnclobberedReg (SUnclobbered a) = a
    1965 
    +
    1966 
    +instrsNonclobberedCode :: SArgumentClobbered NeverClobbers -> OrdList Instr
    1967 
    +instrsNonclobberedCode (SNeverClobbered a) = a
    1968 
    +
    1969 
    +-- | full words
    1970 
    +pattern WFull :: Width
    1971 
    +pattern WFull <- (\case W32 -> True; W64 -> True; _ -> False -> True)
    1972 
    +
    1973 
    +-- | subwords
    1974 
    +pattern WSub :: (Operand -> Operand -> Instr) -> Width
    1975 
    +pattern WSub {truncInstr} <- (\case W16 -> Just UXTH; W8 -> Just UXTB; _ -> Nothing -> (Just truncInstr))
    1976 
    +
    1917 1977 
     -- | Truncate/zero extend the subwords high bits and store the
    1918 
    --- result in a new register. Must be called with w==8 or w==16
    1919 
    -truncateSubwordReg :: Width -> Reg -> NatM (Reg, OrdList Instr)
    1920 
    -truncateSubwordReg w_to r = do
    1921 
    -    massertPpr (w_to == W8 || w_to == W16) (text "truncateSubwordReg:unexpectedWidth")
    1922 
    -    case w_to of
    1923 
    -      -- Asserted false, but be defensive for non-debug builds.
    1924 
    -      W64 -> trunc W64 MOV
    1925 
    -      W32 -> trunc W32 MOV
    1926 
    -
    1927 
    -      -- Actual truncation
    1928 
    -      W16 -> trunc W32 UXTH
    1929 
    -      W8  -> trunc W32 UXTB
    1930 
    -      _   -> panic "truncateSubwordReg:unexpectedWidth"
    1931 
    -  where
    1932 
    -    trunc w instr = do
    1933 
    -        r' <- getNewRegNat (intFormat w_to)
    1934 
    -        return (r', unitOL $ instr (OpReg w r') (OpReg w r))
    1935 
    -
    1936 
    --- | Like @truncateSubwordReg@, but modifes the argument register in place if we
    1937 
    --- need to truncate.
    1938 
    -truncateSubwordRegInplace :: Width -> Reg -> OrdList Instr
    1939 
    -truncateSubwordRegInplace w_to r = do
    1940 
    -    case w_to of
    1941 
    -      W64 -> nilOL
    1942 
    -      W32 -> nilOL
    1943 
    -      W16 -> trunc UXTH
    1944 
    -      W8  -> trunc UXTB
    1945 
    -      _   -> panic "truncateSubwordRegInplace:unexpectedWidth"
    1978 
    +-- result in a new register.
    1979 
    +truncateSubwordReg :: SArgumentClobbering a -> Width -> Reg -> SArgumentClobbered a
    1980 
    +truncateSubwordReg clobbering w_to r = case clobbering of
    1981 
    +  SMayClobberSubwordArgReg
    1982 
    +    -- return the input register
    1983 
    +    | WFull             <- w_to -> SUnclobbered $ pure (r, nilOL)
    1984 
    +    -- allocate a new register
    1985 
    +    | WSub {truncInstr} <- w_to -> SUnclobbered $ do
    1986 
    +      freshReg <- getNewRegNat (intFormat w_to)
    1987 
    +      pure (freshReg, pureTrunc truncInstr W32 freshReg r)
    1988 
    +
    1989 
    +  -- always allocate a new register as the surrounding code
    1990 
    +  -- would allocate one anyways and we don't want to allocate
    1991 
    +  -- multiple times; this may be a pessimation when we don't
    1992 
    +  -- want to allocate a new register for non-subwords
    1993 
    +  SAlwaysAllocateReg -> SUnclobbered $ do
    1994 
    +      freshReg <- getNewRegNat (intFormat w_to)
    1995 
    +      let instrs
    1996 
    +            | WFull <- w_to             = nilOL
    1997 
    +            | WSub {truncInstr} <- w_to = pureTrunc truncInstr W32 freshReg r
    1998 
    +            | otherwise                 = panicUnexpectedWidth
    1999 
    +      pure (freshReg, instrs)
    2000 
    +  SNeverClobbers
    2001 
    +    -- noop
    2002 
    +    | WFull      <- w_to -> SNeverClobbered nilOL
    2003 
    +    -- same register
    2004 
    +    | WSub {truncInstr} <- w_to -> SNeverClobbered $ pureTrunc truncInstr W32 r r
    2005 
    +  _ -> panicUnexpectedWidth
    1946 2006 
       where
    1947 
    -    trunc instr = do
    1948 
    -        unitOL $ instr (OpReg W32 r) (OpReg W32 r)
    2007 
    +  pureTrunc instr targetWidth destinationReg originReg
    2008 
    +    = unitOL $ instr (OpReg targetWidth destinationReg) (OpReg targetWidth originReg)
    2009 
    +  panicUnexpectedWidth = panic "truncateSubwordReg:unexpectedWidth"
    1949 2010
    1950 2011 
     -- -----------------------------------------------------------------------------
    1951 2012 
     --  The 'Amode' type: Memory addressing modes passed up the tree.
    ... ... @@ -3027,7 +3088,7 @@ data BlockInRange = InRange | NotInRange Target
    3027 3088 
     -- See Note [AArch64 far jumps]
    3028 3089 
     makeFarBranches :: Platform -> LabelMap RawCmmStatics -> [NatBasicBlock Instr]
    3029 3090 
                     -> UniqDSM [NatBasicBlock Instr]
    3030 
    -makeFarBranches {- only used when debugging -} _platform statics basic_blocks = do
    3091 
    +makeFarBranches _platform statics basic_blocks = do
    3031 3092 
       -- All offsets/positions are counted in multiples of 4 bytes (the size of AArch64 instructions)
    3032 3093 
       -- That is an offset of 1 represents a 4-byte/one instruction offset.
    3033 3094 
       let (func_size, lblMap) = foldl' calc_lbl_positions (0, mapEmpty) basic_blocks
    ... ... @@ -3143,4 +3204,4 @@ makeFarBranches {- only used when debugging -} _platform statics basic_blocks =
    3143 3204 
           CBZ{}   -> Just long_bz_jump_size
    3144 3205 
           CBNZ{}  -> Just long_bz_jump_size
    3145 3206 
           BCOND{} -> Just long_bc_jump_size
    3146 
    -      _ -> Nothing
    3207 
    +      _ -> Nothing {- only used when debugging -}

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help Notification message regarding https://gitlab.haskell.org/ghc/ghc/-/commit/c758cca3c882d2e4bdff7c5f13b1dd7efefb3e4b at 1785923183