From 3ae2a88c15e6d0bc37e2832686c7423fea93a849 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Wed, 22 Nov 2017 11:34:25 +0100 Subject: [PATCH] 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. --- module/language/cps/specialize-numbers.scm | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/module/language/cps/specialize-numbers.scm b/module/language/cps/specialize-numbers.scm index df570bc6c..a0c4b15f8 100644 --- a/module/language/cps/specialize-numbers.scm +++ b/module/language/cps/specialize-numbers.scm @@ -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