X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-sap.lisp;h=17f71910b4fa836b2541a097dc46f785f55acac6;hb=ced29bbb5c5575ed9f71a4bdd79e222216a63e73;hp=20383b163197e38aca388b30aa2eb3c12f075c37;hpb=ec2616d216958a608581802c47496c0194478dc8;p=sbcl.git diff --git a/src/code/target-sap.lisp b/src/code/target-sap.lisp index 20383b1..17f7191 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,188 @@ ;;; 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)) +(defun sap-ref-octets (sap offset count) + (declare (type system-area-pointer sap) + (fixnum offset count)) + (let ((buffer (make-array count :element-type '(unsigned-byte 8)))) + (dotimes (i count) + (setf (aref buffer i) (sap-ref-8 sap (+ offset i)))) + buffer)) + ;;; 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 LISPOBJ at OFFSET bytes from SAP. +(defun sap-ref-lispobj (sap offset) + (declare (type system-area-pointer sap) + (fixnum offset)) + (sap-ref-lispobj 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-lispobj (sap offset new-value) + (declare (type system-area-pointer sap) + (fixnum offset) + (t new-value)) + (setf (sap-ref-lispobj 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))