[project @ 1998-12-02 13:17:09 by simonm]

[ghc-hetmet.git] / ghc / lib / posix / PosixIO.lhs

diff --git a/ghc/lib/posix/PosixIO.lhs b/ghc/lib/posix/PosixIO.lhs
index 1828670..ff60aa8 100644 (file)
--- a/ghc/lib/posix/PosixIO.lhs
+++ b/ghc/lib/posix/PosixIO.lhs
@@ -30,13 +30,14 @@ module PosixIO (
     ) where
 
 import GlaExts
-import ST
 import PrelIOBase
-import PrelHandle (readHandle, writeHandle, newHandle, getBMode__, getHandleFd )
+import PrelHandle (newHandle, getBMode__, getHandleFd, 
+                  freeFileObject, freeStdFileObject )
 import IO
-import PackedString ( unpackPS, unsafeByteArrayToPS, psToByteArrayST )
 import Addr
 import Foreign
+import Weak    ( addForeignFinaliser )
+import CString ( freeze, allocChars, packStringIO, unpackNBytesBAIO )
 
 import PosixUtil
 import PosixFiles ( stdInput, stdOutput, stdError )
@@ -110,11 +111,11 @@ fdToHandle fd@(FD# fd#) = do
           (or as a result of) program termination.
         -}
 #ifndef __PARALLEL_HASKELL__
-        fo <- 
-          (if fd == stdInput || fd == stdOutput || fd == stdError then
-              makeForeignObj fo (``&freeStdFile''::Addr)
-           else
-             makeForeignObj fo (``&freeFileObject''::Addr))
+        fo <- makeForeignObj fo
+        if fd == stdInput || fd == stdOutput || fd == stdError then
+             addForeignFinaliser fo (freeStdFileObject fo)
+         else
+             addForeignFinaliser fo (freeFileObject fo)
 #endif
         (bm, bf_size)  <- getBMode__ fo
          mkBuffer__ fo bf_size
@@ -136,7 +137,8 @@ fdRead fd nbytes = do
       0  -> fail (IOError Nothing EOF "fdRead" "EOF")
       n | n == nbytes -> do
            buf <- freeze bytes
-           return (unpackPS (unsafeByteArrayToPS buf n), n)
+           s   <- unpackNBytesBAIO buf n
+           return (s, n)
         | otherwise -> do
            -- Let go of the excessively long ByteArray# by copying to a
            -- shorter one.  Maybe we need a new primitive, shrinkCharArray#?
@@ -144,11 +146,12 @@ fdRead fd nbytes = do
            _casm_ ``do {I_ i; for(i = 0; i < %2; i++) ((B_)%0)[i] = ((B_)%1)[i];
                       } while(0);'' bytes' bytes n
             buf <- freeze bytes'
-           return (unpackPS (unsafeByteArrayToPS buf n), n)
+           s   <- unpackNBytesBAIO buf n
+           return (s, n)
 
 fdWrite :: Fd -> String -> IO ByteCount
 fdWrite fd str = do
-    buf <- stToIO (psToByteArrayST str)
+    buf <- packStringIO str
     rc  <- _ccall_ write fd buf (length str)
     if rc /= -1
        then return rc
@@ -269,7 +272,7 @@ lockRequest2Int kind =
   WriteLock -> ``F_WRLCK''
   Unlock    -> ``F_UNLCK''
 
-lock2Bytes :: FileLock -> IO (MutableByteArray RealWorld ())
+lock2Bytes :: FileLock -> IO (MutableByteArray RealWorld Int)
 lock2Bytes (kind, mode, start, len) = do
     bytes <- allocChars ``sizeof(struct flock)''
     _casm_ ``do { struct flock *fl = (struct flock *)%0;
@@ -282,7 +285,7 @@ lock2Bytes (kind, mode, start, len) = do
     return bytes
 --  where
 
-bytes2ProcessIDAndLock :: MutableByteArray s () -> IO (ProcessID, FileLock)
+bytes2ProcessIDAndLock :: MutableByteArray s Int -> IO (ProcessID, FileLock)
 bytes2ProcessIDAndLock bytes = do
     ltype   <- _casm_ ``%r = ((struct flock *)%0)->l_type;'' bytes
     lwhence <- _casm_ ``%r = ((struct flock *)%0)->l_whence;'' bytes