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