Addr.lhs 6.75 KB
Newer Older
1 2 3 4 5 6 7
%
% (c) The AQUA Project, Glasgow University, 1994-1996
%

\section[Addr]{Module @Addr@}

\begin{code}
sof's avatar
sof committed
8 9
#include "MachDeps.h"

sof's avatar
sof committed
10
module Addr 
11 12 13 14
	( Addr

	, module Addr
#ifndef __HUGS__
sof's avatar
sof committed
15 16
	, module Word
	, module Int
17 18 19
	, module PrelAddr 
#endif

sof's avatar
sof committed
20 21 22
        -- (non-standard) coercions
	, addrToInt		-- :: Addr -> Int  
	, intToAddr		-- :: Int  -> Addr
sof's avatar
sof committed
23 24
	    
	) where
25

andy's avatar
andy committed
26 27
import NumExts
#ifndef __HUGS__
28
import PrelAddr
sof's avatar
sof committed
29 30
import PrelForeign
import PrelStable
sof's avatar
sof committed
31
import PrelBase
32
import PrelIOBase ( IO(..) )
sof's avatar
sof committed
33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
import Word	( indexWord8OffAddr,  indexWord16OffAddr
		, indexWord32OffAddr, indexWord64OffAddr
		, readWord8OffAddr,   readWord16OffAddr
		, readWord32OffAddr,  readWord64OffAddr
		, writeWord8OffAddr,  writeWord16OffAddr
		, writeWord32OffAddr, writeWord64OffAddr
		)

import Int	( indexInt8OffAddr,  indexInt16OffAddr
		, indexInt32OffAddr, indexInt64OffAddr
		, readInt8OffAddr,   readInt16OffAddr
		, readInt32OffAddr,  readInt64OffAddr
		, writeInt8OffAddr,  writeInt16OffAddr
		, writeInt32OffAddr, writeInt64OffAddr
		)
sof's avatar
sof committed
48 49
#endif

sof's avatar
sof committed
50 51
\end{code}

sof's avatar
sof committed
52
\begin{code}
andy's avatar
andy committed
53 54 55 56 57 58 59 60 61 62
#ifdef __HUGS__
instance Show Addr where
   showsPrec p addr rs = pad_out (showHex int "") rs
     where
        -- want 0s prefixed to pad it out to a fixed length.
       pad_out ('0':'x':ls) rs = 
	  '0':'x':(replicate (2*ADDR_SIZE_IN_BYTES - length ls) '0') 
			++ ls ++ rs
       int = primAddrToInt addr
#else
sof's avatar
sof committed
63
instance Show Addr where
sof's avatar
sof committed
64
   showsPrec p (A# a) rs = pad_out (showHex int "") rs
sof's avatar
sof committed
65
     where
sof's avatar
sof committed
66
        -- want 0s prefixed to pad it out to a fixed length.
sof's avatar
sof committed
67 68
       pad_out ('0':'x':ls) rs = 
	  '0':'x':(replicate (2*ADDR_SIZE_IN_BYTES - length ls) '0') ++ ls ++ rs
sof's avatar
sof committed
69

sof's avatar
sof committed
70 71 72
       int = 
	case word2Integer# (int2Word# (addr2Int# a)) of
	  (# s, d #) -> J# s d
andy's avatar
andy committed
73
#endif
sof's avatar
sof committed
74 75 76
\end{code}


sof's avatar
sof committed
77 78 79 80 81
Coercing between machine ints and words

\begin{code}
addrToInt :: Addr -> Int
intToAddr :: Int -> Addr
82 83 84 85 86 87

#ifdef __HUGS__
addrToInt = primAddrToInt
intToAddr = primIntToAddr
#else
addrToInt (A# a#) = I# (addr2Int# a#)
sof's avatar
sof committed
88
intToAddr (I# i#) = A# (int2Addr# i#)
89
#endif
sof's avatar
sof committed
90 91
\end{code}

sof's avatar
sof committed
92 93 94 95 96 97 98 99 100
Indexing immutable memory:

\begin{code}
indexCharOffAddr   :: Addr -> Int -> Char
indexIntOffAddr    :: Addr -> Int -> Int
indexWordOffAddr   :: Addr -> Int -> Word
--in PrelAddr: indexAddrOffAddr   :: Addr -> Int -> Addr
indexFloatOffAddr  :: Addr -> Int -> Float
indexDoubleOffAddr :: Addr -> Int -> Double
sof's avatar
sof committed
101
indexStablePtrOffAddr :: Addr -> Int -> StablePtr a
sof's avatar
sof committed
102

103
#ifdef __HUGS__
andy's avatar
andy committed
104 105 106 107 108 109 110
indexCharOffAddr   = error "TODO: indexCharOffAddr  "
indexIntOffAddr    = error "TODO: indexIntOffAddr   "
indexWordOffAddr   = error "TODO: indexWordOffAddr  "
indexAddrOffAddr   = error "TODO: indexAddrOffAddr  "
indexFloatOffAddr  = error "TODO: indexFloatOffAddr "
indexDoubleOffAddr = error "TODO: indexDoubleOffAddr"
indexStablePtrOffAddr = error "TODO: indexStablePtrOffAddr"
111
#else
sof's avatar
sof committed
112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135
indexCharOffAddr (A# addr#) n
  = case n  	    		    	of { I# n# ->
    case indexCharOffAddr# addr# n# 	of { r# ->
    (C# r#)}}

indexIntOffAddr (A# addr#) n
  = case n  	    		    	of { I# n# ->
    case indexIntOffAddr# addr# n# 	of { r# ->
    (I# r#)}}

indexWordOffAddr (A# addr#) n
  = case n  	    		    	of { I# n# ->
    case indexWordOffAddr# addr# n# 	of { r# ->
    (W# r#)}}

indexFloatOffAddr (A# addr#) n
  = case n  	    		    	of { I# n# ->
    case indexFloatOffAddr# addr# n# 	of { r# ->
    (F# r#)}}

indexDoubleOffAddr (A# addr#) n
  = case n  	    	 	    	of { I# n# ->
    case indexDoubleOffAddr# addr# n# 	of { r# ->
    (D# r#)}}
sof's avatar
sof committed
136 137 138 139 140

indexStablePtrOffAddr (A# addr#) n
  = case n  	    	 	    	 of { I# n# ->
    case indexStablePtrOffAddr# addr# n# of { r# ->
    (StablePtr r#)}}
141
#endif
sof's avatar
sof committed
142 143 144 145 146 147
\end{code}

Indexing mutable memory:

\begin{code}
readCharOffAddr    :: Addr -> Int -> IO Char
148
readIntOffAddr     :: Addr -> Int -> IO Int
sof's avatar
sof committed
149 150
readWordOffAddr    :: Addr -> Int -> IO Word
readAddrOffAddr    :: Addr -> Int -> IO Addr
151
readFloatOffAddr   :: Addr -> Int -> IO Float
sof's avatar
sof committed
152
readDoubleOffAddr  :: Addr -> Int -> IO Double
sof's avatar
sof committed
153
readStablePtrOffAddr  :: Addr -> Int -> IO (StablePtr a)
154 155

#ifdef __HUGS__
andy's avatar
andy committed
156 157 158 159 160 161 162
readCharOffAddr      = error "TODO: readCharOffAddr     "
readIntOffAddr       = error "TODO: readIntOffAddr      "
readWordOffAddr      = error "TODO: readWordOffAddr     "
readAddrOffAddr      = error "TODO: readAddrOffAddr     "
readFloatOffAddr     = error "TODO: readFloatOffAddr    "
readDoubleOffAddr    = error "TODO: readDoubleOffAddr   "
readStablePtrOffAddr = error "TODO: readStablePtrOffAddr"
163
#else
sof's avatar
sof committed
164 165 166 167 168 169 170
readCharOffAddr a i = case indexCharOffAddr a i of { C# o# -> return (C# o#) }
readIntOffAddr a i  = case indexIntOffAddr a i of { I# o# -> return (I# o#) }
readWordOffAddr a i = case indexWordOffAddr a i of { W# o# -> return (W# o#) }
readAddrOffAddr a i = case indexAddrOffAddr a i of { A# o# -> return (A# o#) }
readFloatOffAddr a i = case indexFloatOffAddr a i of { F# o# -> return (F# o#) }
readDoubleOffAddr a i = case indexDoubleOffAddr a i of { D# o# -> return (D# o#) }
readStablePtrOffAddr a i = case indexStablePtrOffAddr a i of { StablePtr x -> return (StablePtr x) }
171
#endif
sof's avatar
sof committed
172 173 174 175 176
\end{code}


\begin{code}
writeCharOffAddr   :: Addr -> Int -> Char   -> IO ()
177 178 179 180 181 182 183
writeIntOffAddr    :: Addr -> Int -> Int    -> IO ()
writeWordOffAddr   :: Addr -> Int -> Word  -> IO ()
writeAddrOffAddr   :: Addr -> Int -> Addr   -> IO ()
writeFloatOffAddr  :: Addr -> Int -> Float  -> IO ()
writeDoubleOffAddr :: Addr -> Int -> Double -> IO ()

#ifdef __HUGS__
andy's avatar
andy committed
184 185 186 187 188 189
writeCharOffAddr    = error "TODO: writeCharOffAddr   "
writeIntOffAddr     = error "TODO: writeIntOffAddr    "
writeWordOffAddr    = error "TODO: writeWordOffAddr   "
writeAddrOffAddr    = error "TODO: writeAddrOffAddr   "
writeFloatOffAddr   = error "TODO: writeFloatOffAddr  "
writeDoubleOffAddr  = error "TODO: writeDoubleOffAddr "
190
#else
sof's avatar
sof committed
191
writeCharOffAddr (A# a#) (I# i#) (C# c#) = IO $ \ s# ->
192
      case (writeCharOffAddr#  a# i# c# s#) of s2# -> (# s2#, () #)
sof's avatar
sof committed
193

sof's avatar
sof committed
194
writeIntOffAddr (A# a#) (I# i#) (I# e#) = IO $ \ s# ->
195
      case (writeIntOffAddr#  a# i# e# s#) of s2# -> (# s2#, () #)
sof's avatar
sof committed
196

sof's avatar
sof committed
197
writeWordOffAddr (A# a#) (I# i#) (W# e#) = IO $ \ s# ->
198
      case (writeWordOffAddr#  a# i# e# s#) of s2# -> (# s2#, () #)
sof's avatar
sof committed
199

sof's avatar
sof committed
200
writeAddrOffAddr (A# a#) (I# i#) (A# e#) = IO $ \ s# ->
201
      case (writeAddrOffAddr#  a# i# e# s#) of s2# -> (# s2#, () #)
sof's avatar
sof committed
202

sof's avatar
sof committed
203
writeFloatOffAddr (A# a#) (I# i#) (F# e#) = IO $ \ s# ->
204
      case (writeFloatOffAddr#  a# i# e# s#) of s2# -> (# s2#, () #)
sof's avatar
sof committed
205

sof's avatar
sof committed
206
writeDoubleOffAddr (A# a#) (I# i#) (D# e#) = IO $ \ s# ->
207
      case (writeDoubleOffAddr#  a# i# e# s#) of s2# -> (# s2#, () #)
sof's avatar
sof committed
208 209 210 211 212 213 214 215 216 217 218

#ifndef __PARALLEL_HASKELL__
writeForeignObjOffAddr   :: Addr -> Int -> ForeignObj -> IO ()
writeForeignObjOffAddr (A# a#) (I# i#) (ForeignObj e#) = IO $ \ s# ->
      case (writeForeignObjOffAddr#  a# i# e# s#) of s2# -> (# s2#, () #)
#endif

writeStablePtrOffAddr    :: Addr -> Int -> StablePtr a -> IO ()
writeStablePtrOffAddr (A# a#) (I# i#) (StablePtr e#) = IO $ \ s# ->
      case (writeStablePtrOffAddr#  a# i# e# s#) of s2# -> (# s2# , () #)

219
#endif
220
\end{code}