X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-sap.lisp;h=ae48346484a5921762f022294ffee085ec512f8a;hb=b92e0bedf7e29a43fe4fd9141b5d658751e3bef0;hp=b63c33d37a1f1a7ce0fa21b26f3bd4dbc2c59160;hpb=4fc9d21ae1d8a6a2f8ff70f589d5da103203de13;p=sbcl.git diff --git a/src/code/target-sap.lisp b/src/code/target-sap.lisp index b63c33d..ae48346 100644 --- a/src/code/target-sap.lisp +++ b/src/code/target-sap.lisp @@ -10,8 +10,6 @@ ;;;; files for more information. (in-package "SB!KERNEL") - -;;;; primitive SAP operations ;;; Return T iff the SAP X points to a smaller address then the SAP Y. (defun sap< (x y) @@ -43,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. @@ -58,176 +56,174 @@ ;;; Convert an integer into a SAP. (defun int-sap (int) - (declare (type sap-int-type int)) + (declare (type sap-int int)) (int-sap int)) ;;; 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)) - -;;;; system memory allocation - -(sb!alien:def-alien-routine ("os_allocate" allocate-system-memory) - system-area-pointer - (bytes sb!c-call:unsigned-long)) - -(sb!alien:def-alien-routine ("os_allocate_at" allocate-system-memory-at) - system-area-pointer - (address system-area-pointer) - (bytes sb!c-call:unsigned-long)) - -(sb!alien:def-alien-routine ("os_reallocate" reallocate-system-memory) - system-area-pointer - (old system-area-pointer) - (old-size sb!c-call:unsigned-long) - (new-size sb!c-call:unsigned-long)) - -(sb!alien:def-alien-routine ("os_deallocate" deallocate-system-memory) - sb!c-call:void - (addr system-area-pointer) - (bytes sb!c-call:unsigned-long))