From ab11f71665aa36100c6c4352cf49d983e51d06cc Mon Sep 17 00:00:00 2001 From: dtc <dtc> Date: Mon, 30 Mar 1998 03:05:54 +0000 Subject: [PATCH] Add the special float function %expm1, and an inline VOP implementation for the X86 port. --- code/exports.lisp | 4 +- compiler/float-tran.lisp | 6 +- compiler/x86/float.lisp | 132 +++++++++++++++++++++++++++++++++++++-- 3 files changed, 135 insertions(+), 7 deletions(-) diff --git a/code/exports.lisp b/code/exports.lisp index 47c221eca..bf187b157 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.149 1998/03/26 14:07:24 pw Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.150 1998/03/30 03:05:50 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1416,7 +1416,7 @@ "%ARRAY-FILL-POINTER-P" "%ASIN" "%ASINH" "%ATAN" "%ATAN2" "%ATANH" "%CALLER-FRAME-AND-PC" "%CHECK-BOUND" "%CLOSURE-FUNCTION" "%CLOSURE-INDEX-REF" "%COS" "%COS-QUICK" "%COSH" "%DEPOSIT-FIELD" - "%DOUBLE-FLOAT" "%DPB" "%EXP" "%FUNCTION-HEADER-ARGLIST" + "%DOUBLE-FLOAT" "%DPB" "%EXP" "%EXPM1" "%FUNCTION-HEADER-ARGLIST" "%FUNCTION-HEADER-NAME" "%FUNCTION-HEADER-TYPE" "%HYPOT" "%LDB" "%LOG" "%LOGB" "%LOG10" "%LOG1P" "%LONG-FLOAT" "%MAKE-COMPLEX" "%MAKE-FUNCALLABLE-INSTANCE" "%MAKE-RATIO" diff --git a/compiler/float-tran.lisp b/compiler/float-tran.lisp index 9ae8e2295..5d05c17ba 100644 --- a/compiler/float-tran.lisp +++ b/compiler/float-tran.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/float-tran.lisp,v 1.67 1998/03/30 02:44:26 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.68 1998/03/30 03:05:52 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -419,6 +419,10 @@ (double-float) (double-float 0.0d0) (movable foldable flushable)) +(defknown %expm1 + (double-float) (double-float -1d0) + (movable foldable flushable)) + (defknown (%hypot) (double-float double-float) (double-float 0d0) (movable foldable flushable)) diff --git a/compiler/x86/float.lisp b/compiler/x86/float.lisp index db8388e35..adfc312de 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.27 1998/03/30 02:41:17 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float.lisp,v 1.28 1998/03/30 03:05:54 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2484,9 +2484,9 @@ (:generator 5 (note-this-location vop :internal-error) (unless (zerop (tn-offset x)) - (inst fxch x) ; x to top of stack - (unless (location= x y) - (inst fst x))) ; maybe save it + (inst fxch x) ; x to top of stack + (unless (location= x y) + (inst fst x))) ; maybe save it ;; Check for Inf or NaN (inst fxam) (inst fnstsw) @@ -2516,6 +2516,68 @@ (unless (zerop (tn-offset y)) (inst fstd y)))) +;;; Expm1 = exp(x) - 1. +;;; Handles the following special cases: +;;; expm1(+Inf) is +Inf; expm1(-Inf) is -1.0; expm1(NaN) is NaN. +(define-vop (fexpm1) + (:translate %expm1) + (:args (x :scs (double-reg) :target fr0)) + (:temporary (:sc word-reg :offset eax-offset :from :eval :to :result) temp) + (:temporary (:sc long-reg :offset fr0-offset + :from :argument :to :result) fr0) + (:temporary (:sc long-reg :offset fr1-offset + :from :argument :to :result) fr1) + (:temporary (:sc long-reg :offset fr2-offset + :from :argument :to :result) fr2) + (:results (y :scs (double-reg))) + (:arg-types double-float) + (:result-types double-float) + (:policy :fast-safe) + (:note "inline expm1 function") + (:vop-var vop) + (:save-p :compute-only) + (:ignore temp) + (:generator 5 + (note-this-location vop :internal-error) + (unless (zerop (tn-offset x)) + (inst fxch x) ; x to top of stack + (unless (location= x y) + (inst fst x))) ; maybe save it + ;; Check for Inf or NaN + (inst fxam) + (inst fnstsw) + (inst sahf) + (inst jmp :nc NOINFNAN) ; Neither Inf or NaN. + (inst jmp :np NOINFNAN) ; NaN gives NaN? Continue. + (inst and ah-tn #x02) ; Test sign of Inf. + (inst jmp :z DONE) ; +Inf gives +Inf. + (inst fstp fr0) ; -Inf gives -1.0 + (inst fld1) + (inst fchs) + (inst jmp-short DONE) + NOINFNAN + ;; Free two stack slots leaving the argument on top. + (inst fstp fr2) + (inst fstp fr0) + (inst fldl2e) + (inst fmul fr1) ; Now fr0 = x log2(e) + (inst fst fr1) + (inst frndint) + (inst fsub-sti fr1) + (inst fxch fr1) + (inst f2xm1) + (inst fscale) + (inst fxch fr1) + (inst fld1) + (inst fscale) + (inst fstp fr1) + (inst fld1) + (inst fsub fr1) + (inst fsubr fr2) + DONE + (unless (zerop (tn-offset y)) + (inst fstd y)))) + (define-vop (flog) (:translate %log) (:args (x :scs (double-reg double-stack descriptor-reg) :target fr0)) @@ -3539,6 +3601,68 @@ (unless (zerop (tn-offset y)) (inst fstd y)))) +;;; Expm1 = exp(x) - 1. +;;; Handles the following special cases: +;;; expm1(+Inf) is +Inf; expm1(-Inf) is -1.0; expm1(NaN) is NaN. +(define-vop (fexpm1) + (:translate %expm1) + (:args (x :scs (long-reg) :target fr0)) + (:temporary (:sc word-reg :offset eax-offset :from :eval :to :result) temp) + (:temporary (:sc long-reg :offset fr0-offset + :from :argument :to :result) fr0) + (:temporary (:sc long-reg :offset fr1-offset + :from :argument :to :result) fr1) + (:temporary (:sc long-reg :offset fr2-offset + :from :argument :to :result) fr2) + (:results (y :scs (long-reg))) + (:arg-types long-float) + (:result-types long-float) + (:policy :fast-safe) + (:note "inline expm1 function") + (:vop-var vop) + (:save-p :compute-only) + (:ignore temp) + (:generator 5 + (note-this-location vop :internal-error) + (unless (zerop (tn-offset x)) + (inst fxch x) ; x to top of stack + (unless (location= x y) + (inst fst x))) ; maybe save it + ;; Check for Inf or NaN + (inst fxam) + (inst fnstsw) + (inst sahf) + (inst jmp :nc NOINFNAN) ; Neither Inf or NaN. + (inst jmp :np NOINFNAN) ; NaN gives NaN? Continue. + (inst and ah-tn #x02) ; Test sign of Inf. + (inst jmp :z DONE) ; +Inf gives +Inf. + (inst fstp fr0) ; -Inf gives -1.0 + (inst fld1) + (inst fchs) + (inst jmp-short DONE) + NOINFNAN + ;; Free two stack slots leaving the argument on top. + (inst fstp fr2) + (inst fstp fr0) + (inst fldl2e) + (inst fmul fr1) ; Now fr0 = x log2(e) + (inst fst fr1) + (inst frndint) + (inst fsub-sti fr1) + (inst fxch fr1) + (inst f2xm1) + (inst fscale) + (inst fxch fr1) + (inst fld1) + (inst fscale) + (inst fstp fr1) + (inst fld1) + (inst fsub fr1) + (inst fsubr fr2) + DONE + (unless (zerop (tn-offset y)) + (inst fstd y)))) + (define-vop (flog) (:translate %log) (:args (x :scs (long-reg long-stack descriptor-reg) :target fr0)) -- GitLab