[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

@@ -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

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) }

ghc/compiler/utils/Encoding.hs

-{-# 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.  
 

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}

ghc/compiler/utils/StringBuffer.lhs

 %
-% (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}