ghc/lib/exts/Addr.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1996
   3 %
   4
   5 \section[Addr]{Module @Addr@}
   6
   7 \begin{code}
   8 #include "MachDeps.h"
   9
  10 module Addr
  11         ( Addr
  12
  13         , module Addr
  14 #ifndef __HUGS__
  15         , module Word
  16         , module Int
  17         , module PrelAddr
  18 #endif
  19
  20         -- (non-standard) coercions
  21         , addrToInt             -- :: Addr -> Int
  22         , intToAddr             -- :: Int  -> Addr
  23
  24         ) where
  25
  26 import NumExts
  27 #ifndef __HUGS__
  28 import PrelAddr
  29 import PrelForeign
  30 import PrelStable
  31 import PrelBase
  32 import PrelIOBase ( IO(..) )
  33 import Word     ( indexWord8OffAddr,  indexWord16OffAddr
  34                 , indexWord32OffAddr, indexWord64OffAddr
  35                 , readWord8OffAddr,   readWord16OffAddr
  36                 , readWord32OffAddr,  readWord64OffAddr
  37                 , writeWord8OffAddr,  writeWord16OffAddr
  38                 , writeWord32OffAddr, writeWord64OffAddr
  39                 )
  40
  41 import Int      ( indexInt8OffAddr,  indexInt16OffAddr
  42                 , indexInt32OffAddr, indexInt64OffAddr
  43                 , readInt8OffAddr,   readInt16OffAddr
  44                 , readInt32OffAddr,  readInt64OffAddr
  45                 , writeInt8OffAddr,  writeInt16OffAddr
  46                 , writeInt32OffAddr, writeInt64OffAddr
  47                 )
  48 #endif
  49
  50 \end{code}
  51
  52 \begin{code}
  53 #ifdef __HUGS__
  54 instance Show Addr where
  55    showsPrec p addr rs = pad_out (showHex int "") rs
  56      where
  57         -- want 0s prefixed to pad it out to a fixed length.
  58        pad_out ('0':'x':ls) rs =
  59           '0':'x':(replicate (2*ADDR_SIZE_IN_BYTES - length ls) '0')
  60                         ++ ls ++ rs
  61        int = primAddrToInt addr
  62 #else
  63 instance Show Addr where
  64    showsPrec p (A# a) rs = pad_out (showHex int "") rs
  65      where
  66         -- want 0s prefixed to pad it out to a fixed length.
  67        pad_out ('0':'x':ls) rs =
  68           '0':'x':(replicate (2*ADDR_SIZE_IN_BYTES - length ls) '0') ++ ls ++ rs
  69
  70        int =
  71         case word2Integer# (int2Word# (addr2Int# a)) of
  72           (# s, d #) -> J# s d
  73 #endif
  74 \end{code}
  75
  76
  77 Coercing between machine ints and words
  78
  79 \begin{code}
  80 addrToInt :: Addr -> Int
  81 intToAddr :: Int -> Addr
  82
  83 #ifdef __HUGS__
  84 addrToInt = primAddrToInt
  85 intToAddr = primIntToAddr
  86 #else
  87 addrToInt (A# a#) = I# (addr2Int# a#)
  88 intToAddr (I# i#) = A# (int2Addr# i#)
  89 #endif
  90 \end{code}
  91
  92 Indexing immutable memory:
  93
  94 \begin{code}
  95 indexCharOffAddr   :: Addr -> Int -> Char
  96 indexIntOffAddr    :: Addr -> Int -> Int
  97 indexWordOffAddr   :: Addr -> Int -> Word
  98 --in PrelAddr: indexAddrOffAddr   :: Addr -> Int -> Addr
  99 indexFloatOffAddr  :: Addr -> Int -> Float
 100 indexDoubleOffAddr :: Addr -> Int -> Double
 101 indexStablePtrOffAddr :: Addr -> Int -> StablePtr a
 102
 103 #ifdef __HUGS__
 104 indexCharOffAddr   = error "TODO: indexCharOffAddr  "
 105 indexIntOffAddr    = error "TODO: indexIntOffAddr   "
 106 indexWordOffAddr   = error "TODO: indexWordOffAddr  "
 107 indexAddrOffAddr   = error "TODO: indexAddrOffAddr  "
 108 indexFloatOffAddr  = error "TODO: indexFloatOffAddr "
 109 indexDoubleOffAddr = error "TODO: indexDoubleOffAddr"
 110 indexStablePtrOffAddr = error "TODO: indexStablePtrOffAddr"
 111 #else
 112 indexCharOffAddr (A# addr#) n
 113   = case n                              of { I# n# ->
 114     case indexCharOffAddr# addr# n#     of { r# ->
 115     (C# r#)}}
 116
 117 indexIntOffAddr (A# addr#) n
 118   = case n                              of { I# n# ->
 119     case indexIntOffAddr# addr# n#      of { r# ->
 120     (I# r#)}}
 121
 122 indexWordOffAddr (A# addr#) n
 123   = case n                              of { I# n# ->
 124     case indexWordOffAddr# addr# n#     of { r# ->
 125     (W# r#)}}
 126
 127 indexFloatOffAddr (A# addr#) n
 128   = case n                              of { I# n# ->
 129     case indexFloatOffAddr# addr# n#    of { r# ->
 130     (F# r#)}}
 131
 132 indexDoubleOffAddr (A# addr#) n
 133   = case n                              of { I# n# ->
 134     case indexDoubleOffAddr# addr# n#   of { r# ->
 135     (D# r#)}}
 136
 137 indexStablePtrOffAddr (A# addr#) n
 138   = case n                               of { I# n# ->
 139     case indexStablePtrOffAddr# addr# n# of { r# ->
 140     (StablePtr r#)}}
 141 #endif
 142 \end{code}
 143
 144 Indexing mutable memory:
 145
 146 \begin{code}
 147 readCharOffAddr    :: Addr -> Int -> IO Char
 148 readIntOffAddr     :: Addr -> Int -> IO Int
 149 readWordOffAddr    :: Addr -> Int -> IO Word
 150 readAddrOffAddr    :: Addr -> Int -> IO Addr
 151 readFloatOffAddr   :: Addr -> Int -> IO Float
 152 readDoubleOffAddr  :: Addr -> Int -> IO Double
 153 readStablePtrOffAddr  :: Addr -> Int -> IO (StablePtr a)
 154
 155 #ifdef __HUGS__
 156 readCharOffAddr      = error "TODO: readCharOffAddr     "
 157 readIntOffAddr       = error "TODO: readIntOffAddr      "
 158 readWordOffAddr      = error "TODO: readWordOffAddr     "
 159 readAddrOffAddr      = error "TODO: readAddrOffAddr     "
 160 readFloatOffAddr     = error "TODO: readFloatOffAddr    "
 161 readDoubleOffAddr    = error "TODO: readDoubleOffAddr   "
 162 readStablePtrOffAddr = error "TODO: readStablePtrOffAddr"
 163 #else
 164 readCharOffAddr a i = case indexCharOffAddr a i of { C# o# -> return (C# o#) }
 165 readIntOffAddr a i  = case indexIntOffAddr a i of { I# o# -> return (I# o#) }
 166 readWordOffAddr a i = case indexWordOffAddr a i of { W# o# -> return (W# o#) }
 167 readAddrOffAddr a i = case indexAddrOffAddr a i of { A# o# -> return (A# o#) }
 168 readFloatOffAddr a i = case indexFloatOffAddr a i of { F# o# -> return (F# o#) }
 169 readDoubleOffAddr a i = case indexDoubleOffAddr a i of { D# o# -> return (D# o#) }
 170 readStablePtrOffAddr a i = case indexStablePtrOffAddr a i of { StablePtr x -> return (StablePtr x) }
 171 #endif
 172 \end{code}
 173
 174
 175 \begin{code}
 176 writeCharOffAddr   :: Addr -> Int -> Char   -> IO ()
 177 writeIntOffAddr    :: Addr -> Int -> Int    -> IO ()
 178 writeWordOffAddr   :: Addr -> Int -> Word  -> IO ()
 179 writeAddrOffAddr   :: Addr -> Int -> Addr   -> IO ()
 180 writeFloatOffAddr  :: Addr -> Int -> Float  -> IO ()
 181 writeDoubleOffAddr :: Addr -> Int -> Double -> IO ()
 182
 183 #ifdef __HUGS__
 184 writeCharOffAddr    = error "TODO: writeCharOffAddr   "
 185 writeIntOffAddr     = error "TODO: writeIntOffAddr    "
 186 writeWordOffAddr    = error "TODO: writeWordOffAddr   "
 187 writeAddrOffAddr    = error "TODO: writeAddrOffAddr   "
 188 writeFloatOffAddr   = error "TODO: writeFloatOffAddr  "
 189 writeDoubleOffAddr  = error "TODO: writeDoubleOffAddr "
 190 #else
 191 writeCharOffAddr (A# a#) (I# i#) (C# c#) = IO $ \ s# ->
 192       case (writeCharOffAddr#  a# i# c# s#) of s2# -> (# s2#, () #)
 193
 194 writeIntOffAddr (A# a#) (I# i#) (I# e#) = IO $ \ s# ->
 195       case (writeIntOffAddr#  a# i# e# s#) of s2# -> (# s2#, () #)
 196
 197 writeWordOffAddr (A# a#) (I# i#) (W# e#) = IO $ \ s# ->
 198       case (writeWordOffAddr#  a# i# e# s#) of s2# -> (# s2#, () #)
 199
 200 writeAddrOffAddr (A# a#) (I# i#) (A# e#) = IO $ \ s# ->
 201       case (writeAddrOffAddr#  a# i# e# s#) of s2# -> (# s2#, () #)
 202
 203 writeFloatOffAddr (A# a#) (I# i#) (F# e#) = IO $ \ s# ->
 204       case (writeFloatOffAddr#  a# i# e# s#) of s2# -> (# s2#, () #)
 205
 206 writeDoubleOffAddr (A# a#) (I# i#) (D# e#) = IO $ \ s# ->
 207       case (writeDoubleOffAddr#  a# i# e# s#) of s2# -> (# s2#, () #)
 208
 209 #ifndef __PARALLEL_HASKELL__
 210 writeForeignObjOffAddr   :: Addr -> Int -> ForeignObj -> IO ()
 211 writeForeignObjOffAddr (A# a#) (I# i#) (ForeignObj e#) = IO $ \ s# ->
 212       case (writeForeignObjOffAddr#  a# i# e# s#) of s2# -> (# s2#, () #)
 213 #endif
 214
 215 writeStablePtrOffAddr    :: Addr -> Int -> StablePtr a -> IO ()
 216 writeStablePtrOffAddr (A# a#) (I# i#) (StablePtr e#) = IO $ \ s# ->
 217       case (writeStablePtrOffAddr#  a# i# e# s#) of s2# -> (# s2# , () #)
 218
 219 #endif
 220 \end{code}