FFI for SPARC [was: FFI testers wanted]
Sven Panne <[email protected]>
| Newsgroups | gmane.comp.lang.haskell.hugs.bugs |
|---|---|
| Message-ID | <[email protected]> |
Using cut-n-paste from GHC's sources (esp. Adjustor.c) quite generously, I've hacked together the missing FFI parts for SPARC. Attached is a torture test, too, which is again based on GHC stuff (ffi009.hs). Cheers, S.
sparc_ffi.patch
(text/plain, 4.1 KB)
diff -r -u hugs98-ffi-09072002c.orig/src/builtin.c hugs98-ffi-09072002c/src/builtin.c
--- hugs98-ffi-09072002c.orig/src/builtin.c Tue Jul 9 13:05:26 2002
+++ hugs98-ffi-09072002c/src/builtin.c Tue Jul 23 13:04:30 2002
@@ -2239,6 +2239,8 @@
HugsStablePtr stable;
#if defined(__ppc__)
char code[13*4];
+#elif defined(__sparc__) && defined(__GNUC__)
+ char code[44];
#else
char code[16];
#endif
@@ -2324,6 +2326,65 @@
}
__asm__ volatile ("sync\n\tisync");
}
+ }
+#elif defined(__sparc__) && defined(__GNUC__)
+ /* Mostly cut-n-pasted from GHC's Adjustor.c:
+
+ <00>: 9C23A008 sub %sp, 8, %sp ! make room for %o4/%o5 in caller's frame
+ <04>: DA23A060 st %o5, [%sp + 96] ! shift registers by 2 positions
+ <08>: D823A05C st %o4, [%sp + 92]
+ <0C>: 9A10000B mov %o3, %o5
+ <10>: 9810000A mov %o2, %o4
+ <14>: 96100009 mov %o1, %o3
+ <18>: 94100008 mov %o0, %o2
+ <1C>: 13000000 sethi %hi(app), %o1 ! load up app (1 of 2)
+ <20>: 11000000 sethi %hi(s), %o0 ! load up s (1 of 2)
+ <24>: 81C26000 jmp %o1 + %lo(app) ! jump to app (load 2 of 2)
+ <28>: 90122000 or %o0, %lo(), %o0 ! load up s (2 of 2, delay slot)
+
+ ccall'ing on SPARC is easy, because we are quite lucky to push a
+ multiple of 8 bytes (1 word stable pointer + 1 word dummy arg) in front
+ of the existing arguments (note that %sp must stay double-word aligned at
+ all times, see ABI spec at http://www.sparc.org/standards/psABI3rd.pdf).
+ To do this, we extend the *caller's* stack frame by 2 words and shift
+ the output registers used for argument passing (%o0 - %o5, we are a
+ *leaf* procedure because of the tail-jump) by 2 positions. This makes
+ room in %o0 and %o1 for the additinal arguments, namely the stable
+ pointer and a dummy (used for destination addr of jump on SPARC). This
+ shouldn't cause any problems for a C-like caller: alloca is implemented
+ similarly, and local variables should be accessed via %fp, not %sp. In
+ a nutshell: This should work! (Famous last words! :-)
+ */
+ {
+ unsigned long *adj_code = (unsigned long *)pc;
+ adj_code[ 0] = 0x9C23A008UL; /* sub %sp, 8, %sp */
+ adj_code[ 1] = 0xDA23A060UL; /* st %o5, [%sp + 96] */
+ adj_code[ 2] = 0xD823A05CUL; /* st %o4, [%sp + 92] */
+ adj_code[ 3] = 0x9A10000BUL; /* mov %o3, %o5 */
+ adj_code[ 4] = 0x9810000AUL; /* mov %o2, %o4 */
+ adj_code[ 5] = 0x96100009UL; /* mov %o1, %o3 */
+ adj_code[ 6] = 0x94100008UL; /* mov %o0, %o2 */
+ adj_code[ 7] = 0x13000000UL; /* sethi %hi(app), %o1 */
+ adj_code[ 7] |= ((unsigned long)app) >> 10;
+ adj_code[ 8] = 0x11000000UL; /* sethi %hi(s), %o0 */
+ adj_code[ 8] |= ((unsigned long)s) >> 10;
+ adj_code[ 9] = 0x81C26000UL; /* jmp %o1 + %lo(app) */
+ adj_code[ 9] |= ((unsigned long)app) & 0x000003FFUL;
+ adj_code[10] = 0x90122000UL; /* or %o0, %lo(s), %o0 */
+ adj_code[10] |= ((unsigned long)s) & 0x000003FFUL;
+
+ /* flush cache */
+ asm("flush %0" : : "r" (adj_code ));
+ asm("flush %0" : : "r" (adj_code + 2));
+ asm("flush %0" : : "r" (adj_code + 4));
+ asm("flush %0" : : "r" (adj_code + 6));
+ asm("flush %0" : : "r" (adj_code + 10));
+
+ /* max. 5 instructions latency, and we need at >= 1 for returning */
+ asm("nop");
+ asm("nop");
+ asm("nop");
+ asm("nop");
}
#else
ERRMSG(0) "Foreign import wrapper is not supported on this architecture"
diff -r -u hugs98-ffi-09072002c.orig/src/ffi.c hugs98-ffi-09072002c/src/ffi.c
--- hugs98-ffi-09072002c.orig/src/ffi.c Sat Jul 6 12:52:00 2002
+++ hugs98-ffi-09072002c/src/ffi.c Tue Jul 23 11:54:05 2002
@@ -412,7 +412,13 @@
}
fprintf(out,"(");
if (extraArg) {
+#ifdef __sparc__
+ /* On SPARC we need an additional dummy argument due to stack alignment
+ restrictions, see the comment in mkThunk in builtin.c. */
+ fprintf(out,"HugsStablePtr fun1, void* unusedArg");
+#else
fprintf(out,"HugsStablePtr fun1");
+#endif
if (nonNull(argTys)) {
fprintf(out,", ");
}
ManyArgs.hs
(text/plain, 3.6 KB)
import Foreign
import Random
--------------------------------------------------------------------------------
foreign import ccall "dynamic" callFun5I :: FunPtr (Int -> Int -> Int -> Int -> Int -> Int) -> (Int -> Int -> Int -> Int -> Int -> Int)
foreign import ccall "wrapper" mkFun5I :: (Int -> Int -> Int -> Int -> Int -> Int) -> IO (FunPtr (Int -> Int -> Int -> Int -> Int -> Int))
manyArgs5I :: (Int -> Int -> Int -> Int -> Int -> Int)
manyArgs5I a1 a2 a3 a4 a5 = (((a1 * 31 + a2) * 31 + a3) * 31 + a4) * 31 + a5
test5I :: IO ()
test5I = do
a1 <- randomIO
a2 <- randomIO
a3 <- randomIO
a4 <- randomIO
a5 <- randomIO
funAddr <- mkFun5I manyArgs5I
print (callFun5I funAddr a1 a2 a3 a4 a5 ==
manyArgs5I a1 a2 a3 a4 a5)
freeHaskellFunPtr funAddr
--------------------------------------------------------------------------------
foreign import ccall "dynamic" callFun6D :: FunPtr (Double -> Double -> Double -> Double -> Double -> Double -> Double) -> (Double -> Double -> Double -> Double -> Double -> Double -> Double)
foreign import ccall "wrapper" mkFun6D :: (Double -> Double -> Double -> Double -> Double -> Double -> Double) -> IO (FunPtr (Double -> Double -> Double -> Double -> Double -> Double -> Double))
manyArgs6D :: Double -> Double -> Double -> Double -> Double -> Double -> Double
manyArgs6D a1 a2 a3 a4 a5 a6 =
((((a1 * 31 + a2) * 31 + a3) * 31 + a4) * 31 + a5) * 31 + a6
test6D :: IO ()
test6D = do
a1 <- randomIO
a2 <- randomIO
a3 <- randomIO
a4 <- randomIO
a5 <- randomIO
a6 <- randomIO
funAddr <- mkFun6D manyArgs6D
print (callFun6D funAddr a1 a2 a3 a4 a5 a6 ==
manyArgs6D a1 a2 a3 a4 a5 a6)
freeHaskellFunPtr funAddr
--------------------------------------------------------------------------------
foreign import ccall "dynamic" callFun11M :: FunPtr (Int -> Double -> Float -> Char -> Int -> Int -> Float -> Int -> Char -> Double -> Int -> Double) -> (Int -> Double -> Float -> Char -> Int -> Int -> Float -> Int -> Char -> Double -> Int -> Double)
foreign import ccall "wrapper" mkFun11M :: (Int -> Double -> Float -> Char -> Int -> Int -> Float -> Int -> Char -> Double -> Int -> Double) -> IO (FunPtr (Int -> Double -> Float -> Char -> Int -> Int -> Float -> Int -> Char -> Double -> Int -> Double))
manyArgs11M :: Int -> Double -> Float -> Char -> Int -> Int -> Float -> Int -> Char -> Double -> Int -> Double
manyArgs11M a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 =
(((((((((fromIntegral a1 * 31 + a2) * 31 +
realToFrac a3) * 31 + fromIntegral (fromEnum a4)) * 31 +
fromIntegral a5) * 31 + fromIntegral a6) * 31 +
realToFrac a7) * 31 + fromIntegral a8) * 31 +
fromIntegral (fromEnum a9)) * 31 + a10) * 31 +
fromIntegral a11
test11M :: IO ()
test11M = do
a1 <- randomIO
a2 <- randomIO
a3 <- randomIO
a4 <- randomIO
a5 <- randomIO
a6 <- randomIO
a7 <- randomIO
a8 <- randomIO
a9 <- randomIO
a10 <- randomIO
a11 <- randomIO
funAddr <- mkFun11M manyArgs11M
print (callFun11M funAddr a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 ==
manyArgs11M a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11)
freeHaskellFunPtr funAddr
--------------------------------------------------------------------------------
rep :: String -> IO () -> IO ()
rep msg tst = do
putStrLn ("Testing " ++ msg ++ "...")
sequence_ (replicate 10 tst)
main :: IO ()
main = do
setStdGen (mkStdGen 4711)
rep "5 Int arguments" test5I
rep "6 Double arguments" test6D
rep "11 mixed arguments" test11M