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"
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
......
......@@ -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) }
......
{-# 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,20 +29,10 @@ 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
......@@ -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.
......
......@@ -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}
%
% (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}
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