mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-11 22:31:12 +02:00
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.
This commit is contained in:
Andy Wingo
parent
8f18b71b7a
commit
bdfa1c1b42
8 changed files with 153 additions and 19 deletions
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue