[project @ 2006-01-09 13:25:50 by simonmar]
authorsimonmar <unknown>
Mon, 9 Jan 2006 13:25:50 +0000 (13:25 +0000)
committersimonmar <unknown>
Mon, 9 Jan 2006 13:25:50 +0000 (13:25 +0000)
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
ghc/compiler/utils/Binary.hs
ghc/compiler/utils/Encoding.hs
ghc/compiler/utils/FastString.lhs
ghc/compiler/utils/StringBuffer.lhs

index 2b5252a..fcb24af 100644 (file)
@@ -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
index 7b40bd2..cdb9206 100644 (file)
@@ -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) }
index d15c021..1f266e1 100644 (file)
@@ -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.  
 
index 2558c56..134bb95 100644 (file)
@@ -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}
index e2eed88..70d708d 100644 (file)
@@ -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}