Commit 5d8f5e00 authored by simonmar's avatar simonmar

[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.
parent e1001abd
...@@ -557,11 +557,14 @@ ifeq "$(bootstrapped)" "YES" ...@@ -557,11 +557,14 @@ ifeq "$(bootstrapped)" "YES"
utils/Binary_HC_OPTS = -funbox-strict-fields utils/Binary_HC_OPTS = -funbox-strict-fields
endif 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 main/BinIface_HC_OPTS += -O
utils/Binary_HC_OPTS += -O utils/Binary_HC_OPTS += -O
utils/FastMutInt_HC_OPTS += -O utils/FastMutInt_HC_OPTS += -O
utils/Encoding_HC_OPTS += -O
utils/StringBuffer_HC_OPTS += -O
utils/FastString_HC_OPTS += -O
# ---- Profiling ---- # ---- Profiling ----
#simplCore/Simplify_HC_OPTS = -auto-all #simplCore/Simplify_HC_OPTS = -auto-all
......
...@@ -722,6 +722,16 @@ getFS bh = do ...@@ -722,6 +722,16 @@ getFS bh = do
-- --
go 0 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 instance Binary PackageId where
put_ bh pid = put_ bh (packageIdFS pid) put_ bh pid = put_ bh (packageIdFS pid)
get bh = do { fs <- get bh; return (fsToPackageId fs) } get bh = do { fs <- get bh; return (fsToPackageId fs) }
......
{-# OPTIONS_GHC -O #-}
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
-- --
-- (c) The University of Glasgow, 1997-2003 -- (c) The University of Glasgow, 1997-2006
-- --
-- Character encodings -- Character encodings
-- --
...@@ -19,10 +18,6 @@ module Encoding ( ...@@ -19,10 +18,6 @@ module Encoding (
utf8EncodedLength, utf8EncodedLength,
countUTF8Chars, countUTF8Chars,
-- * Latin-1
latin1DecodeChar,
latin1EncodeChar,
-- * Z-encoding -- * Z-encoding
zEncodeString, zEncodeString,
zDecodeString zDecodeString
...@@ -34,20 +29,10 @@ import Foreign ...@@ -34,20 +29,10 @@ import Foreign
import Data.Char ( ord, chr, isDigit, digitToInt, isHexDigit ) import Data.Char ( ord, chr, isDigit, digitToInt, isHexDigit )
import Numeric ( showHex ) import Numeric ( showHex )
import Data.Bits
import GHC.Ptr ( Ptr(..) ) import GHC.Ptr ( Ptr(..) )
import GHC.Base 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 -- UTF-8
...@@ -200,8 +185,10 @@ utf8EncodedLength str = go 0 str ...@@ -200,8 +185,10 @@ utf8EncodedLength str = go 0 str
{- {-
This is the main name-encoding and decoding function. It encodes any 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 string into a string that is acceptable as a C name. This is done
by which things are known right through the compiler. 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. The basic encoding scheme is this.
......
...@@ -2,8 +2,6 @@ ...@@ -2,8 +2,6 @@
% (c) The University of Glasgow, 1997-2006 % (c) The University of Glasgow, 1997-2006
% %
\begin{code} \begin{code}
{-# OPTIONS -fglasgow-exts -O #-}
{- {-
FastString: A compact, hash-consed, representation of character strings. FastString: A compact, hash-consed, representation of character strings.
Comparison is O(1), and you can get a Unique from them. Comparison is O(1), and you can get a Unique from them.
...@@ -68,16 +66,15 @@ import Encoding ...@@ -68,16 +66,15 @@ import Encoding
import Foreign import Foreign
import Foreign.C import Foreign.C
import GLAEXTS import GHC.Exts
import UNSAFE_IO ( unsafePerformIO ) import System.IO.Unsafe ( unsafePerformIO )
import MONAD_ST ( stToIO ) import Control.Monad.ST ( stToIO )
import DATA_IOREF ( IORef, newIORef, readIORef, writeIORef ) import Data.IORef ( IORef, newIORef, readIORef, writeIORef )
import System.IO ( hPutBuf ) import System.IO ( hPutBuf )
import GHC.Arr ( STArray(..), newSTArray ) import GHC.Arr ( STArray(..), newSTArray )
import GHC.IOBase ( IO(..) ) import GHC.IOBase ( IO(..) )
import GHC.Ptr ( Ptr(..) )
import IO
#define hASH_TBL_SIZE 4091 #define hASH_TBL_SIZE 4091
...@@ -448,12 +445,24 @@ foreign import ccall unsafe "ghc_strlen" ...@@ -448,12 +445,24 @@ foreign import ccall unsafe "ghc_strlen"
inlinePerformIO :: IO a -> a inlinePerformIO :: IO a -> a
inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
-- NB. does *not* add a '\0'-terminator.
pokeCAString :: Ptr CChar -> String -> IO () pokeCAString :: Ptr CChar -> String -> IO ()
pokeCAString ptr str = pokeCAString ptr str =
let let
go [] n = pokeElemOff ptr n 0 go [] n = return ()
go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1) go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
in in
go str 0 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} \end{code}
% %
% (c) The University of Glasgow, 1997-2003 % (c) The University of Glasgow, 1997-2006
% %
\section{String buffers} \section{String buffers}
Buffers for scanning string input stored in external arrays. Buffers for scanning string input stored in external arrays.
\begin{code} \begin{code}
{-# OPTIONS_GHC -O #-}
-- always optimise this module, it's critical
module StringBuffer module StringBuffer
( (
StringBuffer(..), StringBuffer(..),
...@@ -40,19 +37,16 @@ module StringBuffer ...@@ -40,19 +37,16 @@ module StringBuffer
#include "HsVersions.h" #include "HsVersions.h"
import Encoding import Encoding
import FastString (FastString,mkFastString,mkFastStringBytes) import FastString ( FastString,mkFastString,mkFastStringBytes )
import GLAEXTS
import Foreign import Foreign
import System.IO ( hGetBuf, hFileSize,IOMode(ReadMode), hClose )
import GHC.Ptr ( Ptr(..) )
import GHC.Exts
import GHC.IOBase ( IO(..) ) import GHC.IOBase ( IO(..) )
import GHC.Base ( unsafeChr ) import GHC.Base ( unsafeChr )
import System.IO ( hGetBuf )
import IO ( hFileSize, IOMode(ReadMode),
hClose )
#if __GLASGOW_HASKELL__ >= 601 #if __GLASGOW_HASKELL__ >= 601
import System.IO ( openBinaryFile ) import System.IO ( openBinaryFile )
#else #else
...@@ -199,4 +193,19 @@ parseInteger buf len radix to_int ...@@ -199,4 +193,19 @@ parseInteger buf len radix to_int
inlinePerformIO :: IO a -> a inlinePerformIO :: IO a -> a
inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r 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} \end{code}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment