ghc/lib/glaExts/ByteOps.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1994
   3 %
   4 \section[ByteOps]{Convert to/from ``bytes''; to support @Native@ class}
   5
   6 This mimics some code that comes with HBC.
   7
   8 \begin{code}
   9 module ByteOps (
  10         longToBytes,
  11         intToBytes,
  12         shortToBytes,
  13         floatToBytes,
  14         doubleToBytes,
  15
  16         bytesToLong,
  17         bytesToInt,
  18         bytesToShort,
  19         bytesToFloat,
  20         bytesToDouble
  21     ) where
  22
  23 import Cls
  24 import Core
  25 import IInt
  26 import IFloat
  27 import IDouble
  28 import List             ( (++), foldr )
  29 import Prel             ( chr )
  30 import PS               ( _PackedString, _unpackPS )
  31 import TyArray          ( Array(..) )
  32 import TyComplex
  33 import PreludeGlaST
  34 import Text
  35 \end{code}
  36
  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.
  40 \begin{code}
  41 type Bytes = [Char]
  42
  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
  48
  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)
  54 \end{code}
  55
  56 Here we go.
  57 \begin{code}
  58 #define XXXXToBytes(type,xxxx,xxxx__) \
  59 xxxx i stream \
  60   = let \
  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# -> \
  66  \
  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 -> \
  70  \
  71                 unpack arr# 0 (num_bytes - 1) \
  72             ) \
  73     in \
  74     long_bytes ++ stream
  75
  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__)
  81 \end{code}
  82
  83 \begin{code}
  84 unpack :: _MutableByteArray _RealWorld Int -> Int -> Int -> PrimIO [Char]
  85
  86 unpack arr# curr last
  87   = if curr > last then
  88         returnPrimIO []
  89     else
  90         readCharArray arr# curr     `thenPrimIO` \ ch ->
  91         unpack arr# (curr + 1) last `thenPrimIO` \ rest ->
  92         returnPrimIO (ch : rest)
  93 \end{code}
  94
  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}...
  98 \begin{code}
  99 #define bytesToXXXX(htype,xxxx,alloc,read,xxxx__) \
 100 xxxx stream \
 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` \
 105  \
 106         {- make a one-element array to hold the result: -} \
 107         alloc (0::Int, 0)           `thenPrimIO` \ res# -> \
 108  \
 109         {- call the C to do the business: -} \
 110         _casm_ ``%r = xxxx__ ((P_)%0, (htype *) %1);'' arr# res# \
 111                 `thenPrimIO` \ num_bytes -> \
 112  \
 113         {- read the result out of "res#": -} \
 114         read res# (0::Int)  `thenPrimIO` \ i -> \
 115  \
 116         {- box the result and drop the number of bytes taken: -} \
 117         returnPrimIO (i, my_drop num_bytes stream) \
 118     )
 119
 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__)
 125 \end{code}
 126
 127 \begin{code}
 128 pack :: _MutableByteArray _RealWorld Int -> Int -> Int -> [Char] -> PrimIO ()
 129
 130 pack arr# curr last from_bytes
 131   = if curr > last then
 132        returnPrimIO ()
 133     else
 134        case from_bytes of
 135          [] -> writeCharArray arr# curr (chr 0)
 136
 137          (from_byte : xs) ->
 138            writeCharArray arr# curr from_byte   `seqPrimIO`
 139            pack arr# (curr + 1) last xs
 140
 141 -- more cavalier than usual; we know there will be enough bytes:
 142
 143 my_drop :: Int -> [a] -> [a]
 144
 145 my_drop 0 xs     = xs
 146 --my_drop _  []   = []
 147 my_drop m (_:xs) = my_drop (m - 1) xs
 148 \end{code}