[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 27/30: Add integer devirtualization pass.
From: |
Andy Wingo |
Subject: |
[Guile-commits] 27/30: Add integer devirtualization pass. |
Date: |
Fri, 24 Nov 2017 09:24:25 -0500 (EST) |
wingo pushed a commit to branch master
in repository guile.
commit 5c9398099d446c01a5fdbe4268352549876ebd4c
Author: Andy Wingo <address@hidden>
Date: Tue Nov 21 14:27:13 2017 +0100
Add integer devirtualization pass.
* module/language/cps/devirtualize-integers.scm: New pass.
* module/language/cps/optimize.scm:
* module/Makefile.am:
* am/bootstrap.am: Add new pass.
---
am/bootstrap.am | 1 +
module/Makefile.am | 1 +
module/language/cps/devirtualize-integers.scm | 259 ++++++++++++++++++++++++++
module/language/cps/optimize.scm | 3 +
4 files changed, 264 insertions(+)
diff --git a/am/bootstrap.am b/am/bootstrap.am
index d848745..97780e7 100644
--- a/am/bootstrap.am
+++ b/am/bootstrap.am
@@ -79,6 +79,7 @@ SOURCES = \
language/cps/contification.scm \
language/cps/cse.scm \
language/cps/dce.scm \
+ language/cps/devirtualize-integers.scm \
language/cps/effects-analysis.scm \
language/cps/elide-values.scm \
language/cps/handle-interrupts.scm \
diff --git a/module/Makefile.am b/module/Makefile.am
index ef8e7c1..5a5a0bd 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -134,6 +134,7 @@ SOURCES = \
language/cps/contification.scm \
language/cps/cse.scm \
language/cps/dce.scm \
+ language/cps/devirtualize-integers.scm \
language/cps/effects-analysis.scm \
language/cps/elide-values.scm \
language/cps/handle-interrupts.scm \
diff --git a/module/language/cps/devirtualize-integers.scm
b/module/language/cps/devirtualize-integers.scm
new file mode 100644
index 0000000..45db74a
--- /dev/null
+++ b/module/language/cps/devirtualize-integers.scm
@@ -0,0 +1,259 @@
+;;; Continuation-passing style (CPS) intermediate language (IL)
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
+
+;;; Commentary:
+;;;
+;;; Some parts of programs operate on exact integers. An exact integer
+;;; is either a fixnum or a bignum. It's often the case that if we know
+;;; that a number is a fixnum, all operations on it can be unboxed in
+;;; terms of s64 operations. But if there's a series of operations and
+;;; each one works on either bignums or fixnums, then the mixing of
+;;; fixnums and bignums through that one control and data flow path
+;;; makes it impossible for the compiler to specialize operations to
+;;; either type.
+;;;
+;;; This "integer devirtualization" pass tries to duplicate the control
+;;; and data flow of exact integers into two flows: one for bignums and
+;;; one for fixnums. This causes code growth, so it's something we need
+;;; to be careful about.
+;;;
+;;; Code:
+
+(define-module (language cps devirtualize-integers)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-1)
+ #:use-module (language cps)
+ #:use-module (language cps effects-analysis)
+ #:use-module (language cps intmap)
+ #:use-module (language cps intset)
+ #:use-module (language cps utils)
+ #:use-module (language cps with-cps)
+ #:export (devirtualize-integers))
+
+;; Compute a map from VAR -> COUNT, where COUNT indicates the number of
+;; times in the source program that VAR is used.
+(define (compute-use-counts cps)
+ (define (add-use use-counts var)
+ (let ((count (1+ (intmap-ref use-counts var (lambda (_) 0)))))
+ (intmap-add! use-counts var count (lambda (old new) new))))
+ (define (add-uses use-counts vars)
+ (match vars
+ (() use-counts)
+ ((var . vars) (add-uses (add-use use-counts var) vars))))
+ (persistent-intmap
+ (intmap-fold
+ (lambda (label cont use-counts)
+ (match cont
+ (($ $kargs names vars ($ $continue k src exp))
+ (match exp
+ ((or ($ $const) ($ $prim) ($ $fun) ($ $closure) ($ $rec))
+ use-counts)
+ (($ $values args)
+ (add-uses use-counts args))
+ (($ $call proc args)
+ (add-uses (add-use use-counts proc) args))
+ (($ $callk kfun proc args)
+ (add-uses (add-use use-counts proc) args))
+ (($ $branch kt ($ $primcall name param args))
+ (add-uses use-counts args))
+ (($ $primcall name param args)
+ (add-uses use-counts args))
+ (($ $prompt escape? tag handler)
+ (add-use use-counts tag))))
+ (_ use-counts)))
+ cps
+ (transient-intmap))))
+
+(define (peel-trace cps label fx kexit use-counts)
+ "For the graph starting at LABEL, try to peel out a trace that uses
+the variable FX. A peelable trace consists of effect-free terms, or
+terms that only have &type-check effect but which use FX or some
+variable that was defined using FX as an input. No variable defined in
+the trace should be referenced outside of it."
+ (let peel-cont ((cps cps) (label label)
+ (live-vars empty-intmap) ;; var -> pending refcount
+ (fresh-vars empty-intmap) ;; old-name -> new name
+ (vars-of-interest (intset-add empty-intset fx))
+ (defs-of-interest? #f))
+ (define (fail) (with-cps cps #f))
+ (define (add-live-vars live-vars vars)
+ (match vars
+ (() live-vars)
+ ((var . vars)
+ (add-live-vars
+ (let ((count (intmap-ref use-counts var (lambda (_) 0))))
+ (if (zero? count)
+ live-vars
+ (intmap-add live-vars var count)))
+ vars))))
+ (define (subtract-uses live-vars vars)
+ (match vars
+ (() live-vars)
+ ((var . vars)
+ (subtract-uses
+ (let ((count (intmap-ref live-vars var (lambda (_) #f))))
+ (cond
+ ((not count) live-vars)
+ ((= count 1) (intmap-remove live-vars var))
+ (else (intmap-replace live-vars var (1- count)))))
+ vars))))
+ (define (bailout? k)
+ (match (intmap-ref cps k)
+ (($ $kargs _ _
+ ($ $continue _ _
+ ($ $primcall (or 'throw 'throw/value 'throw/value+data))))
+ #t)
+ (_ #f)))
+ (match (intmap-ref cps label)
+ ;; We know the initial label is a $kargs, and we won't follow the
+ ;; graph to get to $kreceive etc, so we can stop with these two
+ ;; continuation kinds.
+ (($ $ktail) (fail))
+ (($ $kargs names vars ($ $continue k src exp))
+ (let* ((vars-of-interest
+ (if defs-of-interest?
+ (fold1 (lambda (var set) (intset-add set var))
+ vars vars-of-interest)
+ vars-of-interest))
+ (live-vars (add-live-vars live-vars vars))
+ (fresh-vars (fold (lambda (var fresh-vars)
+ (intmap-add fresh-vars var (fresh-var)))
+ fresh-vars vars))
+ (vars (map (lambda (var) (intmap-ref fresh-vars var)) vars)))
+ (define (rename-uses args)
+ (map (lambda (arg) (intmap-ref fresh-vars arg (lambda (arg) arg)))
+ args))
+ (define (any-use-of-interest? args)
+ (or-map (lambda (arg) (intset-ref vars-of-interest arg))
+ args))
+ (define (continue k live-vars defs-of-interest? can-terminate-trace?
+ exp)
+ (define (stitch cps k)
+ (with-cps cps
+ (letk label* ($kargs names vars ($continue k src ,exp)))
+ label*))
+ (define (terminate)
+ (stitch cps k))
+ (with-cps cps
+ (let$ k* (peel-cont k live-vars fresh-vars vars-of-interest
+ defs-of-interest?))
+ ($ ((lambda (cps)
+ (cond
+ (k* (stitch cps k*))
+ ((and can-terminate-trace? (eq? live-vars empty-intmap))
+ (terminate))
+ (else (fail))))))))
+ (match exp
+ (($ $const)
+ ;; fine.
+ (continue k live-vars #f #f exp))
+ (($ $values args)
+ (let ((live-vars (subtract-uses live-vars args)))
+ (continue k live-vars
+ (any-use-of-interest? args) #f
+ (build-exp ($values ,(rename-uses args))))))
+ (($ $primcall name param args)
+ ;; exp is effect-free or var of interest in args
+ (let* ((fx (expression-effects exp #f))
+ (uses-of-interest? (any-use-of-interest? args))
+ (live-vars (subtract-uses live-vars args)))
+ ;; If the primcall uses a value of interest,
+ ;; consider it for peeling even if it would cause a
+ ;; type check; perhaps the peeling causes the type
+ ;; check to go away.
+ (if (or (eqv? fx &no-effects)
+ (and uses-of-interest? (eqv? fx &type-check)))
+ (continue k (subtract-uses live-vars args)
+ ;; Primcalls that use values of interest
+ ;; define values of interest.
+ uses-of-interest? #t
+ (build-exp
+ ($primcall name param ,(rename-uses args))))
+ (fail))))
+ (($ $branch kt ($ $primcall name param args))
+ ;; kt or k is kf; var of interest is in args
+ (let* ((live-vars (subtract-uses live-vars args))
+ (uses-of-interest? (any-use-of-interest? args))
+ (defs-of-interest? #f) ;; Branches don't define values.
+ (can-terminate-trace? uses-of-interest?)
+ (exp (build-exp
+ ($primcall name param ,(rename-uses args)))))
+ (cond
+ ((not (any-use-of-interest? args))
+ (fail))
+ ((bailout? kt)
+ (continue k live-vars defs-of-interest? can-terminate-trace?
+ (build-exp ($branch kt ,exp))))
+ ((bailout? k)
+ (let ()
+ (define (stitch cps kt)
+ (with-cps cps
+ (letk label*
+ ($kargs names vars
+ ($continue k src ($branch kt ,exp))))
+ label*))
+ (define (terminate)
+ (stitch cps kt))
+ (with-cps cps
+ (let$ kt* (peel-cont kt live-vars fresh-vars
+ vars-of-interest defs-of-interest?))
+ ($ ((lambda (cps)
+ (cond
+ (kt* (stitch cps kt*))
+ ((and can-terminate-trace? (eq? live-vars
empty-intmap))
+ (terminate))
+ (else (fail)))))))))
+ (else
+ (with-cps cps
+ (letk label*
+ ($kargs names vars
+ ($continue k src ($branch kt ,exp))))
+ label*)))))
+ (_ (fail))))))))
+
+(define (peel-traces-in-function cps body use-counts)
+ (intset-fold
+ (lambda (label cps)
+ (match (intmap-ref cps label)
+ ;; Traces start with a fixnum? predicate. We could expand this
+ ;; in the future if we wanted to.
+ (($ $kargs names vars
+ ($ $continue kf src
+ ($ $branch kt ($ $primcall 'fixnum? #f (x)))))
+ (with-cps cps
+ (let$ kt (peel-trace kt x kf use-counts))
+ ($ ((lambda (cps)
+ (if kt
+ (with-cps cps
+ (setk label
+ ($kargs names vars
+ ($continue kf src
+ ($branch kt ($primcall 'fixnum? #f (x)))))))
+ cps))))))
+ (_ cps)))
+ body
+ cps))
+
+(define (devirtualize-integers cps)
+ (let ((use-counts (compute-use-counts cps)))
+ (with-fresh-name-state cps
+ (intmap-fold
+ (lambda (kfun body cps)
+ (peel-traces-in-function cps body use-counts))
+ (compute-reachable-functions cps)
+ cps))))
diff --git a/module/language/cps/optimize.scm b/module/language/cps/optimize.scm
index c005de9..e5f46b9 100644
--- a/module/language/cps/optimize.scm
+++ b/module/language/cps/optimize.scm
@@ -27,6 +27,7 @@
#:use-module (language cps constructors)
#:use-module (language cps contification)
#:use-module (language cps cse)
+ #:use-module (language cps devirtualize-integers)
#:use-module (language cps dce)
#:use-module (language cps elide-values)
#:use-module (language cps licm)
@@ -96,6 +97,8 @@
(inline-constructors #:inline-constructors? #t)
(elide-values #:elide-values? #t)
(prune-bailouts #:prune-bailouts? #t)
+ (simplify #:simplify? #t)
+ (devirtualize-integers #:eliminate-dead-code? #t)
(peel-loops #:peel-loops? #t)
(eliminate-common-subexpressions #:cse? #t)
(type-fold #:type-fold? #t)
- [Guile-commits] 08/30: Revert "Slot allocation allows s64/u64 representations of same var", (continued)
- [Guile-commits] 08/30: Revert "Slot allocation allows s64/u64 representations of same var", Andy Wingo, 2017/11/24
- [Guile-commits] 07/30: Fix u64/s64 typesafety around fixnum (un)tagging, Andy Wingo, 2017/11/24
- [Guile-commits] 14/30: Fix type check elision for branches, Andy Wingo, 2017/11/24
- [Guile-commits] 06/30: Separate u64 and s64 type inferrers now that ops are monomorphic, Andy Wingo, 2017/11/24
- [Guile-commits] 18/30: Remove thunk?, integer? simple predicate inferrers, Andy Wingo, 2017/11/24
- [Guile-commits] 17/30: Add support for bignum? CPS primitive., Andy Wingo, 2017/11/24
- [Guile-commits] 22/30: Fix inference of generic < on NaN values, Andy Wingo, 2017/11/24
- [Guile-commits] 20/30: Add &exact-number helper definition, Andy Wingo, 2017/11/24
- [Guile-commits] 03/30: Better support for unboxed signed arithmetic, Andy Wingo, 2017/11/24
- [Guile-commits] 30/30: Optimize check-urange in assembler.scm, Andy Wingo, 2017/11/24
- [Guile-commits] 27/30: Add integer devirtualization pass.,
Andy Wingo <=
- [Guile-commits] 12/30: Remove effects-analysis exports that were undefined, Andy Wingo, 2017/11/24
- [Guile-commits] 11/30: Specialize fixnum and s64 phis, Andy Wingo, 2017/11/24
- [Guile-commits] 19/30: Add exact-integer? as interesting Tree-IL effect-free primitive, Andy Wingo, 2017/11/24
- [Guile-commits] 24/30: Declare bignum? as effect-free, Andy Wingo, 2017/11/24
- [Guile-commits] 13/30: Minor compile-cps refactor, Andy Wingo, 2017/11/24
- [Guile-commits] 15/30: DCE eliminates effect-free branches to the same continuation, Andy Wingo, 2017/11/24
- [Guile-commits] 29/30: DCE of branches punches through dead terms, Andy Wingo, 2017/11/24
- [Guile-commits] 21/30: Improve type and range inference on bignums, Andy Wingo, 2017/11/24
- [Guile-commits] 10/30: Fix unboxed immediate range comparison type inference, Andy Wingo, 2017/11/24
- [Guile-commits] 04/30: Specialize-numbers reifies instructions that type-check, Andy Wingo, 2017/11/24