From 507f8de20b498258ec26d6b44731214e48bfa0a8 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Thu, 25 Feb 2021 14:01:29 +0900
Subject: [PATCH] Add a test for the calling convention of "foreign import
prim" on x86_64 and AArch64
---
.../tests/codeGen/should_run/CallConv.hs | 30 +++++++++++++++++++
.../tests/codeGen/should_run/CallConv.stdout | 8 +++++
.../codeGen/should_run/CallConv_aarch64.s | 25 ++++++++++++++++
.../codeGen/should_run/CallConv_x86_64.s | 27 +++++++++++++++++
testsuite/tests/codeGen/should_run/all.T | 6 ++++
5 files changed, 96 insertions(+)
create mode 100644 testsuite/tests/codeGen/should_run/CallConv.hs
create mode 100644 testsuite/tests/codeGen/should_run/CallConv.stdout
create mode 100644 testsuite/tests/codeGen/should_run/CallConv_aarch64.s
create mode 100644 testsuite/tests/codeGen/should_run/CallConv_x86_64.s
diff --git a/testsuite/tests/codeGen/should_run/CallConv.hs b/testsuite/tests/codeGen/should_run/CallConv.hs
new file mode 100644
index 000000000000..937e51ba09de
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/CallConv.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE MagicHash, GHCForeignImportPrim, UnboxedTuples, UnliftedFFITypes #-}
+import GHC.Exts
+
+foreign import prim "someFuncF"
+ someFuncF :: Float# -> Float# -> Float# -> Float# -> (# Float#, Float#, Float#, Float# #)
+
+foreign import prim "someFuncD"
+ someFuncD :: Double# -> Double# -> Double# -> Double# -> (# Double#, Double#, Double#, Double# #)
+
+{-
+someFuncF :: Float# -> Float# -> Float# -> Float# -> (# Float#, Float#, Float#, Float# #)
+someFuncF x y z w = (# x `plusFloat#` y, x `minusFloat#` y, z `timesFloat#` w, z `divideFloat#` w #)
+
+someFuncD :: Double# -> Double# -> Double# -> Double# -> (# Double#, Double#, Double#, Double# #)
+someFuncD x y z w = (# x +## y, x -## y, z *## w, z /## w #)
+-}
+
+main = do
+ case someFuncF 1.0# 3.0# 4.0# 2.0# of
+ (# a, b, c, d #) -> do
+ print (F# a)
+ print (F# b)
+ print (F# c)
+ print (F# d)
+ case someFuncD 1.0## 3.0## 4.0## 2.0## of
+ (# a, b, c, d #) -> do
+ print (D# a)
+ print (D# b)
+ print (D# c)
+ print (D# d)
diff --git a/testsuite/tests/codeGen/should_run/CallConv.stdout b/testsuite/tests/codeGen/should_run/CallConv.stdout
new file mode 100644
index 000000000000..23b7f8f2cf11
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/CallConv.stdout
@@ -0,0 +1,8 @@
+4.0
+-2.0
+8.0
+2.0
+4.0
+-2.0
+8.0
+2.0
diff --git a/testsuite/tests/codeGen/should_run/CallConv_aarch64.s b/testsuite/tests/codeGen/should_run/CallConv_aarch64.s
new file mode 100644
index 000000000000..ccff9cbe0473
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/CallConv_aarch64.s
@@ -0,0 +1,25 @@
+ .globl _someFuncF
+_someFuncF:
+ .globl someFuncF
+someFuncF:
+ fadd s16, s8, s9
+ fsub s9, s8, s9
+ fmov s8, s16
+ fmul s16, s10, s11
+ fdiv s11, s10, s11
+ fmov s10, s16
+ ldr x8, [x20]
+ blr x8
+
+ .globl _someFuncD
+_someFuncD:
+ .globl someFuncD
+someFuncD:
+ fadd d16, d12, d13
+ fsub d13, d12, d13
+ fmov d12, d16
+ fmul d16, d14, d15
+ fdiv d15, d14, d15
+ fmov d14, d16
+ ldr x8, [x20]
+ blr x8
diff --git a/testsuite/tests/codeGen/should_run/CallConv_x86_64.s b/testsuite/tests/codeGen/should_run/CallConv_x86_64.s
new file mode 100644
index 000000000000..e108724aa0cd
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/CallConv_x86_64.s
@@ -0,0 +1,27 @@
+ .globl _someFuncF
+_someFuncF:
+ .globl someFuncF
+someFuncF:
+ movss %xmm1,%xmm0
+ subss %xmm2,%xmm0
+ addss %xmm2,%xmm1
+ movss %xmm0,%xmm2
+ movss %xmm3,%xmm0
+ divss %xmm4,%xmm0
+ mulss %xmm4,%xmm3
+ movss %xmm0,%xmm4
+ jmp *(%rbp)
+
+ .globl _someFuncD
+_someFuncD:
+ .globl someFuncD
+someFuncD:
+ movsd %xmm1,%xmm0
+ subsd %xmm2,%xmm0
+ addsd %xmm2,%xmm1
+ movsd %xmm0,%xmm2
+ movsd %xmm3,%xmm0
+ divsd %xmm4,%xmm0
+ mulsd %xmm4,%xmm3
+ movsd %xmm0,%xmm4
+ jmp *(%rbp)
diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T
index 71c53b07ead3..b744ec97e9b6 100644
--- a/testsuite/tests/codeGen/should_run/all.T
+++ b/testsuite/tests/codeGen/should_run/all.T
@@ -210,3 +210,9 @@ test('T16846', [only_ways(['optasm']), exit_code(1)], compile_and_run, [''])
test('T17920', cmm_src, compile_and_run, [''])
test('T18527', normal, compile_and_run, ['T18527FFI.c'])
test('T19149', only_ways('sanity'), compile_and_run, ['T19149_c.c'])
+
+test('CallConv', [when(unregisterised(), skip),
+ unless(arch('x86_64') or arch('aarch64'), skip),
+ when(arch('x86_64'), extra_hc_opts('CallConv_x86_64.s')),
+ when(arch('aarch64'), extra_hc_opts('CallConv_aarch64.s'))],
+ compile_and_run, [''])
--
GitLab