ghc/lib/misc/ByteOps.lhs

   1 {-
   2 %
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1994
   4 %
   5 \section[ByteOps]{Convert to/from ``bytes''; to support @Native@ class}
   6
   7 This mimics some code that comes with HBC.
   8 -}
   9
  10 \begin{code}
  11 module ByteOps (
  12         longToBytes,
  13         intToBytes,
  14         shortToBytes,
  15         floatToBytes,
  16         doubleToBytes,
  17
  18         bytesToLong,
  19         bytesToInt,
  20         bytesToShort,
  21         bytesToFloat,
  22         bytesToDouble
  23     ) where
  24
  25 import GlaExts
  26 import PrelBase
  27
  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.
  31
  32 type Bytes = [Char]
  33
  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
  39
  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)
  45
  46 --Here we go.
  47
  48 #define XXXXToBytes(type,xxxx,xxxx__) \
  49 xxxx i stream \
  50   = let \
  51         long_bytes      {- DANGEROUS! -} \
  52           = unsafePerformIO ( \
  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# -> \
  56  \
  57                 {- Call out to C to do the dirty deed: -} \
  58                 _casm_ ``%r = xxxx__ ((type)%0, (unsigned char *)%1);'' i arr# \
  59                         >>= \ num_bytes -> \
  60  \
  61                 unpack arr# 0 (num_bytes - 1) \
  62             ) \
  63     in \
  64     long_bytes ++ stream
  65
  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__)
  71
  72 --------------
  73 unpack :: MutableByteArray RealWorld Int -> Int -> Int -> IO [Char]
  74
  75 unpack arr# curr last
  76   = if curr > last then
  77         return []
  78     else
  79         stToIO (readCharArray arr# curr) >>= \ ch ->
  80         unpack arr# (curr + 1) last      >>= \ rest ->
  81         return (ch : rest)
  82
  83 -------------
  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}...
  87
  88 #define bytesToXXXX(htype,xxxx,alloc,read,xxxx__) \
  89 xxxx stream \
  90   = unsafePerformIO ( \
  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              >> \
  94  \
  95         {- make a one-element array to hold the result: -} \
  96         stToIO (alloc (0::Int, 0))          >>= \ res# -> \
  97  \
  98         {- call the C to do the business: -} \
  99         _casm_ ``%r = xxxx__ ((P_)%0, (htype *) %1);'' arr# res# \
 100                 >>= \ num_bytes -> \
 101  \
 102         {- read the result out of "res#": -} \
 103         stToIO (read res# (0::Int))  >>= \ i -> \
 104  \
 105         {- box the result and drop the number of bytes taken: -} \
 106         return (i, my_drop num_bytes stream) \
 107     )
 108
 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__)
 114
 115 ----------------------
 116 pack :: MutableByteArray RealWorld Int -> Int -> Int -> [Char] -> IO ()
 117
 118 pack arr# curr last from_bytes
 119   = if curr > last then
 120        return ()
 121     else
 122        case from_bytes of
 123          [] -> stToIO (writeCharArray arr# curr (chr 0))
 124
 125          (from_byte : xs) ->
 126            stToIO (writeCharArray arr# curr from_byte) >>
 127            pack arr# (curr + 1) last xs
 128
 129 -- more cavalier than usual; we know there will be enough bytes:
 130
 131 my_drop :: Int -> [a] -> [a]
 132
 133 my_drop 0 xs     = xs
 134 --my_drop _  []   = []
 135 my_drop m (_:xs) = my_drop (m - 1) xs
 136
 137 \end{code}