#13606: GHCi segfaults on Windows with D3D code ----------------------------------------+------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.2.1-rc2 Keywords: | Operating System: Windows Architecture: Unknown/Multiple | Type of failure: GHCi crash Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: ----------------------------------------+------------------------------- Warning: this is about as Windows-specific of a bug as it possibly gets, since it requires the use of D3D. I noticed this when trying to run [https://github.com/jwvg0425/d3d11binding examples] from the `d3d11binding` library in GHCi, as they all failed. First, to conjure up the code needed for this: * `Main.hs`: {{{#!hs {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} module Main (main) where import Data.Bits (Bits(..)) import Data.Int (Int32) import Data.Word (Word32) import Foreign.C.String (CString, peekCString, withCString, withCStringLen) import Foreign.Marshal.Alloc (alloca) import Foreign.Ptr (Ptr, castPtr, nullPtr) import Foreign.Storable (Storable(..)) import System.IO (IOMode(..), hGetContents, withFile) #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 foreign import WINDOWS_CCONV "D3DCompile" c_d3dCompile :: Ptr () -> Word32 -> CString -> Ptr D3DShaderMacro -> Ptr ID3DInclude -> CString -> CString -> D3DCompileFlag -> D3DCompileEffectFlag -> Ptr (Ptr ID3DBlob) -> Ptr (Ptr ID3DBlob) -> IO HRESULT maybePoke :: (Storable a) => Maybe a -> (Ptr a -> IO b) -> IO b maybePoke Nothing proc = proc nullPtr maybePoke (Just m) proc = alloca $ \ptr -> do poke ptr m proc ptr maybeWithCString :: Maybe String -> (CString -> IO a) -> IO a maybeWithCString Nothing proc = proc nullPtr maybeWithCString (Just m) proc = withCString m proc type HRESULT = LONG data ID3DBlob = ID3DBlob data ID3DInclude = ID3DInclue type LONG = Int32 data D3DShaderMacro = D3DShaderMacro { _name :: String , _definition :: String } instance Storable D3DShaderMacro where sizeOf _ = 8 alignment _ = 8 peek ptr = do n <- peekByteOff ptr 0 d <- peekByteOff ptr 4 n' <- peekCString n d' <- peekCString d return $ D3DShaderMacro n' d' poke ptr (D3DShaderMacro n d) = do withCString n $ \n' -> withCString d $ \d' -> do pokeByteOff ptr 0 n' pokeByteOff ptr 4 d' type D3DCompileFlag = Word32 type D3DCompileEffectFlag = Word32 d3dCompileEnableStrictness :: D3DCompileFlag d3dCompileEnableStrictness = shift 1 11 d3dCompile :: String -> Maybe String -> Maybe D3DShaderMacro -> Ptr ID3DInclude -> Maybe String -> String -> [D3DCompileFlag] -> [D3DCompileEffectFlag] -> IO (Either (HRESULT, Ptr ID3DBlob) (Ptr ID3DBlob)) d3dCompile source sourceName defines pInclude entryPoint target compileFlags effectFlags = do withCStringLen source $ \(csource, len) -> withCString target $ \pTarget -> maybeWithCString sourceName $ \pSourceName -> maybePoke defines $ \pDefines -> maybeWithCString entryPoint $ \pEntryPoint -> alloca $ \ppCode -> alloca $ \ppErrorMsgs -> do let sFlag = foldl (.|.) 0 compileFlags let eFlag = foldl (.|.) 0 effectFlags putStrLn "Before d3dCompile" hr <- c_d3dCompile (castPtr csource) (fromIntegral len) pSourceName pDefines pInclude pEntryPoint pTarget sFlag eFlag ppCode ppErrorMsgs putStrLn "After d3dCompile" if hr < 0 then do pErrorMsgs <- peek ppErrorMsgs return $ Left (hr, pErrorMsgs) else do pCode <- peek ppCode return $ Right pCode d3dCompileFromFile :: String -> Maybe String -> Maybe D3DShaderMacro -> Ptr ID3DInclude -> Maybe String -> String -> [D3DCompileFlag] -> [D3DCompileEffectFlag] -> IO (Either (HRESULT, Ptr ID3DBlob) (Ptr ID3DBlob)) d3dCompileFromFile fileName sourceName defines pInclude entryPoint target compileFlags effectFlags = withFile fileName ReadMode $ \handle -> do contents <- hGetContents handle d3dCompile contents sourceName defines pInclude entryPoint target compileFlags effectFlags main :: IO () main = do _vb <- compileShaderFromFile "Triangle.fx" "VS" "vs_4_0" return () compileShaderFromFile :: String -> String -> String -> IO (Ptr ID3DBlob) compileShaderFromFile fileName entryPoint shaderModel = do Right res <- d3dCompileFromFile fileName Nothing Nothing nullPtr (Just entryPoint) shaderModel [d3dCompileEnableStrictness] [] return res }}} * `Triangle.fx` {{{ float4 VS( float4 Pos : POSITION ) : SV_POSITION { return Pos; } float4 PS( float4 Pos : SV_POSITION ) : SV_Target { return float4( 1.0f, 1.0f, 0.0f, 1.0f ); // Yellow, with Alpha = 1 } }}} Make sure that `Triangle.fx` is in the same directory as `Main.hs` when running this program. When compiled, this program works OK: {{{ $ C:\Users\RyanGlScott\Software\ghc-8.2.0.20170404\bin\ghc -lD3DCompiler Main.hs -fforce-recomp [1 of 1] Compiling Main ( Main.hs, Main.o ) Linking Main.exe ... $ .\Main.exe Before d3dCompile After d3dCompile }}} But with GHCi, it crashes: {{{ $ C:\Users\RyanGlScott\Software\ghc-8.2.0.20170404\bin\runghc -lD3DCompiler Main.hs Before d3dCompile Access violation in generated code when writing 0000000000000000 }}} I ran these tests on GHC 8.2.1, but I've also reproduced this bug in the past on GHC 8.0.2, so I don't think this is a new bug by any means. -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/13606> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler