X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fghc%2FIOHandle.lhs;h=72f1fae2915884ee266b116f3991a3fba789bbbc;hb=5d9278289bd6886f552951e3ee85200a4ef74f7c;hp=50e1300c98ffad8bb7d3cc27f0a98429e4410540;hpb=9fa0d9f03cc2c7e1102b762bc65c116c02fac108;p=ghc-hetmet.git

diff --git a/ghc/lib/ghc/IOHandle.lhs b/ghc/lib/ghc/IOHandle.lhs
index 50e1300..72f1fae 100644
--- a/ghc/lib/ghc/IOHandle.lhs
+++ b/ghc/lib/ghc/IOHandle.lhs
@@ -8,23 +8,30 @@ This module defines Haskell {\em handles} and the basic operations
 which are supported for them.
 
 \begin{code}
+{-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
 #include "error.h"
 
-{-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
 
 module IOHandle where
 
 import ST
+import UnsafeST
 import STBase
 import ArrBase	( ByteArray(..) )
 import PrelRead	( Read )
+import PrelList (span)
 import Ix
 import IOBase
 import PrelTup
 import PrelBase
 import GHC
-import Foreign  ( makeForeignObj )
-import PrelList (span)
+
+import Foreign  ( Addr, 
+#ifndef __PARALLEL_HASKELL__
+                  ForeignObj, makeForeignObj, writeForeignObj 
+#endif
+		  )
+
 #if defined(__CONCURRENT_HASKELL__)
 import ConcBase
 #endif
@@ -68,7 +75,11 @@ writeHandle h v = stToIO (writeVar h v)
 %*********************************************************
 
 \begin{code}
+#ifndef __PARALLEL_HASKELL__
 filePtr :: Handle__ -> ForeignObj
+#else
+filePtr :: Handle__ -> Addr
+#endif
 filePtr (SemiClosedHandle fp _)  = fp
 filePtr (ReadHandle fp _ _)	 = fp
 filePtr (WriteHandle fp _ _)	 = fp
@@ -116,8 +127,13 @@ stdin = unsafePerformPrimIO (
     _ccall_ getLock (``stdin''::Addr) 0		>>= \ rc ->
     (case rc of
        0 -> new_handle ClosedHandle
-       1 -> makeForeignObj (``stdin''::Addr) (``&freeStdChannel''::Addr) >>= \ fp ->
+       1 -> 
+#ifndef __PARALLEL_HASKELL__
+            makeForeignObj (``stdin''::Addr) (``&freeStdFile''::Addr) >>= \ fp ->
 	    new_handle (ReadHandle fp Nothing False)
+#else
+	    new_handle (ReadHandle ``stdin'' Nothing False)
+#endif
        _ -> constructError "stdin"		>>= \ ioError -> 
             new_handle (ErrorHandle ioError)
     )						>>= \ handle ->
@@ -130,8 +146,13 @@ stdout = unsafePerformPrimIO (
     _ccall_ getLock (``stdout''::Addr) 1	>>= \ rc ->
     (case rc of
        0 -> new_handle ClosedHandle
-       1 -> makeForeignObj (``stdout''::Addr) (``&freeStdChannel''::Addr) >>= \ fp ->
+       1 -> 
+#ifndef __PARALLEL_HASKELL__
+            makeForeignObj (``stdout''::Addr) (``&freeStdFile''::Addr) >>= \ fp ->
 	    new_handle (WriteHandle fp Nothing False)
+#else
+	    new_handle (WriteHandle ``stdout'' Nothing False)
+#endif
        _ -> constructError "stdout"		>>= \ ioError -> 
             new_handle (ErrorHandle ioError)
     )						>>= \ handle ->
@@ -144,8 +165,13 @@ stderr = unsafePerformPrimIO (
     _ccall_ getLock (``stderr''::Addr) 1	>>= \ rc ->
     (case rc of
        0 -> new_handle ClosedHandle
-       1 -> makeForeignObj (``stderr''::Addr) (``&freeStdChannel''::Addr) >>= \ fp ->
+       1 -> 
+#ifndef __PARALLEL_HASKELL__
+            makeForeignObj (``stderr''::Addr) (``&freeStdFile''::Addr) >>= \ fp ->
             new_handle (WriteHandle fp (Just NoBuffering) False)	
+#else
+            new_handle (WriteHandle ``stderr'' (Just NoBuffering) False)	
+#endif
        _ -> constructError "stderr"		>>= \ ioError -> 
             new_handle (ErrorHandle ioError)
     )						>>= \ handle ->
@@ -170,8 +196,12 @@ openFile :: FilePath -> IOMode -> IO Handle
 openFile f m = 
     stToIO (_ccall_ openFile f m')		             >>= \ ptr ->
     if ptr /= ``NULL'' then
-        stToIO (makeForeignObj ptr ((``&freeFile'')::Addr))  >>= \ fp ->
+#ifndef __PARALLEL_HASKELL__
+        makeForeignObj ptr ((``&freeFile'')::Addr)   `thenIO_Prim` \ fp ->
         newHandle (htype fp Nothing False)
+#else
+        newHandle (htype ptr Nothing False)
+#endif
     else
 	stToIO (constructError "openFile")	    >>= \ ioError@(IOError hn iot msg) -> 
 	let
@@ -226,11 +256,12 @@ hClose :: Handle -> IO ()
 
 hClose handle =
     readHandle handle				    >>= \ htype ->
-    writeHandle handle ClosedHandle		    >>
     case htype of 
       ErrorHandle ioError ->
+	  writeHandle handle htype >>
 	  fail ioError
       ClosedHandle -> 
+          writeHandle handle htype		    >>
 	  ioe_closedHandle handle
       SemiClosedHandle fp (buf,_) ->
           (if buf /= ``NULL'' then
@@ -245,19 +276,30 @@ hClose handle =
 	             has been performed, the ForeignObj embedded in the Handle
                      is still lying around in the heap, so care is taken
                      to avoid closing the file object when the ForeignObj
-	             is finalised. (see freeFile()) -}
+	             is finalised.  -}
                 if rc == 0 then 
-	          return ()
+#ifndef __PARALLEL_HASKELL__
+		  -- Mark the foreign object data value as gone to the finaliser (freeFile())
+		  writeForeignObj fp ``NULL''       `thenIO_Prim` \ () ->
+#endif
+		  writeHandle handle ClosedHandle
                 else
+		  writeHandle handle htype >>
 	          constructErrorAndFail "hClose"
 
               else			    
-                  return ()
+                  writeHandle handle htype
       other -> 
-          _ccall_ closeFile (filePtr other)	    `thenIO_Prim` \ rc ->
+	  let fp = filePtr other in
+          _ccall_ closeFile fp	    `thenIO_Prim` \ rc ->
           if rc == 0 then 
-	      return ()
+#ifndef __PARALLEL_HASKELL__
+		  -- Mark the foreign object data
+		  writeForeignObj fp ``NULL''       `thenIO_Prim` \ () ->
+#endif
+	      writeHandle handle ClosedHandle
           else
+ 	      writeHandle handle htype >>
 	      constructErrorAndFail "hClose"
 \end{code}
 
@@ -427,7 +469,11 @@ hSetBuffering handle mode =
               BlockBuffering Nothing -> -2
               BlockBuffering (Just n) -> n
 
+#ifndef __PARALLEL_HASKELL__
     hcon :: Handle__ -> (ForeignObj -> (Maybe BufferMode) -> Bool -> Handle__)
+#else
+    hcon :: Handle__ -> (Addr -> (Maybe BufferMode) -> Bool -> Handle__)
+#endif
     hcon (ReadHandle _ _ _) = ReadHandle
     hcon (WriteHandle _ _ _) = WriteHandle
     hcon (AppendHandle _ _ _) = AppendHandle
@@ -470,8 +516,6 @@ hFlush handle =
 \begin{code}
 data HandlePosn = HandlePosn Handle Int
 
-instance Eq HandlePosn{-partain-}
-
 data SeekMode    =  AbsoluteSeek | RelativeSeek | SeekFromEnd
                     deriving (Eq, Ord, Ix, Enum, Read, Show)
 \end{code}