From 70753d57bf1fb2f5e6379fce007b90bde937f41a Mon Sep 17 00:00:00 2001 From: dtc <dtc> Date: Sun, 16 Nov 1997 14:00:05 +0000 Subject: [PATCH] No longer source transform realpart and imagpart with the complex-float support. The realpart and imagpart functions now need to do some type dispatch. The VOPs are now direct translations of realpart and imagpart; remove the hack accessor functions. --- code/numbers.lisp | 34 ++++++++++++++++++++++++++++++++-- code/x86-vm.lisp | 21 +-------------------- compiler/srctran.lisp | 30 +----------------------------- compiler/x86/float.lisp | 38 ++++++++++++++++++-------------------- 4 files changed, 52 insertions(+), 71 deletions(-) diff --git a/code/numbers.lisp b/code/numbers.lisp index f8e508ee2..053f6f535 100644 --- a/code/numbers.lisp +++ b/code/numbers.lisp @@ -5,11 +5,11 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/numbers.lisp,v 1.30 1997/11/05 14:59:45 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/numbers.lisp,v 1.31 1997/11/16 13:59:56 dtc Exp $") ;;; ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/numbers.lisp,v 1.30 1997/11/05 14:59:45 dtc Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/numbers.lisp,v 1.31 1997/11/16 13:59:56 dtc Exp $ ;;; ;;; This file contains the definitions of most number functions. ;;; @@ -290,14 +290,44 @@ (canonical-complex realpart imagpart)) (float-contagion %%make-complex realpart imagpart (rational))))) +#-complex-float (defun realpart (number) "Extracts the real part of a number." (realpart number)) +#-complex-float (defun imagpart (number) "Extracts the imaginary part of a number." (imagpart number)) +#+complex-float +(defun realpart (number) + "Extracts the real part of a number." + (typecase number + ((complex double-float) + (truly-the double-float (realpart number))) + ((complex single-float) + (truly-the single-float (realpart number))) + ((complex rational) + (kernel:%realpart number)) + (t + number))) + +#+complex-float +(defun imagpart (number) + "Extracts the imaginary part of a number." + (typecase number + ((complex double-float) + (truly-the double-float (imagpart number))) + ((complex single-float) + (truly-the single-float (imagpart number))) + ((complex rational) + (kernel:%imagpart number)) + (float + (float 0 number)) + (t + 0))) + (defun conjugate (number) "Returns the complex conjugate of NUMBER. For non-complex numbers, this is an identity." diff --git a/code/x86-vm.lisp b/code/x86-vm.lisp index f8b6655ce..f4e1161d3 100644 --- a/code/x86-vm.lisp +++ b/code/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/code/x86-vm.lisp,v 1.9 1997/11/16 13:53:01 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/x86-vm.lisp,v 1.10 1997/11/16 13:59:57 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -432,22 +432,3 @@ "Atomically compare object's slot value to test-value and if EQ store new-value in the slot. The original value of the slot is returned." (kernel::%instance-set-conditional object slot test-value new-value)) - -#+complex-float -(progn -(defun complex-single-float-real (x) - (declare (type (complex single-float) x)) - (the single-float (complex-single-float-real x))) - -(defun complex-double-float-real (x) - (declare (type (complex double-float) x)) - (the double-float (complex-double-float-real x))) - -(defun complex-single-float-imag (x) - (declare (type (complex single-float) x)) - (the single-float (complex-single-float-imag x))) - -(defun complex-double-float-imag (x) - (declare (type (complex double-float) x)) - (the double-float (complex-double-float-imag x))) -) ; complex-float diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp index 613310952..46fde871e 100644 --- a/compiler/srctran.lisp +++ b/compiler/srctran.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/srctran.lisp,v 1.61 1997/11/15 04:38:54 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.62 1997/11/16 14:00:01 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -235,34 +235,6 @@ (float 0 ,n-num)) (t 0)))) -;;; -#+complex-float -(def-source-transform realpart (num) - (once-only ((n-num num)) - `(typecase ,n-num - ((complex double-float) - (vm::complex-double-float-real ,n-num)) - ((complex single-float) - (vm::complex-single-float-real ,n-num)) - ((complex rational) - (kernel:%realpart ,n-num)) - (t - ,n-num)))) -;;; -#+complex-float -(def-source-transform imagpart (num) - (once-only ((n-num num)) - `(typecase ,n-num - ((complex double-float) - (vm::complex-double-float-imag ,n-num)) - ((complex single-float) - (vm::complex-single-float-imag ,n-num)) - ((complex rational) - (kernel:%imagpart ,n-num)) - (float - (float 0 ,n-num)) - (t - 0)))) ;;;; Interval arithmetic for computing bounds diff --git a/compiler/x86/float.lisp b/compiler/x86/float.lisp index e73daae0e..717750e5a 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.14 1997/11/08 15:32:05 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float.lisp,v 1.15 1997/11/16 14:00:05 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2560,9 +2560,6 @@ #+complex-float (progn -(eval-when (compile load eval) - (export '(complex-single-float-real complex-double-float-real - complex-single-float-imag complex-double-float-imag))) (define-vop (make-complex-float) (:args (x :target r) @@ -2597,7 +2594,8 @@ (y :scs (single-reg) :to :save)) (:arg-types single-float single-float) (:results (r :scs (complex-single-reg) :from (:argument 0))) - (:result-types complex-single-float)) + (:result-types complex-single-float) + (:note "inline complex single-float creation")) (define-vop (make-complex-double-float make-complex-float) (:translate complex) @@ -2605,13 +2603,8 @@ (y :scs (double-reg) :to :save)) (:arg-types double-float double-float) (:results (r :scs (complex-double-reg) :from (:argument 0))) - (:result-types complex-double-float)) - -;;; Real and imaginary part accessors. -(defknown (complex-single-float-real complex-single-float-imag) - ((complex single-float)) single-float (flushable)) -(defknown (complex-double-float-real complex-double-float-imag) - ((complex double-float)) double-float (flushable)) + (:result-types complex-double-float) + (:note "inline complex double-float creation")) (define-vop (complex-float-value) (:args (x :target r)) @@ -2658,39 +2651,44 @@ (inst fldd ea)))) (t (error "Complex-float-value VOP failure"))))) -(define-vop (complex-single-float-real complex-float-value) - (:translate complex-single-float-real) +(define-vop (realpart/complex-single-float complex-float-value) + (:translate realpart) (:args (x :scs (complex-single-reg complex-single-stack descriptor-reg) :target r)) (:arg-types complex-single-float) (:results (r :scs (single-reg))) (:result-types single-float) + (:note "complex float realpart") (:variant 0)) -(define-vop (complex-double-float-real complex-float-value) - (:translate complex-double-float-real) +(define-vop (realpart/complex-double-float complex-float-value) + (:translate realpart) (:args (x :scs (complex-double-reg complex-double-stack descriptor-reg) :target r)) (:arg-types complex-double-float) (:results (r :scs (double-reg))) (:result-types double-float) + (:note "complex float realpart") (:variant 0)) -(define-vop (complex-single-float-imag complex-float-value) - (:translate complex-single-float-imag) +(define-vop (imagpart/complex-single-float complex-float-value) + (:translate imagpart) (:args (x :scs (complex-single-reg complex-single-stack descriptor-reg) :target r)) (:arg-types complex-single-float) (:results (r :scs (single-reg))) (:result-types single-float) + (:note "complex float imagpart") (:variant 1)) -(define-vop (complex-double-float-imag complex-float-value) - (:translate complex-double-float-imag) +(define-vop (imagpart/complex-double-float complex-float-value) + (:translate imagpart) (:args (x :scs (complex-double-reg complex-double-stack descriptor-reg) :target r)) (:arg-types complex-double-float) (:results (r :scs (double-reg))) (:result-types double-float) + (:note "complex float imagpart") (:variant 1)) + ) ; complex-float -- GitLab