diff --git a/code/sap.lisp b/code/sap.lisp index 920a0148dd7235c91b59ae0b9cf042599587c2d0..f6499db7ecb3fd883010f96e764eef9bf1ceeb7c 100644 --- a/code/sap.lisp +++ b/code/sap.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sap.lisp,v 1.14 1998/02/19 10:52:12 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sap.lisp,v 1.15 1998/03/04 14:56:34 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -64,7 +64,7 @@ (defun sap+ (sap offset) "Return a new sap OFFSET bytes from SAP." (declare (type system-area-pointer sap) - #+(or x86 sparc) (fixnum offset) #-(or x86 sparc) (type index offset)) + (fixnum offset)) (sap+ sap offset)) (defun sap- (sap1 sap2) @@ -85,51 +85,44 @@ (defun sap-ref-8 (sap offset) "Returns the 8-bit byte at OFFSET bytes from SAP." (declare (type system-area-pointer sap) - #+(or x86 sparc) (fixnum offset) - #-(or x86 sparc) (type index offset)) + (fixnum offset)) (sap-ref-8 sap offset)) (defun sap-ref-16 (sap offset) "Returns the 16-bit word at OFFSET bytes from SAP." (declare (type system-area-pointer sap) - #+(or x86 sparc) (fixnum offset) - #-(or x86 sparc) (type index offset)) + (fixnum offset)) (sap-ref-16 sap offset)) (defun sap-ref-32 (sap offset) "Returns the 32-bit dualword at OFFSET bytes from SAP." (declare (type system-area-pointer sap) - #+(or x86 sparc) (fixnum offset) - #-(or x86 sparc) (type index offset)) + (fixnum offset)) (sap-ref-32 sap offset)) #+alpha (defun sap-ref-64 (sap offset) "Returns the 64-bit quadword at OFFSET bytes from SAP." (declare (type system-area-pointer sap) - #+(or x86 sparc) (fixnum offset) - #-(or x86 sparc) (type index offset)) + (fixnum offset)) (sap-ref-64 sap offset)) (defun sap-ref-sap (sap offset) "Returns the 32-bit system-area-pointer at OFFSET bytes from SAP." (declare (type system-area-pointer sap) - #+(or x86 sparc) (fixnum offset) - #-(or x86 sparc) (type index offset)) + (fixnum offset)) (sap-ref-sap sap offset)) (defun sap-ref-single (sap offset) "Returns the 32-bit single-float at OFFSET bytes from SAP." (declare (type system-area-pointer sap) - #+(or x86 sparc) (fixnum offset) - #-(or x86 sparc) (type index offset)) + (fixnum offset)) (sap-ref-single sap offset)) (defun sap-ref-double (sap offset) "Returns the 64-bit double-float at OFFSET bytes from SAP." (declare (type system-area-pointer sap) - #+(or x86 sparc) (fixnum offset) - #-(or x86 sparc) (type index offset)) + (fixnum offset)) (sap-ref-double sap offset)) #+x86 @@ -142,107 +135,92 @@ (defun signed-sap-ref-8 (sap offset) "Returns the signed 8-bit byte at OFFSET bytes from SAP." (declare (type system-area-pointer sap) - #+(or x86 sparc) (fixnum offset) - #-(or x86 sparc) (type index offset)) + (fixnum offset)) (signed-sap-ref-8 sap offset)) (defun signed-sap-ref-16 (sap offset) "Returns the signed 16-bit word at OFFSET bytes from SAP." (declare (type system-area-pointer sap) - #+(or x86 sparc) (fixnum offset) - #-(or x86 sparc) (type index offset)) + (fixnum offset)) (signed-sap-ref-16 sap offset)) (defun signed-sap-ref-32 (sap offset) "Returns the signed 32-bit dualword at OFFSET bytes from SAP." (declare (type system-area-pointer sap) - #+(or x86 sparc) (fixnum offset) - #-(or x86 sparc) (type index offset)) + (fixnum offset)) (signed-sap-ref-32 sap offset)) #+alpha (defun signed-sap-ref-64 (sap offset) "Returns the signed 64-bit quadword at OFFSET bytes from SAP." (declare (type system-area-pointer sap) - #+(or x86 sparc) (fixnum offset) - #-(or x86 sparc) (type index offset)) + (fixnum offset)) (signed-sap-ref-64 sap offset)) (defun %set-sap-ref-8 (sap offset new-value) (declare (type system-area-pointer sap) - #+(or x86 sparc) (fixnum offset) - #-(or x86 sparc) (type index offset) + (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) - #+(or x86 sparc) (fixnum offset) - #-(or x86 sparc) (type index offset) + (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) - #+(or x86 sparc) (fixnum offset) - #-(or x86 sparc) (type index offset) + (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) - #+(or x86 sparc) (fixnum offset) - #-(or x86 sparc) (type index offset) + (fixnum offset) (type (unsigned-byte 64) new-value)) (setf (sap-ref-64 sap offset) new-value)) (defun %set-signed-sap-ref-8 (sap offset new-value) (declare (type system-area-pointer sap) - #+(or x86 sparc) (fixnum offset) - #-(or x86 sparc) (type index offset) + (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) - #+(or x86 sparc) (fixnum offset) - #-(or x86 sparc) (type index offset) + (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) - #+(or x86 sparc) (fixnum offset) - #-(or x86 sparc) (type index offset) + (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) - #+(or x86 sparc) (fixnum offset) - #-(or x86 sparc) (type index offset) + (fixnum offset) (type (signed-byte 64) new-value)) (setf (signed-sap-ref-64 sap offset) new-value)) (defun %set-sap-ref-sap (sap offset new-value) (declare (type system-area-pointer sap new-value) - #+(or x86 sparc) (fixnum offset) - #-(or x86 sparc) (type index 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) - #+(or x86 sparc) (fixnum offset) - #-(or x86 sparc) (type index offset) + (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) - #+(or x86 sparc) (fixnum offset) - #-(or x86 sparc) (type index offset) + (fixnum offset) (type double-float new-value)) (setf (sap-ref-double sap offset) new-value)) diff --git a/compiler/alpha/sap.lisp b/compiler/alpha/sap.lisp index acc6795d536c2569aed62d3c03181809d07ce958..22096bf0346061e2472cdfaf2215d272f3799056 100644 --- a/compiler/alpha/sap.lisp +++ b/compiler/alpha/sap.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/sap.lisp,v 1.3 1997/04/26 20:04:53 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/sap.lisp,v 1.4 1998/03/04 14:56:38 dtc Rel $") ;;; ;;; ********************************************************************** ;;; @@ -161,8 +161,8 @@ (:translate ,ref-name) (:policy :fast-safe) (:args (object :scs (sap-reg) :target sap) - (offset :scs (unsigned-reg))) - (:arg-types system-area-pointer unsigned-num) + (offset :scs (signed-reg))) + (:arg-types system-area-pointer signed-num) ,@(when (or (eq size :byte) (eq size :short)) `((:temporary (:sc non-descriptor-reg) temp) (:temporary (:sc non-descriptor-reg) temp1))) @@ -252,9 +252,9 @@ (:translate ,set-name) (:policy :fast-safe) (:args (object :scs (sap-reg) :target sap) - (offset :scs (unsigned-reg)) + (offset :scs (signed-reg)) (value :scs (,sc) :target result)) - (:arg-types system-area-pointer unsigned-num ,type) + (:arg-types system-area-pointer signed-num ,type) (:results (result :scs (,sc))) (:result-types ,type) (:temporary (:scs (sap-reg) :from (:argument 0)) sap) diff --git a/compiler/hppa/sap.lisp b/compiler/hppa/sap.lisp index 69121d26e15e66418a21aec9c7fe2f6901a03724..c3d412fcbe06e81fc5f5944d3f8022d45e566c00 100644 --- a/compiler/hppa/sap.lisp +++ b/compiler/hppa/sap.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/hppa/sap.lisp,v 1.3 1997/04/26 20:04:56 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/hppa/sap.lisp,v 1.4 1998/03/04 14:56:42 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -165,8 +165,8 @@ (:translate ,ref-name) (:policy :fast-safe) (:args (object :scs (sap-reg)) - (offset :scs (unsigned-reg))) - (:arg-types system-area-pointer unsigned-num) + (offset :scs (signed-reg))) + (:arg-types system-area-pointer signed-num) (:results (result :scs (,sc))) (:result-types ,type) (:generator 5 @@ -209,9 +209,9 @@ (:policy :fast-safe) (:args (object :scs (sap-reg) ,@(unless (eq size :float) '(:target sap))) - (offset :scs (unsigned-reg)) + (offset :scs (signed-reg)) (value :scs (,sc) :target result)) - (:arg-types system-area-pointer unsigned-num ,type) + (:arg-types system-area-pointer signed-num ,type) (:results (result :scs (,sc))) (:result-types ,type) ,@(unless (eq size :float) diff --git a/compiler/mips/sap.lisp b/compiler/mips/sap.lisp index e8e18647744a60369203d711e2c64740401efa7a..a8aaf7e1b9014d35b8475d9fc2ee31de3eae0ef2 100644 --- a/compiler/mips/sap.lisp +++ b/compiler/mips/sap.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/sap.lisp,v 1.30 1997/04/26 20:05:03 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/sap.lisp,v 1.31 1998/03/04 14:56:40 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -161,8 +161,8 @@ (:translate ,ref-name) (:policy :fast-safe) (:args (object :scs (sap-reg) :target sap) - (offset :scs (unsigned-reg))) - (:arg-types system-area-pointer unsigned-num) + (offset :scs (signed-reg))) + (:arg-types system-area-pointer signed-num) (:results (result :scs (,sc))) (:result-types ,type) (:temporary (:scs (sap-reg) :from (:argument 0)) sap) @@ -230,9 +230,9 @@ (:translate ,set-name) (:policy :fast-safe) (:args (object :scs (sap-reg) :target sap) - (offset :scs (unsigned-reg)) + (offset :scs (signed-reg)) (value :scs (,sc) :target result)) - (:arg-types system-area-pointer unsigned-num ,type) + (:arg-types system-area-pointer signed-num ,type) (:results (result :scs (,sc))) (:result-types ,type) (:temporary (:scs (sap-reg) :from (:argument 0)) sap) diff --git a/compiler/saptran.lisp b/compiler/saptran.lisp index d5cc5507ecc635f6a66cf65bc093f17c0879a86f..bad9d32fe0459649e91bc1dc959ade03562828c5 100644 --- a/compiler/saptran.lisp +++ b/compiler/saptran.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/saptran.lisp,v 1.8 1998/02/19 10:52:19 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/saptran.lisp,v 1.9 1998/03/04 14:56:35 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -38,79 +38,79 @@ system-area-pointer (movable)) -(defknown sap-ref-8 (system-area-pointer #+(or x86 sparc) fixnum #-(or x86 sparc) index) (unsigned-byte 8) +(defknown sap-ref-8 (system-area-pointer fixnum) (unsigned-byte 8) (flushable)) -(defknown %set-sap-ref-8 (system-area-pointer #+(or x86 sparc) fixnum #-(or x86 sparc) index (unsigned-byte 8)) +(defknown %set-sap-ref-8 (system-area-pointer fixnum (unsigned-byte 8)) (unsigned-byte 8) ()) -(defknown sap-ref-16 (system-area-pointer #+(or x86 sparc) fixnum #-(or x86 sparc) index) (unsigned-byte 16) +(defknown sap-ref-16 (system-area-pointer fixnum) (unsigned-byte 16) (flushable)) -(defknown %set-sap-ref-16 (system-area-pointer #+(or x86 sparc) fixnum #-(or x86 sparc) index (unsigned-byte 16)) +(defknown %set-sap-ref-16 (system-area-pointer fixnum (unsigned-byte 16)) (unsigned-byte 16) ()) -(defknown sap-ref-32 (system-area-pointer #+(or x86 sparc) fixnum #-(or x86 sparc) index) (unsigned-byte 32) +(defknown sap-ref-32 (system-area-pointer fixnum) (unsigned-byte 32) (flushable)) -(defknown %set-sap-ref-32 (system-area-pointer #+(or x86 sparc) fixnum #-(or x86 sparc) index (unsigned-byte 32)) +(defknown %set-sap-ref-32 (system-area-pointer fixnum (unsigned-byte 32)) (unsigned-byte 32) ()) #+alpha -(defknown sap-ref-64 (system-area-pointer #+(or x86 sparc) fixnum #-(or x86 sparc) index) (unsigned-byte 64) +(defknown sap-ref-64 (system-area-pointer fixnum) (unsigned-byte 64) (flushable)) #+alpha -(defknown %set-sap-ref-64 (system-area-pointer #+(or x86 sparc) fixnum #-(or x86 sparc) index (unsigned-byte 64)) +(defknown %set-sap-ref-64 (system-area-pointer fixnum (unsigned-byte 64)) (unsigned-byte 64) ()) -(defknown signed-sap-ref-8 (system-area-pointer #+(or x86 sparc) fixnum #-(or x86 sparc) index) (signed-byte 8) +(defknown signed-sap-ref-8 (system-area-pointer fixnum) (signed-byte 8) (flushable)) -(defknown %set-signed-sap-ref-8 (system-area-pointer #+(or x86 sparc) fixnum #-(or x86 sparc) index (signed-byte 8)) +(defknown %set-signed-sap-ref-8 (system-area-pointer fixnum (signed-byte 8)) (signed-byte 8) ()) -(defknown signed-sap-ref-16 (system-area-pointer #+(or x86 sparc) fixnum #-(or x86 sparc) index) (signed-byte 16) +(defknown signed-sap-ref-16 (system-area-pointer fixnum) (signed-byte 16) (flushable)) -(defknown %set-signed-sap-ref-16 (system-area-pointer #+(or x86 sparc) fixnum #-(or x86 sparc) index (signed-byte 16)) +(defknown %set-signed-sap-ref-16 (system-area-pointer fixnum (signed-byte 16)) (signed-byte 16) ()) -(defknown signed-sap-ref-32 (system-area-pointer #+(or x86 sparc) fixnum #-(or x86 sparc) index) (signed-byte 32) +(defknown signed-sap-ref-32 (system-area-pointer fixnum) (signed-byte 32) (flushable)) -(defknown %set-signed-sap-ref-32 (system-area-pointer #+(or x86 sparc) fixnum #-(or x86 sparc) index (signed-byte 32)) +(defknown %set-signed-sap-ref-32 (system-area-pointer fixnum (signed-byte 32)) (signed-byte 32) ()) #+alpha -(defknown signed-sap-ref-64 (system-area-pointer #+(or x86 sparc) fixnum #-(or x86 sparc) index) (signed-byte 64) +(defknown signed-sap-ref-64 (system-area-pointer fixnum) (signed-byte 64) (flushable)) #+alpha -(defknown %set-signed-sap-ref-64 (system-area-pointer #+(or x86 sparc) fixnum #-(or x86 sparc) index (signed-byte 64)) +(defknown %set-signed-sap-ref-64 (system-area-pointer fixnum (signed-byte 64)) (signed-byte 64) ()) -(defknown sap-ref-sap (system-area-pointer #+(or x86 sparc) fixnum #-(or x86 sparc) index) system-area-pointer +(defknown sap-ref-sap (system-area-pointer fixnum) system-area-pointer (flushable)) -(defknown %set-sap-ref-sap (system-area-pointer #+(or x86 sparc) fixnum #-(or x86 sparc) index system-area-pointer) +(defknown %set-sap-ref-sap (system-area-pointer fixnum system-area-pointer) system-area-pointer ()) -(defknown sap-ref-single (system-area-pointer #+(or x86 sparc) fixnum #-(or x86 sparc) index) single-float +(defknown sap-ref-single (system-area-pointer fixnum) single-float (flushable)) -(defknown sap-ref-double (system-area-pointer #+(or x86 sparc) fixnum #-(or x86 sparc) index) double-float +(defknown sap-ref-double (system-area-pointer fixnum) double-float (flushable)) #+x86 (defknown sap-ref-long (system-area-pointer fixnum) long-float (flushable)) (defknown %set-sap-ref-single - (system-area-pointer #+(or x86 sparc) fixnum #-(or x86 sparc) index single-float) single-float + (system-area-pointer fixnum single-float) single-float ()) (defknown %set-sap-ref-double - (system-area-pointer #+(or x86 sparc) fixnum #-(or x86 sparc) index double-float) double-float + (system-area-pointer fixnum double-float) double-float ())