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. 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,", "); } 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