Skip to content
Snippets Groups Projects
Commit 63f036e0 authored by dtc's avatar dtc
Browse files

From Raymond Toy:

o Define %max/%min functions for byte-compilation and constant
  folding.
o Always evaluate all arguments, even if we can prove we won't use
  that argument.  (Don't shortcut %max/%min.)
parent 45026f2e
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.96 2000/04/06 18:40:15 dtc Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.97 2000/04/07 20:33:34 dtc Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -3502,21 +3502,23 @@ ...@@ -3502,21 +3502,23 @@
real real
(movable foldable flushable)) (movable foldable flushable))
;; Needed for the byte-compiled stuff and constant folding since we've
;; declared these as foldable functions.
(defun %max (x y)
(%max x y))
(defun %min (x y)
(%min x y))
;; Convert max/min of many args into the obvious set of nested max/min's. ;; Convert max/min of many args into the obvious set of nested max/min's.
(def-source-transform max (arg &rest more-args) (def-source-transform max (arg &rest more-args)
(cond ((null more-args) (cond ((null more-args)
`(values ,arg)) `(values ,arg))
#+nil
((= (length more-args) 1)
`(%max ,arg ,@more-args))
(t (t
`(%max ,arg (max ,@more-args))))) `(%max ,arg (max ,@more-args)))))
(def-source-transform min (arg &rest more-args) (def-source-transform min (arg &rest more-args)
(cond ((null more-args) (cond ((null more-args)
`(values ,arg)) `(values ,arg))
((= (length more-args) 1)
`(%min ,arg ,@more-args))
(t (t
`(%min ,arg (min ,@more-args))))) `(%min ,arg (min ,@more-args)))))
...@@ -3550,36 +3552,26 @@ ...@@ -3550,36 +3552,26 @@
(unsigned (specifier-type '(unsigned-byte 32))) (unsigned (specifier-type '(unsigned-byte 32)))
(d-float (specifier-type 'double-float)) (d-float (specifier-type 'double-float))
(s-float (specifier-type 'single-float))) (s-float (specifier-type 'single-float)))
(multiple-value-bind (definitely-< definitely->=) ;; Use %%max if both args are good types of the same type. As a
(ir1-transform-<-helper x y) ;; last resort, use the obvious comparison to select the desired
;; Return the appropriate arg if we can prove one is always ;; element.
;; greater than the other. If not, use %%max if both args are (cond ((or (and (csubtypep x-type signed)
;; good types of the same type. As a last resort, use the (csubtypep y-type signed))
;; obvious comparison to select the desired element. (and (csubtypep x-type unsigned)
(cond (definitely-< (csubtypep y-type unsigned))
`(values y)) (and (csubtypep x-type d-float)
(definitely->= (csubtypep y-type d-float))
`(values x)) (and (csubtypep x-type s-float)
((and (csubtypep x-type signed) (csubtypep y-type s-float)))
(csubtypep y-type signed)) `(sparc::%%max x y))
`(sparc::%%max x y)) (t
((and (csubtypep x-type unsigned) (let ((arg1 (gensym))
(csubtypep y-type unsigned)) (arg2 (gensym)))
`(sparc::%%max x y)) `(let ((,arg1 x)
((and (csubtypep x-type d-float) (,arg2 y))
(csubtypep y-type d-float)) (if (> ,arg1 ,arg2)
`(sparc::%%max x y)) ,arg1 ,arg2)))))))
((and (csubtypep x-type s-float)
(csubtypep y-type s-float))
`(sparc::%%max x y))
(t
(let ((arg1 (gensym))
(arg2 (gensym)))
`(let ((,arg1 x)
(,arg2 y))
(if (> ,arg1 ,arg2)
,arg1 ,arg2))))))))
(deftransform %min ((x y) (real real) * :when :both) (deftransform %min ((x y) (real real) * :when :both)
(let ((x-type (continuation-type x)) (let ((x-type (continuation-type x))
(y-type (continuation-type y)) (y-type (continuation-type y))
...@@ -3587,33 +3579,25 @@ ...@@ -3587,33 +3579,25 @@
(unsigned (specifier-type '(unsigned-byte 32))) (unsigned (specifier-type '(unsigned-byte 32)))
(d-float (specifier-type 'double-float)) (d-float (specifier-type 'double-float))
(s-float (specifier-type 'single-float))) (s-float (specifier-type 'single-float)))
(multiple-value-bind (definitely-< definitely->=) (cond ((or (and (csubtypep x-type signed)
(ir1-transform-<-helper x y) (csubtypep y-type signed))
(cond (definitely-< (and (csubtypep x-type unsigned)
`(values x)) (csubtypep y-type unsigned))
(definitely->= (and (csubtypep x-type d-float)
`(values y)) (csubtypep y-type d-float))
((and (csubtypep x-type signed) (and (csubtypep x-type s-float)
(csubtypep y-type signed)) (csubtypep y-type s-float)))
`(sparc::%%min x y)) `(sparc::%%min x y))
((and (csubtypep x-type unsigned) (t
(csubtypep y-type unsigned)) (let ((arg1 (gensym))
`(sparc::%%min x y)) (arg2 (gensym)))
((and (csubtypep x-type d-float) `(let ((,arg1 x)
(csubtypep y-type d-float)) (,arg2 y))
`(sparc::%%min x y)) (if (< ,arg1 ,arg2)
((and (csubtypep x-type s-float) ,arg1 ,arg2)))))))
(csubtypep y-type s-float))
`(sparc::%%min x y))
(t
(let ((arg1 (gensym))
(arg2 (gensym)))
`(let ((,arg1 x)
(,arg2 y))
(if (< ,arg1 ,arg2)
,arg1 ,arg2))))))))
) )
;;;; Converting N-arg arithmetic functions: ;;;; Converting N-arg arithmetic functions:
;;; ;;;
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment