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

Commits:

7 changed files:

Changes:

  • compiler/GHC/Cmm/Lint.hs
    ... ... @@ -99,11 +99,11 @@ lintCmmExpr expr@(CmmMachOp op args) = do
    99 99 
       platform <- getPlatform
    100 100 
       tys <- mapM lintCmmExpr args
    101 101 
       lintShiftOp op (zip args tys)
    102 
    -  let machop_arg_widths = machOpArgReps platform op
    102 
    +  let machop_arg_widths_m = machOpArgReps platform op
    103 103 
           arg_tys           = map (cmmExprType platform) args
    104 
    -  if map typeWidth arg_tys == machop_arg_widths
    104 
    +  if maybe False (\machop_arg_widths -> map typeWidth arg_tys == machop_arg_widths) machop_arg_widths_m
    105 105 
         then cmmCheckMachOp op args tys
    106 
    -    else cmmLintMachOpErr expr arg_tys machop_arg_widths
    106 
    +    else cmmLintMachOpErr expr arg_tys machop_arg_widths_m
    107 107 
     lintCmmExpr (CmmRegOff reg offset)
    108 108 
       = do let rep = typeWidth (cmmRegType reg)
    109 109 
            lintCmmExpr (CmmMachOp (MO_Add rep)
    ... ... @@ -279,8 +279,16 @@ addLintInfo info thing = CmmLint $ \platform ->
    279 279 
             Left err -> Left (hang info 2 err)
    280 280 
             Right a  -> Right a
    281 281
    282 
    -cmmLintMachOpErr :: CmmExpr -> [CmmType] -> [Width] -> CmmLint a
    283 
    -cmmLintMachOpErr expr argsRep opExpectsRep
    282 
    +cmmLintMachOpErr :: CmmExpr -> [CmmType] -> Maybe [Width] -> CmmLint a
    283 
    +cmmLintMachOpErr expr argsRep Nothing
    284 
    +     = do
    285 
    +       platform <- getPlatform
    286 
    +       cmmLintErr (text "in MachOp application: " $$
    287 
    +                   nest 2 (pdoc platform expr) $$
    288 
    +                      text "op is using unsupported width" $$
    289 
    +                      (text "arguments provide: " <+> ppr argsRep))
    290 
    +
    291 
    +cmmLintMachOpErr expr argsRep (Just opExpectsRep)
    284 292 
          = do
    285 293 
            platform <- getPlatform
    286 294 
            cmmLintErr (text "in MachOp application: " $$

  • compiler/GHC/Cmm/MachOp.hs
    ... ... @@ -565,111 +565,118 @@ comparisonResultRep = bWord -- is it?
    565 565 
     -- application of a MachOp is "type-correct" by checking that the MachReps of
    566 566 
     -- its arguments are the same as the MachOp expects.  This is used when
    567 567 
     -- linting a CmmExpr.
    568 
    +-- We also check if the given width is supported at all. But there might be
    569 
    +-- false positives.
    568 570
    569 
    -machOpArgReps :: Platform -> MachOp -> [Width]
    571 
    +machOpArgReps :: Platform -> MachOp -> Maybe [Width]
    570 572 
     machOpArgReps platform op =
    571 573 
       case op of
    572 
    -    MO_Add    w         -> [w,w]
    573 
    -    MO_Sub    w         -> [w,w]
    574 
    -    MO_Eq     w         -> [w,w]
    575 
    -    MO_Ne     w         -> [w,w]
    576 
    -    MO_Mul    w         -> [w,w]
    577 
    -    MO_S_MulMayOflo w   -> [w,w]
    578 
    -    MO_S_Quot w         -> [w,w]
    579 
    -    MO_S_Rem  w         -> [w,w]
    580 
    -    MO_S_Neg  w         -> [w]
    581 
    -    MO_U_Quot w         -> [w,w]
    582 
    -    MO_U_Rem  w         -> [w,w]
    583 
    -
    584 
    -    MO_S_Ge w           -> [w,w]
    585 
    -    MO_S_Le w           -> [w,w]
    586 
    -    MO_S_Gt w           -> [w,w]
    587 
    -    MO_S_Lt w           -> [w,w]
    588 
    -
    589 
    -    MO_U_Ge w           -> [w,w]
    590 
    -    MO_U_Le w           -> [w,w]
    591 
    -    MO_U_Gt w           -> [w,w]
    592 
    -    MO_U_Lt w           -> [w,w]
    593 
    -
    594 
    -    MO_F_Add w          -> [w,w]
    595 
    -    MO_F_Sub w          -> [w,w]
    596 
    -    MO_F_Mul w          -> [w,w]
    597 
    -    MO_F_Quot w         -> [w,w]
    598 
    -    MO_F_Neg w          -> [w]
    599 
    -    MO_F_Min w          -> [w,w]
    600 
    -    MO_F_Max w          -> [w,w]
    601 
    -
    602 
    -    MO_FMA _ l w        -> [vecwidth l w, vecwidth l w, vecwidth l w]
    603 
    -
    604 
    -    MO_F_Eq  w          -> [w,w]
    605 
    -    MO_F_Ne  w          -> [w,w]
    606 
    -    MO_F_Ge  w          -> [w,w]
    607 
    -    MO_F_Le  w          -> [w,w]
    608 
    -    MO_F_Gt  w          -> [w,w]
    609 
    -    MO_F_Lt  w          -> [w,w]
    610 
    -
    611 
    -    MO_And   w          -> [w,w]
    612 
    -    MO_Or    w          -> [w,w]
    613 
    -    MO_Xor   w          -> [w,w]
    614 
    -    MO_Not   w          -> [w]
    615 
    -    MO_Shl   w          -> [w, wordWidth platform]
    616 
    -    MO_U_Shr w          -> [w, wordWidth platform]
    617 
    -    MO_S_Shr w          -> [w, wordWidth platform]
    618 
    -
    619 
    -    MO_SS_Conv from _     -> [from]
    620 
    -    MO_UU_Conv from _     -> [from]
    621 
    -    MO_XX_Conv from _     -> [from]
    622 
    -    MO_SF_Round from _    -> [from]
    623 
    -    MO_FS_Truncate from _ -> [from]
    624 
    -    MO_FF_Conv from _     -> [from]
    625 
    -    MO_WF_Bitcast w       -> [w]
    626 
    -    MO_FW_Bitcast w       -> [w]
    627 
    -
    628 
    -    MO_V_Shuffle  l w _ -> [vecwidth l w, vecwidth l w]
    629 
    -    MO_VF_Shuffle l w _ -> [vecwidth l w, vecwidth l w]
    630 
    -
    631 
    -    MO_V_Broadcast _ w  -> [w]
    632 
    -    MO_V_Insert   l w   -> [vecwidth l w, w, W32]
    633 
    -    MO_V_Extract  l w   -> [vecwidth l w, W32]
    634 
    -    MO_VF_Broadcast _ w -> [w]
    635 
    -    MO_VF_Insert  l w   -> [vecwidth l w, w, W32]
    636 
    -    MO_VF_Extract l w   -> [vecwidth l w, W32]
    574 
    +    MO_Add    w         -> Just [w,w]
    575 
    +    MO_Sub    w         -> Just [w,w]
    576 
    +    MO_Eq     w         -> Just [w,w]
    577 
    +    MO_Ne     w         -> Just [w,w]
    578 
    +    MO_Mul    w         -> Just [w,w]
    579 
    +    MO_S_MulMayOflo w   -> Just [w,w]
    580 
    +    MO_S_Quot w         -> Just [w,w]
    581 
    +    MO_S_Rem  w         -> Just [w,w]
    582 
    +    MO_S_Neg  w         -> Just [w]
    583 
    +    MO_U_Quot w         -> Just [w,w]
    584 
    +    MO_U_Rem  w         -> Just [w,w]
    585 
    +
    586 
    +    MO_S_Ge w           -> Just [w,w]
    587 
    +    MO_S_Le w           -> Just [w,w]
    588 
    +    MO_S_Gt w           -> Just [w,w]
    589 
    +    MO_S_Lt w           -> Just [w,w]
    590 
    +
    591 
    +    MO_U_Ge w           -> Just [w,w]
    592 
    +    MO_U_Le w           -> Just [w,w]
    593 
    +    MO_U_Gt w           -> Just [w,w]
    594 
    +    MO_U_Lt w           -> Just [w,w]
    595 
    +
    596 
    +    MO_F_Add w          -> Just [w,w]
    597 
    +    MO_F_Sub w          -> Just [w,w]
    598 
    +    MO_F_Mul w          -> Just [w,w]
    599 
    +    MO_F_Quot w         -> Just [w,w]
    600 
    +    MO_F_Neg w          -> Just [w]
    601 
    +    MO_F_Min w          -> Just [w,w]
    602 
    +    MO_F_Max w          -> Just [w,w]
    603 
    +
    604 
    +    MO_FMA _ l w        -> Just [vecwidth l w, vecwidth l w, vecwidth l w]
    605 
    +
    606 
    +    MO_F_Eq  w          -> Just [w,w]
    607 
    +    MO_F_Ne  w          -> Just [w,w]
    608 
    +    MO_F_Ge  w          -> Just [w,w]
    609 
    +    MO_F_Le  w          -> Just [w,w]
    610 
    +    MO_F_Gt  w          -> Just [w,w]
    611 
    +    MO_F_Lt  w          -> Just [w,w]
    612 
    +
    613 
    +    MO_And   w          -> Just [w,w]
    614 
    +    MO_Or    w          -> Just [w,w]
    615 
    +    MO_Xor   w          -> Just [w,w]
    616 
    +    MO_Not   w          -> Just [w]
    617 
    +    MO_Shl   w          -> Just [w, wordWidth platform]
    618 
    +    MO_U_Shr w          -> Just [w, wordWidth platform]
    619 
    +    MO_S_Shr w          -> Just [w, wordWidth platform]
    620 
    +
    621 
    +    MO_SS_Conv from _     -> Just [from]
    622 
    +    MO_UU_Conv from _     -> Just [from]
    623 
    +    MO_XX_Conv from _     -> Just [from]
    624 
    +    -- Only supports W32/W64
    625 
    +    MO_SF_Round from _w   -> onlyW32W64 from
    626 
    +    MO_FS_Truncate from _ -> onlyW32W64 from
    627 
    +    MO_FF_Conv from _     -> onlyW32W64 from
    628 
    +    MO_WF_Bitcast w       -> onlyW32W64 w
    629 
    +    MO_FW_Bitcast w       -> onlyW32W64 w
    630 
    +
    631 
    +    MO_V_Shuffle  l w _ -> Just [vecwidth l w, vecwidth l w]
    632 
    +    MO_VF_Shuffle l w _ -> Just [vecwidth l w, vecwidth l w]
    633 
    +
    634 
    +    MO_V_Broadcast _ w  -> Just [w]
    635 
    +    MO_V_Insert   l w   -> Just [vecwidth l w, w, W32]
    636 
    +    MO_V_Extract  l w   -> Just [vecwidth l w, W32]
    637 
    +    MO_VF_Broadcast _ w -> Just [w]
    638 
    +    MO_VF_Insert  l w   -> Just [vecwidth l w, w, W32]
    639 
    +    MO_VF_Extract l w   -> Just [vecwidth l w, W32]
    637 640 
           -- SIMD vector indices are always 32 bit
    638 641
    639 
    -    MO_V_Add l w        -> [vecwidth l w, vecwidth l w]
    640 
    -    MO_V_Sub l w        -> [vecwidth l w, vecwidth l w]
    641 
    -    MO_V_Mul l w        -> [vecwidth l w, vecwidth l w]
    642 
    +    MO_V_Add l w        -> Just [vecwidth l w, vecwidth l w]
    643 
    +    MO_V_Sub l w        -> Just [vecwidth l w, vecwidth l w]
    644 
    +    MO_V_Mul l w        -> Just [vecwidth l w, vecwidth l w]
    642 645
    643 
    -    MO_VS_Neg  l w      -> [vecwidth l w]
    644 
    -    MO_VS_Abs  l w      -> [vecwidth l w]
    645 
    -    MO_VS_Min  l w      -> [vecwidth l w, vecwidth l w]
    646 
    -    MO_VS_Max  l w      -> [vecwidth l w, vecwidth l w]
    646 
    +    MO_VS_Neg  l w      -> Just [vecwidth l w]
    647 
    +    MO_VS_Abs  l w      -> Just [vecwidth l w]
    648 
    +    MO_VS_Min  l w      -> Just [vecwidth l w, vecwidth l w]
    649 
    +    MO_VS_Max  l w      -> Just [vecwidth l w, vecwidth l w]
    647 650
    648 
    -    MO_VU_Min  l w      -> [vecwidth l w, vecwidth l w]
    649 
    -    MO_VU_Max  l w      -> [vecwidth l w, vecwidth l w]
    651 
    +    MO_VU_Min  l w      -> Just [vecwidth l w, vecwidth l w]
    652 
    +    MO_VU_Max  l w      -> Just [vecwidth l w, vecwidth l w]
    650 653
    651 654 
         -- NOTE: The below is owing to the fact that floats use the SSE registers
    652 
    -    MO_VF_Add  l w      -> [vecwidth l w, vecwidth l w]
    653 
    -    MO_VF_Sub  l w      -> [vecwidth l w, vecwidth l w]
    654 
    -    MO_VF_Mul  l w      -> [vecwidth l w, vecwidth l w]
    655 
    -    MO_VF_Quot l w      -> [vecwidth l w, vecwidth l w]
    656 
    -    MO_VF_Neg  l w      -> [vecwidth l w]
    657 
    -    MO_VF_Abs  l w      -> [vecwidth l w]
    658 
    -    MO_VF_Sqrt l w      -> [vecwidth l w]
    659 
    -    MO_VF_Min  l w      -> [vecwidth l w, vecwidth l w]
    660 
    -    MO_VF_Max  l w      -> [vecwidth l w, vecwidth l w]
    661 
    -
    662 
    -    MO_V_And  l w       -> [vecwidth l w, vecwidth l w]
    663 
    -    MO_V_Or   l w       -> [vecwidth l w, vecwidth l w]
    664 
    -    MO_V_Xor  l w       -> [vecwidth l w, vecwidth l w]
    665 
    -    MO_VF_And l w       -> [vecwidth l w, vecwidth l w]
    666 
    -    MO_VF_Or  l w       -> [vecwidth l w, vecwidth l w]
    667 
    -    MO_VF_Xor l w       -> [vecwidth l w, vecwidth l w]
    668 
    -
    669 
    -    MO_RelaxedRead _    -> [wordWidth platform]
    670 
    -    MO_AlignmentCheck _ w -> [w]
    655 
    +    MO_VF_Add  l w      -> Just [vecwidth l w, vecwidth l w]
    656 
    +    MO_VF_Sub  l w      -> Just [vecwidth l w, vecwidth l w]
    657 
    +    MO_VF_Mul  l w      -> Just [vecwidth l w, vecwidth l w]
    658 
    +    MO_VF_Quot l w      -> Just [vecwidth l w, vecwidth l w]
    659 
    +    MO_VF_Neg  l w      -> Just [vecwidth l w]
    660 
    +    MO_VF_Abs  l w      -> Just [vecwidth l w]
    661 
    +    MO_VF_Sqrt l w      -> Just [vecwidth l w]
    662 
    +    MO_VF_Min  l w      -> Just [vecwidth l w, vecwidth l w]
    663 
    +    MO_VF_Max  l w      -> Just [vecwidth l w, vecwidth l w]
    664 
    +
    665 
    +    MO_V_And  l w       -> Just [vecwidth l w, vecwidth l w]
    666 
    +    MO_V_Or   l w       -> Just [vecwidth l w, vecwidth l w]
    667 
    +    MO_V_Xor  l w       -> Just [vecwidth l w, vecwidth l w]
    668 
    +    MO_VF_And l w       -> Just [vecwidth l w, vecwidth l w]
    669 
    +    MO_VF_Or  l w       -> Just [vecwidth l w, vecwidth l w]
    670 
    +    MO_VF_Xor l w       -> Just [vecwidth l w, vecwidth l w]
    671 
    +
    672 
    +    MO_RelaxedRead _    -> Just [wordWidth platform]
    673 
    +    MO_AlignmentCheck _ w -> Just [w]
    671 674 
       where
    672 675 
         vecwidth l w = widthFromBytes (l * widthInBytes w)
    676 
    +    onlyW32W64 w
    677 
    +      | w == W64 = Just [w]
    678 
    +      | w == W32 = Just [w]
    679 
    +      | otherwise = Nothing
    673 680
    674 681 
     -----------------------------------------------------------------------------
    675 682 
     -- CallishMachOp

  • testsuite/tests/codeGen/should_run/T27537.hs
    1 
    +{-# LANGUAGE MagicHash #-}
    2 
    +
    3 
    +import GHC.Exts
    4 
    +
    5 
    +{-# NOINLINE lt8 #-}
    6 
    +lt8 :: Int -> Word -> Int    -- ltWord8# 254 255: must be 1
    7 
    +lt8 (I# m) (W# n) = I# (ltWord8# (int8ToWord8# (intToInt8# m)) (wordToWord8# n))
    8 
    +
    9 
    +{-# NOINLINE eq8 #-}
    10 
    +eq8 :: Int -> Word -> Int    -- eqWord8# 254 254: must be 1
    11 
    +eq8 (I# m) (W# n) = I# (eqWord8# (int8ToWord8# (intToInt8# m)) (wordToWord8# n))
    12 
    +
    13 
    +{-# NOINLINE eqi16 #-}
    14 
    +eqi16 :: Int -> Int -> Int   -- eqInt16# (-2) (-2): must be 1
    15 
    +eqi16 (I# m) (I# n) = I# (eqInt16# (intToInt16# m) (word16ToInt16# (wordToWord16# (int2Word# n))))
    16 
    +
    17 
    +{-# NOINLINE rem8 #-}
    18 
    +rem8 :: Int -> Word -> Word  -- remWord8# 254 100: must be 54
    19 
    +rem8 (I# m) (W# n) = W# (word8ToWord# (remWord8# (int8ToWord8# (intToInt8# m)) (wordToWord8# n)))
    20 
    +
    21 
    +main :: IO ()
    22 
    +main = do
    23 
    +  print (lt8   (-2) 255)
    24 
    +  print (eq8   (-2) 254)
    25 
    +  print (eqi16 (-2) 65534)
    26 
    +  print (rem8  (-2) 100)

  • testsuite/tests/codeGen/should_run/T27537.stdout
    1 
    +1
    2 
    +1
    3 
    +1
    4 
    +54

  • testsuite/tests/codeGen/should_run/T27538.hs
    1 
    +{-# LANGUAGE MagicHash #-}
    2 
    +
    3 
    +import GHC.Exts
    4 
    +
    5 
    +{-# NOINLINE ix #-}
    6 
    +ix :: Int
    7 
    +ix = 0
    8 
    +
    9 
    +{-# NOINLINE f #-}
    10 
    +f :: Int8# -> Int#
    11 
    +f x = if isTrue# (x `ltInt8#` intToInt8# 0#)
    12 
    +        then (int8ToWord8# x) `gtWord8#` wordToWord8# 200##
    13 
    +        else 1#
    14 
    +
    15 
    +main :: IO ()
    16 
    +main = do
    17 
    +  let !(I# i) = ix
    18 
    +      x = indexInt8OffAddr# "\x80"# i
    19 
    +  putStrLn ("f(0x80) = " ++ show (I# (f x)))

  • testsuite/tests/codeGen/should_run/T27538.stdout
    1 
    +f(0x80) = 0

  • testsuite/tests/codeGen/should_run/all.T
    ... ... @@ -297,3 +297,7 @@ test('aarch64-sxtw-run',
    297 297 
          ['aarch64-sxtw-run', [('aarch64-sxtw-cmm.cmm', '')], '-O'])
    298 298
    299 299 
     test('T27430', [req_c, extra_ways(['optasm'])], compile_and_run, ['T27430_c.c'])
    300 
    +
    301 
    +test('T27537', normal, compile_and_run, ['-O'])
    302 
    +
    303 
    +test('T27538', normal, compile_and_run, ['-O'])

    • —
    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/-/compare/7fefaf5f34da5c723b8dce977710a582f80640a4...1523beef0d172548211894720063a32ffe8453bc at 1784980446