diff --git a/module/Makefile.am b/module/Makefile.am index 587d7b5ce..65f7f5a94 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -158,6 +158,7 @@ CPS2_LANG_SOURCES = \ language/cps2/optimize.scm \ language/cps2/simplify.scm \ language/cps2/spec.scm \ + language/cps2/specialize-primcalls.scm \ language/cps2/types.scm \ language/cps2/utils.scm \ language/cps2/with-cps.scm diff --git a/module/language/cps2/optimize.scm b/module/language/cps2/optimize.scm index bfc43c122..d6400ed4c 100644 --- a/module/language/cps2/optimize.scm +++ b/module/language/cps2/optimize.scm @@ -29,6 +29,7 @@ #:use-module (language cps2 dce) #:use-module (language cps2 prune-top-level-scopes) #:use-module (language cps2 simplify) + #:use-module (language cps2 specialize-primcalls) #:export (optimize)) (define (kw-arg-ref args kw default) @@ -60,7 +61,7 @@ (run-pass! simplify #:simplify? #t) (run-pass! contify #:contify? #t) (run-pass! inline-constructors #:inline-constructors? #t) - ;; (run-pass! specialize-primcalls #:specialize-primcalls? #t) + (run-pass! specialize-primcalls #:specialize-primcalls? #t) ;; (run-pass! elide-values #:elide-values? #t) ;; (run-pass! prune-bailouts #:prune-bailouts? #t) ;; (run-pass! eliminate-common-subexpressions #:cse? #t) diff --git a/module/language/cps2/specialize-primcalls.scm b/module/language/cps2/specialize-primcalls.scm new file mode 100644 index 000000000..00d2149d7 --- /dev/null +++ b/module/language/cps2/specialize-primcalls.scm @@ -0,0 +1,59 @@ +;;; Continuation-passing style (CPS) intermediate language (IL) + +;; Copyright (C) 2013, 2014, 2015 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 bytecode operations can encode an immediate as an operand. +;;; This pass tranforms generic primcalls to these specialized +;;; primcalls, if possible. +;;; +;;; Code: + +(define-module (language cps2 specialize-primcalls) + #:use-module (ice-9 match) + #:use-module (language cps2) + #:use-module (language cps2 utils) + #:use-module (language cps intmap) + #:export (specialize-primcalls)) + +(define (specialize-primcalls conts) + (let ((constants (compute-constant-values conts))) + (define (immediate-u8? var) + (let ((val (intmap-ref constants var (lambda (_) #f)))) + (and (exact-integer? val) (<= 0 val 255)))) + (define (specialize-primcall name args) + (match (cons name args) + (('make-vector (? immediate-u8? n) init) 'make-vector/immediate) + (('vector-ref v (? immediate-u8? n)) 'vector-ref/immediate) + (('vector-set! v (? immediate-u8? n) x) 'vector-set!/immediate) + (('allocate-struct v (? immediate-u8? n)) 'allocate-struct/immediate) + (('struct-ref s (? immediate-u8? n)) 'struct-ref/immediate) + (('struct-set! s (? immediate-u8? n) x) 'struct-set!/immediate) + (_ #f))) + (intmap-map + (lambda (label cont) + (match cont + (($ $kargs names vars ($ $continue k src ($ $primcall name args))) + (let ((name* (specialize-primcall name args))) + (if name* + (build-cont + ($kargs names vars + ($continue k src ($primcall name* args)))) + cont))) + (_ cont))) + conts)))