src/code/target-sap.lisp

   1 ;;;; support for System Area Pointers (SAPs) in the target machine
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; This software is derived from the CMU CL system, which was
   7 ;;;; written at Carnegie Mellon University and released into the
   8 ;;;; public domain. The software is in the public domain and is
   9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  10 ;;;; files for more information.
  11
  12 (in-package "SB!SYS")
  13 ;;; FIXME: Shouldn't these be IN-PACKAGE SB!KERNEL instead? (They're
  14 ;;; not dependent on the OS, only on the CPU architecture.)
  15
  16 (file-comment
  17   "$Header$")
  18 \f
  19 ;;;; primitive SAP operations
  20
  21 (defun sap< (x y)
  22   #!+sb-doc
  23   "Return T iff the SAP X points to a smaller address then the SAP Y."
  24   (declare (type system-area-pointer x y))
  25   (sap< x y))
  26
  27 (defun sap<= (x y)
  28   #!+sb-doc
  29   "Return T iff the SAP X points to a smaller or the same address as
  30    the SAP Y."
  31   (declare (type system-area-pointer x y))
  32   (sap<= x y))
  33
  34 (defun sap= (x y)
  35   #!+sb-doc
  36   "Return T iff the SAP X points to the same address as the SAP Y."
  37   (declare (type system-area-pointer x y))
  38   (sap= x y))
  39
  40 (defun sap>= (x y)
  41   #!+sb-doc
  42   "Return T iff the SAP X points to a larger or the same address as
  43    the SAP Y."
  44   (declare (type system-area-pointer x y))
  45   (sap>= x y))
  46
  47 (defun sap> (x y)
  48   #!+sb-doc
  49   "Return T iff the SAP X points to a larger address then the SAP Y."
  50   (declare (type system-area-pointer x y))
  51   (sap> x y))
  52
  53 (defun sap+ (sap offset)
  54   #!+sb-doc
  55   "Return a new sap OFFSET bytes from SAP."
  56   (declare (type system-area-pointer sap)
  57            (fixnum offset))
  58   (sap+ sap offset))
  59
  60 (defun sap- (sap1 sap2)
  61   #!+sb-doc
  62   "Return the byte offset between SAP1 and SAP2."
  63   (declare (type system-area-pointer sap1 sap2))
  64   (sap- sap1 sap2))
  65
  66 (defun sap-int (sap)
  67   #!+sb-doc
  68   "Converts a System Area Pointer into an integer."
  69   (declare (type system-area-pointer sap))
  70   (sap-int sap))
  71
  72 (defun int-sap (int)
  73   #!+sb-doc
  74   "Converts an integer into a System Area Pointer."
  75   (declare (type sap-int-type int))
  76   (int-sap int))
  77
  78 (defun sap-ref-8 (sap offset)
  79   #!+sb-doc
  80   "Returns the 8-bit byte at OFFSET bytes from SAP."
  81   (declare (type system-area-pointer sap)
  82            (fixnum offset))
  83   (sap-ref-8 sap offset))
  84
  85 (defun sap-ref-16 (sap offset)
  86   #!+sb-doc
  87   "Returns the 16-bit word at OFFSET bytes from SAP."
  88   (declare (type system-area-pointer sap)
  89            (fixnum offset))
  90   (sap-ref-16 sap offset))
  91
  92 (defun sap-ref-32 (sap offset)
  93   #!+sb-doc
  94   "Returns the 32-bit dualword at OFFSET bytes from SAP."
  95   (declare (type system-area-pointer sap)
  96            (fixnum offset))
  97   (sap-ref-32 sap offset))
  98
  99 #!+alpha
 100 (defun sap-ref-64 (sap offset)
 101   #!+sb-doc
 102   "Returns the 64-bit quadword at OFFSET bytes from SAP."
 103   (declare (type system-area-pointer sap)
 104            (fixnum offset))
 105   (sap-ref-64 sap offset))
 106
 107 (defun sap-ref-sap (sap offset)
 108   #!+sb-doc
 109   "Returns the 32-bit system-area-pointer at OFFSET bytes from SAP."
 110   (declare (type system-area-pointer sap)
 111            (fixnum offset))
 112   (sap-ref-sap sap offset))
 113
 114 (defun sap-ref-single (sap offset)
 115   #!+sb-doc
 116   "Returns the 32-bit single-float at OFFSET bytes from SAP."
 117   (declare (type system-area-pointer sap)
 118            (fixnum offset))
 119   (sap-ref-single sap offset))
 120
 121 (defun sap-ref-double (sap offset)
 122   #!+sb-doc
 123   "Returns the 64-bit double-float at OFFSET bytes from SAP."
 124   (declare (type system-area-pointer sap)
 125            (fixnum offset))
 126   (sap-ref-double sap offset))
 127
 128 #!+(or x86 long-float)
 129 (defun sap-ref-long (sap offset)
 130   #!+sb-doc
 131   "Returns the long-float at OFFSET bytes from SAP."
 132   (declare (type system-area-pointer sap)
 133            (fixnum offset))
 134   (sap-ref-long sap offset))
 135
 136 (defun signed-sap-ref-8 (sap offset)
 137   #!+sb-doc
 138   "Returns the signed 8-bit byte at OFFSET bytes from SAP."
 139   (declare (type system-area-pointer sap)
 140            (fixnum offset))
 141   (signed-sap-ref-8 sap offset))
 142
 143 (defun signed-sap-ref-16 (sap offset)
 144   #!+sb-doc
 145   "Returns the signed 16-bit word at OFFSET bytes from SAP."
 146   (declare (type system-area-pointer sap)
 147            (fixnum offset))
 148   (signed-sap-ref-16 sap offset))
 149
 150 (defun signed-sap-ref-32 (sap offset)
 151   #!+sb-doc
 152   "Returns the signed 32-bit dualword at OFFSET bytes from SAP."
 153   (declare (type system-area-pointer sap)
 154            (fixnum offset))
 155   (signed-sap-ref-32 sap offset))
 156
 157 #!+alpha
 158 (defun signed-sap-ref-64 (sap offset)
 159   #!+sb-doc
 160   "Returns the signed 64-bit quadword at OFFSET bytes from SAP."
 161   (declare (type system-area-pointer sap)
 162            (fixnum offset))
 163   (signed-sap-ref-64 sap offset))
 164
 165 (defun %set-sap-ref-8 (sap offset new-value)
 166   (declare (type system-area-pointer sap)
 167            (fixnum offset)
 168            (type (unsigned-byte 8) new-value))
 169   (setf (sap-ref-8 sap offset) new-value))
 170
 171 (defun %set-sap-ref-16 (sap offset new-value)
 172   (declare (type system-area-pointer sap)
 173            (fixnum offset)
 174            (type (unsigned-byte 16) new-value))
 175   (setf (sap-ref-16 sap offset) new-value))
 176
 177 (defun %set-sap-ref-32 (sap offset new-value)
 178   (declare (type system-area-pointer sap)
 179            (fixnum offset)
 180            (type (unsigned-byte 32) new-value))
 181   (setf (sap-ref-32 sap offset) new-value))
 182
 183 #!+alpha
 184 (defun %set-sap-ref-64 (sap offset new-value)
 185   (declare (type system-area-pointer sap)
 186            (fixnum offset)
 187            (type (unsigned-byte 64) new-value))
 188   (setf (sap-ref-64 sap offset) new-value))
 189
 190 (defun %set-signed-sap-ref-8 (sap offset new-value)
 191   (declare (type system-area-pointer sap)
 192            (fixnum offset)
 193            (type (signed-byte 8) new-value))
 194   (setf (signed-sap-ref-8 sap offset) new-value))
 195
 196 (defun %set-signed-sap-ref-16 (sap offset new-value)
 197   (declare (type system-area-pointer sap)
 198            (fixnum offset)
 199            (type (signed-byte 16) new-value))
 200   (setf (signed-sap-ref-16 sap offset) new-value))
 201
 202 (defun %set-signed-sap-ref-32 (sap offset new-value)
 203   (declare (type system-area-pointer sap)
 204            (fixnum offset)
 205            (type (signed-byte 32) new-value))
 206   (setf (signed-sap-ref-32 sap offset) new-value))
 207
 208 #!+alpha
 209 (defun %set-signed-sap-ref-64 (sap offset new-value)
 210   (declare (type system-area-pointer sap)
 211            (fixnum offset)
 212            (type (signed-byte 64) new-value))
 213   (setf (signed-sap-ref-64 sap offset) new-value))
 214
 215 (defun %set-sap-ref-sap (sap offset new-value)
 216   (declare (type system-area-pointer sap new-value)
 217            (fixnum offset))
 218   (setf (sap-ref-sap sap offset) new-value))
 219
 220 (defun %set-sap-ref-single (sap offset new-value)
 221   (declare (type system-area-pointer sap)
 222            (fixnum offset)
 223            (type single-float new-value))
 224   (setf (sap-ref-single sap offset) new-value))
 225
 226 (defun %set-sap-ref-double (sap offset new-value)
 227   (declare (type system-area-pointer sap)
 228            (fixnum offset)
 229            (type double-float new-value))
 230   (setf (sap-ref-double sap offset) new-value))
 231
 232 #!+long-float
 233 (defun %set-sap-ref-long (sap offset new-value)
 234   (declare (type system-area-pointer sap)
 235            (fixnum offset)
 236            (type long-float new-value))
 237   (setf (sap-ref-long sap offset) new-value))
 238 \f
 239 ;;;; system memory allocation
 240
 241 (sb!alien:def-alien-routine ("os_allocate" allocate-system-memory)
 242                             system-area-pointer
 243   (bytes sb!c-call:unsigned-long))
 244
 245 (sb!alien:def-alien-routine ("os_allocate_at" allocate-system-memory-at)
 246                             system-area-pointer
 247   (address system-area-pointer)
 248   (bytes sb!c-call:unsigned-long))
 249
 250 (sb!alien:def-alien-routine ("os_reallocate" reallocate-system-memory)
 251                             system-area-pointer
 252   (old system-area-pointer)
 253   (old-size sb!c-call:unsigned-long)
 254   (new-size sb!c-call:unsigned-long))
 255
 256 (sb!alien:def-alien-routine ("os_deallocate" deallocate-system-memory)
 257                             sb!c-call:void
 258   (addr system-area-pointer)
 259   (bytes sb!c-call:unsigned-long))