From: William Harold Newman <william.newman@airmail.net>
Date: Wed, 1 Aug 2001 18:02:29 +0000 (+0000)
Subject: 0.6.12.61:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=b1a50831ec47d41b07fe2225b91ff4ff560609da;p=sbcl.git

0.6.12.61:
	copied transforms for TRUNCATE, FLOOR, and CEILING from
		CMU CL 18c. (Like various other efficiency fixes,
		they're in contrib/compiler-extras.lisp instead
		of the main system. My plan is to merge all the
		contrib/*-extra.lisp stuff into the main system
		in version 0.7.x.)
---

diff --git a/contrib/compiler-extras.lisp b/contrib/compiler-extras.lisp
index d04a308..82c96be 100644
--- a/contrib/compiler-extras.lisp
+++ b/contrib/compiler-extras.lisp
@@ -424,3 +424,39 @@
   (check-inlineability-of-find-position-if sequence from-end)
   '(%find-position-vector-macro item sequence
 				from-end start end key test))
+
+^L
+;;;; optimizations for floating point FLOOR, CEILING, TRUNCATE, and
+;;;; ROUND, lifted from CMU CL 18c
+;;;;
+;;;; (Without these optimizations, these functions cons!)
+
+;; Convert (TRUNCATE x y) to the obvious implementation.  We only want
+;; this when under certain conditions and let the generic TRUNCATE
+;; handle the rest.  (Note: if Y = 1, the divide and multiply by Y
+;; should be removed by other DEFTRANSFORMs.)
+
+(deftransform truncate ((x &optional y)
+                        (float &optional (or float integer)))
+  '(let ((res (%unary-truncate (/ x y))))
+     (values res (- x (* y res)))))
+
+(deftransform floor ((number &optional divisor)
+                     (float &optional (or integer float)))
+  '(multiple-value-bind (tru rem) (truncate number divisor)
+    (if (and (not (zerop rem))
+             (if (minusp divisor)
+                 (plusp number)
+                 (minusp number)))
+        (values (1- tru) (+ rem divisor))
+        (values tru rem))))
+
+(deftransform ceiling ((number &optional divisor)
+                       (float &optional (or integer float)))
+  '(multiple-value-bind (tru rem) (truncate number divisor)
+    (if (and (not (zerop rem))
+             (if (minusp divisor)
+                 (minusp number)
+                 (plusp number)))
+        (values (1+ tru) (- rem divisor))
+        (values tru rem))))
diff --git a/version.lisp-expr b/version.lisp-expr
index 2400f6d..6ab2baf 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -16,4 +16,4 @@
 ;;; four numeric fields, is used for versions which aren't released
 ;;; but correspond only to CVS tags or snapshots.
 
-"0.6.12.60"
+"0.6.12.61"