diff --git a/code/exports.lisp b/code/exports.lisp index 6f02e0dde6871dd2b065dce6f3d040ed9b73b9a0..83f6167966215af15ee0184a3588f2499d8e9707 100644 --- a/code/exports.lisp +++ b/code/exports.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/exports.lisp,v 1.141 1998/02/19 10:52:10 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.142 1998/02/21 18:24:41 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -668,9 +668,9 @@ "DOUBLE-FLOAT-SIZE" "DOUBLE-FLOAT-TRAPPING-NAN-BIT" "DOUBLE-FLOAT-TYPE" "DOUBLE-FLOAT-VALUE-SLOT" "DOUBLE-INT-CARG-REG-SC-NUMBER" "DOUBLE-REG-SC-NUMBER" - "DOUBLE-STACK-SC-NUMBER" "DWORD-REG-SC-NUMBER" - "DYLAN-FUNCTION-HEADER-TYPE" "ERROR-TRAP" - "EVEN-FIXNUM-TYPE" "EXPORTED-STATIC-SYMBOLS" "EXTERN-ALIEN-NAME" + "DOUBLE-STACK-SC-NUMBER" "DYLAN-FUNCTION-HEADER-TYPE" + "ERROR-TRAP" "EVEN-FIXNUM-TYPE" + "EXPORTED-STATIC-SYMBOLS" "EXTERN-ALIEN-NAME" "FDEFN-FUNCTION-SLOT" "FDEFN-NAME-SLOT" "FDEFN-RAW-ADDR-SLOT" "FDEFN-SIZE" "FDEFN-TYPE" "FIND-HOLES" "FIXNUM" "FIXUP-CODE-OBJECT" "FLOAT-DENORMAL-TRAP-BIT" @@ -679,8 +679,8 @@ "FLOAT-OVERFLOW-TRAP-BIT" "FLOAT-SIGN-SHIFT" "FLOAT-UNDERFLOW-TRAP-BIT" "FLOATING-POINT-MODES" "FORWARDING-POINTER-TYPE" - "FP-DOUBLE-CONSTANT-SC-NUMBER" "FP-DOUBLE-ZERO-SC-NUMBER" - "FP-SINGLE-CONSTANT-SC-NUMBER" "FP-SINGLE-ZERO-SC-NUMBER" + "FP-CONSTANT-SC-NUMBER" + "FP-DOUBLE-ZERO-SC-NUMBER" "FP-SINGLE-ZERO-SC-NUMBER" "FUNCALLABLE-INSTANCE-FUNCTION-SLOT" "FUNCALLABLE-INSTANCE-HEADER-TYPE" "FUNCALLABLE-INSTANCE-INFO-OFFSET" diff --git a/compiler/x86/float.lisp b/compiler/x86/float.lisp index af9b32ca1cad6401c807b7b4fc5c0a28d669e879..3b831238dca6f2e46c51baa5798844d4a49988e5 100644 --- a/compiler/x86/float.lisp +++ b/compiler/x86/float.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float.lisp,v 1.21 1998/02/19 19:34:56 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float.lisp,v 1.22 1998/02/21 18:24:46 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -138,14 +138,12 @@ ;;; Anyhow, might as well use the feature. It can be turned ;;; off by hacking the "immediate-constant-sc" in vm.lisp. (define-move-function (load-fp-constant 2) (vop x y) - ((fp-single-constant)(single-reg) - (fp-double-constant)(double-reg)) - + ((fp-constant) (single-reg double-reg)) (let ((value (c::constant-value (c::tn-leaf x)))) (with-empty-tn@fp-top(y) (cond ((zerop value) (inst fldz)) - ((or (= value 1f0)(= value 1d0)) + ((= value 1l0) (inst fld1)) (t (warn "Ignoring bogus i387 Constant ~a" value)))))) @@ -308,16 +306,6 @@ (define-move-vop move-from-single :move (single-reg) (descriptor-reg)) -(define-vop (move-from-fp-single-const) - (:args (x :scs (fp-single-constant))) - (:results (y :scs (descriptor-reg))) - (:generator 2 - (ecase (c::constant-value (c::tn-leaf x)) - (0f0 (load-symbol-value y *fp-constant-0s0*)) - (1f0 (load-symbol-value y *fp-constant-1s0*))))) -(define-move-vop move-from-fp-single-const :move - (fp-single-constant) (descriptor-reg)) - (define-vop (move-from-double) (:args (x :scs (double-reg) :to :save)) (:results (y :scs (descriptor-reg))) @@ -330,15 +318,17 @@ (define-move-vop move-from-double :move (double-reg) (descriptor-reg)) -(define-vop (move-from-fp-double-const) - (:args (x :scs (fp-double-constant))) +(define-vop (move-from-fp-constant) + (:args (x :scs (fp-constant))) (:results (y :scs (descriptor-reg))) (:generator 2 (ecase (c::constant-value (c::tn-leaf x)) + (0f0 (load-symbol-value y *fp-constant-0s0*)) + (1f0 (load-symbol-value y *fp-constant-1s0*)) (0d0 (load-symbol-value y *fp-constant-0d0*)) (1d0 (load-symbol-value y *fp-constant-1d0*))))) -(define-move-vop move-from-fp-double-const :move - (fp-double-constant) (descriptor-reg)) +(define-move-vop move-from-fp-constant :move + (fp-constant) (descriptor-reg)) ;;; ;;; Move from a descriptor to a float register diff --git a/compiler/x86/vm.lisp b/compiler/x86/vm.lisp index b9f2f9b35c2b0542ad0866f656f8e32de1175c56..bc0db76f69e7a7f378a76c27e1d61c9168978062 100644 --- a/compiler/x86/vm.lisp +++ b/compiler/x86/vm.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/vm.lisp,v 1.7 1998/02/14 21:09:52 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/vm.lisp,v 1.8 1998/02/21 18:24:45 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -106,17 +106,6 @@ (defreg fr7 7 :float) (defregset float-regs fr0 fr1 fr2 fr3 fr4 fr5 fr6 fr7) -;(defvar *double-float-register-names* (make-array 8 :initial-element nil)) -;(defreg dfr0 0 :double-float) -;(defreg dfr1 1 :double-float) -;(defreg dfr2 2 :double-float) -;(defreg dfr3 3 :double-float) -;(defreg dfr4 4 :double-float) -;(defreg dfr5 5 :double-float) -;(defreg dfr6 6 :double-float) -;(defreg dfr7 7 :double-float) -;(defregset double-float-regs dfr0 dfr1 dfr2 dfr3 dfr4 dfr5 dfr6 dfr7) - ;;;; SB definitions. @@ -168,10 +157,8 @@ ;; Non-immediate contstants in the constant pool (constant constant) - ;; Some FP constants can be generated in the i387 silicon. - - (fp-single-constant immediate-constant) - (fp-double-constant immediate-constant) + ;; Some FP constants can be generated in the i387 silicon. + (fp-constant immediate-constant) (immediate immediate-constant) @@ -190,7 +177,7 @@ #+complex-float (complex-single-stack stack :element-size 2) ; complex-single-floats #+complex-float - (complex-double-stack stack :element-size 4) ; complex-double-floats. + (complex-double-stack stack :element-size 4) ; complex-double-floats ;; **** Magic SCs. @@ -219,8 +206,7 @@ :locations #.dword-regs :element-size 2 ; :reserve-locations (#.eax-offset) - :constant-scs - (constant immediate) + :constant-scs (constant immediate) :save-p t :alternate-scs (control-stack)) @@ -258,11 +244,6 @@ :alternate-scs (unsigned-stack)) ;; Random objects that must not be seen by GC. Used only as temporaries. - (dword-reg registers - :locations #.dword-regs - :element-size 2 -; :reserve-locations (#.eax-offset) - ) (word-reg registers :locations #.word-regs :element-size 2 @@ -278,14 +259,14 @@ ;; Non-Descriptor single-floats. (single-reg float-registers :locations (0 1 2 3 4 5 6 7) - :constant-scs (fp-single-constant) + :constant-scs (fp-constant) :save-p t :alternate-scs (single-stack)) ;; Non-Descriptor double-floats. (double-reg float-registers :locations (0 1 2 3 4 5 6 7) - :constant-scs (fp-double-constant) + :constant-scs (fp-constant) :save-p t :alternate-scs (double-stack)) @@ -314,8 +295,8 @@ (defconstant byte-sc-names '(base-char-reg byte-reg base-char-stack)) (defconstant word-sc-names '(word-reg)) (defconstant dword-sc-names - '(any-reg descriptor-reg sap-reg signed-reg unsigned-reg dword-reg - control-stack signed-stack unsigned-stack sap-stack single-stack constant)) + '(any-reg descriptor-reg sap-reg signed-reg unsigned-reg control-stack + signed-stack unsigned-stack sap-stack single-stack constant)) ;;; ;;; added by jrd. I guess the right thing to do is to treat floats @@ -343,7 +324,7 @@ :offset ,reg-offset-name))))) `(progn ,@(forms))))) -(def-random-reg-tns dword-reg eax ebx ecx edx ebp esp edi esi) +(def-random-reg-tns unsigned-reg eax ebx ecx edx ebp esp edi esi) (def-random-reg-tns word-reg ax bx cx dx bp sp di si) (def-random-reg-tns byte-reg al ah bl bh cl ch dl dh) @@ -352,16 +333,10 @@ ;; Added by pw. -(defparameter fp-single-constant-tn +(defparameter fp-constant-tn (make-random-tn :kind :normal - :sc (sc-or-lose 'fp-single-constant) + :sc (sc-or-lose 'fp-constant) :offset 31)) ; Offset doesn't get used. -(defparameter fp-double-constant-tn - (make-random-tn :kind :normal - :sc (sc-or-lose 'fp-single-constant) - :offset 31)) - - ;;; Immediate-Constant-SC @@ -374,15 +349,14 @@ ((or fixnum system-area-pointer character) (sc-number-or-lose 'immediate *backend*)) (symbol - (if (static-symbol-p value) - (sc-number-or-lose 'immediate *backend*) - nil)) + (when (static-symbol-p value) + (sc-number-or-lose 'immediate *backend*))) (single-float (when (or (eql value 0f0) (eql value 1f0)) - (sc-number-or-lose 'fp-single-constant *backend*))) + (sc-number-or-lose 'fp-constant *backend*))) (double-float (when (or (eql value 0d0) (eql value 1d0)) - (sc-number-or-lose 'fp-double-constant *backend*))))) + (sc-number-or-lose 'fp-constant *backend*))))) ;;;; Function Call Parameters @@ -439,7 +413,6 @@ (< -1 offset (length name-vec)) (svref name-vec offset)) (format nil "<Unknown Reg: off=~D, sc=~A>" offset sc-name)))) - ;; (float-registers "FloatStackTop") (float-registers (format nil "FR~D" offset)) (stack (format nil "S~D" offset)) (constant (format nil "Const~D" offset))