X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-sap.lisp;h=ae48346484a5921762f022294ffee085ec512f8a;hb=ec2e02db335d1545b3c18233bf440ca4160f780d;hp=20383b163197e38aca388b30aa2eb3c12f075c37;hpb=ec2616d216958a608581802c47496c0194478dc8;p=sbcl.git

diff --git a/src/code/target-sap.lisp b/src/code/target-sap.lisp
index 20383b1..ae48346 100644
--- a/src/code/target-sap.lisp
+++ b/src/code/target-sap.lisp
@@ -41,7 +41,7 @@
 ;;; Return a new SAP, OFFSET bytes from SAP.
 (defun sap+ (sap offset)
   (declare (type system-area-pointer sap)
-	   (fixnum offset))
+           (type (signed-byte #.sb!vm:n-word-bits) offset))
   (sap+ sap offset))
 
 ;;; Return the byte offset between SAP1 and SAP2.
@@ -62,148 +62,168 @@
 ;;; Return the 8-bit byte at OFFSET bytes from SAP.
 (defun sap-ref-8 (sap offset)
   (declare (type system-area-pointer sap)
-	   (fixnum offset))
+           (fixnum offset))
   (sap-ref-8 sap offset))
 
 ;;; Return the 16-bit word at OFFSET bytes from SAP.
 (defun sap-ref-16 (sap offset)
   (declare (type system-area-pointer sap)
-	   (fixnum offset))
+           (fixnum offset))
   (sap-ref-16 sap offset))
 
 ;;; Returns the 32-bit dualword at OFFSET bytes from SAP.
 (defun sap-ref-32 (sap offset)
   (declare (type system-area-pointer sap)
-	   (fixnum offset))
+           (fixnum offset))
   (sap-ref-32 sap offset))
 
 ;;; Return the 64-bit quadword at OFFSET bytes from SAP.
-#!+alpha
 (defun sap-ref-64 (sap offset)
   (declare (type system-area-pointer sap)
-	   (fixnum offset))
+           (fixnum offset))
   (sap-ref-64 sap offset))
 
+;;; Return the unsigned word of natural size OFFSET bytes from SAP.
+(defun sap-ref-word (sap offset)
+  (declare (type system-area-pointer sap)
+           (fixnum offset))
+  (sap-ref-word sap offset))
+
 ;;; Return the 32-bit SAP at OFFSET bytes from SAP.
 (defun sap-ref-sap (sap offset)
   (declare (type system-area-pointer sap)
-	   (fixnum offset))
+           (fixnum offset))
   (sap-ref-sap sap offset))
 
 ;;; Return the 32-bit SINGLE-FLOAT at OFFSET bytes from SAP.
 (defun sap-ref-single (sap offset)
   (declare (type system-area-pointer sap)
-	   (fixnum offset))
+           (fixnum offset))
   (sap-ref-single sap offset))
 
 ;;; Return the 64-bit DOUBLE-FLOAT at OFFSET bytes from SAP.
 (defun sap-ref-double (sap offset)
   (declare (type system-area-pointer sap)
-	   (fixnum offset))
+           (fixnum offset))
   (sap-ref-double sap offset))
 
 ;;; Return the LONG-FLOAT at OFFSET bytes from SAP.
 #!+(or x86 long-float)
 (defun sap-ref-long (sap offset)
   (declare (type system-area-pointer sap)
-	   (fixnum offset))
+           (fixnum offset))
   (sap-ref-long sap offset))
 
 ;;; Return the signed 8-bit byte at OFFSET bytes from SAP.
 (defun signed-sap-ref-8 (sap offset)
   (declare (type system-area-pointer sap)
-	   (fixnum offset))
+           (fixnum offset))
   (signed-sap-ref-8 sap offset))
 
 ;;; Return the signed 16-bit word at OFFSET bytes from SAP.
 (defun signed-sap-ref-16 (sap offset)
   (declare (type system-area-pointer sap)
-	   (fixnum offset))
+           (fixnum offset))
   (signed-sap-ref-16 sap offset))
 
 ;;; Return the signed 32-bit dualword at OFFSET bytes from SAP.
 (defun signed-sap-ref-32 (sap offset)
   (declare (type system-area-pointer sap)
-	   (fixnum offset))
+           (fixnum offset))
   (signed-sap-ref-32 sap offset))
 
 ;;; Return the signed 64-bit quadword at OFFSET bytes from SAP.
-#!+alpha
 (defun signed-sap-ref-64 (sap offset)
   (declare (type system-area-pointer sap)
-	   (fixnum offset))
+           (fixnum offset))
   (signed-sap-ref-64 sap offset))
 
+;;; Return the signed word of natural size OFFSET bytes from SAP.
+(defun signed-sap-ref-word (sap offset)
+  (declare (type system-area-pointer sap)
+           (fixnum offset))
+  (signed-sap-ref-word sap offset))
+
 (defun %set-sap-ref-8 (sap offset new-value)
   (declare (type system-area-pointer sap)
-	   (fixnum offset)
-	   (type (unsigned-byte 8) new-value))
+           (fixnum offset)
+           (type (unsigned-byte 8) new-value))
   (setf (sap-ref-8 sap offset) new-value))
 
 (defun %set-sap-ref-16 (sap offset new-value)
   (declare (type system-area-pointer sap)
-	   (fixnum offset)
-	   (type (unsigned-byte 16) new-value))
+           (fixnum offset)
+           (type (unsigned-byte 16) new-value))
   (setf (sap-ref-16 sap offset) new-value))
 
 (defun %set-sap-ref-32 (sap offset new-value)
   (declare (type system-area-pointer sap)
-	   (fixnum offset)
-	   (type (unsigned-byte 32) new-value))
+           (fixnum offset)
+           (type (unsigned-byte 32) new-value))
   (setf (sap-ref-32 sap offset) new-value))
 
-#!+alpha
 (defun %set-sap-ref-64 (sap offset new-value)
   (declare (type system-area-pointer sap)
-	   (fixnum offset)
-	   (type (unsigned-byte 64) new-value))
+           (fixnum offset)
+           (type (unsigned-byte 64) new-value))
   (setf (sap-ref-64 sap offset) new-value))
 
+(defun %set-sap-ref-word (sap offset new-value)
+  (declare (type system-area-pointer sap)
+           (fixnum offset)
+           (type (unsigned-byte #.sb!vm:n-machine-word-bits) new-value))
+  (setf (sap-ref-word sap offset) new-value))
+
 (defun %set-signed-sap-ref-8 (sap offset new-value)
   (declare (type system-area-pointer sap)
-	   (fixnum offset)
-	   (type (signed-byte 8) new-value))
+           (fixnum offset)
+           (type (signed-byte 8) new-value))
   (setf (signed-sap-ref-8 sap offset) new-value))
 
 (defun %set-signed-sap-ref-16 (sap offset new-value)
   (declare (type system-area-pointer sap)
-	   (fixnum offset)
-	   (type (signed-byte 16) new-value))
+           (fixnum offset)
+           (type (signed-byte 16) new-value))
   (setf (signed-sap-ref-16 sap offset) new-value))
 
 (defun %set-signed-sap-ref-32 (sap offset new-value)
   (declare (type system-area-pointer sap)
-	   (fixnum offset)
-	   (type (signed-byte 32) new-value))
+           (fixnum offset)
+           (type (signed-byte 32) new-value))
   (setf (signed-sap-ref-32 sap offset) new-value))
 
-#!+alpha
 (defun %set-signed-sap-ref-64 (sap offset new-value)
   (declare (type system-area-pointer sap)
-	   (fixnum offset)
-	   (type (signed-byte 64) new-value))
+           (fixnum offset)
+           (type (signed-byte 64) new-value))
   (setf (signed-sap-ref-64 sap offset) new-value))
 
+(defun %set-signed-sap-ref-word (sap offset new-value)
+  (declare (type system-area-pointer sap)
+           (fixnum offset)
+           (type (signed-byte #.sb!vm:n-machine-word-bits) new-value))
+  (setf (signed-sap-ref-word sap offset) new-value))
+
 (defun %set-sap-ref-sap (sap offset new-value)
   (declare (type system-area-pointer sap new-value)
-	   (fixnum offset))
+           (fixnum offset))
   (setf (sap-ref-sap sap offset) new-value))
 
 (defun %set-sap-ref-single (sap offset new-value)
   (declare (type system-area-pointer sap)
-	   (fixnum offset)
-	   (type single-float new-value))
+           (fixnum offset)
+           (type single-float new-value))
   (setf (sap-ref-single sap offset) new-value))
 
 (defun %set-sap-ref-double (sap offset new-value)
   (declare (type system-area-pointer sap)
-	   (fixnum offset)
-	   (type double-float new-value))
+           (fixnum offset)
+           (type double-float new-value))
   (setf (sap-ref-double sap offset) new-value))
 
 #!+long-float
 (defun %set-sap-ref-long (sap offset new-value)
   (declare (type system-area-pointer sap)
-	   (fixnum offset)
-	   (type long-float new-value))
+           (fixnum offset)
+           (type long-float new-value))
   (setf (sap-ref-long sap offset) new-value))