mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
Better unboxing for logand over s64 values
* module/language/cps/specialize-numbers.scm (specialize-operations): Do a better job unboxing logand if we know the result is a u64, even if arguments are s64.
This commit is contained in:
parent
695362a830
commit
3ae2a88c15
1 changed files with 20 additions and 0 deletions
|
@ -484,6 +484,26 @@ BITS indicating the significant bits needed for a variable. BITS may be
|
|||
(unbox-u64 a) (unbox-u64 b) (box-u64 result)))
|
||||
(setk label ($kargs names vars ,body)))))
|
||||
|
||||
(((or 'logand 'logior 'logxor 'logsub)
|
||||
(? u64-result?) #f (? s64-operand? a) (? s64-operand? b))
|
||||
(let ((op (match op
|
||||
('logand 'ulogand) ('logior 'ulogior)
|
||||
('logxor 'ulogxor) ('logsub 'ulogsub))))
|
||||
(define (unbox-u64* x)
|
||||
(let ((unbox-s64 (unbox-s64 x)))
|
||||
(lambda (cps k src x)
|
||||
(with-cps cps
|
||||
(letv s64)
|
||||
(letk ks64 ($kargs ('s64) (s64)
|
||||
($continue k src
|
||||
($primcall 's64->u64 #f (s64)))))
|
||||
($ (unbox-s64 k src x))))))
|
||||
(with-cps cps
|
||||
(let$ body (specialize-binop
|
||||
k src op a b
|
||||
(unbox-u64* a) (unbox-u64* b) (box-u64 result)))
|
||||
(setk label ($kargs names vars ,body)))))
|
||||
|
||||
(((or 'add 'sub 'mul)
|
||||
(? s64-result?) #f (? s64-operand? a) (? s64-operand? b))
|
||||
(let ((op (match op
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue