[prev in list] [next in list] [prev in thread] [next in thread]
List: sbcl-commits
Subject: [Sbcl-commits] master: Avoid uselessly re-scanning modular arithmetic expressions
From: "Paul Khuong" <pkhuong () users ! sourceforge ! net>
Date: 2013-07-18 21:05:46
Message-ID: E1UzvOX-0001Mn-Sx () sfs-ml-1 ! v29 ! ch3 ! sourceforge ! com
[Download RAW message or body]
The branch "master" has been updated in SBCL:
via be3993e597ead1ffe9def14536d218c5d36511d9 (commit)
from e240610bcc02cfe6f970131a362502d33be114c5 (commit)
- Log -----------------------------------------------------------------
commit be3993e597ead1ffe9def14536d218c5d36511d9
Author: Paul Khuong <pvk@pvk.ca>
Date: Thu Jul 18 14:29:12 2013 -0400
Avoid uselessly re-scanning modular arithmetic expressions
When modular arithmetic transforms have already fired for a
subexpression, and that subexpression's width is at most as wide
as the bitwidth we're cutting to, there is no need to re-traverse
the subexpression.
There was already some code to detect that case. Make it more general,
and, more importantly, sound.
---
src/compiler/srctran.lisp | 65 +++++++++++++++++++++++++++-----------------
1 files changed, 40 insertions(+), 25 deletions(-)
diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 2fc1c40..0ffbf42 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -2987,31 +2987,46 @@
(fun-name (lvar-fun-name (combination-fun node)))
(modular-fun (find-modular-version fun-name kind
signedp width)))
- (when (and modular-fun
- (not (and (eq fun-name 'logand)
- (csubtypep
- (single-value-type (node-derived-type node))
- type))))
- (binding* ((name (etypecase modular-fun
- ((eql :good) fun-name)
- (modular-fun-info
- (modular-fun-info-name modular-fun))
- (function
- (funcall modular-fun node width)))
- :exit-if-null))
- (unless (eql modular-fun :good)
- (setq did-something t)
- (change-ref-leaf
- fun-ref
- (find-free-fun name "in a strange place"))
- (setf (combination-kind node) :full))
- (unless (functionp modular-fun)
- (dolist (arg (basic-combination-args node))
- (when (cut-lvar arg)
- (setq did-something t))))
- (when did-something
- (reoptimize-node node name))
- (values t did-something))))))))
+ (cond ((not modular-fun)
+ ;; don't know what to do here
+ (values nil nil))
+ ((let ((dtype (single-value-type
+ (node-derived-type node))))
+ (and
+ (case fun-name
+ (logand
+ (csubtypep dtype
+ (specifier-type 'unsigned-byte)))
+ (logior
+ (csubtypep dtype
+ (specifier-type '(integer * 0))))
+ (mask-signed-field
+ t)
+ (t nil))
+ (csubtypep dtype type)))
+ ;; nothing to do
+ (values t nil))
+ (t
+ (binding* ((name (etypecase modular-fun
+ ((eql :good) fun-name)
+ (modular-fun-info
+ (modular-fun-info-name modular-fun))
+ (function
+ (funcall modular-fun node width)))
+ :exit-if-null))
+ (unless (eql modular-fun :good)
+ (setq did-something t)
+ (change-ref-leaf
+ fun-ref
+ (find-free-fun name "in a strange place"))
+ (setf (combination-kind node) :full))
+ (unless (functionp modular-fun)
+ (dolist (arg (basic-combination-args node))
+ (when (cut-lvar arg)
+ (setq did-something t))))
+ (when did-something
+ (reoptimize-node node name))
+ (values t did-something)))))))))
(cut-lvar (lvar &aux did-something must-insert)
"Cut all the LVAR's use nodes. If any of them wasn't handled
and its type is too wide for the operation we wish to perform
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL
------------------------------------------------------------------------------
See everything from the browser to the database with AppDynamics
Get end-to-end visibility with application monitoring from AppDynamics
Isolate bottlenecks and diagnose root cause in seconds.
Start your free trial of AppDynamics Pro today!
http://pubads.g.doubleclick.net/gampad/clk?id=48808831&iu=/4140/ostg.clktrk
_______________________________________________
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