mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-17 22:52:25 +02:00
Code Activity

$primcall has a "param" member

Browse source 
* module/language/cps.scm ($primcall): Add "param" member, which will be
  a constant parameter to the primcall.  The idea is that constants used
  by primcalls as immediates don't need to participate in optimizations
  in any way -- they should not participate in CSE, have the same
  lifetime as the primcall so not part of DCE either, and don't need
  slot allocation.  Indirecting them through a named $const binding is
  complication for no benefit.  This change should eventually improve
  compilation time and memory usage, once we fully take advantage of it,
  as the number of labels and variables will go down.
* module/language/cps/closure-conversion.scm:
* module/language/cps/compile-bytecode.scm:
* module/language/cps/constructors.scm:
* module/language/cps/contification.scm:
* module/language/cps/cse.scm:
* module/language/cps/dce.scm:
* module/language/cps/effects-analysis.scm:
* module/language/cps/elide-values.scm:
* module/language/cps/handle-interrupts.scm:
* module/language/cps/licm.scm:
* module/language/cps/peel-loops.scm:
* module/language/cps/prune-bailouts.scm:
* module/language/cps/prune-top-level-scopes.scm:
* module/language/cps/reify-primitives.scm:
* module/language/cps/renumber.scm:
* module/language/cps/rotate-loops.scm:
* module/language/cps/self-references.scm:
* module/language/cps/simplify.scm:
* module/language/cps/slot-allocation.scm:
* module/language/cps/specialize-numbers.scm:
* module/language/cps/specialize-primcalls.scm:
* module/language/cps/split-rec.scm:
* module/language/cps/type-checks.scm:
* module/language/cps/type-fold.scm:
* module/language/cps/types.scm:
* module/language/cps/utils.scm:
* module/language/cps/verify.scm:
* module/language/tree-il/compile-cps.scm: Adapt all users.
This commit is contained in:
Andy Wingo 2017-11-01 11:57:16 +01:00
parent 2d8c75f9f2
commit c54c151eb6
29 changed files with 427 additions and 420 deletions
Download patch file Download diff file Expand all files Collapse all files

18
module/language/cps/constructors.scm
View file

@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
;; Copyright (C) 2013, 2014, 2015, 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
@ -42,13 +42,13 @@
(letv tail)
(letk ktail ($kargs ('tail) (tail)
($continue k src
($primcall 'cons (arg tail)))))
($primcall 'cons #f (arg tail)))))
($ (build-list args ktail))))))
(with-cps out
(letv val)
(letk kvalues ($kargs ('val) (val)
($continue k src
($primcall 'values (val)))))
($primcall 'values #f (val)))))
($ (build-list args kvalues))))
(define (inline-vector out k src args)
@ -56,7 +56,7 @@
(match args
(()
(with-cps out
(build-term ($continue k src ($primcall 'values (vec))))))
(build-term ($continue k src ($primcall 'values #f (vec))))))
((arg . args)
(with-cps out
(let$ next (initialize vec args (1+ n)))
@ -64,10 +64,10 @@
(letv u64)
(letk kunbox ($kargs ('idx) (u64)
($continue knext src
($primcall 'vector-set! (vec u64 arg)))))
($primcall 'vector-set! #f (vec u64 arg)))))
($ (with-cps-constants ((idx n))
(build-term ($continue kunbox src
($primcall 'scm->u64 (idx))))))))))
($primcall 'scm->u64 #f (idx))))))))))
(with-cps out
(letv vec)
(let$ body (initialize vec args 0))
@ -77,9 +77,9 @@
(letv u64)
(letk kunbox ($kargs ('len) (u64)
($continue kalloc src
($primcall 'make-vector (u64 init)))))
($primcall 'make-vector #f (u64 init)))))
(build-term ($continue kunbox src
($primcall 'scm->u64 (len))))))))
($primcall 'scm->u64 #f (len))))))))
(define (find-constructor-inliner name)
(match name
@ -93,7 +93,7 @@
(intmap-fold
(lambda (label cont out)
(match cont
(($ $kargs names vars ($ $continue k src ($ $primcall name args)))
(($ $kargs names vars ($ $continue k src ($ $primcall name #f args)))
(let ((inline (find-constructor-inliner name)))
(if inline
(call-with-values (lambda () (inline out k src args))