mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +02:00
Code Activity

Better unboxing for logand over s64 values

Browse source 
* 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:
Andy Wingo 2017-11-22 11:34:25 +01:00
parent 695362a830
commit 3ae2a88c15
1 changed files with 20 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -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))) (unbox-u64 a) (unbox-u64 b) (box-u64 result)))
(setk label ($kargs names vars ,body))))) (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) (((or 'add 'sub 'mul)
(? s64-result?) #f (? s64-operand? a) (? s64-operand? b)) (? s64-result?) #f (? s64-operand? a) (? s64-operand? b))
(let ((op (match op (let ((op (match op