From 8b703e120300b386c966532c50e61f4c0ede0047 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Mon, 29 Mar 2004 18:47:03 +0000 Subject: [PATCH] Make the def-source-transform and defoptimizer for max and min consistent in which argument is selected. Previously, they were inconsistent which causes problems when the argument types are equal, but of different types. (Based on a patch Alexey Dejneka did for SBCL for the same issue.) --- compiler/sparc/float.lisp | 26 ++++++++++++++++---------- compiler/srctran.lisp | 6 +++--- 2 files changed, 19 insertions(+), 13 deletions(-) diff --git a/compiler/sparc/float.lisp b/compiler/sparc/float.lisp index d2e22014e..7b336a01f 100644 --- a/compiler/sparc/float.lisp +++ b/compiler/sparc/float.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/sparc/float.lisp,v 1.43 2003/10/27 18:30:27 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/float.lisp,v 1.44 2004/03/29 18:47:03 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2485,13 +2485,13 @@ (defun %%min (x y) (declare (type (or (unsigned-byte 32) (signed-byte 32) single-float double-float) x y)) - (if (< x y) + (if (<= x y) x y)) (defun %%max (x y) (declare (type (or (unsigned-byte 32) (signed-byte 32) single-float double-float) x y)) - (if (> x y) + (if (>= x y) x y)) (macrolet @@ -2609,22 +2609,28 @@ ;; Derive the types of max and min (defoptimizer (max derive-type) ((x y)) + ;; It's Y < X instead of X < Y because that's how the + ;; source-transform, the deftransform and the max function do the + ;; comparisons. This is important if the types of X and Y are + ;; different types, like integer vs double-float because CMUCL + ;; returns the actual arg, instead of applying float-contagion to + ;; the result. (multiple-value-bind (definitely-< definitely->=) - (ir1-transform-<-helper x y) + (ir1-transform-<-helper y x) (cond (definitely-< - (continuation-type y)) - (definitely->= (continuation-type x)) + (definitely->= + (continuation-type y)) (t (make-canonical-union-type (list (continuation-type x) (continuation-type y))))))) (defoptimizer (min derive-type) ((x y)) - (multiple-value-bind (definitely-< definitely->=) - (ir1-transform-<-helper x y) - (cond (definitely-< + (multiple-value-bind (definitely-> definitely-<=) + (ir1-transform-<-helper y x) + (cond (definitely-<= (continuation-type x)) - (definitely->= + (definitely-> (continuation-type y)) (t (make-canonical-union-type (list (continuation-type x) diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp index 0bfc797bc..22b7c99a1 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.143 2004/01/19 20:15:28 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.144 2004/03/29 18:47:03 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -3295,7 +3295,7 @@ `(values (the real ,arg)) (once-only ((arg1 arg) (arg2 `(max ,@more-args))) - `(if (> ,arg1 ,arg2) + `(if (>= ,arg1 ,arg2) ,arg1 ,arg2)))) ;;; (def-source-transform min (arg &rest more-args) @@ -3303,7 +3303,7 @@ `(values (the real ,arg)) (once-only ((arg1 arg) (arg2 `(min ,@more-args))) - `(if (< ,arg1 ,arg2) + `(if (<= ,arg1 ,arg2) ,arg1 ,arg2)))) ) -- GitLab