2 % (c) The GRASP/AQUA Project, Glasgow University, 1997-1998
4 \section{Basic ops on packed representations}
6 Some basic operations for working on packed representations of series
7 of bytes (character strings). Used by the interface lexer input
11 {-# OPTIONS -monly-3-regs -optc-DNON_POSIX_SOURCE #-}
14 strLength, -- :: _Addr -> Int
15 copyPrefixStr, -- :: _Addr -> Int -> ByteArray Int
16 copySubStr, -- :: _Addr -> Int -> Int -> ByteArray Int
17 copySubStrBA, -- :: ByteArray Int -> Int -> Int -> ByteArray Int
19 eqStrPrefix, -- :: Addr# -> ByteArray# -> Int# -> Bool
20 eqCharStrPrefix, -- :: Addr# -> Addr# -> Int# -> Bool
21 eqStrPrefixBA, -- :: ByteArray# -> ByteArray# -> Int# -> Int# -> Bool
22 eqCharStrPrefixBA, -- :: Addr# -> ByteArray# -> Int# -> Int# -> Bool
24 addrOffset# -- :: Addr# -> Int# -> Addr#
27 -- This #define suppresses the "import FastString" that
28 -- HsVersions otherwise produces
29 #define COMPILING_FAST_STRING
30 #include "HsVersions.h"
33 #if __GLASGOW_HASKELL__ < 411
34 import PrelAddr ( Addr(..) )
36 import Addr ( Addr(..) )
41 #if __GLASGOW_HASKELL__ < 503
49 Copying a char string prefix into a byte array,
50 {\em assuming} the prefix does not contain any
54 copyPrefixStr :: Addr -> Int -> ByteArray Int
55 copyPrefixStr (A# a) len@(I# length#) =
57 {- allocate an array that will hold the string
58 (not forgetting the NUL at the end)
60 (new_ps_array (length# +# 1#)) >>= \ ch_array ->
61 {- Revert back to Haskell-only solution for the moment.
62 _ccall_ memcpy ch_array (A# a) len >>= \ () ->
63 write_ps_array ch_array length# (chr# 0#) >>
65 -- fill in packed string from "addr"
66 fill_in ch_array 0# >>
68 freeze_ps_array ch_array length# >>= \ barr ->
71 fill_in :: MutableByteArray s Int -> Int# -> ST s ()
75 = write_ps_array arr_in# idx (chr# 0#) >>
78 = case (indexCharOffAddr# a idx) of { ch ->
79 write_ps_array arr_in# idx ch >>
80 fill_in arr_in# (idx +# 1#) }
84 Copying out a substring, assume a 0-indexed string:
85 (and positive lengths, thank you).
88 copySubStr :: Addr -> Int -> Int -> ByteArray Int
89 copySubStr a start length =
91 _casm_ `` %r= (char *)((char *)%0 + (int)%1); '' a start
93 return (copyPrefixStr a_start length))
95 -- step on (char *) pointer by x units.
96 addrOffset# :: Addr# -> Int# -> Addr#
98 case unsafePerformIO (_casm_ ``%r=(char *)((char *)%0 + (int)%1); '' (A# a#) (I# i#)) of
101 copySubStrBA :: ByteArray Int -> Int -> Int -> ByteArray Int
102 copySubStrBA (ByteArray _ _ barr#) (I# start#) len@(I# length#) =
104 {- allocate an array that will hold the string
105 (not forgetting the NUL at the end)
107 new_ps_array (length# +# 1#) >>= \ ch_array ->
108 -- fill in packed string from "addr"
109 fill_in ch_array 0# >>
111 freeze_ps_array ch_array length#)
113 fill_in :: MutableByteArray s Int -> Int# -> ST s ()
117 = write_ps_array arr_in# idx (chr# 0#) >>
120 = case (indexCharArray# barr# (start# +# idx)) of { ch ->
121 write_ps_array arr_in# idx ch >>
122 fill_in arr_in# (idx +# 1#) }
125 (Very :-) ``Specialised'' versions of some CharArray things...
126 [Copied from PackBase; no real reason -- UGH]
129 new_ps_array :: Int# -> ST s (MutableByteArray s Int)
130 write_ps_array :: MutableByteArray s Int -> Int# -> Char# -> ST s ()
131 freeze_ps_array :: MutableByteArray s Int -> Int# -> ST s (ByteArray Int)
133 new_ps_array size = ST $ \ s ->
134 #if __GLASGOW_HASKELL__ < 411
135 case (newCharArray# size s) of { (# s2#, barr# #) ->
136 (# s2#, MutableByteArray bot bot barr# #) }
137 #else /* 411 and higher */
138 case (newByteArray# size s) of { (# s2#, barr# #) ->
139 (# s2#, MutableByteArray bot bot barr# #) }
142 bot = error "new_ps_array"
144 write_ps_array (MutableByteArray _ _ barr#) n ch = ST $ \ s# ->
145 case writeCharArray# barr# n ch s# of { s2# ->
148 -- same as unsafeFreezeByteArray
149 freeze_ps_array (MutableByteArray _ _ arr#) len# = ST $ \ s# ->
150 case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
151 (# s2#, ByteArray 0 (I# len#) frozen# #) }
155 Compare two equal-length strings for equality:
158 eqStrPrefix :: Addr# -> ByteArray# -> Int# -> Bool
159 eqStrPrefix a# barr# len# =
161 x <- memcmp_ba a# barr# (I# len#)
165 eqCharStrPrefix :: Addr# -> Addr# -> Int# -> Bool
166 eqCharStrPrefix a1# a2# len# =
168 x <- memcmp a1# a2# (I# len#)
171 eqStrPrefixBA :: ByteArray# -> ByteArray# -> Int# -> Int# -> Bool
172 eqStrPrefixBA b1# b2# start# len# =
174 x <- memcmp_baoff_ba b2# (I# start#) b1# (I# len#)
177 eqCharStrPrefixBA :: Addr# -> ByteArray# -> Int# -> Int# -> Bool
178 eqCharStrPrefixBA a# b2# start# len# =
180 x <- memcmp_baoff b2# (I# start#) a# (I# len#)
185 foreign import ccall "ghc_strlen" unsafe
186 strLength :: Addr -> Int
188 foreign import ccall "ghc_memcmp" unsafe
189 memcmp :: Addr# -> Addr# -> Int -> IO Int
191 foreign import ccall "ghc_memcmp" unsafe
192 memcmp_ba :: Addr# -> ByteArray# -> Int -> IO Int
194 foreign import ccall "ghc_memcmp_off" unsafe
195 memcmp_baoff :: ByteArray# -> Int -> Addr# -> Int -> IO Int
197 foreign import ccall "ghc_memcmp_off" unsafe
198 memcmp_baoff_ba :: ByteArray# -> Int -> ByteArray# -> Int -> IO Int