Email Archive: sbcl-commits (read-only)
|
[Sbcl-commits] CVS: sbcl/src/compiler/x86-64 float.lisp,1.7,1.8 parms.lisp,1.6,1.7 sap.lisp,1.3,1.4
From: Juho Snellman <jsnell@us...> - 2005-05-30 05:25
|
Update of /cvsroot/sbcl/sbcl/src/compiler/x86-64
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6996/src/compiler/x86-64
Modified Files:
float.lisp parms.lisp sap.lisp
Log Message:
0.9.1.8:
* Fix typo (current-dynamic-space-spart -> current-dynamic-space-start)
in the gencgc branch of the "clean up DYNAMIC-SPACE-START
and -END ugliness on cheney-platforms" changes in 0.9.1.5.
* Fix compiling with GCC 4 on x86 and x86-64 (sbcl-devel
"Fixes for gcc4", Sascha Wilde).
* Remove a leftover "with-tn@...)" from x86-64/float.lisp
(sbcl-devel , James Knight)
* More x86-64 fp cleanups. (sbcl-devel "x86-64 fp exceptions",
"x86-64 move-*-float-arg bug", James Knight 2005-05-27/29).
Index: float.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/float.lisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- float.lisp 18 May 2005 02:22:51 -0000 1.7
+++ float.lisp 30 May 2005 05:25:44 -0000 1.8
@@ -329,10 +329,9 @@
(:single 1)
(:double 2) ))
n-word-bytes)))))
- (with-tn@...)
- ,@(ecase format
- (:single '((inst movss ea x)))
- (:double '((inst movsd ea x)))))))))))
+ ,@(ecase format
+ (:single '((inst movss ea x)))
+ (:double '((inst movsd ea x))))))))))
(define-move-vop ,name :move-arg
(,sc descriptor-reg) (,sc)))))
(frob move-single-float-arg single-reg single-stack :single)
@@ -766,61 +765,6 @@
(inst shr lo-bits 32)))
-;;;; float mode hackery
-
-(sb!xc:deftype float-modes () '(unsigned-byte 64)) ; really only 16
-(defknown floating-point-modes () float-modes (flushable))
-(defknown ((setf floating-point-modes)) (float-modes)
- float-modes)
-
-(define-vop (floating-point-modes)
- (:results (res :scs (unsigned-reg)))
- (:result-types unsigned-num)
- (:translate floating-point-modes)
- (:policy :fast-safe)
- (:temporary (:sc unsigned-stack :from :argument :to :result) temp)
- (:generator 8
- (inst stmxcsr temp)
- (move res temp)
- ;; Extract status from bytes 0-5 to bytes 16-21
- (inst and temp (1- (expt 2 6)))
- (inst shl temp 16)
- ;; Extract mask from bytes 7-12 to bytes 0-5
- (inst shr res 7)
- (inst and res (1- (expt 2 6)))
- ;; Flip the bits to convert from "1 means exception masked" to
- ;; "1 means exception enabled".
- (inst xor res (1- (expt 2 6)))
- (inst or res temp)))
-
-(define-vop (set-floating-point-modes)
- (:args (new :scs (unsigned-reg) :to :result :target res))
- (:results (res :scs (unsigned-reg)))
- (:arg-types unsigned-num)
- (:result-types unsigned-num)
- (:translate (setf floating-point-modes))
- (:policy :fast-safe)
- (:temporary (:sc unsigned-reg :from :argument :to :result) temp1)
- (:temporary (:sc unsigned-stack :from :argument :to :result) temp2)
- (:generator 3
- (move res new)
- (inst stmxcsr temp2)
- ;; Clear status + masks
- (inst and temp2 (lognot (logior (1- (expt 2 6))
- (ash (1- (expt 2 6)) 7))))
- ;; Replace current status
- (move temp1 new)
- (inst shr temp1 16)
- (inst and temp1 (1- (expt 2 6)))
- (inst or temp2 temp1)
- ;; Replace exception masks
- (move temp1 new)
- (inst and temp1 (1- (expt 2 6)))
- (inst xor temp1 (1- (expt 2 6)))
- (inst shl temp1 7)
- (inst or temp2 temp1)
- (inst ldmxcsr temp2)))
-
;;;; complex float VOPs
Index: parms.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/parms.lisp,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- parms.lisp 18 May 2005 02:22:51 -0000 1.6
+++ parms.lisp 30 May 2005 05:25:44 -0000 1.7
@@ -60,24 +60,13 @@
(def!constant double-float-hidden-bit (ash 1 20))
(def!constant double-float-trapping-nan-bit (ash 1 19))
-(def!constant long-float-bias 16382)
-(defconstant-eqx long-float-exponent-byte (byte 15 0) #'equalp)
-(defconstant-eqx long-float-significand-byte (byte 31 0) #'equalp)
-(def!constant long-float-normal-exponent-min 1)
-(def!constant long-float-normal-exponent-max #x7FFE)
-(def!constant long-float-hidden-bit (ash 1 31)) ; actually not hidden
-(def!constant long-float-trapping-nan-bit (ash 1 30))
-
(def!constant single-float-digits
(+ (byte-size single-float-significand-byte) 1))
(def!constant double-float-digits
(+ (byte-size double-float-significand-byte) 32 1))
-(def!constant long-float-digits
- (+ (byte-size long-float-significand-byte) 32 1))
-
-;;; pfw -- from i486 microprocessor programmer's reference manual
+;;; from AMD64 Architecture manual
(def!constant float-invalid-trap-bit (ash 1 0))
(def!constant float-denormal-trap-bit (ash 1 1))
(def!constant float-divide-by-zero-trap-bit (ash 1 2))
@@ -90,12 +79,11 @@
(def!constant float-round-to-positive 2)
(def!constant float-round-to-zero 3)
-(defconstant-eqx float-rounding-mode (byte 2 10) #'equalp)
-(defconstant-eqx float-sticky-bits (byte 6 16) #'equalp)
-(defconstant-eqx float-traps-byte (byte 6 0) #'equalp)
-(defconstant-eqx float-exceptions-byte (byte 6 16) #'equalp)
-(defconstant-eqx float-precision-control (byte 2 8) #'equalp)
-(def!constant float-fast-bit 0) ; no fast mode on x86
+(defconstant-eqx float-rounding-mode (byte 2 13) #'equalp)
+(defconstant-eqx float-sticky-bits (byte 6 0) #'equalp)
+(defconstant-eqx float-traps-byte (byte 6 7) #'equalp)
+(defconstant-eqx float-exceptions-byte (byte 6 0) #'equalp)
+(def!constant float-fast-bit 0) ; no fast mode on x86-64
;;;; description of the target address space
Index: sap.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/sap.lisp,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- sap.lisp 8 Jan 2005 00:55:58 -0000 1.3
+++ sap.lisp 30 May 2005 05:25:44 -0000 1.4
@@ -377,32 +377,6 @@
(:generator 4
(inst movss (make-ea :dword :base sap :disp offset) value)
(move result value)))
-
-;;;; SAP-REF-LONG
-#+nil
-(define-vop (sap-ref-long)
- (:translate sap-ref-long)
- (:policy :fast-safe)
- (:args (sap :scs (sap-reg))
- (offset :scs (signed-reg)))
- (:arg-types system-area-pointer signed-num)
- (:results (result :scs (#!+long-float long-reg #!-long-float double-reg)))
- (:result-types #!+long-float long-float #!-long-float double-float)
- (:generator 5
- (with-empty-tn@...)
- (inst fldl (make-ea :qword :base sap :index offset)))))
-#+nil
-(define-vop (sap-ref-long-c)
- (:translate sap-ref-long)
- (:policy :fast-safe)
- (:args (sap :scs (sap-reg)))
- (:arg-types system-area-pointer (:constant (signed-byte 64)))
- (:info offset)
- (:results (result :scs (#!+long-float long-reg #!-long-float double-reg)))
- (:result-types #!+long-float long-float #!-long-float double-float)
- (:generator 4
- (with-empty-tn@...)
- (inst fldl (make-ea :qword :base sap :disp offset)))))
;;; noise to convert normal lisp data objects into SAPs
|
Thread View
| Thread | Author | Date |
|---|---|---|
| [Sbcl-commits] CVS: sbcl/src/compiler/x86-64 float.lisp,1.7,1.8 parms.lisp,1.6,1.7 sap.lisp,1.3,1.4 | Juho Snellman <jsnell@us...> |