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 {-# OPTIONS -#include "cbits/ByteOps.h" #-}
  12
  13 module ByteOps (
  14         longToBytes,
  15         intToBytes,
  16         shortToBytes,
  17         floatToBytes,
  18         doubleToBytes,
  19
  20         bytesToLong,
  21         bytesToInt,
  22         bytesToShort,
  23         bytesToFloat,
  24         bytesToDouble
  25     ) where
  26
  27 import GlaExts
  28 import PrelBase
  29
  30 -- \tr{xxxToBytes} prepends an \tr{xxx} to a byte stream.
  31 -- \tr{bytesToXxx} snaffles an \tr{xxx} from a byte stream,
  32 -- also returning the rest of the stream.
  33
  34 type Bytes = [Char]
  35
  36 longToBytes    :: Int    -> Bytes -> Bytes
  37 intToBytes     :: Int    -> Bytes -> Bytes
  38 shortToBytes   :: Int    -> Bytes -> Bytes
  39 floatToBytes   :: Float  -> Bytes -> Bytes
  40 doubleToBytes  :: Double -> Bytes -> Bytes
  41
  42 bytesToLong    :: Bytes -> (Int,    Bytes)
  43 bytesToInt     :: Bytes -> (Int,    Bytes)
  44 bytesToShort   :: Bytes -> (Int,    Bytes)
  45 bytesToFloat   :: Bytes -> (Float,  Bytes)
  46 bytesToDouble  :: Bytes -> (Double, Bytes)
  47
  48 --Here we go.
  49
  50 #define XXXXToBytes(type,xxxx,xxxx__) \
  51 xxxx i stream \
  52   = let \
  53         long_bytes      {- DANGEROUS! -} \
  54           = unsafePerformIO ( \
  55                 {- Allocate a wad of memory to put the "long"'s bytes. \
  56                    Let's hope 32 bytes will be big enough. -} \
  57                 stToIO (newCharArray (0::Int, 31)) >>= \ arr# -> \
  58  \
  59                 {- Call out to C to do the dirty deed: -} \
  60                 _casm_ ``%r = xxxx__ ((type)%0, (unsigned char *)%1);'' i arr# \
  61                         >>= \ num_bytes -> \
  62  \
  63                 unpack arr# 0 (num_bytes - 1) \
  64             ) \
  65     in \
  66     long_bytes ++ stream
  67
  68 XXXXToBytes(long,longToBytes,long2bytes__)
  69 XXXXToBytes(int,intToBytes,int2bytes__)
  70 XXXXToBytes(short,shortToBytes,short2bytes__)
  71 XXXXToBytes(float,floatToBytes,float2bytes__)
  72 XXXXToBytes(double,doubleToBytes,double2bytes__)
  73
  74 --------------
  75 unpack :: MutableByteArray RealWorld Int -> Int -> Int -> IO [Char]
  76
  77 unpack arr# curr last
  78   = if curr > last then
  79         return []
  80     else
  81         stToIO (readCharArray arr# curr) >>= \ ch ->
  82         unpack arr# (curr + 1) last      >>= \ rest ->
  83         return (ch : rest)
  84
  85 -------------
  86 --Now we go the other way.  The paranoia checking (absent) leaves
  87 --something to be desired.  Really have to be careful on
  88 --funny-sized things like \tr{shorts}...
  89
  90 #define bytesToXXXX(htype,xxxx,alloc,read,xxxx__) \
  91 xxxx stream \
  92   = unsafePerformIO ( \
  93         {- slam (up to) 32 bytes [random] from the stream into an array -} \
  94         stToIO (newCharArray (0::Int, 31)) >>= \ arr# -> \
  95         pack arr# 0 31 stream              >> \
  96  \
  97         {- make a one-element array to hold the result: -} \
  98         stToIO (alloc (0::Int, 0))          >>= \ res# -> \
  99  \
 100         {- call the C to do the business: -} \
 101         _casm_ ``%r = xxxx__ ((P_)%0, (htype *) %1);'' arr# res# \
 102                 >>= \ num_bytes -> \
 103  \
 104         {- read the result out of "res#": -} \
 105         stToIO (read res# (0::Int))  >>= \ i -> \
 106  \
 107         {- box the result and drop the number of bytes taken: -} \
 108         return (i, my_drop num_bytes stream) \
 109     )
 110
 111 bytesToXXXX(I_,bytesToLong,newIntArray,readIntArray,bytes2long__)
 112 bytesToXXXX(I_,bytesToInt,newIntArray,readIntArray,bytes2int__)
 113 bytesToXXXX(I_,bytesToShort,newIntArray,readIntArray,bytes2short__)
 114 bytesToXXXX(StgFloat,bytesToFloat,newFloatArray,readFloatArray,bytes2float__)
 115 bytesToXXXX(StgDouble,bytesToDouble,newDoubleArray,readDoubleArray,bytes2double__)
 116
 117 ----------------------
 118 pack :: MutableByteArray RealWorld Int -> Int -> Int -> [Char] -> IO ()
 119
 120 pack arr# curr last from_bytes
 121   = if curr > last then
 122        return ()
 123     else
 124        case from_bytes of
 125          [] -> stToIO (writeCharArray arr# curr (chr 0))
 126
 127          (from_byte : xs) ->
 128            stToIO (writeCharArray arr# curr from_byte) >>
 129            pack arr# (curr + 1) last xs
 130
 131 -- more cavalier than usual; we know there will be enough bytes:
 132
 133 my_drop :: Int -> [a] -> [a]
 134
 135 my_drop 0 xs     = xs
 136 --my_drop _  []   = []
 137 my_drop m (_:xs) = my_drop (m - 1) xs
 138
 139 \end{code}