Skip to content
Snippets Groups Projects
Commit 0cca1cdc authored by sof's avatar sof
Browse files

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

Completeness job - added read and write ops for various sized Ints and Words.
parent 9a492e41
No related merge requests found
Hide whitespace changes
Inline Side-by-side
ghc/lib/exts/MutableArray.lhs
+ 220
− 39
View file @ 0cca1cdc
......@@ -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}
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment