Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/2cecdca7ed27a64dcf05cc4bd2187d96397bb055 >--------------------------------------------------------------- commit 2cecdca7ed27a64dcf05cc4bd2187d96397bb055 Author: Simon Marlow <[email protected]> Date: Wed Jun 29 11:51:02 2011 +0100 add a test for stack pointer alignment (see #5250) >--------------------------------------------------------------- tests/ghc-regress/rts/5250.hs | 60 +++++++++++++++++++++++++++++++++++++++ tests/ghc-regress/rts/all.T | 10 ++++++ tests/ghc-regress/rts/spalign.c | 30 +++++++++++++++++++ 3 files changed, 100 insertions(+), 0 deletions(-) diff --git a/tests/ghc-regress/rts/5250.hs b/tests/ghc-regress/rts/5250.hs new file mode 100644 index 0000000..f10c2e7 --- /dev/null +++ b/tests/ghc-regress/rts/5250.hs @@ -0,0 +1,60 @@ +module Main where + +import Foreign +import Foreign.C +import Text.Printf +import System.Exit +import Control.Monad + +foreign import ccall "getesp" getesp :: IO CInt + +main = do + checkSpAlignment + wrap checkSpAlignment >>= run + wrap1 args1 >>= \f -> run1 f 3 + wrap2 args2 >>= \f -> run2 f 3 4 + wrap3 args3 >>= \f -> run3 f 3 4 5 + wrap4 args4 >>= \f -> run4 f 3 4 5 6 + +foreign import ccall "wrapper" wrap :: IO () -> IO (FunPtr (IO ())) +foreign import ccall "dynamic" run :: FunPtr (IO ()) -> IO () + +type Args1 = Int -> IO () + +foreign import ccall "wrapper" wrap1 :: Args1 -> IO (FunPtr Args1) +foreign import ccall "dynamic" run1 :: FunPtr Args1 -> Args1 + +args1 :: Args1 +args1 _ = checkSpAlignment + +type Args2 = Int -> Int -> IO () + +foreign import ccall "wrapper" wrap2 :: Args2 -> IO (FunPtr Args2) +foreign import ccall "dynamic" run2 :: FunPtr Args2 -> Args2 + +args2 :: Args2 +args2 _ _ = checkSpAlignment + +type Args3 = Int -> Int -> Int -> IO () + +foreign import ccall "wrapper" wrap3 :: Args3 -> IO (FunPtr Args3) +foreign import ccall "dynamic" run3 :: FunPtr Args3 -> Args3 + +args3 :: Args3 +args3 _ _ _ = checkSpAlignment + +type Args4 = Int -> Int -> Int -> Int -> IO () + +foreign import ccall "wrapper" wrap4 :: Args4 -> IO (FunPtr Args4) +foreign import ccall "dynamic" run4 :: FunPtr Args4 -> Args4 + +args4 :: Args4 +args4 _ _ _ _ = checkSpAlignment + +checkSpAlignment :: IO () +checkSpAlignment = do + esp <- getesp + when (((esp + fromIntegral (sizeOf (undefined :: Ptr ()))) .&. 15) /= 0) $ do + printf "esp not aligned correctly: %x\n" (fromIntegral esp :: Word32) + exitWith (ExitFailure 1) + diff --git a/tests/ghc-regress/rts/all.T b/tests/ghc-regress/rts/all.T index a008e3b..172c295 100644 --- a/tests/ghc-regress/rts/all.T +++ b/tests/ghc-regress/rts/all.T @@ -105,3 +105,13 @@ test('return_mem_to_os', normal, compile_and_run, ['']) test('4850', extra_clean(['4850.o','4850.hi','4850']), run_command, ['$MAKE -s --no-print-directory 4850']) + +def config_5250(opts): + if not (config.arch in ['i386','x86_64']): + opts.skip = 1; + +test('5250', [ config_5250, + extra_clean(['spalign.o']), + omit_ways(['ghci']) ], + compile_and_run, ['spalign.c']) + diff --git a/tests/ghc-regress/rts/spalign.c b/tests/ghc-regress/rts/spalign.c new file mode 100644 index 0000000..0b776e1 --- /dev/null +++ b/tests/ghc-regress/rts/spalign.c @@ -0,0 +1,30 @@ +#include "Rts.h" + +#ifdef darwin_HOST_OS +#define STG_GLOBAL ".globl " +#else +#define STG_GLOBAL ".global " +#endif + +#ifdef LEADING_UNDERSCORE +#define GETESP "_getesp" +#else +#define GETESP "getesp" +#endif + +void __dummy__(void) +{ + __asm__ volatile ( + STG_GLOBAL GETESP "\n" + GETESP ":\n\t" + +#if defined(i386_HOST_ARCH) + "movl %%esp, %%eax\n\t" +#elif defined(x86_64_HOST_ARCH) + "movq %%rsp, %%rax\n\t" +#else +#error splign.c: not implemented for this architecture +#endif + "ret" + : : ); +} _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
