[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 30/41: Add tagged and untagged arithmetic ops with immed
From: |
Andy Wingo |
Subject: |
[Guile-commits] 30/41: Add tagged and untagged arithmetic ops with immediate operands |
Date: |
Wed, 02 Dec 2015 08:06:56 +0000 |
wingo pushed a commit to branch master
in repository guile.
commit bdfa1c1b424fc6d408c55e7db17cb3ed7117606a
Author: Andy Wingo <address@hidden>
Date: Fri Nov 20 14:52:35 2015 +0100
Add tagged and untagged arithmetic ops with immediate operands
* libguile/vm-engine.c (add/immediate, sub/immediate)
(uadd/immediate, usub/immediate, umul/immediate): New instructions.
* module/language/cps/compile-bytecode.scm (compile-function):
* module/language/cps/slot-allocation.scm (compute-needs-slot):
* module/language/cps/types.scm:
* module/system/vm/assembler.scm (system):
* module/language/cps/effects-analysis.scm: Support
for new instructions.
* module/language/cps/optimize.scm (optimize-first-order-cps): Move
primcall specialization to the last step -- the only benefit of doing
it earlier was easier reasoning about side effects, and we're already
doing that in a more general way with (language cps types).
* module/language/cps/specialize-primcalls.scm (specialize-primcalls):
Specialize add and sub to add/immediate and sub/immediate, and
specialize u64 addition as well. U64 specialization doesn't work now
though because computing constant values doesn't work for U64s; oh
well.
---
libguile/vm-engine.c | 102 ++++++++++++++++++++++++-
module/language/cps/compile-bytecode.scm | 13 +++
module/language/cps/effects-analysis.scm | 5 +
module/language/cps/optimize.scm | 4 +-
module/language/cps/slot-allocation.scm | 7 ++-
module/language/cps/specialize-primcalls.scm | 31 +++++---
module/language/cps/types.scm | 5 +
module/system/vm/assembler.scm | 5 +
8 files changed, 153 insertions(+), 19 deletions(-)
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 80ab3af..2f3b3fd 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -2382,7 +2382,29 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
BINARY_INTEGER_OP (+, scm_sum);
}
- VM_DEFINE_OP (87, unused_87, NULL, NOP)
+ /* add/immediate dst:8 src:8 imm:8
+ *
+ * Add the unsigned 8-bit value IMM to the value from SRC, and place
+ * the result in DST.
+ */
+ VM_DEFINE_OP (87, add_immediate, "add/immediate", OP1 (X8_S8_S8_C8) | OP_DST)
+ {
+ scm_t_uint8 dst, src, imm;
+ SCM x;
+
+ UNPACK_8_8_8 (op, dst, src, imm);
+ x = SP_REF (src);
+
+ if (SCM_LIKELY (SCM_I_INUMP (x)))
+ {
+ scm_t_signed_bits sum = SCM_I_INUM (x) + (scm_t_signed_bits) imm;
+
+ if (SCM_LIKELY (SCM_POSFIXABLE (sum)))
+ RETURN (SCM_I_MAKINUM (sum));
+ }
+
+ RETURN_EXP (scm_sum (x, SCM_I_MAKINUM (imm)));
+ }
/* sub dst:8 a:8 b:8
*
@@ -2393,7 +2415,29 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
BINARY_INTEGER_OP (-, scm_difference);
}
- VM_DEFINE_OP (89, unused_89, NULL, NOP)
+ /* sub/immediate dst:8 src:8 imm:8
+ *
+ * Subtract the unsigned 8-bit value IMM from the value in SRC, and
+ * place the result in DST.
+ */
+ VM_DEFINE_OP (89, sub_immediate, "sub/immediate", OP1 (X8_S8_S8_C8) | OP_DST)
+ {
+ scm_t_uint8 dst, src, imm;
+ SCM x;
+
+ UNPACK_8_8_8 (op, dst, src, imm);
+ x = SP_REF (src);
+
+ if (SCM_LIKELY (SCM_I_INUMP (x)))
+ {
+ scm_t_signed_bits diff = SCM_I_INUM (x) - (scm_t_signed_bits) imm;
+
+ if (SCM_LIKELY (SCM_NEGFIXABLE (diff)))
+ RETURN (SCM_I_MAKINUM (diff));
+ }
+
+ RETURN_EXP (scm_difference (x, SCM_I_MAKINUM (imm)));
+ }
/* mul dst:8 a:8 b:8
*
@@ -3400,9 +3444,57 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
NEXT (1);
}
- VM_DEFINE_OP (152, unused_152, NULL, NOP)
- VM_DEFINE_OP (153, unused_153, NULL, NOP)
- VM_DEFINE_OP (154, unused_154, NULL, NOP)
+ /* uadd/immediate dst:8 src:8 imm:8
+ *
+ * Add the unsigned 64-bit value from SRC with the unsigned 8-bit
+ * value IMM and place the raw unsigned 64-bit result in DST.
+ * Overflow will wrap around.
+ */
+ VM_DEFINE_OP (152, uadd_immediate, "uadd/immediate", OP1 (X8_S8_S8_C8) |
OP_DST)
+ {
+ scm_t_uint8 dst, src, imm;
+ scm_t_uint64 x;
+
+ UNPACK_8_8_8 (op, dst, src, imm);
+ x = SP_REF_U64 (src);
+ SP_SET_U64 (dst, x + (scm_t_uint64) imm);
+ NEXT (1);
+ }
+
+ /* usub/immediate dst:8 src:8 imm:8
+ *
+ * Subtract the unsigned 8-bit value IMM from the unsigned 64-bit
+ * value in SRC and place the raw unsigned 64-bit result in DST.
+ * Overflow will wrap around.
+ */
+ VM_DEFINE_OP (153, usub_immediate, "usub/immediate", OP1 (X8_S8_S8_C8) |
OP_DST)
+ {
+ scm_t_uint8 dst, src, imm;
+ scm_t_uint64 x;
+
+ UNPACK_8_8_8 (op, dst, src, imm);
+ x = SP_REF_U64 (src);
+ SP_SET_U64 (dst, x - (scm_t_uint64) imm);
+ NEXT (1);
+ }
+
+ /* umul/immediate dst:8 src:8 imm:8
+ *
+ * Multiply the unsigned 64-bit value from SRC by the unsigned 8-bit
+ * value IMM and place the raw unsigned 64-bit result in DST.
+ * Overflow will wrap around.
+ */
+ VM_DEFINE_OP (154, umul_immediate, "umul/immediate", OP1 (X8_S8_S8_C8) |
OP_DST)
+ {
+ scm_t_uint8 dst, src, imm;
+ scm_t_uint64 x;
+
+ UNPACK_8_8_8 (op, dst, src, imm);
+ x = SP_REF_U64 (src);
+ SP_SET_U64 (dst, x * (scm_t_uint64) imm);
+ NEXT (1);
+ }
+
VM_DEFINE_OP (155, unused_155, NULL, NOP)
VM_DEFINE_OP (156, unused_156, NULL, NOP)
VM_DEFINE_OP (157, unused_157, NULL, NOP)
diff --git a/module/language/cps/compile-bytecode.scm
b/module/language/cps/compile-bytecode.scm
index 2a6370c..9dfee57 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -179,6 +179,19 @@
(($ $primcall 'struct-ref/immediate (struct n))
(emit-struct-ref/immediate asm (from-sp dst) (from-sp (slot struct))
(constant n)))
+ (($ $primcall 'add/immediate (x y))
+ (emit-add/immediate asm (from-sp dst) (from-sp (slot x)) (constant
y)))
+ (($ $primcall 'sub/immediate (x y))
+ (emit-sub/immediate asm (from-sp dst) (from-sp (slot x)) (constant
y)))
+ (($ $primcall 'uadd/immediate (x y))
+ (emit-uadd/immediate asm (from-sp dst) (from-sp (slot x))
+ (constant y)))
+ (($ $primcall 'usub/immediate (x y))
+ (emit-usub/immediate asm (from-sp dst) (from-sp (slot x))
+ (constant y)))
+ (($ $primcall 'umul/immediate (x y))
+ (emit-umul/immediate asm (from-sp dst) (from-sp (slot x))
+ (constant y)))
(($ $primcall 'builtin-ref (name))
(emit-builtin-ref asm (from-sp dst) (constant name)))
(($ $primcall 'scm->f64 (src))
diff --git a/module/language/cps/effects-analysis.scm
b/module/language/cps/effects-analysis.scm
index 21df42c..43ec1b0 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -418,8 +418,10 @@ is or might be a read or a write to the same location as
A."
((u64->= . _))
((zero? . _) &type-check)
((add . _) &type-check)
+ ((add/immediate . _) &type-check)
((mul . _) &type-check)
((sub . _) &type-check)
+ ((sub/immediate . _) &type-check)
((div . _) &type-check)
((fadd . _))
((fsub . _))
@@ -428,6 +430,9 @@ is or might be a read or a write to the same location as A."
((uadd . _))
((usub . _))
((umul . _))
+ ((uadd/immediate . _))
+ ((usub/immediate . _))
+ ((umul/immediate . _))
((quo . _) &type-check)
((rem . _) &type-check)
((mod . _) &type-check)
diff --git a/module/language/cps/optimize.scm b/module/language/cps/optimize.scm
index 7d4dc2f..707b68d 100644
--- a/module/language/cps/optimize.scm
+++ b/module/language/cps/optimize.scm
@@ -94,7 +94,6 @@
(simplify #:simplify? #t)
(contify #:contify? #t)
(inline-constructors #:inline-constructors? #t)
- (specialize-primcalls #:specialize-primcalls? #t)
(elide-values #:elide-values? #t)
(prune-bailouts #:prune-bailouts? #t)
(peel-loops #:peel-loops? #t)
@@ -110,7 +109,8 @@
(eliminate-common-subexpressions #:cse? #t)
(eliminate-dead-code #:eliminate-dead-code? #t)
(rotate-loops #:rotate-loops? #t)
- (simplify #:simplify? #t))
+ (simplify #:simplify? #t)
+ (specialize-primcalls #:specialize-primcalls? #t))
(define (cps-default-optimization-options)
(list ;; #:split-rec? #t
diff --git a/module/language/cps/slot-allocation.scm
b/module/language/cps/slot-allocation.scm
index e8519f0..d41013f 100644
--- a/module/language/cps/slot-allocation.scm
+++ b/module/language/cps/slot-allocation.scm
@@ -347,6 +347,10 @@ the definitions that are live before and after LABEL, as
intsets."
(defs+ s))
(($ $primcall 'struct-set!/immediate (s n x))
(defs+* (intset s x)))
+ (($ $primcall (or 'add/immediate 'sub/immediate
+ 'uadd/immediate 'usub/immediate 'umul/immediate)
+ (x y))
+ (defs+ x))
(($ $primcall 'builtin-ref (idx))
defs)
(_
@@ -794,7 +798,8 @@ are comparable with eqv?. A tmp slot may be used."
'fadd 'fsub 'fmul 'fdiv))
(intmap-add representations var 'f64))
(($ $primcall (or 'scm->u64 'bv-length
- 'uadd 'usub 'umul))
+ 'uadd 'usub 'umul
+ 'uadd/immediate 'usub/immediate
'umul/immediate))
(intmap-add representations var 'u64))
(_
(intmap-add representations var 'scm))))
diff --git a/module/language/cps/specialize-primcalls.scm
b/module/language/cps/specialize-primcalls.scm
index c15fbdb..0c234ee 100644
--- a/module/language/cps/specialize-primcalls.scm
+++ b/module/language/cps/specialize-primcalls.scm
@@ -33,27 +33,36 @@
(define (specialize-primcalls conts)
(let ((constants (compute-constant-values conts)))
- (define (immediate-u8? var)
+ (define (u8? var)
(let ((val (intmap-ref constants var (lambda (_) #f))))
(and (exact-integer? val) (<= 0 val 255))))
(define (specialize-primcall name args)
+ (define (rename name)
+ (build-exp ($primcall name args)))
(match (cons name args)
- (('make-vector (? immediate-u8? n) init) 'make-vector/immediate)
- (('vector-ref v (? immediate-u8? n)) 'vector-ref/immediate)
- (('vector-set! v (? immediate-u8? n) x) 'vector-set!/immediate)
- (('allocate-struct v (? immediate-u8? n)) 'allocate-struct/immediate)
- (('struct-ref s (? immediate-u8? n)) 'struct-ref/immediate)
- (('struct-set! s (? immediate-u8? n) x) 'struct-set!/immediate)
+ (('make-vector (? u8? n) init) (rename 'make-vector/immediate))
+ (('vector-ref v (? u8? n)) (rename 'vector-ref/immediate))
+ (('vector-set! v (? u8? n) x) (rename 'vector-set!/immediate))
+ (('allocate-struct v (? u8? n)) (rename 'allocate-struct/immediate))
+ (('struct-ref s (? u8? n)) (rename 'struct-ref/immediate))
+ (('struct-set! s (? u8? n) x) (rename 'struct-set!/immediate))
+ (('add x (? u8? y)) (build-exp ($primcall 'add/immediate (x y))))
+ (('add (? u8? x) y) (build-exp ($primcall 'add/immediate (y x))))
+ (('sub x (? u8? y)) (build-exp ($primcall 'sub/immediate (x y))))
+ (('uadd x (? u8? y)) (build-exp ($primcall 'uadd/immediate (x y))))
+ (('uadd (? u8? x) y) (build-exp ($primcall 'uadd/immediate (y x))))
+ (('usub x (? u8? y)) (build-exp ($primcall 'usub/immediate (x y))))
+ (('umul x (? u8? y)) (build-exp ($primcall 'umul/immediate (x y))))
+ (('umul (? u8? x) y) (build-exp ($primcall 'umul/immediate (y x))))
(_ #f)))
(intmap-map
(lambda (label cont)
(match cont
(($ $kargs names vars ($ $continue k src ($ $primcall name args)))
- (let ((name* (specialize-primcall name args)))
- (if name*
+ (let ((exp* (specialize-primcall name args)))
+ (if exp*
(build-cont
- ($kargs names vars
- ($continue k src ($primcall name* args))))
+ ($kargs names vars ($continue k src ,exp*)))
cont)))
(_ cont)))
conts)))
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index 1a0eebb..6928589 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -933,6 +933,7 @@ minimum, and maximum."
min* max*))))))
(define-simple-type-checker (add &number &number))
+(define-type-aliases add add/immediate)
(define-type-checker (fadd a b) #t)
(define-type-checker (uadd a b) #t)
(define-type-inferrer (add a b result)
@@ -949,8 +950,10 @@ minimum, and maximum."
(if (<= max #xffffffffffffffff)
(define! result &u64 (+ (&min a) (&min b)) max)
(define! result &u64 0 #xffffffffffffffff))))
+(define-type-aliases uadd uadd/immediate)
(define-simple-type-checker (sub &number &number))
+(define-type-aliases sub sub/immediate)
(define-type-checker (fsub a b) #t)
(define-type-checker (usub a b) #t)
(define-type-inferrer (sub a b result)
@@ -967,6 +970,7 @@ minimum, and maximum."
(if (< min 0)
(define! result &u64 0 #xffffffffffffffff)
(define! result &u64 min (- (&max a) (&min b))))))
+(define-type-aliases usub usub/immediate)
(define-simple-type-checker (mul &number &number))
(define-type-checker (fmul a b) #t)
@@ -1019,6 +1023,7 @@ minimum, and maximum."
(if (<= max #xffffffffffffffff)
(define! result &u64 (* (&min a) (&min b)) max)
(define! result &u64 0 #xffffffffffffffff))))
+(define-type-aliases umul umul/immediate)
(define-type-checker (div a b)
(and (check-type a &number -inf.0 +inf.0)
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 9dcd6dc..0733311 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -129,7 +129,9 @@
(emit-set-car!* . emit-set-car!)
(emit-set-cdr!* . emit-set-cdr!)
(emit-add* . emit-add)
+ (emit-add/immediate* . emit-add/immediate)
(emit-sub* . emit-sub)
+ (emit-sub/immediate* . emit-sub/immediate)
(emit-mul* . emit-mul)
(emit-div* . emit-div)
(emit-quo* . emit-quo)
@@ -143,6 +145,9 @@
(emit-uadd* . emit-uadd)
(emit-usub* . emit-usub)
(emit-umul* . emit-umul)
+ (emit-uadd/immediate* . emit-uadd/immediate)
+ (emit-usub/immediate* . emit-usub/immediate)
+ (emit-umul/immediate* . emit-umul/immediate)
(emit-logand* . emit-logand)
(emit-logior* . emit-logior)
(emit-logxor* . emit-logxor)
- [Guile-commits] 22/41: Specialize u64 comparisons, (continued)
- [Guile-commits] 22/41: Specialize u64 comparisons, Andy Wingo, 2015/12/02
- [Guile-commits] 26/41: Slower range saturation in type inference, Andy Wingo, 2015/12/02
- [Guile-commits] 21/41: Add instructions to branch on u64 comparisons, Andy Wingo, 2015/12/02
- [Guile-commits] 25/41: Add unsigned 64-bit arithmetic operators: uadd, usub, umul, Andy Wingo, 2015/12/02
- [Guile-commits] 24/41: Unbox u64 phi values, Andy Wingo, 2015/12/02
- [Guile-commits] 28/41: Specialize u64 arithmetic, Andy Wingo, 2015/12/02
- [Guile-commits] 37/41: Disable warnings on bootstrap build, Andy Wingo, 2015/12/02
- [Guile-commits] 35/41: Add current-thread VM op, Andy Wingo, 2015/12/02
- [Guile-commits] 27/41: Better range inference for indexes of vector-ref, string-ref et al, Andy Wingo, 2015/12/02
- [Guile-commits] 29/41: Remove add1 and sub1, Andy Wingo, 2015/12/02
- [Guile-commits] 30/41: Add tagged and untagged arithmetic ops with immediate operands,
Andy Wingo <=
- [Guile-commits] 32/41: Add support for unboxed s64 values, Andy Wingo, 2015/12/02
- [Guile-commits] 39/41: Specialize u64 bit operations, Andy Wingo, 2015/12/02
- [Guile-commits] 31/41: New instructions load-f64, load-u64, Andy Wingo, 2015/12/02
- [Guile-commits] 36/41: Add logsub op., Andy Wingo, 2015/12/02
- [Guile-commits] 40/41: More efficient assembler instructions, Andy Wingo, 2015/12/02
- [Guile-commits] 33/41: Untag values and indexes for all bytevector instructions, Andy Wingo, 2015/12/02
- [Guile-commits] 41/41: Assembler has a single growable vector, Andy Wingo, 2015/12/02
- [Guile-commits] 38/41: Add untagged bitwise operations, Andy Wingo, 2015/12/02
- [Guile-commits] 34/41: Unbox indexes of vectors, strings, and structs, Andy Wingo, 2015/12/02