[commit: base] master: Don't use stdcall on Win64: It isn't supported; ccall is used instead (28670dd)
Ian Lynagh
igloo at earth.li
Thu May 17 04:39:49 CEST 2012
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 <igloo at earth.li>
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
More information about the Cvs-libraries
mailing list