Skip to content
Snippets Groups Projects
Commit 73b22ff1 authored by Ben Gamari's avatar Ben Gamari Committed by Marge Bot
Browse files

testsuite: Add test for #21465

parent be7102e5
No related branches found
No related tags found
No related merge requests found
{-# LANGUAGE ForeignFunctionInterface #-}
module Main where
foreign import ccall "test_c" testC :: IO ()
helper :: IO ()
helper = putStrLn "This is the helper function"
foreign export ccall helper :: IO ()
main :: IO ()
main = do
x <- testC
putStrLn "Done."
This is the helper function
Done.
0: 01 01
1: 02 02
2: 03 03
3: 04 04
4: 05 05
5: 06 06
6: 07 07
7: 08 08
8: 09 09
9: 0a 0a
10: 0b 0b
11: 0c 0c
12: 0d 0d
13: 0e 0e
14: 0f 0f
15: 10 10
#include <stdio.h>
// Haskell function
extern void helper();
void test_c() {
unsigned char blah[16] = {0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08, 0x09, 0x0A, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F, 0x10};
unsigned char foo[16] = {0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
// Copy blah into xmm6
asm (
"movups %[blah], %%xmm6"
:
: [blah] "m" (blah)
: "xmm6"
);
// Call to Haskell
helper();
// Copy xmm6 to foo
asm (
"movups %%xmm6, %[foo]"
: [foo] "=m" (foo)
:
: "xmm6"
);
for (int i = 0; i < 16; i++) {
printf("%2i: %02x %02x\n", i, blah[i], foo[i]);
}
}
# Check that the full width of callee-saved XMM registers are preserved across
# calls into Haskell on Windows.
test('T21465', unless(opsys('mingw32') and arch('x86_64'), skip), compile_and_run, ['T21465_c.c'])
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment