Sat Sep 26 20:02:36 PDT 2009 Tim Chevalier * Conditionally compile hPutChar and hPutStr to perform IO with a single foreign call This patch is meant to be used in conjunction with the stand-alone External Core- handling libraries. Conditionally, it redefines the functions hPutChar and hPutStr to call a function extcore_hPutChar, which writes a character to stdout. (Thus, the handle argument to hPutChar is ignored.) This implementation is meant to serve as an example of how to redefine standard GHC library functions so as to reduce the set of primops and foreign calls that need to be implemented, rather than for any practical use. Recompiling the libraries with EXTRA_HC_OPTS=-DSIMPLE_IO will activate the simplified definitions of hPutChar and hPutStr. The implementor of the External Core back-end is responsible for implementing the foreign call extcore_hPutChar. New patches: [Conditionally compile hPutChar and hPutStr to perform IO with a single foreign call Tim Chevalier **20090927030236 Ignore-this: eee99600689c66b4b3591a915bda15cb This patch is meant to be used in conjunction with the stand-alone External Core- handling libraries. Conditionally, it redefines the functions hPutChar and hPutStr to call a function extcore_hPutChar, which writes a character to stdout. (Thus, the handle argument to hPutChar is ignored.) This implementation is meant to serve as an example of how to redefine standard GHC library functions so as to reduce the set of primops and foreign calls that need to be implemented, rather than for any practical use. Recompiling the libraries with EXTRA_HC_OPTS=-DSIMPLE_IO will activate the simplified definitions of hPutChar and hPutStr. The implementor of the External Core back-end is responsible for implementing the foreign call extcore_hPutChar. ] { hunk ./GHC/IO.hs 23 -- #hide module GHC.IO ( hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr, +#ifndef SIMPLE_IO commitBuffer', -- hack, see below hunk ./GHC/IO.hs 25 +#endif hGetcBuffered, -- needed by ghc/compiler/utils/StringBuffer.lhs hGetBuf, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking, slurpFile, memcpy_ba_baoff, hunk ./GHC/IO.hs 57 import GHC.Conc #endif +#ifdef SIMPLE_IO +foreign import ccall unsafe "extcore_hPutChar" + extcore_hPutChar :: Char# -> IO () +#endif -- --------------------------------------------------------------------------- -- Simple input operations hunk ./GHC/IO.hs 425 -- * 'isPermissionError' if another system resource limit would be exceeded. hPutChar :: Handle -> Char -> IO () +#ifdef SIMPLE_IO +hPutChar _handle c = + let C# i = c in + extcore_hPutChar i +#else hPutChar handle c = do c `seq` return () wantWritableHandle "hPutChar" handle $ \ handle_ -> do hunk ./GHC/IO.hs 441 with (castCharToCChar c) $ \buf -> do writeRawBufferPtr "hPutChar" fd (haIsStream handle_) buf 0 1 return () +#endif hunk ./GHC/IO.hs 443 +#ifndef SIMPLE_IO hPutcBuffered :: Handle__ -> Bool -> Char -> IO () hPutcBuffered handle_ is_line c = do let ref = haBuffer handle_ hunk ./GHC/IO.hs 457 writeIORef ref flushed_buf else do writeIORef ref new_buf - +#endif hPutChars :: Handle -> [Char] -> IO () hPutChars _ [] = return () hunk ./GHC/IO.hs 494 hPutStr :: Handle -> String -> IO () hPutStr handle str = do +#ifndef SIMPLE_IO buffer_mode <- wantWritableHandle "hPutStr" handle (\ handle_ -> do getSpareBuffer handle_) case buffer_mode of hunk ./GHC/IO.hs 499 (NoBuffering, _) -> do +#endif hPutChars handle str -- v. slow, but we don't care hunk ./GHC/IO.hs 501 +#ifndef SIMPLE_IO (LineBuffering, buf) -> do writeLines handle buf str (BlockBuffering _, buf) -> do hunk ./GHC/IO.hs 507 writeBlocks handle buf str - getSpareBuffer :: Handle__ -> IO (BufferMode, Buffer) getSpareBuffer Handle__{haBuffer=ref, haBuffers=spare_ref, hunk ./GHC/IO.hs 677 else return buf_ret +#endif + -- --------------------------------------------------------------------------- -- Reading/writing sequences of bytes. } Context: [TAG GHC 6.10.4 release Ian Lynagh **20090719123606] [remove msvcrt and kernel32 from extra-libraries Simon Marlow **20090520111626 Ignore-this: cd2e24a5144c6ca0efe03ceaea8f577b ] [add _O_NOINHERIT when opening files on Windows (see #2650) Simon Marlow **20090520130926 Ignore-this: 6dfbdfe13e739cc339e627294e077ba6 ] [FIX #3171: make sure we have only one table of signal handlers Simon Marlow **20090423112837 Ignore-this: 3d8039b47efac2629e73a7d7e7d58983 ] [TAG base 4.1.0.0 Ian Lynagh **20090402004235] [TAG GHC 6.10.2 release Ian Lynagh **20090401221746] [FIX #2189: re-enabled cooked mode for Console-connected Handles on Windows Simon Marlow *-20090305113323 Patch from Sigbjorn Finne ] [Partial fix for #2917 Simon Marlow **20090305154153 Ignore-this: 3a06cd3ea09f1d6454d52031802a93fd - add newAlignedPinnedByteArray# for allocating pinned BAs with arbitrary alignment - the old newPinnedByteArray# now aligns to 16 bytes Foreign.alloca will use newAlignedPinnedByteArray#, and so might end up wasting less space than before (we used to align to 8 by default). Foreign.allocaBytes and Foreign.mallocForeignPtrBytes will get 16-byte aligned memory, which is enough to avoid problems with SSE instructions on x86, for example. There was a bug in the old newPinnedByteArray#: it aligned to 8 bytes, but would have failed if the header was not a multiple of 8 (fortunately it always was, even with profiling). Also we occasionally wasted some space unnecessarily due to alignment in allocatePinned(). I haven't done anything about Foreign.malloc/mallocBytes, which will give you the same alignment guarantees as malloc() (8 bytes on Linux/x86 here). ] [avoid a space leak building up in the "prodding" IORef (part of #2992) Simon Marlow **20090311093938] [Update version number, 4.0.0.0 -> 4.1.0.0 Ian Lynagh **20090307213233] [Add config.guess, config.sub and install-sh Ian Lynagh **20090307153831] [MERGED: add final newlines Ian Lynagh **20090306202744 Simon Marlow **20090305140014 My Windows build has started complaining about lacking final newlines, I'm not entirely sure why. ] [FIX #2189: re-enabled cooked mode for Console-connected Handles on Windows Simon Marlow **20090305113323 Patch from Sigbjorn Finne ] [Fix warnings: put imports inside ifdefs Ian Lynagh **20090220173941] [ifdef out the syncIOManager export on Windows; fixes the build Ian Lynagh **20090220173414] [ifdef out the definition of setCloseOnExec on Windows; fixes the build Ian Lynagh **20090220173041] [Set the IO manager pipe descriptors to FD_CLOEXEC Simon Marlow **20090219114217 Ignore-this: ac670a45f8a4d06dd7831a2674d6c119 This pipe is an internal implementation detail, we don't really want it to be exposed. ] [Rewrite of signal-handling (base patch; see also ghc and unix patches) Simon Marlow **20090219102203 Ignore-this: 2122e05eaaab184b9ef0f269ce4c9282 The API is the same (for now). The new implementation has the capability to define signal handlers that have access to the siginfo of the signal (#592), but this functionality is not exposed in this patch. #2451 is the ticket for the new API. The main purpose of bringing this in now is to fix race conditions in the old signal handling code (#2858). Later we can enable the new API in the HEAD. Implementation differences: - More of the signal-handling is moved into Haskell. We store the table of signal handlers in an MVar, rather than having a table of StablePtrs in the RTS. - In the threaded RTS, the siginfo of the signal is passed down the pipe to the IO manager thread, which manages the business of starting up new signal handler threads. In the non-threaded RTS, the siginfo of caught signals is stored in the RTS, and the scheduler starts new signal handler threads. ] [Fix #2971: we had lost the non-blocking flag on Handles created by openFile Simon Marlow **20090206165912 Ignore-this: 546f1a799b6e80f7b25c73ef642d8f9d This code is a mess, fortunately the new IO library cleans it up. ] [add some rules of thumb for catching exceptions, restructure the docs a bit Simon Marlow **20090205150642 Ignore-this: 8294e58f247b2cc3f193991434d336de ] [Fix #2903: ensure CWStringLen contains the length of the array rather than the String Ross Paterson **20090203011026] [OldException catches unknown exceptions as DynException Ian Lynagh **20090202151856 It's important that we put all exceptions into the old Exception type somehow, or throwing a new exception wouldn't cause the cleanup code for bracket, finally etc to happen. ] [Update the Exception docs Ian Lynagh **20090131204845] [Fix typo (reqwests -> requests); trac #2908, spotted by bancroft Ian Lynagh **20090104154405] [warning fix: don't use -XPatternSignatures in GHC >= 6.10 Simon Marlow **20081217104637] [FIX #1364: added support for C finalizers that run as soon as the value is no longer reachable. Ivan Tomac **20081210150510 Patch amended by Simon Marlow: - mkWeakFinalizer# commoned up with mkWeakFinalizerEnv# ] [TAG base 4.0.0.0 Ian Lynagh **20081212141854] [Fix #2750: change Prelude.(,) to Prelude.(,,) Jose Pedro Magalhaes **20081201113411] [Fix typo (or out of date reference) in throwTo documentation. shelarcy **20081129024639] [re-instate the gcd/Integer and lcm/Integer RULES Simon Marlow **20081120101826 Fixes a performance regression between 6.8.3 and 6.10.1 ] [Add more description of what "round" does, from the H98 report Ian Lynagh **20081119143131] [FIX #2722: update RULES for the Category/Arrow split Ross Paterson **20081104144515 The rule arr id = id interacts unpleasantly with the advice to define id = arr id in instances of Category that are also instances of Arrow (#2722). Also changed a couple of >>>'s to .'s in later rules. ] [TAG GHC 6.10.1 release Ian Lynagh **20081107191823] [docs about how exceptions are handled by forkIO'd threads (#2651) Simon Marlow **20081016100410] [Unhide GHC.Arr from haddock Ian Lynagh **20081013172823 This works around a bug where haddock comments aren't available to be re-exported between packages. I've also moved some pragmas around so that haddock can find the docs. ] [add link to the new syb wiki jpm@cs.uu.nl**20081013111605] [changing haddock links jpm@cs.uu.nl**20081010095434] [removed (->) instance from Data.Data jpm@cs.uu.nl**20081006075254] [added new module Data.Data 'Jose Pedro Magalhaes '**20081002140535 The new Data.Data module contains all of Data.Generics.Basics and most of Data.Generics.Instances. The missing instances were deemed dubious and moved to the syb package. ] [add new Data.Data module 'Jose Pedro Magalhaes '**20081002082735] [restore Complex's derived Data instance 'Jose Pedro Magalhaes '**20081002082655] [update Data.Generics import 'Jose Pedro Magalhaes '**20081002082604] [Don't use ^(2::Int) in Data.Complex.magnitude; partially fixes trac #2450 Ian Lynagh **20081004142651 We still might want to make a RULE for this, so the bug is not fully fixed. ] [Restore the Haskell 98 behaviour of Show Ratio (#1920) Simon Marlow **20080923134949] [Pad version number to 4.0.0.0 Ian Lynagh **20080920155801] [TAG 6.10 branch has been forked Ian Lynagh **20080919123437] [TAG GHC 6.10 fork Ian Lynagh **20080919004936] Patch bundle hash: a9741492b0334a97f29931bfc016946ada174faa