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

Commits:

2 changed files:

Changes:

  • testsuite/tests/codeGen/should_run/CCallConv.hs
    ... ... @@ -3,6 +3,7 @@
    3 3 
     {-# LANGUAGE MagicHash #-}
    4 4 
     {-# LANGUAGE UnboxedTuples #-}
    5 5 
     {-# LANGUAGE UnliftedFFITypes #-}
    6 
    +{-# LANGUAGE ExtendedLiterals #-}
    6 7
    7 8 
     -- | This test ensures that sub-word signed and unsigned parameters are correctly
    8 9 
     -- handed over to C functions. I.e. it asserts the calling-convention.
    ... ... @@ -59,6 +60,31 @@ foreign import ccall "fun32"
    59 60 
         Int32# -> -- s1
    60 61 
         Int64# -- result
    61 62
    63 
    +foreign import ccall "shrink32"
    64 
    +  shrink32 ::
    65 
    +    Int64# -> -- a0
    66 
    +    Int32# -- result
    67 
    +
    68 
    +foreign import ccall "shrink16"
    69 
    +  shrink16 ::
    70 
    +    Int64# -> -- a0
    71 
    +    Int16# -- result
    72 
    +
    73 
    +foreign import ccall "shrink8"
    74 
    +  shrink8 ::
    75 
    +    Int64# -> -- a0
    76 
    +    Int8# -- result
    77 
    +
    78 
    +foreign import ccall "shrink32_16"
    79 
    +  shrink32_16 ::
    80 
    +    Int32# -> -- a0
    81 
    +    Int16# -- result
    82 
    +
    83 
    +foreign import ccall "shrink32_8"
    84 
    +  shrink32_8 ::
    85 
    +    Int32# -> -- a0
    86 
    +    Int8# -- result
    87 
    +
    62 88 
     foreign import ccall "funFloat"
    63 89 
       funFloat ::
    64 90 
         Float# -> -- a0
    ... ... @@ -115,6 +141,42 @@ main = do
    115 141 
       hFlush stdout
    116 142 
       assertEqual expected_res32 (I64# res32)
    117 143
    144 
    +  -- Shrinking/zeroing of subword sizes
    145 
    +  let input :: Int64# = -1#Int64
    146 
    +      res32 :: Int32# = shrink32 input
    147 
    +      expected_res32 :: Int32 = fromIntegral (I64# input)
    148 
    +  print $ "fun32 result:" ++ show (I64# res32)
    149 
    +  hFlush stdout
    150 
    +  assertEqual expected_res32 (I64# res32)
    151 
    +
    152 
    +  let input :: Int64# = -1#Int64
    153 
    +      res16 :: Int16# = shrink16 input
    154 
    +      expected_res16 :: Int16 = fromIntegral (I64# input)
    155 
    +  print $ "shrink16 result:" ++ show (I16# res16)
    156 
    +  hFlush stdout
    157 
    +  assertEqual expected_res16 (I16# res16)
    158 
    +
    159 
    +  let input :: Int64# = -1#Int64
    160 
    +      res8 :: Int8# = shrink8 input
    161 
    +      expected_res8 :: Int8 = fromIntegral (I64# input)
    162 
    +  print $ "shrink8 result:" ++ show (I8# res8)
    163 
    +  hFlush stdout
    164 
    +  assertEqual expected_res8 (I8# res8)
    165 
    +
    166 
    +  let input32 :: Int32# = -1#Int32
    167 
    +      res16 :: Int16# = shrink32_16 input32
    168 
    +      expected_res16 :: Int16 = fromIntegral (I32# input32)
    169 
    +  print $ "shrink32_16 result:" ++ show (I16# res16)
    170 
    +  hFlush stdout
    171 
    +  assertEqual expected_res16 (I16# res16)
    172 
    +
    173 
    +  let input32 :: Int32# = -1#Int32
    174 
    +      res8 :: Int8# = shrink32_8 input32
    175 
    +      expected_res8 :: Int8 = fromIntegral (I32# input32)
    176 
    +  print $ "shrink32_8 result:" ++ show (I8# res8)
    177 
    +  hFlush stdout
    178 
    +  assertEqual expected_res8 (I8# res8)
    179 
    +
    118 180 
       let resFloat :: Float = F# (funFloat 1.0# 1.1# 1.2# 1.3# 1.4# 1.5# 1.6# 1.7# 1.8# 1.9#)
    119 181 
       print $ "funFloat result:" ++ show resFloat
    120 182 
       hFlush stdout

  • testsuite/tests/codeGen/should_run/CCallConv_c.c
    ... ... @@ -62,6 +62,51 @@ int64_t fun32(int32_t a0, uint32_t a1, int32_t a2, int32_t a3, int32_t a4,
    62 62 
              s1;
    63 63 
     }
    64 64
    65 
    +int32_t shrink32(int64_t a0) {
    66 
    +  printf("shrink32:\n");
    67 
    +  printf("a0: %#llx %lld\n", a0, a0);
    68 
    +
    69 
    +  fflush(stdout);
    70 
    +
    71 
    +  return a0;
    72 
    +}
    73 
    +
    74 
    +int16_t shrink16(int64_t a0) {
    75 
    +  printf("shrink16:\n");
    76 
    +  printf("a0: %#llx %lld\n", a0, a0);
    77 
    +
    78 
    +  fflush(stdout);
    79 
    +
    80 
    +  return a0;
    81 
    +}
    82 
    +
    83 
    +int8_t shrink8(int64_t a0) {
    84 
    +  printf("shrink8:\n");
    85 
    +  printf("a0: %#llx %lld\n", a0, a0);
    86 
    +
    87 
    +  fflush(stdout);
    88 
    +
    89 
    +  return a0;
    90 
    +}
    91 
    +
    92 
    +int16_t shrink32_16(int32_t a0) {
    93 
    +  printf("shrink32_16:\n");
    94 
    +  printf("a0: %#llx %lld\n", a0, a0);
    95 
    +
    96 
    +  fflush(stdout);
    97 
    +
    98 
    +  return a0;
    99 
    +}
    100 
    +
    101 
    +int8_t shrink32_8(int32_t a0) {
    102 
    +  printf("shrink32_8:\n");
    103 
    +  printf("a0: %#llx %lld\n", a0, a0);
    104 
    +
    105 
    +  fflush(stdout);
    106 
    +
    107 
    +  return a0;
    108 
    +}
    109 
    +
    65 110 
     float funFloat(float a0, float a1, float a2, float a3, float a4, float a5,
    66 111 
                  float a6, float a7, float s0, float s1) {
    67 112 
       printf("funFloat:\n");

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help