[Sbcl-commits] master: Implement CEILING/FLOOR to truncate via transforms, not inline.

[stassats <sta...@us...>]

The branch "master" has been updated in SBCL:
       via  a795db2b2107df6757e6745ded770c9b60b2317e (commit)
      from  e2327c3f4f133e1922d368639ff3abdf131ef8bd (commit)

- Log -----------------------------------------------------------------
commit a795db2b2107df6757e6745ded770c9b60b2317e
Author: Stas Boukarev <sta...@gm...>
Date:   Fri Mar 21 08:47:27 2014 +0400

    Implement CEILING/FLOOR to truncate via transforms, not inline.
    
    CEILING/FLOOR/MOD/REM are implemented have both transforms and inline
    functions, which do not play well together. The inline expansion is
    applied first, causing the transforms to be ignored.
---
 package-data-list.lisp-expr |    2 -
 src/code/numbers.lisp       |   71 ++++++++++--------------------------------
 src/compiler/fndb.lisp      |    4 --
 src/compiler/srctran.lisp   |   35 +++++++++++++++++----
 4 files changed, 46 insertions(+), 66 deletions(-)

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index d87d64c..4baac94 100644
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -1341,7 +1341,6 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
                "%ATAN" "%ATAN2" "%ATANH"
                "%CALLER-FRAME"
                "%CALLER-PC"
-               "%CEILING"
                "%CHECK-BOUND"
                "%CHECK-GENERIC-SEQUENCE-BOUNDS"
                "%CHECK-VECTOR-SEQUENCE-BOUNDS"
@@ -1359,7 +1358,6 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
                "%DOUBLE-FLOAT" "%DPB" "%EQL"
                "%EXIT"
                "%EXP" "%EXPM1"
-               "%FLOOR"
                "%FIND-POSITION"
                "%FIND-POSITION-VECTOR-MACRO" "%FIND-POSITION-IF"
                "%FIND-POSITION-IF-VECTOR-MACRO" "%FIND-POSITION-IF-NOT"
diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp
index cb1dc1f..ff6cf4c 100644
--- a/src/code/numbers.lisp
+++ b/src/code/numbers.lisp
@@ -653,51 +653,27 @@
   #!+multiply-high-vops
   (%multiply-high x y))
 
-;;; Declare these guys inline to let them get optimized a little.
-;;; ROUND and FROUND are not declared inline since they seem too
-;;; obscure and too big to inline-expand by default. Also, this gives
-;;; the compiler a chance to pick off the unary float case.
-;;;
-;;; CEILING and FLOOR are implemented in terms of %CEILING and %FLOOR
-;;; if no better transform can be found: they aren't inline directly,
-;;; since we want to try a transform specific to them before letting
-;;; the transform for TRUNCATE pick up the slack.
-#!-sb-fluid (declaim (inline rem mod fceiling ffloor ftruncate %floor %ceiling))
-(defun %floor (number divisor)
-  ;; If the numbers do not divide exactly and the result of
-  ;; (/ NUMBER DIVISOR) would be negative then decrement the quotient
-  ;; and augment the remainder by the divisor.
-  (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))))
-
 (defun floor (number &optional (divisor 1))
   #!+sb-doc
   "Return the greatest integer not greater than number, or number/divisor.
   The second returned value is (mod number divisor)."
-  (%floor number divisor))
-
-(defun %ceiling (number divisor)
-  ;; If the numbers do not divide exactly and the result of
-  ;; (/ NUMBER DIVISOR) would be positive then increment the quotient
-  ;; and decrement the remainder by the divisor.
-  (multiple-value-bind (tru rem) (truncate number divisor)
-    (if (and (not (zerop rem))
-             (if (minusp divisor)
-                 (minusp number)
-                 (plusp number)))
-        (values (+ tru 1) (- rem divisor))
-        (values tru rem))))
+  (floor number divisor))
 
 (defun ceiling (number &optional (divisor 1))
   #!+sb-doc
   "Return the smallest integer not less than number, or number/divisor.
   The second returned value is the remainder."
-  (%ceiling number divisor))
+  (ceiling number divisor))
+
+(defun rem (number divisor)
+  #!+sb-doc
+  "Return second result of TRUNCATE."
+  (rem number divisor))
+
+(defun mod (number divisor)
+  #!+sb-doc
+  "Return second result of FLOOR."
+  (mod number divisor))
 
 (defun round (number &optional (divisor 1))
   #!+sb-doc
@@ -722,30 +698,17 @@
                          (values (- tru 1) (+ rem divisor))))
                     (t (values tru rem))))))))
 
-(defun rem (number divisor)
-  #!+sb-doc
-  "Return second result of TRUNCATE."
-  (multiple-value-bind (tru rem) (truncate number divisor)
-    (declare (ignore tru))
-    rem))
-
-(defun mod (number divisor)
-  #!+sb-doc
-  "Return second result of FLOOR."
-  (let ((rem (rem number divisor)))
-    (if (and (not (zerop rem))
-             (if (minusp divisor)
-                 (plusp number)
-                 (minusp number)))
-        (+ rem divisor)
-        rem)))
-
 (defmacro !define-float-rounding-function (name op doc)
   `(defun ,name (number &optional (divisor 1))
     ,doc
     (multiple-value-bind (res rem) (,op number divisor)
       (values (float res (if (floatp rem) rem 1.0)) rem))))
 
+;;; Declare these guys inline to let them get optimized a little.
+;;; ROUND and FROUND are not declared inline since they seem too
+;;; obscure and too big to inline-expand by default. Also, this gives
+;;; the compiler a chance to pick off the unary float case.
+#!-sb-fluid (declaim (inline fceiling ffloor ftruncate))
 (defun ftruncate (number &optional (divisor 1))
   #!+sb-doc
   "Same as TRUNCATE, but returns first value as a float."
diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index a98cfde..2d0724b 100644
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -330,10 +330,6 @@
 (defknown %multiply-high (word word) word
     (movable foldable flushable))
 
-(defknown (%floor %ceiling)
-  (real real) (values integer real)
-  (movable foldable flushable explicit-check))
-
 (defknown (mod rem) (real real) real
   (movable foldable flushable explicit-check))
 
diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 5fd86bf..213dbaa 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -3231,13 +3231,36 @@
         `(ash x ,len))))
 
 ;;; These must come before the ones below, so that they are tried
-;;; first. Since %FLOOR and %CEILING are inlined, this allows
-;;; the general case to be handled by TRUNCATE transforms.
-(deftransform floor ((x y))
-  `(%floor x y))
+;;; first.
+(deftransform floor ((number divisor))
+  `(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 ((x y))
-  `(%ceiling x y))
+(deftransform ceiling ((number divisor))
+  `(multiple-value-bind (tru rem) (truncate number divisor)
+     (if (and (not (zerop rem))
+              (if (minusp divisor)
+                  (minusp number)
+                  (plusp number)))
+         (values (+ tru 1) (- rem divisor))
+         (values tru rem))))
+
+(deftransform rem ((number divisor))
+  `(nth-value 1 (truncate number divisor)))
+
+(deftransform mod ((number divisor))
+  `(let ((rem (rem number divisor)))
+     (if (and (not (zerop rem))
+              (if (minusp divisor)
+                  (plusp number)
+                  (minusp number)))
+         (+ rem divisor)
+         rem)))
 
 ;;; If arg is a constant power of two, turn FLOOR into a shift and
 ;;; mask. If CEILING, add in (1- (ABS Y)), do FLOOR and correct a

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL