diff --git a/compiler/alpha/call.lisp b/compiler/alpha/call.lisp index 16ff2ca138365fd8b09926e4a413720b9f1b6929..526db6a6284ab2f9fe364de342878f534e01f17a 100644 --- a/compiler/alpha/call.lisp +++ b/compiler/alpha/call.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/call.lisp,v 1.2 1994/10/31 04:39:51 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/call.lisp,v 1.3 1998/01/26 15:54:27 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -170,7 +170,8 @@ (define-vop (xep-allocate-frame) - (:info start-lab) + (:info start-lab copy-more-arg-follows) + (:ignore copy-more-arg-follows) (:vop-var vop) (:temporary (:scs (non-descriptor-reg)) temp) (:generator 1 diff --git a/compiler/alpha/float.lisp b/compiler/alpha/float.lisp index 44fdc2c5d0a89948ef83e814b8013d47f4d055cb..5bb1911e2470db9f1c7e9f6f83bd35d97133747a 100644 --- a/compiler/alpha/float.lisp +++ b/compiler/alpha/float.lisp @@ -6,7 +6,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/float.lisp,v 1.5 1998/01/24 14:52:18 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/float.lisp,v 1.6 1998/01/26 15:54:30 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -289,16 +289,12 @@ (:results (y :scs (,sc))) (:note "pointer to complex float coercion") (:generator 2 - (let ((real-tn ,(if double-p - '(complex-double-reg-real-tn y) - '(complex-single-reg-real-tn y)))) + (let ((real-tn (complex-double-reg-real-tn y))) (inst ,(if double-p 'ldt 'lds) real-tn (- (* ,real-value vm:word-bytes) vm:other-pointer-type) x)) - (let ((imag-tn ,(if double-p - '(complex-double-reg-imag-tn y) - '(complex-single-reg-imag-tn y)))) + (let ((imag-tn (complex-double-reg-imag-tn y))) (inst ,(if double-p 'ldt 'lds) imag-tn (- (* ,imag-value vm:word-bytes) vm:other-pointer-type) @@ -659,9 +655,7 @@ (define-vop (double-float-high-bits) (:args (float :scs (double-reg descriptor-reg) :load-if (not (sc-is float double-stack)))) - (:results (hi-bits :scs (signed-reg) - :load-if (or (sc-is float descriptor-reg double-stack) - (not (sc-is hi-bits signed-stack))))) + (:results (hi-bits :scs (signed-reg))) (:temporary (:scs (double-stack)) stack-temp) (:arg-types double-float) (:result-types signed-num) @@ -688,9 +682,7 @@ (define-vop (double-float-low-bits) (:args (float :scs (double-reg descriptor-reg) :load-if (not (sc-is float double-stack)))) - (:results (lo-bits :scs (unsigned-reg) - :load-if (or (sc-is float descriptor-reg double-stack) - (not (sc-is lo-bits unsigned-stack))))) + (:results (lo-bits :scs (unsigned-reg))) (:temporary (:scs (double-stack)) stack-temp) (:arg-types double-float) (:result-types unsigned-num) diff --git a/compiler/alpha/nlx.lisp b/compiler/alpha/nlx.lisp index ce8c8310ccb4f93e0b1b013a94864fa2b2e3363e..0538fcd29be2d087232cb30dff0be66ece70d1e8 100644 --- a/compiler/alpha/nlx.lisp +++ b/compiler/alpha/nlx.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/nlx.lisp,v 1.3 1998/01/21 19:28:44 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/nlx.lisp,v 1.4 1998/01/26 15:54:34 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -31,7 +31,6 @@ ;;; Make a TN for the argument count passing location for a ;;; non-local entry. ;;; -#+nil (def-vm-support-routine make-nlx-entry-argument-start-location () (make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset)) diff --git a/compiler/alpha/vm.lisp b/compiler/alpha/vm.lisp index db5698b4484f915f12b1e452601c236048eb10d5..3401eff3d6c969e75e10ed1ef27007509f89b54c 100644 --- a/compiler/alpha/vm.lisp +++ b/compiler/alpha/vm.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/vm.lisp,v 1.3 1998/01/21 19:23:45 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/vm.lisp,v 1.4 1998/01/26 15:54:36 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -219,21 +219,21 @@ ;; Non-Descriptor single-floats. (single-reg float-registers - :locations #.(loop for i from 4 to 31 collect i) + :locations #.(loop for i from 4 to 30 collect i) :constant-scs (fp-single-zero) :save-p t :alternate-scs (single-stack)) ;; Non-Descriptor double-floats. (double-reg float-registers - :locations #.(loop for i from 4 to 31 collect i) + :locations #.(loop for i from 4 to 30 collect i) :constant-scs (fp-double-zero) :save-p t :alternate-scs (double-stack)) #+complex-float (complex-single-reg float-registers - :locations #.(loop for i from 4 to 31 by 2 collect i) + :locations #.(loop for i from 4 to 28 by 2 collect i) :element-size 2 :constant-scs () :save-p t @@ -241,7 +241,7 @@ #+complex-float (complex-double-reg float-registers - :locations #.(loop for i from 4 to 31 by 2 collect i) + :locations #.(loop for i from 4 to 28 by 2 collect i) :element-size 2 :constant-scs () :save-p t @@ -311,11 +311,11 @@ (sc-number-or-lose 'immediate *backend*) nil)) (single-float - (if (zerop value) + (if (eql value 0f0) (sc-number-or-lose 'fp-single-zero *backend*) nil)) (double-float - (if (zerop value) + (if (eql value 0d0) (sc-number-or-lose 'fp-double-zero *backend*) nil)))) diff --git a/compiler/backend.lisp b/compiler/backend.lisp index f5af2fc6741da020aa4aeb59a7e074af1f7e488a..16b6cc6259745f0ab5f6ba4a15f49f59c59ccb84 100644 --- a/compiler/backend.lisp +++ b/compiler/backend.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/backend.lisp,v 1.30 1998/01/22 00:04:18 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/backend.lisp,v 1.31 1998/01/26 15:54:17 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -85,7 +85,7 @@ ;; From NLX.LISP make-nlx-sp-tn make-dynamic-state-tns - #+(or x86 sparc) make-nlx-entry-argument-start-location + #+(or x86 sparc alpha) make-nlx-entry-argument-start-location ;; From SUPPORT.LISP generate-call-sequence diff --git a/compiler/ir2tran.lisp b/compiler/ir2tran.lisp index de7ca26826d6d2c15b90eed3636ab7ba429a1186..209fb39b2250eb0234a19d13cb196b358f016db2 100644 --- a/compiler/ir2tran.lisp +++ b/compiler/ir2tran.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/ir2tran.lisp,v 1.64 1998/01/22 00:04:20 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir2tran.lisp,v 1.65 1998/01/26 15:54:20 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1144,10 +1144,12 @@ (optional-dispatch-more-entry ef)) ;; Special case the xep-allocate-frame + copy-more-arg case. (progn - (vop xep-allocate-frame node block start-label #+(or x86 sparc) t) + (vop xep-allocate-frame node block start-label + #+(or x86 sparc alpha) t) (vop copy-more-arg node block (optional-dispatch-max-args ef))) ;; No more args, so normal entry. - (vop xep-allocate-frame node block start-label #+(or x86 sparc) nil)) + (vop xep-allocate-frame node block start-label + #+(or x86 sparc alpha) nil)) (if (ir2-environment-environment env) (let ((closure @@ -1607,8 +1609,8 @@ (2cont (continuation-info cont)) (2info (nlx-info-info info)) (top-loc (ir2-nlx-info-save-sp 2info)) - (start-loc #-(or x86 sparc) (make-old-fp-passing-location t) - #+(or x86 sparc) (make-nlx-entry-argument-start-location)) + (start-loc #-(or x86 sparc alpha) (make-old-fp-passing-location t) + #+(or x86 sparc alpha) (make-nlx-entry-argument-start-location)) (count-loc (make-argument-count-location)) (target (ir2-nlx-info-target 2info)))