mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-15 08:10:17 +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

84
module/language/cps/cse.scm
View file

@ -249,10 +249,10 @@ false. It could be that both true and false proofs are available."
(($ $closure label nfree) #f)
(($ $call proc args) #f)
(($ $callk k proc args) #f)
(($ $primcall name args)
(cons* 'primcall name (subst-vars var-substs args)))
(($ $branch _ ($ $primcall name args))
(cons* 'primcall name (subst-vars var-substs args)))
(($ $primcall name param args)
(cons* 'primcall name param (subst-vars var-substs args)))
(($ $branch _ ($ $primcall name param args))
(cons* 'primcall name param (subst-vars var-substs args)))
(($ $values args) #f)
(($ $prompt escape? tag handler) #f)))
@ -265,64 +265,64 @@ false. It could be that both true and false proofs are available."
(hash-set! equiv-set aux-key
(acons label (list var) equiv))))
(match exp-key
(('primcall 'box val)
(('primcall 'box #f val)
(match defs
((box)
(add-def! `(primcall box-ref ,(subst box)) val))))
(('primcall 'box-set! box val)
(add-def! `(primcall box-ref ,box) val))
(('primcall 'cons car cdr)
(add-def! `(primcall box-ref #f ,(subst box)) val))))
(('primcall 'box-set! #f box val)
(add-def! `(primcall box-ref #f ,box) val))
(('primcall 'cons #f car cdr)
(match defs
((pair)
(add-def! `(primcall car ,(subst pair)) car)
(add-def! `(primcall cdr ,(subst pair)) cdr))))
(('primcall 'set-car! pair car)
(add-def! `(primcall car ,pair) car))
(('primcall 'set-cdr! pair cdr)
(add-def! `(primcall cdr ,pair) cdr))
(('primcall (or 'make-vector 'make-vector/immediate) len fill)
(add-def! `(primcall car #f ,(subst pair)) car)
(add-def! `(primcall cdr #f ,(subst pair)) cdr))))
(('primcall 'set-car! #f pair car)
(add-def! `(primcall car #f ,pair) car))
(('primcall 'set-cdr! #f pair cdr)
(add-def! `(primcall cdr #f ,pair) cdr))
(('primcall (or 'make-vector 'make-vector/immediate) #f len fill)
(match defs
((vec)
(add-def! `(primcall vector-length ,(subst vec)) len))))
(('primcall 'vector-set! vec idx val)
(add-def! `(primcall vector-ref ,vec ,idx) val))
(('primcall 'vector-set!/immediate vec idx val)
(add-def! `(primcall vector-ref/immediate ,vec ,idx) val))
(('primcall (or 'allocate-struct 'allocate-struct/immediate)
(add-def! `(primcall vector-length #f ,(subst vec)) len))))
(('primcall 'vector-set! #f vec idx val)
(add-def! `(primcall vector-ref #f ,vec ,idx) val))
(('primcall 'vector-set!/immediate #f vec idx val)
(add-def! `(primcall vector-ref/immediate #f ,vec ,idx) val))
(('primcall (or 'allocate-struct 'allocate-struct/immediate) #f
vtable size)
(match defs
((struct)
(add-def! `(primcall struct-vtable ,(subst struct))
(add-def! `(primcall struct-vtable #f ,(subst struct))
vtable))))
(('primcall 'struct-set! struct n val)
(add-def! `(primcall struct-ref ,struct ,n) val))
(('primcall 'struct-set!/immediate struct n val)
(add-def! `(primcall struct-ref/immediate ,struct ,n) val))
(('primcall 'scm->f64 scm)
(('primcall 'struct-set! #f struct n val)
(add-def! `(primcall struct-ref #f ,struct ,n) val))
(('primcall 'struct-set!/immediate #f struct n val)
(add-def! `(primcall struct-ref/immediate #f ,struct ,n) val))
(('primcall 'scm->f64 #f scm)
(match defs
((f64)
(add-def! `(primcall f64->scm ,f64) scm))))
(('primcall 'f64->scm f64)
(add-def! `(primcall f64->scm #f ,f64) scm))))
(('primcall 'f64->scm #f f64)
(match defs
((scm)
(add-def! `(primcall scm->f64 ,scm) f64))))
(('primcall 'scm->u64 scm)
(add-def! `(primcall scm->f64 #f ,scm) f64))))
(('primcall 'scm->u64 #f scm)
(match defs
((u64)
(add-def! `(primcall u64->scm ,u64) scm))))
(('primcall (or 'u64->scm 'u64->scm/unlikely) u64)
(add-def! `(primcall u64->scm #f ,u64) scm))))
(('primcall (or 'u64->scm 'u64->scm/unlikely) #f u64)
(match defs
((scm)
(add-def! `(primcall scm->u64 ,scm) u64)
(add-def! `(primcall scm->u64/truncate ,scm) u64))))
(('primcall 'scm->s64 scm)
(add-def! `(primcall scm->u64 #f ,scm) u64)
(add-def! `(primcall scm->u64/truncate #f ,scm) u64))))
(('primcall 'scm->s64 #f scm)
(match defs
((s64)
(add-def! `(primcall s64->scm ,s64) scm))))
(('primcall (or 's64->scm 's64->scm/unlikely) s64)
(add-def! `(primcall s64->scm #f ,s64) scm))))
(('primcall (or 's64->scm 's64->scm/unlikely) #f s64)
(match defs
((scm)
(add-def! `(primcall scm->s64 ,scm) s64))))
(add-def! `(primcall scm->s64 #f ,scm) s64))))
(_ #t))))
(define (visit-label label equiv-labels var-substs)
@ -405,8 +405,8 @@ false. It could be that both true and false proofs are available."
($call (subst-var proc) ,(map subst-var args)))
(($ $callk k proc args)
($callk k (subst-var proc) ,(map subst-var args)))
(($ $primcall name args)
($primcall name ,(map subst-var args)))
(($ $primcall name param args)
($primcall name param ,(map subst-var args)))
(($ $branch k exp)
($branch k ,(visit-exp exp)))
(($ $values args)