[Git][ghc/ghc][wip/supersven/ghc-master-riscv-ncg] Add test for C calling convention
Sven Tennie (@supersven)
gitlab at gitlab.haskell.org
Tue Sep 10 17:00:27 UTC 2024
Sven Tennie pushed to branch wip/supersven/ghc-master-riscv-ncg at Glasgow Haskell Compiler / GHC
Commits:
eab0e738 by Sven Tennie at 2024-09-10T18:58:12+02:00
Add test for C calling convention
Ensure that parameters and return values are correctly processed. A
dedicated test (like this) helps to get the subtleties of calling
conventions easily right.
The test is failing for WASM32 and marked as fragile to not forget to
investigate this (#25249).
- - - - -
4 changed files:
- + testsuite/tests/codeGen/should_run/CCallConv.hs
- + testsuite/tests/codeGen/should_run/CCallConv.stdout
- + testsuite/tests/codeGen/should_run/CCallConv_c.c
- testsuite/tests/codeGen/should_run/all.T
Changes:
=====================================
testsuite/tests/codeGen/should_run/CCallConv.hs
=====================================
@@ -0,0 +1,132 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE GHCForeignImportPrim #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+
+-- | This test ensures that sub-word signed and unsigned parameters are correctly
+-- handed over to C functions. I.e. it asserts the calling-convention.
+--
+-- The number of parameters is currently shaped for the RISCV64 calling-convention.
+-- You may need to add more parameters to the C functions in case there are more
+-- registers reserved for parameters in your architecture.
+module Main where
+
+import Data.Word
+import GHC.Exts
+import GHC.Int
+import System.IO
+
+foreign import ccall "fun8"
+ fun8 ::
+ Int8# -> -- a0
+ Word8# -> -- a1
+ Int8# -> -- a2
+ Int8# -> -- a3
+ Int8# -> -- a4
+ Int8# -> -- a5
+ Int8# -> -- a6
+ Int8# -> -- a7
+ Word8# -> -- s0
+ Int8# -> -- s1
+ Int64# -- result
+
+foreign import ccall "fun16"
+ fun16 ::
+ Int16# -> -- a0
+ Word16# -> -- a1
+ Int16# -> -- a2
+ Int16# -> -- a3
+ Int16# -> -- a4
+ Int16# -> -- a5
+ Int16# -> -- a6
+ Int16# -> -- a7
+ Word16# -> -- s0
+ Int16# -> -- s1
+ Int64# -- result
+
+foreign import ccall "fun32"
+ fun32 ::
+ Int32# -> -- a0
+ Word32# -> -- a1
+ Int32# -> -- a2
+ Int32# -> -- a3
+ Int32# -> -- a4
+ Int32# -> -- a5
+ Int32# -> -- a6
+ Int32# -> -- a7
+ Word32# -> -- s0
+ Int32# -> -- s1
+ Int64# -- result
+
+foreign import ccall "funFloat"
+ funFloat ::
+ Float# -> -- a0
+ Float# -> -- a1
+ Float# -> -- a2
+ Float# -> -- a3
+ Float# -> -- a4
+ Float# -> -- a5
+ Float# -> -- a6
+ Float# -> -- a7
+ Float# -> -- s0
+ Float# -> -- s1
+ Float# -- result
+
+foreign import ccall "funDouble"
+ funDouble ::
+ Double# -> -- a0
+ Double# -> -- a1
+ Double# -> -- a2
+ Double# -> -- a3
+ Double# -> -- a4
+ Double# -> -- a5
+ Double# -> -- a6
+ Double# -> -- a7
+ Double# -> -- s0
+ Double# -> -- s1
+ Double# -- result
+
+main :: IO ()
+main = do
+ -- N.B. the values here aren't choosen by accident: -1 means all bits one in
+ -- twos-complement, which is the same as the max word value.
+ let i8 :: Int8# = intToInt8# (-1#)
+ w8 :: Word8# = wordToWord8# (255##)
+ res8 :: Int64# = fun8 i8 w8 i8 i8 i8 i8 i8 i8 w8 i8
+ expected_res8 :: Int64 = 2 * (fromInteger . fromIntegral) (maxBound :: Word8) + 8 * (-1)
+ print $ "fun8 result:" ++ show (I64# res8)
+ hFlush stdout
+ assertEqual expected_res8 (I64# res8)
+
+ let i16 :: Int16# = intToInt16# (-1#)
+ w16 :: Word16# = wordToWord16# (65535##)
+ res16 :: Int64# = fun16 i16 w16 i16 i16 i16 i16 i16 i16 w16 i16
+ expected_res16 :: Int64 = 2 * (fromInteger . fromIntegral) (maxBound :: Word16) + 8 * (-1)
+ print $ "fun16 result:" ++ show (I64# res16)
+ hFlush stdout
+ assertEqual expected_res16 (I64# res16)
+
+ let i32 :: Int32# = intToInt32# (-1#)
+ w32 :: Word32# = wordToWord32# (4294967295##)
+ res32 :: Int64# = fun32 i32 w32 i32 i32 i32 i32 i32 i32 w32 i32
+ expected_res32 :: Int64 = 2 * (fromInteger . fromIntegral) (maxBound :: Word32) + 8 * (-1)
+ print $ "fun32 result:" ++ show (I64# res32)
+ hFlush stdout
+ assertEqual expected_res32 (I64# res32)
+
+ 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#)
+ print $ "funFloat result:" ++ show resFloat
+ hFlush stdout
+ assertEqual (14.5 :: Float) resFloat
+
+ let resDouble :: Double = D# (funDouble 1.0## 1.1## 1.2## 1.3## 1.4## 1.5## 1.6## 1.7## 1.8## 1.9##)
+ print $ "funDouble result:" ++ show resDouble
+ hFlush stdout
+ assertEqual (14.5 :: Double) resDouble
+
+assertEqual :: (Eq a, Show a) => a -> a -> IO ()
+assertEqual a b =
+ if a == b
+ then pure ()
+ else error $ show a ++ " =/= " ++ show b
=====================================
testsuite/tests/codeGen/should_run/CCallConv.stdout
=====================================
@@ -0,0 +1,60 @@
+fun8:
+a0: 0xffffffff -1
+a1: 0xff 255
+a2: 0xffffffff -1
+a3: 0xffffffff -1
+a4: 0xffffffff -1
+a5: 0xffffffff -1
+a6: 0xffffffff -1
+a7: 0xffffffff -1
+s0: 0xffffffff -1
+s1: 0xff 255
+"fun8 result:502"
+fun16:
+a0: 0xffffffff -1
+a1: 0xffff 65535
+a2: 0xffffffff -1
+a3: 0xffffffff -1
+a4: 0xffffffff -1
+a5: 0xffffffff -1
+a6: 0xffffffff -1
+a7: 0xffffffff -1
+s0: 0xffffffff -1
+s1: 0xffff 65535
+"fun16 result:131062"
+fun32:
+a0: 0xffffffff -1
+a1: 0xffffffff 4294967295
+a2: 0xffffffff -1
+a3: 0xffffffff -1
+a4: 0xffffffff -1
+a5: 0xffffffff -1
+a6: 0xffffffff -1
+a7: 0xffffffff -1
+s0: 0xffffffff -1
+s1: 0xffffffff 4294967295
+"fun32 result:8589934582"
+funFloat:
+a0: 1.000000
+a1: 1.100000
+a2: 1.200000
+a3: 1.300000
+a4: 1.400000
+a5: 1.500000
+a6: 1.600000
+a7: 1.700000
+s0: 1.800000
+s1: 1.900000
+"funFloat result:14.5"
+funDouble:
+a0: 1.000000
+a1: 1.100000
+a2: 1.200000
+a3: 1.300000
+a4: 1.400000
+a5: 1.500000
+a6: 1.600000
+a7: 1.700000
+s0: 1.800000
+s1: 1.900000
+"funDouble result:14.5"
=====================================
testsuite/tests/codeGen/should_run/CCallConv_c.c
=====================================
@@ -0,0 +1,101 @@
+#include <stdint.h>
+#include <stdio.h>
+
+int64_t fun8(int8_t a0, uint8_t a1, int8_t a2, int8_t a3, int8_t a4, int8_t a5,
+ int8_t a6, int8_t a7, int8_t s0, uint8_t s1) {
+ printf("fun8:\n");
+ printf("a0: %#x %hhd\n", a0, a0);
+ printf("a1: %#x %hhu\n", a1, a1);
+ printf("a2: %#x %hhd\n", a2, a2);
+ printf("a3: %#x %hhd\n", a3, a3);
+ printf("a4: %#x %hhd\n", a4, a4);
+ printf("a5: %#x %hhd\n", a5, a5);
+ printf("a6: %#x %hhd\n", a6, a6);
+ printf("a7: %#x %hhd\n", a7, a7);
+ printf("s0: %#x %hhd\n", s0, s0);
+ printf("s1: %#x %hhu\n", s1, s1);
+
+ fflush(stdout);
+
+ return a0 + a1 + a2 + a3 + a4 + a5 + a6 + a7 + s0 + s1;
+}
+
+int64_t fun16(int16_t a0, uint16_t a1, int16_t a2, int16_t a3, int16_t a4,
+ int16_t a5, int16_t a6, int16_t a7, int16_t s0, uint16_t s1) {
+ printf("fun16:\n");
+ printf("a0: %#x %hd\n", a0, a0);
+ printf("a1: %#x %hu\n", a1, a1);
+ printf("a2: %#x %hd\n", a2, a2);
+ printf("a3: %#x %hd\n", a3, a3);
+ printf("a4: %#x %hd\n", a4, a4);
+ printf("a5: %#x %hd\n", a5, a5);
+ printf("a6: %#x %hd\n", a6, a6);
+ printf("a7: %#x %hd\n", a7, a7);
+ printf("s0: %#x %hd\n", s0, s0);
+ printf("s1: %#x %hu\n", s1, s1);
+
+ fflush(stdout);
+
+ return a0 + a1 + a2 + a3 + a4 + a5 + a6 + a7 + s0 + s1;
+}
+
+int64_t fun32(int32_t a0, uint32_t a1, int32_t a2, int32_t a3, int32_t a4,
+ int32_t a5, int32_t a6, int32_t a7, int32_t s0, uint32_t s1) {
+ printf("fun32:\n");
+ printf("a0: %#x %d\n", a0, a0);
+ printf("a1: %#x %u\n", a1, a1);
+ printf("a2: %#x %d\n", a2, a2);
+ printf("a3: %#x %d\n", a3, a3);
+ printf("a4: %#x %d\n", a4, a4);
+ printf("a5: %#x %d\n", a5, a5);
+ printf("a6: %#x %d\n", a6, a6);
+ printf("a7: %#x %d\n", a7, a7);
+ printf("s0: %#x %d\n", s0, s0);
+ printf("s1: %#x %u\n", s1, s1);
+
+ fflush(stdout);
+
+ // Ensure the addition happens in long int (not just int) precission.
+ // Otherwise, the result is truncated during the operation.
+ int64_t force_int64_precission = 0;
+ return force_int64_precission + a0 + a1 + a2 + a3 + a4 + a5 + a6 + a7 + s0 +
+ s1;
+}
+
+float funFloat(float a0, float a1, float a2, float a3, float a4, float a5,
+ float a6, float a7, float s0, float s1) {
+ printf("funFloat:\n");
+ printf("a0: %f\n", a0);
+ printf("a1: %f\n", a1);
+ printf("a2: %f\n", a2);
+ printf("a3: %f\n", a3);
+ printf("a4: %f\n", a4);
+ printf("a5: %f\n", a5);
+ printf("a6: %f\n", a6);
+ printf("a7: %f\n", a7);
+ printf("s0: %f\n", s0);
+ printf("s1: %f\n", s1);
+
+ fflush(stdout);
+
+ return a0 + a1 + a2 + a3 + a4 + a5 + a6 + a7 + s0 + s1;
+}
+
+double funDouble(double a0, double a1, double a2, double a3, double a4, double a5,
+ double a6, double a7, double s0, double s1) {
+ printf("funDouble:\n");
+ printf("a0: %f\n", a0);
+ printf("a1: %f\n", a1);
+ printf("a2: %f\n", a2);
+ printf("a3: %f\n", a3);
+ printf("a4: %f\n", a4);
+ printf("a5: %f\n", a5);
+ printf("a6: %f\n", a6);
+ printf("a7: %f\n", a7);
+ printf("s0: %f\n", s0);
+ printf("s1: %f\n", s1);
+
+ fflush(stdout);
+
+ return a0 + a1 + a2 + a3 + a4 + a5 + a6 + a7 + s0 + s1;
+}
=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -250,3 +250,5 @@ test('CtzClz0', normal, compile_and_run, [''])
test('T23034', req_c, compile_and_run, ['-O2 T23034_c.c'])
test('T24700', normal, compile_and_run, ['-O'])
test('T24893', normal, compile_and_run, ['-O'])
+
+test('CCallConv', [req_c, when(arch('wasm32'), fragile(25249))], compile_and_run, ['CCallConv_c.c'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eab0e738eb8f4a69b0299455e3336a579f4a7e98
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eab0e738eb8f4a69b0299455e3336a579f4a7e98
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240910/70298ac2/attachment-0001.html>
More information about the ghc-commits
mailing list