mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-09 21:40:33 +02:00
Add hacks around lack of allocation sinking
* module/language/cps/compile-bytecode.scm (compile-function): * module/language/cps/cse.scm (compute-equivalent-subexpressions): * module/language/cps/effects-analysis.scm: * module/language/cps/primitives.scm (*macro-instruction-arities*): * module/language/cps/specialize-numbers.scm (compute-specializable-vars): * module/language/cps/types.scm: Add new variants of u64->scm and s64->scm that can't be replaced by CSE's auxiliary definitions, so we can sink unlikely allocations to side branches. This is a hack until we can get allocation sinking working
This commit is contained in:
parent
c9ec866ef9
commit
f34abbc396
6 changed files with 12 additions and 5 deletions
|
@ -221,13 +221,13 @@
|
|||
(emit-scm->u64/truncate asm (from-sp dst) (from-sp (slot src))))
|
||||
(($ $primcall 'load-u64 (src))
|
||||
(emit-load-u64 asm (from-sp dst) (constant src)))
|
||||
(($ $primcall 'u64->scm (src))
|
||||
(($ $primcall (or 'u64->scm 'u64->scm/unlikely) (src))
|
||||
(emit-u64->scm asm (from-sp dst) (from-sp (slot src))))
|
||||
(($ $primcall 'scm->s64 (src))
|
||||
(emit-scm->s64 asm (from-sp dst) (from-sp (slot src))))
|
||||
(($ $primcall 'load-s64 (src))
|
||||
(emit-load-s64 asm (from-sp dst) (constant src)))
|
||||
(($ $primcall 's64->scm (src))
|
||||
(($ $primcall (or 's64->scm 's64->scm/unlikely) (src))
|
||||
(emit-s64->scm asm (from-sp dst) (from-sp (slot src))))
|
||||
(($ $primcall 'bv-length (bv))
|
||||
(emit-bv-length asm (from-sp dst) (from-sp (slot bv))))
|
||||
|
|
|
@ -310,7 +310,7 @@ false. It could be that both true and false proofs are available."
|
|||
(match defs
|
||||
((u64)
|
||||
(add-def! `(primcall u64->scm ,u64) scm))))
|
||||
(('primcall 'u64->scm u64)
|
||||
(('primcall (or 'u64->scm 'u64->scm/unlikely) u64)
|
||||
(match defs
|
||||
((scm)
|
||||
(add-def! `(primcall scm->u64 ,scm) u64)
|
||||
|
@ -319,7 +319,7 @@ false. It could be that both true and false proofs are available."
|
|||
(match defs
|
||||
((s64)
|
||||
(add-def! `(primcall s64->scm ,s64) scm))))
|
||||
(('primcall 's64->scm s64)
|
||||
(('primcall (or 's64->scm 's64->scm/unlikely) s64)
|
||||
(match defs
|
||||
((scm)
|
||||
(add-def! `(primcall scm->s64 ,scm) s64))))
|
||||
|
|
|
@ -381,9 +381,11 @@ is or might be a read or a write to the same location as A."
|
|||
((scm->u64/truncate _) &type-check)
|
||||
((load-u64 _))
|
||||
((u64->scm _))
|
||||
((u64->scm/unlikely _))
|
||||
((scm->s64 _) &type-check)
|
||||
((load-s64 _))
|
||||
((s64->scm _))
|
||||
((s64->scm/unlikely _))
|
||||
((untag-fixnum _)))
|
||||
|
||||
;; Bytevectors.
|
||||
|
|
|
@ -66,7 +66,9 @@
|
|||
(bytevector-ieee-double-native-set! . bv-f64-set!)))
|
||||
|
||||
(define *macro-instruction-arities*
|
||||
'((cache-current-module! . (0 . 2))
|
||||
'((u64->scm/unlikely . (1 . 1))
|
||||
(s64->scm/unlikely . (1 . 1))
|
||||
(cache-current-module! . (0 . 2))
|
||||
(cached-toplevel-box . (1 . 3))
|
||||
(cached-module-box . (1 . 4))))
|
||||
|
||||
|
|
|
@ -550,6 +550,7 @@ BITS indicating the significant bits needed for a variable. BITS may be
|
|||
(define (exp-result-u64? exp)
|
||||
(match exp
|
||||
((or ($ $primcall 'u64->scm (_))
|
||||
($ $primcall 'u64->scm/unlikely (_))
|
||||
($ $const (and (? number?) (? exact-integer?)
|
||||
(? (lambda (n) (<= 0 n #xffffffffffffffff))))))
|
||||
#t)
|
||||
|
|
|
@ -862,6 +862,7 @@ minimum, and maximum."
|
|||
#t)
|
||||
(define-type-inferrer (u64->scm u64 result)
|
||||
(define-exact-integer! result (&min/0 u64) (&max/u64 u64)))
|
||||
(define-type-aliases u64->scm u64->scm/unlikely)
|
||||
|
||||
(define-type-checker (scm->s64 scm)
|
||||
(check-type scm &exact-integer &s64-min &s64-max))
|
||||
|
@ -869,6 +870,7 @@ minimum, and maximum."
|
|||
(restrict! scm &exact-integer &s64-min &s64-max)
|
||||
(define! result &s64 (&min/s64 scm) (&max/s64 scm)))
|
||||
(define-type-aliases scm->s64 load-s64)
|
||||
(define-type-aliases s64->scm s64->scm/unlikely)
|
||||
|
||||
(define-simple-type-checker (untag-fixnum &fixnum))
|
||||
(define-type-inferrer (untag-fixnum scm result)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue