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