From 0cca1cdcfdb433edcc013a643d72cf2580a78e33 Mon Sep 17 00:00:00 2001 From: sof Date: Mon, 25 Jan 1999 14:00:46 +0000 Subject: [PATCH] [project @ 1999-01-25 14:00:46 by sof] Completeness job - added read and write ops for various sized Ints and Words. --- ghc/lib/exts/MutableArray.lhs | 259 ++++++++++++++++++++++++++++++++++------- 1 file changed, 220 insertions(+), 39 deletions(-) diff --git a/ghc/lib/exts/MutableArray.lhs b/ghc/lib/exts/MutableArray.lhs index 6153c44..202c297 100644 --- 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} -- 1.7.10.4