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 ;;; Return the 16-bit word at OFFSET bytes from SAP.
  69 (defun sap-ref-16 (sap offset)
  70   (declare (type system-area-pointer sap)
  71            (fixnum offset))
  72   (sap-ref-16 sap offset))
  73
  74 ;;; Returns the 32-bit dualword at OFFSET bytes from SAP.
  75 (defun sap-ref-32 (sap offset)
  76   (declare (type system-area-pointer sap)
  77            (fixnum offset))
  78   (sap-ref-32 sap offset))
  79
  80 ;;; Return the 64-bit quadword at OFFSET bytes from SAP.
  81 (defun sap-ref-64 (sap offset)
  82   (declare (type system-area-pointer sap)
  83            (fixnum offset))
  84   (sap-ref-64 sap offset))
  85
  86 ;;; Return the unsigned word of natural size OFFSET bytes from SAP.
  87 (defun sap-ref-word (sap offset)
  88   (declare (type system-area-pointer sap)
  89            (fixnum offset))
  90   (sap-ref-word sap offset))
  91
  92 ;;; Return the 32-bit SAP at OFFSET bytes from SAP.
  93 (defun sap-ref-sap (sap offset)
  94   (declare (type system-area-pointer sap)
  95            (fixnum offset))
  96   (sap-ref-sap sap offset))
  97
  98 ;;; Return the 32-bit SINGLE-FLOAT at OFFSET bytes from SAP.
  99 (defun sap-ref-single (sap offset)
 100   (declare (type system-area-pointer sap)
 101            (fixnum offset))
 102   (sap-ref-single sap offset))
 103
 104 ;;; Return the 64-bit DOUBLE-FLOAT at OFFSET bytes from SAP.
 105 (defun sap-ref-double (sap offset)
 106   (declare (type system-area-pointer sap)
 107            (fixnum offset))
 108   (sap-ref-double sap offset))
 109
 110 ;;; Return the LONG-FLOAT at OFFSET bytes from SAP.
 111 #!+(or x86 long-float)
 112 (defun sap-ref-long (sap offset)
 113   (declare (type system-area-pointer sap)
 114            (fixnum offset))
 115   (sap-ref-long sap offset))
 116
 117 ;;; Return the signed 8-bit byte at OFFSET bytes from SAP.
 118 (defun signed-sap-ref-8 (sap offset)
 119   (declare (type system-area-pointer sap)
 120            (fixnum offset))
 121   (signed-sap-ref-8 sap offset))
 122
 123 ;;; Return the signed 16-bit word at OFFSET bytes from SAP.
 124 (defun signed-sap-ref-16 (sap offset)
 125   (declare (type system-area-pointer sap)
 126            (fixnum offset))
 127   (signed-sap-ref-16 sap offset))
 128
 129 ;;; Return the signed 32-bit dualword at OFFSET bytes from SAP.
 130 (defun signed-sap-ref-32 (sap offset)
 131   (declare (type system-area-pointer sap)
 132            (fixnum offset))
 133   (signed-sap-ref-32 sap offset))
 134
 135 ;;; Return the signed 64-bit quadword at OFFSET bytes from SAP.
 136 (defun signed-sap-ref-64 (sap offset)
 137   (declare (type system-area-pointer sap)
 138            (fixnum offset))
 139   (signed-sap-ref-64 sap offset))
 140
 141 ;;; Return the signed word of natural size OFFSET bytes from SAP.
 142 (defun signed-sap-ref-word (sap offset)
 143   (declare (type system-area-pointer sap)
 144            (fixnum offset))
 145   (signed-sap-ref-word sap offset))
 146
 147 (defun %set-sap-ref-8 (sap offset new-value)
 148   (declare (type system-area-pointer sap)
 149            (fixnum offset)
 150            (type (unsigned-byte 8) new-value))
 151   (setf (sap-ref-8 sap offset) new-value))
 152
 153 (defun %set-sap-ref-16 (sap offset new-value)
 154   (declare (type system-area-pointer sap)
 155            (fixnum offset)
 156            (type (unsigned-byte 16) new-value))
 157   (setf (sap-ref-16 sap offset) new-value))
 158
 159 (defun %set-sap-ref-32 (sap offset new-value)
 160   (declare (type system-area-pointer sap)
 161            (fixnum offset)
 162            (type (unsigned-byte 32) new-value))
 163   (setf (sap-ref-32 sap offset) new-value))
 164
 165 (defun %set-sap-ref-64 (sap offset new-value)
 166   (declare (type system-area-pointer sap)
 167            (fixnum offset)
 168            (type (unsigned-byte 64) new-value))
 169   (setf (sap-ref-64 sap offset) new-value))
 170
 171 (defun %set-sap-ref-word (sap offset new-value)
 172   (declare (type system-area-pointer sap)
 173            (fixnum offset)
 174            (type (unsigned-byte #.sb!vm:n-machine-word-bits) new-value))
 175   (setf (sap-ref-word sap offset) new-value))
 176
 177 (defun %set-signed-sap-ref-8 (sap offset new-value)
 178   (declare (type system-area-pointer sap)
 179            (fixnum offset)
 180            (type (signed-byte 8) new-value))
 181   (setf (signed-sap-ref-8 sap offset) new-value))
 182
 183 (defun %set-signed-sap-ref-16 (sap offset new-value)
 184   (declare (type system-area-pointer sap)
 185            (fixnum offset)
 186            (type (signed-byte 16) new-value))
 187   (setf (signed-sap-ref-16 sap offset) new-value))
 188
 189 (defun %set-signed-sap-ref-32 (sap offset new-value)
 190   (declare (type system-area-pointer sap)
 191            (fixnum offset)
 192            (type (signed-byte 32) new-value))
 193   (setf (signed-sap-ref-32 sap offset) new-value))
 194
 195 (defun %set-signed-sap-ref-64 (sap offset new-value)
 196   (declare (type system-area-pointer sap)
 197            (fixnum offset)
 198            (type (signed-byte 64) new-value))
 199   (setf (signed-sap-ref-64 sap offset) new-value))
 200
 201 (defun %set-signed-sap-ref-word (sap offset new-value)
 202   (declare (type system-area-pointer sap)
 203            (fixnum offset)
 204            (type (signed-byte #.sb!vm:n-machine-word-bits) new-value))
 205   (setf (signed-sap-ref-word sap offset) new-value))
 206
 207 (defun %set-sap-ref-sap (sap offset new-value)
 208   (declare (type system-area-pointer sap new-value)
 209            (fixnum offset))
 210   (setf (sap-ref-sap sap offset) new-value))
 211
 212 (defun %set-sap-ref-single (sap offset new-value)
 213   (declare (type system-area-pointer sap)
 214            (fixnum offset)
 215            (type single-float new-value))
 216   (setf (sap-ref-single sap offset) new-value))
 217
 218 (defun %set-sap-ref-double (sap offset new-value)
 219   (declare (type system-area-pointer sap)
 220            (fixnum offset)
 221            (type double-float new-value))
 222   (setf (sap-ref-double sap offset) new-value))
 223
 224 #!+long-float
 225 (defun %set-sap-ref-long (sap offset new-value)
 226   (declare (type system-area-pointer sap)
 227            (fixnum offset)
 228            (type long-float new-value))
 229   (setf (sap-ref-long sap offset) new-value))