From 5d8f5e005c673f6e14a7e1b61f889b176ccf4766 Mon Sep 17 00:00:00 2001 From: simonmar Date: Mon, 9 Jan 2006 13:25:50 +0000 Subject: [PATCH] [project @ 2006-01-09 13:25:50 by simonmar] Fix up to compile with GHC 5.04.x again. Also includes a fix for a memory error I discovered along the way: should fix the "scavenge_one" crash in the stage2 build of recent HEADs. --- ghc/compiler/Makefile | 7 +++++-- ghc/compiler/utils/Binary.hs | 10 ++++++++++ ghc/compiler/utils/Encoding.hs | 25 ++++++------------------- ghc/compiler/utils/FastString.lhs | 27 ++++++++++++++++++--------- ghc/compiler/utils/StringBuffer.lhs | 31 ++++++++++++++++++++----------- 5 files changed, 59 insertions(+), 41 deletions(-) diff --git a/ghc/compiler/Makefile b/ghc/compiler/Makefile index 2b5252a..fcb24af 100644 --- a/ghc/compiler/Makefile +++ b/ghc/compiler/Makefile @@ -557,11 +557,14 @@ ifeq "$(bootstrapped)" "YES" utils/Binary_HC_OPTS = -funbox-strict-fields endif -# BinIface and Binary take ages to both compile and run if you don's use -O +# We always optimise some low-level modules, otherwise performance of +# a non-optimised compiler is severely affected. main/BinIface_HC_OPTS += -O utils/Binary_HC_OPTS += -O utils/FastMutInt_HC_OPTS += -O - +utils/Encoding_HC_OPTS += -O +utils/StringBuffer_HC_OPTS += -O +utils/FastString_HC_OPTS += -O # ---- Profiling ---- #simplCore/Simplify_HC_OPTS = -auto-all diff --git a/ghc/compiler/utils/Binary.hs b/ghc/compiler/utils/Binary.hs index 7b40bd2..cdb9206 100644 --- a/ghc/compiler/utils/Binary.hs +++ b/ghc/compiler/utils/Binary.hs @@ -722,6 +722,16 @@ getFS bh = do -- go 0 +#if __GLASGOW_HASKELL__ < 600 +mallocForeignPtrBytes :: Int -> IO (ForeignPtr a) +mallocForeignPtrBytes n = do + r <- mallocBytes n + newForeignPtr r (finalizerFree r) + +foreign import ccall unsafe "stdlib.h free" + finalizerFree :: Ptr a -> IO () +#endif + instance Binary PackageId where put_ bh pid = put_ bh (packageIdFS pid) get bh = do { fs <- get bh; return (fsToPackageId fs) } diff --git a/ghc/compiler/utils/Encoding.hs b/ghc/compiler/utils/Encoding.hs index d15c021..1f266e1 100644 --- a/ghc/compiler/utils/Encoding.hs +++ b/ghc/compiler/utils/Encoding.hs @@ -1,7 +1,6 @@ -{-# OPTIONS_GHC -O #-} -- ----------------------------------------------------------------------------- -- --- (c) The University of Glasgow, 1997-2003 +-- (c) The University of Glasgow, 1997-2006 -- -- Character encodings -- @@ -19,10 +18,6 @@ module Encoding ( utf8EncodedLength, countUTF8Chars, - -- * Latin-1 - latin1DecodeChar, - latin1EncodeChar, - -- * Z-encoding zEncodeString, zDecodeString @@ -34,21 +29,11 @@ import Foreign import Data.Char ( ord, chr, isDigit, digitToInt, isHexDigit ) import Numeric ( showHex ) +import Data.Bits import GHC.Ptr ( Ptr(..) ) import GHC.Base -- ----------------------------------------------------------------------------- --- Latin-1 - -latin1DecodeChar ptr = do - w <- peek ptr - return (unsafeChr (fromIntegral w), ptr `plusPtr` 1) - -latin1EncodeChar c ptr = do - poke ptr (fromIntegral (ord c)) - return (ptr `plusPtr` 1) - --- ----------------------------------------------------------------------------- -- UTF-8 -- We can't write the decoder as efficiently as we'd like without @@ -200,8 +185,10 @@ utf8EncodedLength str = go 0 str {- This is the main name-encoding and decoding function. It encodes any -string into a string that is acceptable as a C name. This is the name -by which things are known right through the compiler. +string into a string that is acceptable as a C name. This is done +right before we emit a symbol name into the compiled C or asm code. +Z-encoding of strings is cached in the FastString interface, so we +never encode the same string more than once. The basic encoding scheme is this. diff --git a/ghc/compiler/utils/FastString.lhs b/ghc/compiler/utils/FastString.lhs index 2558c56..134bb95 100644 --- a/ghc/compiler/utils/FastString.lhs +++ b/ghc/compiler/utils/FastString.lhs @@ -2,8 +2,6 @@ % (c) The University of Glasgow, 1997-2006 % \begin{code} -{-# OPTIONS -fglasgow-exts -O #-} - {- FastString: A compact, hash-consed, representation of character strings. Comparison is O(1), and you can get a Unique from them. @@ -68,16 +66,15 @@ import Encoding import Foreign import Foreign.C -import GLAEXTS -import UNSAFE_IO ( unsafePerformIO ) -import MONAD_ST ( stToIO ) -import DATA_IOREF ( IORef, newIORef, readIORef, writeIORef ) +import GHC.Exts +import System.IO.Unsafe ( unsafePerformIO ) +import Control.Monad.ST ( stToIO ) +import Data.IORef ( IORef, newIORef, readIORef, writeIORef ) import System.IO ( hPutBuf ) import GHC.Arr ( STArray(..), newSTArray ) import GHC.IOBase ( IO(..) ) - -import IO +import GHC.Ptr ( Ptr(..) ) #define hASH_TBL_SIZE 4091 @@ -448,12 +445,24 @@ foreign import ccall unsafe "ghc_strlen" inlinePerformIO :: IO a -> a inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r +-- NB. does *not* add a '\0'-terminator. pokeCAString :: Ptr CChar -> String -> IO () pokeCAString ptr str = let - go [] n = pokeElemOff ptr n 0 + go [] n = return () go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1) in go str 0 +#if __GLASGOW_HASKELL__ < 600 +mallocForeignPtrBytes :: Int -> IO (ForeignPtr a) +mallocForeignPtrBytes n = do + r <- mallocBytes n + newForeignPtr r (finalizerFree r) + +foreign import ccall unsafe "stdlib.h free" + finalizerFree :: Ptr a -> IO () + +peekCAStringLen = peekCStringLen +#endif \end{code} diff --git a/ghc/compiler/utils/StringBuffer.lhs b/ghc/compiler/utils/StringBuffer.lhs index e2eed88..70d708d 100644 --- a/ghc/compiler/utils/StringBuffer.lhs +++ b/ghc/compiler/utils/StringBuffer.lhs @@ -1,14 +1,11 @@ % -% (c) The University of Glasgow, 1997-2003 +% (c) The University of Glasgow, 1997-2006 % \section{String buffers} Buffers for scanning string input stored in external arrays. \begin{code} -{-# OPTIONS_GHC -O #-} --- always optimise this module, it's critical - module StringBuffer ( StringBuffer(..), @@ -40,19 +37,16 @@ module StringBuffer #include "HsVersions.h" import Encoding -import FastString (FastString,mkFastString,mkFastStringBytes) - -import GLAEXTS +import FastString ( FastString,mkFastString,mkFastStringBytes ) import Foreign +import System.IO ( hGetBuf, hFileSize,IOMode(ReadMode), hClose ) +import GHC.Ptr ( Ptr(..) ) +import GHC.Exts import GHC.IOBase ( IO(..) ) import GHC.Base ( unsafeChr ) -import System.IO ( hGetBuf ) - -import IO ( hFileSize, IOMode(ReadMode), - hClose ) #if __GLASGOW_HASKELL__ >= 601 import System.IO ( openBinaryFile ) #else @@ -199,4 +193,19 @@ parseInteger buf len radix to_int inlinePerformIO :: IO a -> a inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r +#if __GLASGOW_HASKELL__ < 600 +mallocForeignPtrArray :: Storable a => Int -> IO (ForeignPtr a) +mallocForeignPtrArray = doMalloc undefined + where + doMalloc :: Storable b => b -> Int -> IO (ForeignPtr b) + doMalloc dummy size = mallocForeignPtrBytes (size * sizeOf dummy) + +mallocForeignPtrBytes :: Int -> IO (ForeignPtr a) +mallocForeignPtrBytes n = do + r <- mallocBytes n + newForeignPtr r (finalizerFree r) + +foreign import ccall unsafe "stdlib.h free" + finalizerFree :: Ptr a -> IO () +#endif \end{code} -- 1.7.10.4