2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1994
4 \section[ByteOps]{Convert to/from ``bytes''; to support @Native@ class}
6 This mimics some code that comes with HBC.
28 import List ( (++), foldr )
30 import PS ( _PackedString, _unpackPS )
31 import TyArray ( Array(..) )
37 \tr{xxxToBytes} prepends an \tr{xxx} to a byte stream.
38 \tr{bytesToXxx} snaffles an \tr{xxx} from a byte stream,
39 also returning the rest of the stream.
43 longToBytes :: Int -> Bytes -> Bytes
44 intToBytes :: Int -> Bytes -> Bytes
45 shortToBytes :: Int -> Bytes -> Bytes
46 floatToBytes :: Float -> Bytes -> Bytes
47 doubleToBytes :: Double -> Bytes -> Bytes
49 bytesToLong :: Bytes -> (Int, Bytes)
50 bytesToInt :: Bytes -> (Int, Bytes)
51 bytesToShort :: Bytes -> (Int, Bytes)
52 bytesToFloat :: Bytes -> (Float, Bytes)
53 bytesToDouble :: Bytes -> (Double, Bytes)
58 #define XXXXToBytes(type,xxxx,xxxx__) \
61 long_bytes {- DANGEROUS! -} \
62 = unsafePerformPrimIO ( \
63 {- Allocate a wad of memory to put the "long"'s bytes. \
64 Let's hope 32 bytes will be big enough. -} \
65 newCharArray (0::Int, 31) `thenPrimIO` \ arr# -> \
67 {- Call out to C to do the dirty deed: -} \
68 _casm_ ``%r = xxxx__ ((type)%0, (unsigned char *)%1);'' i arr# \
69 `thenPrimIO` \ num_bytes -> \
71 unpack arr# 0 (num_bytes - 1) \
76 XXXXToBytes(long,longToBytes,long2bytes__)
77 XXXXToBytes(int,intToBytes,int2bytes__)
78 XXXXToBytes(short,shortToBytes,short2bytes__)
79 XXXXToBytes(float,floatToBytes,float2bytes__)
80 XXXXToBytes(double,doubleToBytes,double2bytes__)
84 unpack :: _MutableByteArray _RealWorld Int -> Int -> Int -> PrimIO [Char]
90 readCharArray arr# curr `thenPrimIO` \ ch ->
91 unpack arr# (curr + 1) last `thenPrimIO` \ rest ->
92 returnPrimIO (ch : rest)
95 Now we go the other way. The paranoia checking (absent) leaves
96 something to be desired. Really have to be careful on
97 funny-sized things like \tr{shorts}...
99 #define bytesToXXXX(htype,xxxx,alloc,read,xxxx__) \
101 = unsafePerformPrimIO ( \
102 {- slam (up to) 32 bytes [random] from the stream into an array -} \
103 newCharArray (0::Int, 31) `thenPrimIO` \ arr# -> \
104 pack arr# 0 31 stream `seqPrimIO` \
106 {- make a one-element array to hold the result: -} \
107 alloc (0::Int, 0) `thenPrimIO` \ res# -> \
109 {- call the C to do the business: -} \
110 _casm_ ``%r = xxxx__ ((P_)%0, (htype *) %1);'' arr# res# \
111 `thenPrimIO` \ num_bytes -> \
113 {- read the result out of "res#": -} \
114 read res# (0::Int) `thenPrimIO` \ i -> \
116 {- box the result and drop the number of bytes taken: -} \
117 returnPrimIO (i, my_drop num_bytes stream) \
120 bytesToXXXX(I_,bytesToLong,newIntArray,readIntArray,bytes2long__)
121 bytesToXXXX(I_,bytesToInt,newIntArray,readIntArray,bytes2int__)
122 bytesToXXXX(I_,bytesToShort,newIntArray,readIntArray,bytes2short__)
123 bytesToXXXX(StgFloat,bytesToFloat,newFloatArray,readFloatArray,bytes2float__)
124 bytesToXXXX(StgDouble,bytesToDouble,newDoubleArray,readDoubleArray,bytes2double__)
128 pack :: _MutableByteArray _RealWorld Int -> Int -> Int -> [Char] -> PrimIO ()
130 pack arr# curr last from_bytes
131 = if curr > last then
135 [] -> writeCharArray arr# curr (chr 0)
138 writeCharArray arr# curr from_byte `seqPrimIO`
139 pack arr# (curr + 1) last xs
141 -- more cavalier than usual; we know there will be enough bytes:
143 my_drop :: Int -> [a] -> [a]
147 my_drop m (_:xs) = my_drop (m - 1) xs