[project @ 2001-11-27 00:18:59 by sof]

[ghc-hetmet.git] / ghc / compiler / utils / StringBuffer.lhs

diff --git a/ghc/compiler/utils/StringBuffer.lhs b/ghc/compiler/utils/StringBuffer.lhs
index dfe061e..291fee4 100644 (file)
--- a/ghc/compiler/utils/StringBuffer.lhs
+++ b/ghc/compiler/utils/StringBuffer.lhs
@@ -69,33 +69,32 @@ module StringBuffer
 
 #include "HsVersions.h"
 
-import GlaExts
+
 #if __GLASGOW_HASKELL__ < 411
 import PrelAddr        ( Addr(..) )
+import Panic           ( panic )
 #else
 import Addr            ( Addr(..) )
+import Ptr             ( Ptr(..) )
 #endif
-import Foreign
+
+#if __GLASGOW_HASKELL__ >= 501
+import PrelIO          ( hGetcBuffered )
+#else
 import Char            ( chr )
-import Panic           ( panic )
+#endif
+
+import GlaExts
+import Foreign
 
 import IO              ( openFile  )
 import IOExts          ( slurpFile )
 import PrelIOBase
 import PrelHandle
 import Addr
-#if __GLASGOW_HASKELL__ >= 411
-import Ptr             ( Ptr(..) )
-#endif
 
 import PrelPack                ( unpackCStringBA )
 
-#if __GLASGOW_HASKELL__ >= 501
-import PrelIO          ( hGetcBuffered )
-import PrelCError      ( throwErrnoIfMinus1RetryMayBlock )
-import PrelConc                ( threadWaitRead )
-#endif
-
 import Exception       ( bracket )
 import PrimPacked
 import FastString
@@ -129,11 +128,17 @@ hGetStringBuffer expand_tabs fname = do
                                    return (A# a#, read)
 #endif
 
-   let (A# a#) = a;  (I# read#) = read
+       -- urk! slurpFile gives us a buffer that doesn't have room for
+       -- the sentinel.  Assume it has a final newline for now, and overwrite
+       -- that with the sentinel.  slurpFileExpandTabs (below) leaves room
+       -- for the sentinel.
+   let  (A# a#) = a;  
+       (I# read#) = read;
+       end# = read# -# 1#
 
          -- add sentinel '\NUL'
-   _casm_ `` ((char *)%0)[(int)%1]=(char)0; '' (A# a#) (I# (read# -# 1#))
-   return (StringBuffer a# read# 0# 0#)
+   _casm_ `` ((char *)%0)[(int)%1]=(char)0; '' (A# a#) (I# end#)
+   return (StringBuffer a# end# 0# 0#)
 
 unsafeWriteBuffer :: StringBuffer -> Int# -> Char# -> StringBuffer
 unsafeWriteBuffer s@(StringBuffer a _ _ _) i# ch# =
@@ -191,12 +196,17 @@ slurpFileExpandTabs fname = do
    (\ handle ->
      do sz <- hFileSize handle
         if sz > toInteger (maxBound::Int) 
-         then IOERROR (userError "slurpFile: file too big")
+         then ioError (userError "slurpFile: file too big")
           else do
            let sz_i = fromInteger sz
-               sz_i' = (sz_i * 12) `div` 10            -- add 20% for tabs
-           chunk <- allocMem sz_i'
-           trySlurp handle sz_i' chunk
+            if sz_i == 0
+                       -- empty file: just allocate a buffer containing '\0'
+               then do chunk <- allocMem 1
+                       writeCharOffAddr chunk 0 '\0'
+                       return (chunk, 0)
+               else do let sz_i' = (sz_i * 12) `div` 10 -- add 20% for tabs
+                       chunk <- allocMem sz_i'
+                       trySlurp handle sz_i' chunk
    )
 
 trySlurp :: Handle -> Int -> Addr -> IO (Addr, Int)
@@ -235,7 +245,12 @@ trySlurp handle sz_i chunk =
                buf <- readIORef ref
                ch <- (if not (bufferEmpty buf)
                      then hGetcBuffered fd ref buf
-                     else do new_buf <- fillReadBuffer fd True buf
+                     else do 
+#if __GLASGOW_HASKELL__ >= 503
+                             new_buf <- fillReadBuffer fd True False buf
+#else
+                             new_buf <- fillReadBuffer fd True buf
+#endif
                              hGetcBuffered fd ref new_buf)
                    `catch` \e -> if isEOFError e
                        then return '\xFFFF'
@@ -269,7 +284,7 @@ trySlurp handle sz_i chunk =
 #if __GLASGOW_HASKELL__ < 404
   writeHandle handle handle_
 #endif
-  return (chunk', rc+1 {-room for sentinel-})
+  return (chunk', rc+1 {- room for sentinel -})
 
 
 reAllocMem :: Addr -> Int -> IO Addr