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