Repository : ssh://darcs.haskell.org//srv/darcs/packages/haskeline On branch : master
http://hackage.haskell.org/trac/ghc/changeset/4e2792f9106cd2b7c058f110afc65ace96a370fe >--------------------------------------------------------------- commit 4e2792f9106cd2b7c058f110afc65ace96a370fe Author: Judah Jacobson <[email protected]> Date: Wed May 16 19:17:42 2012 +0000 Change foreign imports to use ccall for Win64. This prevents warnings about the stdcall calling convention on Win64. This patch was submitted by Ian Lynagh. >--------------------------------------------------------------- System/Console/Haskeline/Backend/Win32.hsc | 23 ++++++++++++----------- System/Console/Haskeline/Directory.hsc | 11 ++++++----- haskeline.cabal | 4 ++-- includes/windows_cconv.h | 11 +++++++++++ 4 files changed, 31 insertions(+), 18 deletions(-) diff --git a/System/Console/Haskeline/Backend/Win32.hsc b/System/Console/Haskeline/Backend/Win32.hsc index 36d6f85..25927fc 100644 --- a/System/Console/Haskeline/Backend/Win32.hsc +++ b/System/Console/Haskeline/Backend/Win32.hsc @@ -26,14 +26,15 @@ import Data.ByteString.Internal (createAndTrim) import qualified Data.ByteString as B #include "win_console.h" +#include "windows_cconv.h" -foreign import stdcall "windows.h ReadConsoleInputW" c_ReadConsoleInput +foreign import WINDOWS_CCONV "windows.h ReadConsoleInputW" c_ReadConsoleInput :: HANDLE -> Ptr () -> DWORD -> Ptr DWORD -> IO Bool -foreign import stdcall "windows.h WaitForSingleObject" c_WaitForSingleObject +foreign import WINDOWS_CCONV "windows.h WaitForSingleObject" c_WaitForSingleObject :: HANDLE -> DWORD -> IO DWORD -foreign import stdcall "windows.h GetNumberOfConsoleInputEvents" +foreign import WINDOWS_CCONV "windows.h GetNumberOfConsoleInputEvents" c_GetNumberOfConsoleInputEvents :: HANDLE -> Ptr DWORD -> IO Bool getNumberOfEvents :: HANDLE -> IO Int @@ -178,7 +179,7 @@ setPosition :: HANDLE -> Coord -> IO () setPosition h c = with c $ failIfFalse_ "SetConsoleCursorPosition" . c_SetPosition h -foreign import stdcall "windows.h GetConsoleScreenBufferInfo" +foreign import WINDOWS_CCONV "windows.h GetConsoleScreenBufferInfo" c_GetScreenBufferInfo :: HANDLE -> Ptr () -> IO Bool getPosition :: HANDLE -> IO Coord @@ -197,7 +198,7 @@ getBufferSize = withScreenBufferInfo $ \p -> do c <- (#peek CONSOLE_SCREEN_BUFFER_INFO, dwSize) p return Layout {width = coordX c, height = coordY c} -foreign import stdcall "windows.h WriteConsoleW" c_WriteConsoleW +foreign import WINDOWS_CCONV "windows.h WriteConsoleW" c_WriteConsoleW :: HANDLE -> Ptr TCHAR -> DWORD -> Ptr DWORD -> Ptr () -> IO Bool writeConsole :: HANDLE -> String -> IO () @@ -210,7 +211,7 @@ writeConsole h str = withArray tstr $ \t_arr -> alloca $ \numWritten -> do where tstr = map (toEnum . fromEnum) str -foreign import stdcall "windows.h MessageBeep" c_messageBeep :: UINT -> IO Bool +foreign import WINDOWS_CCONV "windows.h MessageBeep" c_messageBeep :: UINT -> IO Bool messageBeep :: IO () messageBeep = c_messageBeep (-1) >> return ()-- intentionally ignore failures. @@ -218,10 +219,10 @@ messageBeep = c_messageBeep (-1) >> return ()-- intentionally ignore failures. ---------- -- Console mode -foreign import stdcall "windows.h GetConsoleMode" c_GetConsoleMode +foreign import WINDOWS_CCONV "windows.h GetConsoleMode" c_GetConsoleMode :: HANDLE -> Ptr DWORD -> IO Bool -foreign import stdcall "windows.h SetConsoleMode" c_SetConsoleMode +foreign import WINDOWS_CCONV "windows.h SetConsoleMode" c_SetConsoleMode :: HANDLE -> DWORD -> IO Bool withWindowMode :: MonadException m => Handles -> m a -> m a @@ -411,7 +412,7 @@ putOut = do ------------------------ -- Multi-byte conversion -foreign import stdcall "WideCharToMultiByte" wideCharToMultiByte +foreign import WINDOWS_CCONV "WideCharToMultiByte" wideCharToMultiByte :: CodePage -> DWORD -> LPCWSTR -> CInt -> LPCSTR -> CInt -> LPCSTR -> LPBOOL -> IO CInt @@ -425,7 +426,7 @@ unicodeToCodePage cp wideStr = withCWStringLen wideStr $ \(wideBuff, wideLen) -> fmap fromEnum $ wideCharToMultiByte cp 0 wideBuff (toEnum wideLen) (castPtr outBuff) outSize nullPtr nullPtr -foreign import stdcall "MultiByteToWideChar" multiByteToWideChar +foreign import WINDOWS_CCONV "MultiByteToWideChar" multiByteToWideChar :: CodePage -> DWORD -> LPCSTR -> CInt -> LPWSTR -> CInt -> IO CInt codePageToUnicode :: CodePage -> B.ByteString -> IO String @@ -445,7 +446,7 @@ getCodePage = do then return conCP else getACP -foreign import stdcall "IsDBCSLeadByteEx" c_IsDBCSLeadByteEx +foreign import WINDOWS_CCONV "IsDBCSLeadByteEx" c_IsDBCSLeadByteEx :: CodePage -> BYTE -> BOOL getMultiByteChar :: CodePage -> Handle -> MaybeT IO Char diff --git a/System/Console/Haskeline/Directory.hsc b/System/Console/Haskeline/Directory.hsc index c3fd00f..9024e9b 100644 --- a/System/Console/Haskeline/Directory.hsc +++ b/System/Console/Haskeline/Directory.hsc @@ -20,14 +20,15 @@ import qualified System.Directory #include <windows.h> #include <Shlobj.h> +#include "windows_cconv.h" -foreign import stdcall "FindFirstFileW" c_FindFirstFile +foreign import WINDOWS_CCONV "FindFirstFileW" c_FindFirstFile :: LPCTSTR -> Ptr () -> IO HANDLE -foreign import stdcall "FindNextFileW" c_FindNextFile +foreign import WINDOWS_CCONV "FindNextFileW" c_FindNextFile :: HANDLE -> Ptr () -> IO Bool -foreign import stdcall "FindClose" c_FindClose :: HANDLE -> IO BOOL +foreign import WINDOWS_CCONV "FindClose" c_FindClose :: HANDLE -> IO BOOL getDirectoryContents :: FilePath -> IO [FilePath] getDirectoryContents fp = allocaBytes (#size WIN32_FIND_DATA) $ \findP -> @@ -45,7 +46,7 @@ getDirectoryContents fp = allocaBytes (#size WIN32_FIND_DATA) $ \findP -> else c_FindClose h >> return [f] peekFileName = peekCWString . (#ptr WIN32_FIND_DATA, cFileName) -foreign import stdcall "GetFileAttributesW" c_GetFileAttributes +foreign import WINDOWS_CCONV "GetFileAttributesW" c_GetFileAttributes :: LPCTSTR -> IO DWORD doesDirectoryExist :: FilePath -> IO Bool @@ -60,7 +61,7 @@ getHomeDirectory = System.Directory.getHomeDirectory #else type HRESULT = #type HRESULT -foreign import stdcall "SHGetFolderPathW" c_SHGetFolderPath +foreign import WINDOWS_CCONV "SHGetFolderPathW" c_SHGetFolderPath :: Ptr () -> CInt -> HANDLE -> DWORD -> LPTSTR -> IO HRESULT getHomeDirectory :: IO FilePath diff --git a/haskeline.cabal b/haskeline.cabal index 3628ffe..c8b4590 100644 --- a/haskeline.cabal +++ b/haskeline.cabal @@ -98,8 +98,8 @@ Library Build-depends: Win32>=2.0 Other-modules: System.Console.Haskeline.Backend.Win32 c-sources: cbits/win_console.c - includes: win_console.h - install-includes: win_console.h + includes: win_console.h windows_cconv.h + install-includes: win_console.h windows_cconv.h cpp-options: -DMINGW } else { Build-depends: unix>=2.0 && < 2.6 diff --git a/includes/windows_cconv.h b/includes/windows_cconv.h new file mode 100644 index 0000000..2ee26f6 --- /dev/null +++ b/includes/windows_cconv.h @@ -0,0 +1,11 @@ +// Define the foreign import calling convention. +// On Win32, it's stdcall. +// On Win64, it's ccall. +#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 + _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
