3 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1994
5 \section[ByteOps]{Convert to/from ``bytes''; to support @Native@ class}
7 This mimics some code that comes with HBC.
28 -- \tr{xxxToBytes} prepends an \tr{xxx} to a byte stream.
29 -- \tr{bytesToXxx} snaffles an \tr{xxx} from a byte stream,
30 -- also returning the rest of the stream.
34 longToBytes :: Int -> Bytes -> Bytes
35 intToBytes :: Int -> Bytes -> Bytes
36 shortToBytes :: Int -> Bytes -> Bytes
37 floatToBytes :: Float -> Bytes -> Bytes
38 doubleToBytes :: Double -> Bytes -> Bytes
40 bytesToLong :: Bytes -> (Int, Bytes)
41 bytesToInt :: Bytes -> (Int, Bytes)
42 bytesToShort :: Bytes -> (Int, Bytes)
43 bytesToFloat :: Bytes -> (Float, Bytes)
44 bytesToDouble :: Bytes -> (Double, Bytes)
48 #define XXXXToBytes(type,xxxx,xxxx__) \
51 long_bytes {- DANGEROUS! -} \
53 {- Allocate a wad of memory to put the "long"'s bytes. \
54 Let's hope 32 bytes will be big enough. -} \
55 stToIO (newCharArray (0::Int, 31)) >>= \ arr# -> \
57 {- Call out to C to do the dirty deed: -} \
58 _casm_ ``%r = xxxx__ ((type)%0, (unsigned char *)%1);'' i arr# \
61 unpack arr# 0 (num_bytes - 1) \
66 XXXXToBytes(long,longToBytes,long2bytes__)
67 XXXXToBytes(int,intToBytes,int2bytes__)
68 XXXXToBytes(short,shortToBytes,short2bytes__)
69 XXXXToBytes(float,floatToBytes,float2bytes__)
70 XXXXToBytes(double,doubleToBytes,double2bytes__)
73 unpack :: MutableByteArray RealWorld Int -> Int -> Int -> IO [Char]
79 stToIO (readCharArray arr# curr) >>= \ ch ->
80 unpack arr# (curr + 1) last >>= \ rest ->
84 --Now we go the other way. The paranoia checking (absent) leaves
85 --something to be desired. Really have to be careful on
86 --funny-sized things like \tr{shorts}...
88 #define bytesToXXXX(htype,xxxx,alloc,read,xxxx__) \
91 {- slam (up to) 32 bytes [random] from the stream into an array -} \
92 stToIO (newCharArray (0::Int, 31)) >>= \ arr# -> \
93 pack arr# 0 31 stream >> \
95 {- make a one-element array to hold the result: -} \
96 stToIO (alloc (0::Int, 0)) >>= \ res# -> \
98 {- call the C to do the business: -} \
99 _casm_ ``%r = xxxx__ ((P_)%0, (htype *) %1);'' arr# res# \
102 {- read the result out of "res#": -} \
103 stToIO (read res# (0::Int)) >>= \ i -> \
105 {- box the result and drop the number of bytes taken: -} \
106 return (i, my_drop num_bytes stream) \
109 bytesToXXXX(I_,bytesToLong,newIntArray,readIntArray,bytes2long__)
110 bytesToXXXX(I_,bytesToInt,newIntArray,readIntArray,bytes2int__)
111 bytesToXXXX(I_,bytesToShort,newIntArray,readIntArray,bytes2short__)
112 bytesToXXXX(StgFloat,bytesToFloat,newFloatArray,readFloatArray,bytes2float__)
113 bytesToXXXX(StgDouble,bytesToDouble,newDoubleArray,readDoubleArray,bytes2double__)
115 ----------------------
116 pack :: MutableByteArray RealWorld Int -> Int -> Int -> [Char] -> IO ()
118 pack arr# curr last from_bytes
119 = if curr > last then
123 [] -> stToIO (writeCharArray arr# curr (chr 0))
126 stToIO (writeCharArray arr# curr from_byte) >>
127 pack arr# (curr + 1) last xs
129 -- more cavalier than usual; we know there will be enough bytes:
131 my_drop :: Int -> [a] -> [a]
135 my_drop m (_:xs) = my_drop (m - 1) xs