[project @ 1999-08-20 13:12:18 by simonpj]

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

diff --git a/ghc/lib/posix/PosixIO.lhs b/ghc/lib/posix/PosixIO.lhs
index 1828670..4baf007 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    ( addForeignFinalizer )
+import CString ( freeze, allocChars, packStringIO, unpackNBytesBAIO )
 
 import PosixUtil
 import PosixFiles ( stdInput, stdOutput, stdError )
@@ -46,7 +47,7 @@ createPipe :: IO (Fd, Fd)
 createPipe = do
     bytes <- allocChars ``(2*sizeof(int))''
     rc    <- _casm_ ``%r = pipe((int *)%0);'' bytes
-    if rc /= -1
+    if rc /= ((-1)::Int)
        then do
        rd <- _casm_ ``%r = ((int *)%0)[0];'' bytes
        wd <- _casm_ ``%r = ((int *)%0)[1];'' bytes
@@ -78,8 +79,8 @@ handleToFd h = do
 fdToHandle :: Fd -> IO Handle
 fdToHandle fd@(FD# fd#) = do
      -- first find out what kind of file desc. this is..
-    flags <- _ccall_ fcntl fd (``F_GETFL''::Int) 0
-    if flags /= -1 
+    flags <- _ccall_ fcntl fd (``F_GETFL''::Int) (0::Int)
+    if flags /= ((-1)::Int)
      then do
       let
        (I# flags#) = flags
@@ -97,7 +98,7 @@ fdToHandle fd@(FD# fd#) = do
         | rwH       = (ReadWriteHandle, 1)
         | otherwise = (ReadHandle, 0)
          
-      fo <- _ccall_ openFd fd flags flush_on_close
+      fo <- _ccall_ openFd fd flags (flush_on_close::Int)
       if fo /= nullAddr then do
         {-
           A distinction is made here between std{Input,Output,Error} Fds
@@ -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 <- mkForeignObj fo
+        if fd == stdInput || fd == stdOutput || fd == stdError then
+             addForeignFinalizer fo (freeStdFileObject fo)
+         else
+             addForeignFinalizer fo (freeFileObject fo)
 #endif
         (bm, bf_size)  <- getBMode__ fo
          mkBuffer__ fo bf_size
@@ -127,16 +128,17 @@ fdToHandle fd@(FD# fd#) = do
    fd_str = "<file descriptor: " ++ show (I# fd#) ++ ">"
 
 fdRead :: Fd -> ByteCount -> IO (String, ByteCount)
-fdRead fd 0 = return ("", 0)
-fdRead fd nbytes = do
+fdRead _fd 0 = return ("", 0)
+fdRead fd  nbytes = do
     bytes <-  allocChars nbytes
     rc    <-  _ccall_ read fd bytes nbytes
     case rc of
       -1 -> syserr "fdRead"
-      0  -> fail (IOError Nothing EOF "fdRead" "EOF")
+      0  -> ioError (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,13 +146,14 @@ 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
+    if rc /= ((-1)::Int)
        then return rc
        else syserr "fdWrite"
 
@@ -160,7 +163,7 @@ data FdOption = AppendOnWrite
 
 queryFdOption :: Fd -> FdOption -> IO Bool
 queryFdOption fd CloseOnExec =
-    _ccall_ fcntl fd (``F_GETFD''::Int) 0          >>= \ (I# flags#) ->
+    _ccall_ fcntl fd (``F_GETFD''::Int) (0::Int)    >>= \ (I# flags#) ->
     if flags# /=# -1# then
        return ((int2Word# flags# `and#` fd_cloexec#) `neWord#` int2Word# 0#)
     else
@@ -168,7 +171,7 @@ queryFdOption fd CloseOnExec =
   where
     fd_cloexec# = case (``FD_CLOEXEC'') of { W# x -> x }
 queryFdOption fd other =
-    _ccall_ fcntl fd (``F_GETFL''::Int) 0          >>= \ (I# flags#) ->
+    _ccall_ fcntl fd (``F_GETFL''::Int) (0::Int)    >>= \ (I# flags#) ->
     if flags# >=# 0# then
        return ((int2Word# flags# `and#` opt#) `neWord#` int2Word# 0#)
     else
@@ -181,13 +184,13 @@ queryFdOption fd other =
 
 setFdOption :: Fd -> FdOption -> Bool -> IO ()
 setFdOption fd CloseOnExec val = do
-    flags <- _ccall_ fcntl fd (``F_GETFD''::Int) 0
-    if flags /= -1 then do
+    flags <- _ccall_ fcntl fd (``F_GETFD''::Int) (0::Int)
+    if flags /= ((-1)::Int) then do
        rc <- (if val then
                 _casm_ ``%r = fcntl(%0, F_SETFD, %1 | FD_CLOEXEC);'' fd flags
               else do
                 _casm_ ``%r = fcntl(%0, F_SETFD, %1 & ~FD_CLOEXEC);'' fd flags)
-       if rc /= -1
+       if rc /= ((-1)::Int)
           then return ()
           else fail
      else fail
@@ -195,13 +198,13 @@ setFdOption fd CloseOnExec val = do
     fail = syserr "setFdOption"
 
 setFdOption fd other val = do
-    flags <- _ccall_ fcntl fd (``F_GETFL''::Int) 0
-    if flags >= 0 then do
+    flags <- _ccall_ fcntl fd (``F_GETFL''::Int) (0::Int)
+    if flags >= (0::Int) then do
        rc <- (if val then
                 _casm_ ``%r = fcntl(%0, F_SETFL, %1 | %2);'' fd flags opt
               else do
                 _casm_ ``%r = fcntl(%0, F_SETFL, %1 & ~(%2));'' fd flags opt)
-       if rc /= -1
+       if rc /= ((-1)::Int)
           then return ()
           else fail
      else fail
@@ -222,7 +225,7 @@ getLock :: Fd -> FileLock -> IO (Maybe (ProcessID, FileLock))
 getLock fd lock = do
     flock <- lock2Bytes lock
     rc    <- _ccall_ fcntl fd (``F_GETLK''::Int) flock
-    if rc /= -1
+    if rc /= ((-1)::Int)
        then do
            result <- bytes2ProcessIDAndLock flock
            return (maybeResult result)
@@ -244,7 +247,7 @@ waitToSetLock fd lock = do
 fdSeek :: Fd -> SeekMode -> FileOffset -> IO FileOffset
 fdSeek fd mode offset = do
     rc <- _ccall_ lseek fd offset (mode2Int mode)
-    if rc /= -1
+    if rc /= ((-1)::Int)
        then return rc
        else syserr "fdSeek"
 
@@ -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