Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/28670dd735ede9e0ee6e7e930883c6282f913af9 >--------------------------------------------------------------- commit 28670dd735ede9e0ee6e7e930883c6282f913af9 Author: Ian Lynagh <[email protected]> Date: Wed May 16 15:31:41 2012 +0100 Don't use stdcall on Win64: It isn't supported; ccall is used instead >--------------------------------------------------------------- GHC/Conc/Windows.hs | 12 +++++++++++- GHC/Environment.hs | 14 +++++++++++--- GHC/IO/Encoding/CodePage.hs | 14 ++++++++++++-- GHC/IO/FD.hs | 16 +++++++++++++--- System/CPUTime.hsc | 15 +++++++++++++-- System/Environment.hs | 18 ++++++++++++++---- 6 files changed, 74 insertions(+), 15 deletions(-) diff --git a/GHC/Conc/Windows.hs b/GHC/Conc/Windows.hs index 764e39e..0170b06 100644 --- a/GHC/Conc/Windows.hs +++ b/GHC/Conc/Windows.hs @@ -57,6 +57,16 @@ import GHC.Show (Show) import GHC.Word (Word32, Word64) import GHC.Windows +#ifdef mingw32_HOST_OS +# if defined(i386_HOST_ARCH) +# define WINDOWS_CCONV stdcall +# elif defined(x86_64_HOST_ARCH) +# define WINDOWS_CCONV ccall +# else +# error Unknown mingw32 arch +# endif +#endif + -- ---------------------------------------------------------------------------- -- Thread waiting @@ -326,6 +336,6 @@ foreign import ccall unsafe "readIOManagerEvent" -- in the RTS (ThrIOManager.c) foreign import ccall unsafe "sendIOManagerEvent" -- in the RTS (ThrIOManager.c) c_sendIOManagerEvent :: Word32 -> IO () -foreign import stdcall "WaitForSingleObject" +foreign import WINDOWS_CCONV "WaitForSingleObject" c_WaitForSingleObject :: HANDLE -> DWORD -> IO DWORD diff --git a/GHC/Environment.hs b/GHC/Environment.hs index 3f15161..f5d9e28 100644 --- a/GHC/Environment.hs +++ b/GHC/Environment.hs @@ -11,6 +11,14 @@ import Foreign.C import GHC.IO (finally) import GHC.Windows +# if defined(i386_HOST_ARCH) +# define WINDOWS_CCONV stdcall +# elif defined(x86_64_HOST_ARCH) +# define WINDOWS_CCONV ccall +# else +# error Unknown mingw32 arch +# endif + -- Ignore the arguments to hs_init on Windows for the sake of Unicode compat getFullArgs :: IO [String] getFullArgs = do @@ -24,13 +32,13 @@ getFullArgs = do p_argvs <- peekArray (fromIntegral argc) p_argv mapM peekCWString p_argvs -foreign import stdcall unsafe "windows.h GetCommandLineW" +foreign import WINDOWS_CCONV unsafe "windows.h GetCommandLineW" c_GetCommandLine :: IO (Ptr CWString) -foreign import stdcall unsafe "windows.h CommandLineToArgvW" +foreign import WINDOWS_CCONV unsafe "windows.h CommandLineToArgvW" c_CommandLineToArgv :: Ptr CWString -> Ptr CInt -> IO (Ptr CWString) -foreign import stdcall unsafe "Windows.h LocalFree" +foreign import WINDOWS_CCONV unsafe "Windows.h LocalFree" c_LocalFree :: Ptr a -> IO (Ptr a) #else import Control.Monad diff --git a/GHC/IO/Encoding/CodePage.hs b/GHC/IO/Encoding/CodePage.hs index 0af89d7..039f720 100644 --- a/GHC/IO/Encoding/CodePage.hs +++ b/GHC/IO/Encoding/CodePage.hs @@ -30,6 +30,16 @@ import GHC.IO.Encoding.UTF8 (mkUTF8) import GHC.IO.Encoding.UTF16 (mkUTF16le, mkUTF16be) import GHC.IO.Encoding.UTF32 (mkUTF32le, mkUTF32be) +#ifdef mingw32_HOST_OS +# if defined(i386_HOST_ARCH) +# define WINDOWS_CCONV stdcall +# elif defined(x86_64_HOST_ARCH) +# define WINDOWS_CCONV ccall +# else +# error Unknown mingw32 arch +# endif +#endif + -- note CodePage = UInt which might not work on Win64. But the Win32 package -- also has this issue. getCurrentCodePage :: IO Word32 @@ -40,10 +50,10 @@ getCurrentCodePage = do else getACP -- Since the Win32 package depends on base, we have to import these ourselves: -foreign import stdcall unsafe "windows.h GetConsoleCP" +foreign import WINDOWS_CCONV unsafe "windows.h GetConsoleCP" getConsoleCP :: IO Word32 -foreign import stdcall unsafe "windows.h GetACP" +foreign import WINDOWS_CCONV unsafe "windows.h GetACP" getACP :: IO Word32 {-# NOINLINE currentCodePage #-} diff --git a/GHC/IO/FD.hs b/GHC/IO/FD.hs index f9df794..1b47ee9 100644 --- a/GHC/IO/FD.hs +++ b/GHC/IO/FD.hs @@ -58,6 +58,16 @@ import qualified System.Posix.Internals import System.Posix.Internals hiding (FD, setEcho, getEcho) import System.Posix.Types +#ifdef mingw32_HOST_OS +# if defined(i386_HOST_ARCH) +# define WINDOWS_CCONV stdcall +# elif defined(x86_64_HOST_ARCH) +# define WINDOWS_CCONV ccall +# else +# error Unknown mingw32 arch +# endif +#endif + c_DEBUG_DUMP :: Bool c_DEBUG_DUMP = False @@ -321,7 +331,7 @@ release fd = do _ <- unlockFile (fdFD fd) return () #ifdef mingw32_HOST_OS -foreign import stdcall unsafe "HsBase.h closesocket" +foreign import WINDOWS_CCONV unsafe "HsBase.h closesocket" c_closesocket :: CInt -> IO CInt #endif @@ -620,10 +630,10 @@ blockingWriteRawBufferPtr loc fd buf off len -- NOTE: "safe" versions of the read/write calls for use by the threaded RTS. -- These calls may block, but that's ok. -foreign import stdcall safe "recv" +foreign import WINDOWS_CCONV safe "recv" c_safe_recv :: CInt -> Ptr Word8 -> CSize -> CInt{-flags-} -> IO CSsize -foreign import stdcall safe "send" +foreign import WINDOWS_CCONV safe "send" c_safe_send :: CInt -> Ptr Word8 -> CSize -> CInt{-flags-} -> IO CSsize #endif diff --git a/System/CPUTime.hsc b/System/CPUTime.hsc index 385e0fb..8934a7e 100644 --- a/System/CPUTime.hsc +++ b/System/CPUTime.hsc @@ -72,6 +72,17 @@ import System.IO.Unsafe (unsafePerformIO) #endif +##ifdef mingw32_HOST_OS +## if defined(i386_HOST_ARCH) +## define WINDOWS_CCONV stdcall +## elif defined(x86_64_HOST_ARCH) +## define WINDOWS_CCONV ccall +## else +## error Unknown mingw32 arch +## endif +##else +##endif + #if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) realToInteger :: Real a => a -> Integer realToInteger ct = round (realToFrac ct :: Double) @@ -158,8 +169,8 @@ foreign import ccall unsafe times :: Ptr CTms -> IO CClock type FILETIME = () type HANDLE = () -- need proper Haskell names (initial lower-case character) -foreign import stdcall unsafe "GetCurrentProcess" getCurrentProcess :: IO (Ptr HANDLE) -foreign import stdcall unsafe "GetProcessTimes" getProcessTimes :: Ptr HANDLE -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> IO CInt +foreign import WINDOWS_CCONV unsafe "GetCurrentProcess" getCurrentProcess :: IO (Ptr HANDLE) +foreign import WINDOWS_CCONV unsafe "GetProcessTimes" getProcessTimes :: Ptr HANDLE -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> IO CInt #endif /* not _WIN32 */ #endif /* __GLASGOW_HASKELL__ */ diff --git a/System/Environment.hs b/System/Environment.hs index 859f4a1..7be95ad 100644 --- a/System/Environment.hs +++ b/System/Environment.hs @@ -61,6 +61,16 @@ import System ) #endif +#ifdef mingw32_HOST_OS +# if defined(i386_HOST_ARCH) +# define WINDOWS_CCONV stdcall +# elif defined(x86_64_HOST_ARCH) +# define WINDOWS_CCONV ccall +# else +# error Unknown mingw32 arch +# endif +#endif + #ifdef __GLASGOW_HASKELL__ -- --------------------------------------------------------------------------- -- getArgs, getProgName, getEnv @@ -202,7 +212,7 @@ getEnv name = lookupEnv name >>= maybe handleError return eRROR_ENVVAR_NOT_FOUND :: DWORD eRROR_ENVVAR_NOT_FOUND = 203 -foreign import stdcall unsafe "windows.h GetLastError" +foreign import WINDOWS_CCONV unsafe "windows.h GetLastError" c_GetLastError:: IO DWORD #else @@ -224,7 +234,7 @@ lookupEnv name = withCWString name $ \s -> try_size s 256 _ | res > size -> try_size s res -- Rare: size increased between calls to GetEnvironmentVariable | otherwise -> peekCWString p_value >>= return . Just -foreign import stdcall unsafe "windows.h GetEnvironmentVariableW" +foreign import WINDOWS_CCONV unsafe "windows.h GetEnvironmentVariableW" c_GetEnvironmentVariable :: LPTSTR -> LPTSTR -> DWORD -> IO DWORD #else lookupEnv name = @@ -335,10 +345,10 @@ getEnvironment = bracket c_GetEnvironmentStrings c_FreeEnvironmentStrings $ \pBl c <- peek pBlock' seekNull pBlock' (c == (0 :: Word8 )) -foreign import stdcall unsafe "windows.h GetEnvironmentStringsW" +foreign import WINDOWS_CCONV unsafe "windows.h GetEnvironmentStringsW" c_GetEnvironmentStrings :: IO (Ptr CWchar) -foreign import stdcall unsafe "windows.h FreeEnvironmentStringsW" +foreign import WINDOWS_CCONV unsafe "windows.h FreeEnvironmentStringsW" c_FreeEnvironmentStrings :: Ptr CWchar -> IO Bool #else getEnvironment = do _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
