[project @ 1998-10-21 11:42:00 by sof]

StablePtr array ops added

diff --git a/ghc/lib/exts/MutableArray.lhs b/ghc/lib/exts/MutableArray.lhs
index 35fbe7d..c3a061e 100644 (file)
--- a/ghc/lib/exts/MutableArray.lhs
+++ b/ghc/lib/exts/MutableArray.lhs
@@ -22,7 +22,8 @@ module MutableArray
     newAddrArray,
     newIntArray,
     newFloatArray,
-    newDoubleArray,     -- :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix) 
+    newDoubleArray,
+    newStablePtrArray,  -- :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix) 
 
     boundsOfArray,      -- :: Ix ix => MutableArray s ix elt -> (ix, ix)  
     boundsOfByteArray,  -- :: Ix ix => MutableByteArray s ix -> (ix, ix)
@@ -34,20 +35,23 @@ module MutableArray
     readAddrArray,      -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Addr
     readFloatArray,     -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Float
     readDoubleArray,    -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Double
-
-    writeArray,        -- :: Ix ix => MutableArray s ix elt -> ix -> elt -> ST s () 
-    writeCharArray,     -- :: Ix ix => MutableByteArray s ix -> ix -> Char -> ST s () 
-    writeIntArray,      -- :: Ix ix => MutableByteArray s ix -> ix -> Int  -> ST s () 
-    writeAddrArray,     -- :: Ix ix => MutableByteArray s ix -> ix -> Addr -> ST s () 
-    writeFloatArray,    -- :: Ix ix => MutableByteArray s ix -> ix -> Float -> ST s () 
-    writeDoubleArray,   -- :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s () 
-
-    freezeArray,       -- :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
-    freezeCharArray,    -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
-    freezeIntArray,     -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
-    freezeAddrArray,    -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
-    freezeFloatArray,   -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
-    freezeDoubleArray,  -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
+    readStablePtrArray, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s (StablePtr a)
+
+    writeArray,          -- :: Ix ix => MutableArray s ix elt -> ix -> elt -> ST s () 
+    writeCharArray,       -- :: Ix ix => MutableByteArray s ix -> ix -> Char -> ST s () 
+    writeIntArray,        -- :: Ix ix => MutableByteArray s ix -> ix -> Int  -> ST s () 
+    writeAddrArray,       -- :: Ix ix => MutableByteArray s ix -> ix -> Addr -> ST s () 
+    writeFloatArray,      -- :: Ix ix => MutableByteArray s ix -> ix -> Float -> ST s () 
+    writeDoubleArray,     -- :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s () 
+    writeStablePtrArray,  -- :: Ix ix => MutableByteArray s ix -> ix -> StablePtr a -> ST s () 
+
+    freezeArray,         -- :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
+    freezeCharArray,      -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
+    freezeIntArray,       -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
+    freezeAddrArray,      -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
+    freezeFloatArray,     -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
+    freezeDoubleArray,    -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
+    freezeStablePtrArray, -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 
     unsafeFreezeArray,     -- :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)  
     unsafeFreezeByteArray, -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
@@ -65,12 +69,25 @@ module MutableArray
     ) where
 
 import PrelArr
-import PrelBase (sizeofMutableByteArray#, sizeofByteArray#, Int(..) )
+import PrelBase ( sizeofMutableByteArray#, sizeofByteArray#
+               , Int(..), Int#, (+#), (==#)
+               , StablePtr#, MutableByteArray#, State#
+               , unsafeFreezeByteArray#
+               , newStablePtrArray#, readStablePtrArray#
+               , indexStablePtrArray#, writeStablePtrArray#
+               )
+
+import PrelForeign
+import PrelST
 import ST
 import Ix
 
 \end{code}
 
+Note: the absence of operations to read/write ForeignObjs to a mutable
+array is not accidental; storing foreign objs in a mutable array is
+not supported.
+
 \begin{code}
 sizeofByteArray :: Ix ix => ByteArray ix -> Int
 sizeofByteArray (ByteArray _ arr#) = 
@@ -84,6 +101,65 @@ sizeofMutableByteArray (MutableByteArray _ arr#) =
 
 \end{code}
 
+\begin{code}
+newStablePtrArray :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix) 
+newStablePtrArray ixs = ST $ \ s# ->
+    case rangeSize ixs              of { I# n# ->
+    case (newStablePtrArray# n# s#) of { StateAndMutableByteArray# s2# barr# ->
+    STret s2# (MutableByteArray ixs barr#) }}
+
+readStablePtrArray    :: Ix ix => MutableByteArray s ix -> ix -> ST s (StablePtr a)
+readStablePtrArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
+    case (index ixs n)                   of { I# n# ->
+    case readStablePtrArray# barr# n# s#  of { StateAndStablePtr# s2# r# ->
+    STret s2# (StablePtr r#) }}
+
+indexStablePtrArray    :: Ix ix => ByteArray ix -> ix -> (StablePtr a)
+indexStablePtrArray (ByteArray ixs barr#) n
+  = case (index ixs n)                 of { I# n# ->
+    case indexStablePtrArray# barr# n#         of { r# ->
+    (StablePtr r#)}}
+
+writeStablePtrArray    :: Ix ix => MutableByteArray s ix -> ix -> StablePtr a  -> ST s () 
+writeStablePtrArray (MutableByteArray ixs barr#) n (StablePtr sp#) = ST $ \ s# ->
+    case (index ixs n)                        of { I# n# ->
+    case writeStablePtrArray# barr# n# sp# s#  of { s2#   ->
+    STret s2# () }}
+
+freezeStablePtrArray    :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
+freezeStablePtrArray (MutableByteArray ixs arr#) = ST $ \ s# ->
+    case rangeSize ixs     of { I# n# ->
+    case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
+    STret s2# (ByteArray ixs frozen#) }}
+  where
+    freeze  :: MutableByteArray# s     -- the thing
+           -> Int#                     -- size of thing to be frozen
+           -> State# s                 -- the Universe and everything
+           -> StateAndByteArray# s
+
+    freeze arr# n# s#
+      = case (newStablePtrArray# n# s#)    of { StateAndMutableByteArray# s2# newarr1# ->
+       case copy 0# n# arr# newarr1# s2#  of { StateAndMutableByteArray# s3# newarr2# ->
+       unsafeFreezeByteArray# newarr2# s3#
+       }}
+      where
+       copy :: Int# -> Int#
+            -> MutableByteArray# s -> MutableByteArray# s
+            -> State# s
+            -> StateAndMutableByteArray# s
+
+       copy cur# end# from# to# s#
+         | cur# ==# end#
+           = StateAndMutableByteArray# s# to#
+         | otherwise
+           = case (readStablePtrArray#  from# cur#       s#) of { StateAndStablePtr# s1# ele ->
+             case (writeStablePtrArray# to#   cur# ele  s1#) of { s2# ->
+             copy (cur# +# 1#) end# from# to# s2#
+             }}
+
+\end{code}
+
+
 begin{code}
 readWord8Array  :: Ix ix => MutableByteArray RealWorld ix -> ix -> IO Word8
 readWord16Array :: Ix ix => MutableByteArray RealWorld ix -> ix -> IO Word16