[prev in list] [next in list] [prev in thread] [next in thread]
List: sbcl-commits
Subject: [Sbcl-commits] master: Implement CEILING/FLOOR to truncate via transforms, not inline.
From: "stassats" <stassats () users ! sourceforge ! net>
Date: 2014-03-21 4:47:47
Message-ID: E1WQrN1-0005DW-9k () sfs-ml-2 ! v29 ! ch3 ! sourceforge ! com
[Download RAW message or body]
The branch "master" has been updated in SBCL:
via a795db2b2107df6757e6745ded770c9b60b2317e (commit)
from e2327c3f4f133e1922d368639ff3abdf131ef8bd (commit)
- Log -----------------------------------------------------------------
commit a795db2b2107df6757e6745ded770c9b60b2317e
Author: Stas Boukarev <stassats@gmail.com>
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
------------------------------------------------------------------------------
Learn Graph Databases - Download FREE O'Reilly Book
"Graph Databases" is the definitive new guide to graph databases and their
applications. Written by three acclaimed leaders in the field,
this first edition is now available. Download your free book today!
http://p.sf.net/sfu/13534_NeoTech
_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic