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

Revert specialization of fixnum phi variables

Browse source 
* module/language/cps/specialize-numbers.scm
  (compute-specializable-fixnum-vars, compute-specializable-phis)
  (apply-specialization): Don't specialize phis as fixnums.  Need to try
  again with some proper range analysis, as a variable defined with
  tag-fixnum can indicate either a u64 or a s64.
This commit is contained in:
Andy Wingo 2017-11-20 18:28:55 +01:00
parent 8ce6f359bb
commit 83c04003a2
1 changed files with 5 additions and 36 deletions
Download patch file Download diff file Expand all files Collapse all files

41
module/language/cps/specialize-numbers.scm
View file

@ -897,29 +897,6 @@ BITS indicating the significant bits needed for a variable. BITS may be
(compute-specializable-vars cps body preds defs exp-result-u64?
'(scm->u64 'scm->u64/truncate)))
;; Compute vars whose definitions are all exact integers in the fixnum
;; range and whose uses include an untag operation.
(define (compute-specializable-fixnum-vars cps body preds defs)
;; Is the result of EXP definitely a fixnum?
(define (exp-result-fixnum? exp)
(define (fixnum? n)
(and (number? n) (exact-integer? n)
(<= (target-most-negative-fixnum)
n
(target-most-positive-fixnum))))
(match exp
((or ($ $primcall 'tag-fixnum #f (_))
($ $primcall 'tag-fixnum/unlikely #f (_))
($ $const (? fixnum?))
($ $primcall 'load-const/unlikely (? fixnum?) ()))
#t)
(_ #f)))
(compute-specializable-vars cps body preds defs exp-result-fixnum?
'(untag-fixnum
scm->s64
scm->u64 scm->u64/truncate)))
(define (compute-phi-vars cps preds)
(intmap-fold (lambda (label preds phis)
(match preds
@ -939,25 +916,19 @@ BITS indicating the significant bits needed for a variable. BITS may be
;; at least one use that is an unbox operation.
(define (compute-specializable-phis cps body preds defs)
(let ((f64-vars (compute-specializable-f64-vars cps body preds defs))
(fixnum-vars (compute-specializable-fixnum-vars cps body preds defs))
(u64-vars (compute-specializable-u64-vars cps body preds defs))
(phi-vars (compute-phi-vars cps preds)))
(unless (eq? empty-intset (intset-intersect f64-vars fixnum-vars))
(error "expected f64 and fixnum vars to be disjoint sets"))
(unless (eq? empty-intset (intset-intersect f64-vars u64-vars))
(error "expected f64 and u64 vars to be disjoint sets"))
(intset-fold
(lambda (var out) (intmap-add out var 'u64))
(intset-subtract (intset-intersect u64-vars phi-vars) fixnum-vars)
(intset-intersect u64-vars phi-vars)
(intset-fold
(lambda (var out) (intmap-add out var 'fx))
(intset-intersect fixnum-vars phi-vars)
(intset-fold
(lambda (var out) (intmap-add out var 'f64))
(intset-intersect f64-vars phi-vars)
empty-intmap)))))
(lambda (var out) (intmap-add out var 'f64))
(intset-intersect f64-vars phi-vars)
empty-intmap))))
;; Each definition of an f64/fx/u64 variable should unbox that variable.
;; Each definition of a f64/u64 variable should unbox that variable.
;; The cont that binds the variable should re-box it under its original
;; name, and rely on CSE to remove the boxing as appropriate.
(define (apply-specialization cps kfun body preds defs phis)
@ -971,12 +942,10 @@ BITS indicating the significant bits needed for a variable. BITS may be
(define (unbox-op var)
(match (intmap-ref phis var)
('f64 'scm->f64)
('fx 'untag-fixnum)
('u64 'scm->u64)))
(define (box-op var)
(match (intmap-ref phis var)
('f64 'f64->scm)
('fx 'tag-fixnum)
('u64 'u64->scm)))
(define (unbox-operands)
(define (unbox-arg cps arg def-var have-arg)