- = errorIO (msg_hdr sTDERR{-msg hdr-} >>
- _ccall_ fflush sTDERR >>
- fputs sTDERR s >>
- _ccall_ fflush sTDERR >>
- _ccall_ getErrorHandler >>= \ errorHandler ->
- if errorHandler == (-1::Int) then
- _ccall_ stg_exit (1::Int)
- else
- _casm_ ``%r = (StgStablePtr)(%0);'' errorHandler
- >>= \ osptr ->
- _ccall_ decrementErrorCount >>= \ () ->
- deRefStablePtr osptr >>= \ oact ->
- oact
- )
+ = errorIO ( do
+ (hFlush stdout) `catch` (\ _ -> return ())
+ -- Note: there's potential for trouble here in a
+ -- a concurrent setting if an error is flagged after the
+ -- lock on the stdout handle. (I don't see a possibility
+ -- of this occurring with the current impl, but still.)
+ let bs@(ByteArray (_,len) _) = packString s
+ _ccall_ writeErrString__ msg_hdr bs len
+ errorHandler <- _ccall_ getErrorHandler
+ if errorHandler == (-1::Int) then
+ _ccall_ stg_exit (1::Int)
+ else do
+ osptr <- _casm_ ``%r = (StgStablePtr)(%0);'' errorHandler
+ _ccall_ decrementErrorCount
+ oact <- deRefStablePtr osptr
+ oact
+ )
+