From 8e71893672ec6c663ce84247bc21be94ad3b1f3a Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Wed, 21 Oct 1998 11:42:00 +0000
Subject: [PATCH] [project @ 1998-10-21 11:42:00 by sof] StablePtr array ops
 added

---
 ghc/lib/exts/MutableArray.lhs |  108 +++++++++++++++++++++++++++++++++++------
 1 file changed, 92 insertions(+), 16 deletions(-)

diff --git a/ghc/lib/exts/MutableArray.lhs b/ghc/lib/exts/MutableArray.lhs
index 35fbe7d..c3a061e 100644
--- 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
-- 
1.7.10.4