[project @ 1999-01-25 14:00:46 by sof]

Completeness job - added read and write ops for various sized Ints and Words.

diff --git a/ghc/lib/exts/MutableArray.lhs b/ghc/lib/exts/MutableArray.lhs
index 6153c44..202c297 100644 (file)
--- a/ghc/lib/exts/MutableArray.lhs
+++ b/ghc/lib/exts/MutableArray.lhs
@@ -61,29 +61,39 @@ module MutableArray
     sizeofByteArray,       -- :: Ix ix => ByteArray ix -> Int
     sizeofMutableByteArray, -- :: Ix ix => MutableByteArray s ix -> Int
 
-    indexStablePtrArray,    -- :: Ix ix => ByteArray ix -> ix -> (StablePtr a)
+    readWord8Array,        -- :: Ix ix => MutableByteArray s ix -> Int -> IO Word8
+    readWord16Array,       -- :: Ix ix => MutableByteArray s ix -> Int -> IO Word16
+    readWord32Array,       -- :: Ix ix => MutableByteArray s ix -> Int -> IO Word32
+    readWord64Array,       -- :: Ix ix => MutableByteArray s ix -> Int -> IO Word64
+
+    writeWord8Array,       -- :: Ix ix => MutableByteArray s ix -> Int -> Word8  -> IO ()
+    writeWord16Array,      -- :: Ix ix => MutableByteArray s ix -> Int -> Word16 -> IO ()
+    writeWord32Array,      -- :: Ix ix => MutableByteArray s ix -> Int -> Word32 -> IO ()
+    writeWord64Array,      -- :: Ix ix => MutableByteArray s ix -> Int -> Word64 -> IO ()
+
+    readInt8Array,         -- :: Ix ix => MutableByteArray s ix -> Int -> IO Int8
+    readInt16Array,        -- :: Ix ix => MutableByteArray s ix -> Int -> IO Int16
+    readInt32Array,        -- :: Ix ix => MutableByteArray s ix -> Int -> IO Int32
+    readInt64Array,        -- :: Ix ix => MutableByteArray s ix -> Int -> IO Int64
+
+    writeInt8Array,        -- :: Ix ix => MutableByteArray s ix -> Int -> Int8  -> IO ()
+    writeInt16Array,       -- :: Ix ix => MutableByteArray s ix -> Int -> Int16 -> IO ()
+    writeInt32Array,       -- :: Ix ix => MutableByteArray s ix -> Int -> Int32 -> IO ()
+    writeInt64Array        -- :: Ix ix => MutableByteArray s ix -> Int -> Int64 -> IO ()
 
-{-
-    readWord8Array,        -- :: Ix ix => MutableByteArray s ix -> Word8
-    readWord16Array,       -- :: Ix ix => MutableByteArray s ix -> Word16
-    readWord32Array,       -- :: Ix ix => MutableByteArray s ix -> Word32
--}
     ) where
 
+import PrelIOBase
+import PrelBase
 import PrelArr
+import PrelAddr
 import PrelArrExtra
-import PrelBase ( sizeofMutableByteArray#, sizeofByteArray#
-               , Int(..), Int#, (+#), (==#)
-               , StablePtr#, MutableByteArray#, State#
-               , unsafeFreezeByteArray#, ByteArray#
-               , newStablePtrArray#, readStablePtrArray#
-               , indexStablePtrArray#, writeStablePtrArray#
-               )
-
 import PrelForeign
 import PrelST
 import ST
 import Ix
+import Word
+import Int
 
 \end{code}
 
@@ -117,12 +127,6 @@ readStablePtrArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
     case readStablePtrArray# barr# n# s#  of { (# s2#, r# #) ->
     (# 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# ->
@@ -163,35 +167,212 @@ freezeStablePtrArray (MutableByteArray ixs arr#) = ST $ \ s# ->
 \end{code}
 
 
-begin{code}
-readWord8Array  :: Ix ix => MutableByteArray RealWorld ix -> ix -> IO Word8
-readWord16Array :: Ix ix => MutableByteArray RealWorld ix -> ix -> IO Word16
-readWord32Array :: Ix ix => MutableByteArray RealWorld ix -> ix -> IO Word32
+Reminder: indexing an array at some base type is done in units
+of the size of the type being; *not* in bytes.
 
-{- NB!!: The index for an array is in units of the element type being read -}
+\begin{code}
+readWord8Array  :: MutableByteArray RealWorld Int -> Int -> IO Word8
+readWord16Array :: MutableByteArray RealWorld Int -> Int -> IO Word16
+readWord32Array :: MutableByteArray RealWorld Int -> Int -> IO Word32
+readWord64Array :: MutableByteArray RealWorld Int -> Int -> IO Word64
 
 readWord8Array (MutableByteArray ixs arr#) n@(I# n#) =
     case sizeofMutableByteArray# arr#   of 
-      I# bytes# 
-       | n# ># (bytes# -# 1#) -> fail (userError "readWord8Array: index out of bounds "++show n)
+      bytes# 
+       | n# ># (bytes# -# 1#) -> ioError (userError ("readWord8Array: index out of bounds "++show n))
        | otherwise            -> IO $ \ s# ->
-         case readCharArray# barr# n# s#  of 
-           (# s2# , r# #) -> (# s2# , W8# (int2Word# (ord# r#)) #) 
+         case readCharArray# arr# n# s#  of 
+           (# s2# , r# #) -> (# s2# , intToWord8 (I# (ord# r#)) #) 
 
 readWord16Array (MutableByteArray ixs arr#) n@(I# n#) =
     case sizeofMutableByteArray# arr#   of 
-      I# bytes# 
-       | (2# *# n#) ># (bytes# -# 1#) -> fail (userError "readWord16Array: index out of bounds "++show n)
-       | otherwise                    -> IO $ \ s# ->
-         case readWordArray# barr# n# s#  of 
-           (# s2# , w# #) -> (# s2# , wordToWord16 (W# w#) #)
+      bytes# 
+       | n# ># (bytes# `quotInt#` 2# -# 1#) -> ioError (userError ("readWord16Array: index out of bounds "++show n))
+       | otherwise                         -> IO $ \ s# ->
+         case readWordArray# arr# (n# `quotInt#` 2#) s#  of 
+           (# s2# , w# #) -> 
+               case n# `remInt#` 2# of
+                  0# -> (# s2# , wordToWord16 (W# w#) #)              -- the double byte hides in the lower half of the wrd.
+                  1# -> (# s2# , wordToWord16 (W# (shiftRL# w# 16#)) #)  -- take the upper 16 bits.
 
 readWord32Array (MutableByteArray ixs arr#) n@(I# n#) =
     case sizeofMutableByteArray# arr#   of 
-      I# bytes# 
-       | (4# *# n#) ># (bytes# -# 1#) -> fail (userError "readWord32Array: index out of bounds "++show n)
-       | otherwise                    -> IO $ \ s# ->
-         case readWordArray# barr# n# s#  of 
+      bytes# 
+       | n# ># (bytes# `quotInt#` 4# -# 1#) -> ioError (userError ("readWord32Array: index out of bounds "++show n))
+       | otherwise                         -> IO $ \ s# ->
+         case readWordArray# arr# n# s#  of 
            (# s2# , w# #) -> (# s2# , wordToWord32 (W# w#) #)
 
-end{code}
+readWord64Array mb n = do
+  l <- readWord32Array mb (2*n)
+  h <- readWord32Array mb (2*n + 1)
+#ifdef WORDS_BIGENDIAN
+  return ( word32ToWord64 h + word32ToWord64 l * word32ToWord64 (maxBound::Word32))  
+#else
+  return ( word32ToWord64 l + word32ToWord64 h * word32ToWord64 (maxBound::Word32))  
+#endif
+
+writeWord8Array  :: MutableByteArray RealWorld Int -> Int -> Word8  -> IO ()
+writeWord16Array :: MutableByteArray RealWorld Int -> Int -> Word16 -> IO ()
+writeWord32Array :: MutableByteArray RealWorld Int -> Int -> Word32 -> IO ()
+writeWord64Array :: MutableByteArray RealWorld Int -> Int -> Word64 -> IO ()
+
+writeWord8Array (MutableByteArray ixs arr#) n@(I# n#) w =
+    case sizeofMutableByteArray# arr#  of 
+      bytes# 
+       | n# ># (bytes# -# 1#) -> ioError (userError ("writeWord8Array: index out of bounds "++show n))
+       | otherwise            -> IO $ \ s# ->
+         case writeCharArray# arr# n# (chr# (word2Int# (word8ToWord# w))) s#  of 
+           s2# -> (# s2# , () #) 
+
+writeWord16Array (MutableByteArray ixs arr#) n@(I# n#) w =
+    case sizeofMutableByteArray# arr#  of 
+      bytes# 
+       | n# ># (bytes# `quotInt#` 2# -# 1#) -> ioError (userError ("writeWord16Array: index out of bounds "++show n))
+       | otherwise            -> IO $ \ s# ->
+         case readWordArray# arr# (n# `quotInt#` 2#) s#  of 
+           (# s2# , v# #) -> 
+              case writeWordArray# arr# (n# `quotInt#` 2#) (w# `or#` (v# `and#` mask )) s2#  of 
+               s3# -> (# s3# , () #) 
+  where
+   w# = 
+     let w' = word16ToWord# w in
+     case n# `remInt#` 2# of
+        0# -> w'
+       1# -> shiftL# w' 16#
+   
+   mask =
+     case n# `remInt#` 2# of
+       0# -> case ``0xffff0000'' of W# x -> x   -- writing to the lower half of the word.
+       1# -> int2Word# 0x0000ffff#
+
+writeWord32Array (MutableByteArray ixs arr#) n@(I# n#) w =
+    case sizeofMutableByteArray# arr#  of 
+      bytes# 
+       | n# ># (bytes# `quotInt#` 4# -# 1#) -> ioError (userError ("writeWord32Array: index out of bounds "++show n))
+       | otherwise            -> IO $ \ s# ->
+         case writeWordArray# arr# n# w# s#  of 
+           s2# -> (# s2# , () #) 
+  where
+   w# = word32ToWord# w
+
+writeWord64Array mb n w = do
+#ifdef WORDS_BIGENDIAN
+   writeWord32Array mb (n*2) h
+   writeWord32Array mb (n*2+1) l
+#else
+   writeWord32Array mb (n*2) l
+   writeWord32Array mb (n*2+1) h
+#endif
+  where
+    h       = word64ToWord32 h'
+    l       = word64ToWord32 l'
+    (h',l') = w `divMod` (word32ToWord64 (maxBound::Word32) + 1)
+
+
+\end{code}
+
+\begin{code}
+readInt8Array  :: MutableByteArray RealWorld Int -> Int -> IO Int8
+readInt16Array :: MutableByteArray RealWorld Int -> Int -> IO Int16
+readInt32Array :: MutableByteArray RealWorld Int -> Int -> IO Int32
+readInt64Array :: MutableByteArray RealWorld Int -> Int -> IO Int64
+
+readInt8Array (MutableByteArray ixs arr#) n@(I# n#) =
+    case sizeofMutableByteArray# arr#   of 
+      bytes# 
+       | n# ># (bytes# -# 1#) -> ioError (userError ("readInt8Array: index out of bounds "++show n))
+       | otherwise            -> IO $ \ s# ->
+         case readCharArray# arr# n# s#  of 
+           (# s2# , r# #) -> (# s2# , intToInt8 (I# (ord# r#)) #)
+
+readInt16Array (MutableByteArray ixs arr#) n@(I# n#) =
+    case sizeofMutableByteArray# arr#   of 
+      bytes# 
+       | n# ># (bytes# `quotInt#` 2# -# 1#) -> ioError (userError ("readInt16Array: index out of bounds "++show n))
+       | otherwise                         -> IO $ \ s# ->
+         case readIntArray# arr# (n# `quotInt#` 2#) s#  of 
+           (# s2# , i# #) -> 
+                   case n# `remInt#` 2# of
+                     0# -> (# s2# , intToInt16 (I# i#) #)
+                     1# -> (# s2# , intToInt16 (I# i#) #) -- FIXME.
+
+readInt32Array (MutableByteArray ixs arr#) n@(I# n#) =
+    case sizeofMutableByteArray# arr#   of 
+      bytes# 
+       | n# ># (bytes# `quotInt#` 4# -# 1#) -> ioError (userError ("readInt32Array: index out of bounds "++show n))
+       | otherwise                         -> IO $ \ s# ->
+         case readIntArray# arr# n# s#  of 
+           (# s2# , i# #) -> (# s2# , intToInt32 (I# i#) #)
+
+readInt64Array mb n = do
+  l <- readInt32Array mb (2*n)
+  h <- readInt32Array mb (2*n + 1)
+#ifdef WORDS_BIGENDIAN
+  return ( int32ToInt64 h + int32ToInt64 l * int32ToInt64 (maxBound::Int32))  
+#else
+  return ( int32ToInt64 l + int32ToInt64 h * int32ToInt64 (maxBound::Int32))  
+#endif
+
+writeInt8Array  :: MutableByteArray RealWorld Int -> Int -> Int8  -> IO ()
+writeInt16Array :: MutableByteArray RealWorld Int -> Int -> Int16 -> IO ()
+writeInt32Array :: MutableByteArray RealWorld Int -> Int -> Int32 -> IO ()
+writeInt64Array :: MutableByteArray RealWorld Int -> Int -> Int64 -> IO ()
+
+writeInt8Array (MutableByteArray ixs arr#) n@(I# n#) i =
+    case sizeofMutableByteArray# arr#  of 
+      bytes# 
+       | n# ># (bytes# -# 1#) -> ioError (userError ("writeInt8Array: index out of bounds "++show n))
+       | otherwise            -> IO $ \ s# ->
+         case writeCharArray# arr# n# ch s#  of 
+           s2# -> (# s2# , () #) 
+  where
+   ch = chr# (int8ToInt# i)
+
+writeInt16Array (MutableByteArray ixs arr#) n@(I# n#) i =
+    case sizeofMutableByteArray# arr#  of 
+      bytes# 
+       | n# ># (bytes# `quotInt#` 2# -# 1#) -> ioError (userError ("writeInt16Array: index out of bounds "++show n))
+       | otherwise            -> IO $ \ s# ->
+         case readIntArray# arr# (n# `quotInt#` 2#) s#  of 
+           (# s2# , v# #) ->
+             let w' = word2Int# (int2Word# i# `or#` (int2Word# v# `and#` mask))
+             in
+              case writeIntArray# arr# (n# `quotInt#` 2#) w' s#  of
+                s2# -> (# s2# , () #) 
+  where
+   i# = 
+     let i' = int16ToInt# i in
+     case n# `remInt#` 2# of
+        0# -> i'
+       1# -> iShiftL# i' 16#
+   
+   mask =
+     case n# `remInt#` 2# of
+       0# -> case ``0xffff0000'' of W# x -> x   -- writing to the lower half of the word.
+       1# -> int2Word# 0x0000ffff#
+
+writeInt32Array (MutableByteArray ixs arr#) n@(I# n#) i =
+    case sizeofMutableByteArray# arr#  of 
+      bytes# 
+       | n# ># (bytes# `quotInt#` 4# -# 1#) -> ioError (userError ("writeInt32Array: index out of bounds "++show n))
+       | otherwise            -> IO $ \ s# ->
+         case writeIntArray# arr# n# i# s#  of 
+           s2# -> (# s2# , () #) 
+  where
+   i# = int32ToInt# i
+
+writeInt64Array mb n w = do
+#ifdef WORDS_BIGENDIAN
+   writeInt32Array mb (n*2) h
+   writeInt32Array mb (n*2+1) l
+#else
+   writeInt32Array mb (n*2)   l
+   writeInt32Array mb (n*2+1) h
+#endif
+  where
+    h       = int64ToInt32 h'
+    l       = int64ToInt32 l'
+    (h',l') = w `divMod` (int32ToInt64 (maxBound::Int32) * 2 - 1)
+
+\end{code}