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   (int-sap int))
  60
  61 ;;; Return the 8-bit byte at OFFSET bytes from SAP.
  62 (defun sap-ref-8 (sap offset)
  63   (declare (type system-area-pointer sap)
  64            (fixnum offset))
  65   (sap-ref-8 sap offset))
  66
  67 (defun sap-ref-octets (sap offset count)
  68   (declare (type system-area-pointer sap)
  69            (fixnum offset count))
  70   (let ((buffer (make-array count :element-type '(unsigned-byte 8))))
  71     (dotimes (i count)
  72       (setf (aref buffer i) (sap-ref-8 sap (+ offset i))))
  73     buffer))
  74
  75 ;;; Return the 16-bit word at OFFSET bytes from SAP.
  76 (defun sap-ref-16 (sap offset)
  77   (declare (type system-area-pointer sap)
  78            (fixnum offset))
  79   (sap-ref-16 sap offset))
  80
  81 ;;; Returns the 32-bit dualword at OFFSET bytes from SAP.
  82 (defun sap-ref-32 (sap offset)
  83   (declare (type system-area-pointer sap)
  84            (fixnum offset))
  85   (sap-ref-32 sap offset))
  86
  87 ;;; Return the 64-bit quadword at OFFSET bytes from SAP.
  88 (defun sap-ref-64 (sap offset)
  89   (declare (type system-area-pointer sap)
  90            (fixnum offset))
  91   (sap-ref-64 sap offset))
  92
  93 ;;; Return the unsigned word of natural size OFFSET bytes from SAP.
  94 (defun sap-ref-word (sap offset)
  95   (declare (type system-area-pointer sap)
  96            (fixnum offset))
  97   (sap-ref-word sap offset))
  98
  99 ;;; Return the 32-bit SAP at OFFSET bytes from SAP.
 100 (defun sap-ref-sap (sap offset)
 101   (declare (type system-area-pointer sap)
 102            (fixnum offset))
 103   (sap-ref-sap sap offset))
 104
 105 ;; Return the LISPOBJ at OFFSET bytes from SAP.
 106 (defun sap-ref-lispobj (sap offset)
 107   (declare (type system-area-pointer sap)
 108            (fixnum offset))
 109   (sap-ref-lispobj sap offset))
 110
 111 ;;; Return the 32-bit SINGLE-FLOAT at OFFSET bytes from SAP.
 112 (defun sap-ref-single (sap offset)
 113   (declare (type system-area-pointer sap)
 114            (fixnum offset))
 115   (sap-ref-single sap offset))
 116
 117 ;;; Return the 64-bit DOUBLE-FLOAT at OFFSET bytes from SAP.
 118 (defun sap-ref-double (sap offset)
 119   (declare (type system-area-pointer sap)
 120            (fixnum offset))
 121   (sap-ref-double sap offset))
 122
 123 ;;; Return the LONG-FLOAT at OFFSET bytes from SAP.
 124 #!+(or x86 long-float)
 125 (defun sap-ref-long (sap offset)
 126   (declare (type system-area-pointer sap)
 127            (fixnum offset))
 128   (sap-ref-long sap offset))
 129
 130 ;;; Return the signed 8-bit byte at OFFSET bytes from SAP.
 131 (defun signed-sap-ref-8 (sap offset)
 132   (declare (type system-area-pointer sap)
 133            (fixnum offset))
 134   (signed-sap-ref-8 sap offset))
 135
 136 ;;; Return the signed 16-bit word at OFFSET bytes from SAP.
 137 (defun signed-sap-ref-16 (sap offset)
 138   (declare (type system-area-pointer sap)
 139            (fixnum offset))
 140   (signed-sap-ref-16 sap offset))
 141
 142 ;;; Return the signed 32-bit dualword at OFFSET bytes from SAP.
 143 (defun signed-sap-ref-32 (sap offset)
 144   (declare (type system-area-pointer sap)
 145            (fixnum offset))
 146   (signed-sap-ref-32 sap offset))
 147
 148 ;;; Return the signed 64-bit quadword at OFFSET bytes from SAP.
 149 (defun signed-sap-ref-64 (sap offset)
 150   (declare (type system-area-pointer sap)
 151            (fixnum offset))
 152   (signed-sap-ref-64 sap offset))
 153
 154 ;;; Return the signed word of natural size OFFSET bytes from SAP.
 155 (defun signed-sap-ref-word (sap offset)
 156   (declare (type system-area-pointer sap)
 157            (fixnum offset))
 158   (signed-sap-ref-word sap offset))
 159
 160 (defun %set-sap-ref-8 (sap offset new-value)
 161   (declare (type system-area-pointer sap)
 162            (fixnum offset)
 163            (type (unsigned-byte 8) new-value))
 164   (setf (sap-ref-8 sap offset) new-value))
 165
 166 (defun %set-sap-ref-16 (sap offset new-value)
 167   (declare (type system-area-pointer sap)
 168            (fixnum offset)
 169            (type (unsigned-byte 16) new-value))
 170   (setf (sap-ref-16 sap offset) new-value))
 171
 172 (defun %set-sap-ref-32 (sap offset new-value)
 173   (declare (type system-area-pointer sap)
 174            (fixnum offset)
 175            (type (unsigned-byte 32) new-value))
 176   (setf (sap-ref-32 sap offset) new-value))
 177
 178 (defun %set-sap-ref-64 (sap offset new-value)
 179   (declare (type system-area-pointer sap)
 180            (fixnum offset)
 181            (type (unsigned-byte 64) new-value))
 182   (setf (sap-ref-64 sap offset) new-value))
 183
 184 (defun %set-sap-ref-word (sap offset new-value)
 185   (declare (type system-area-pointer sap)
 186            (fixnum offset)
 187            (type (unsigned-byte #.sb!vm:n-machine-word-bits) new-value))
 188   (setf (sap-ref-word 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 (defun %set-signed-sap-ref-64 (sap offset new-value)
 209   (declare (type system-area-pointer sap)
 210            (fixnum offset)
 211            (type (signed-byte 64) new-value))
 212   (setf (signed-sap-ref-64 sap offset) new-value))
 213
 214 (defun %set-signed-sap-ref-word (sap offset new-value)
 215   (declare (type system-area-pointer sap)
 216            (fixnum offset)
 217            (type (signed-byte #.sb!vm:n-machine-word-bits) new-value))
 218   (setf (signed-sap-ref-word sap offset) new-value))
 219
 220 (defun %set-sap-ref-sap (sap offset new-value)
 221   (declare (type system-area-pointer sap new-value)
 222            (fixnum offset))
 223   (setf (sap-ref-sap sap offset) new-value))
 224
 225 (defun %set-sap-ref-lispobj (sap offset new-value)
 226   (declare (type system-area-pointer sap)
 227            (fixnum offset)
 228            (t new-value))
 229   (setf (sap-ref-lispobj sap offset) new-value))
 230
 231 (defun %set-sap-ref-single (sap offset new-value)
 232   (declare (type system-area-pointer sap)
 233            (fixnum offset)
 234            (type single-float new-value))
 235   (setf (sap-ref-single sap offset) new-value))
 236
 237 (defun %set-sap-ref-double (sap offset new-value)
 238   (declare (type system-area-pointer sap)
 239            (fixnum offset)
 240            (type double-float new-value))
 241   (setf (sap-ref-double sap offset) new-value))
 242
 243 #!+long-float
 244 (defun %set-sap-ref-long (sap offset new-value)
 245   (declare (type system-area-pointer sap)
 246            (fixnum offset)
 247            (type long-float new-value))
 248   (setf (sap-ref-long sap offset) new-value))