[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/04: Add ursh/immediate and ulsh/immediate ops
From: |
Andy Wingo |
Subject: |
[Guile-commits] 01/04: Add ursh/immediate and ulsh/immediate ops |
Date: |
Thu, 03 Dec 2015 08:07:02 +0000 |
wingo pushed a commit to branch master
in repository guile.
commit 9514dc7b95c1e8041dd1ddc84e46a2a37b178d20
Author: Andy Wingo <address@hidden>
Date: Wed Dec 2 21:48:10 2015 +0100
Add ursh/immediate and ulsh/immediate ops
* libguile/vm-engine.c (ursh/immediate, ulsh/immediate): New ops.
* module/language/cps/effects-analysis.scm:
* module/language/cps/slot-allocation.scm (compute-var-representations)
(compute-needs-slot):
* module/language/cps/specialize-primcalls.scm (specialize-primcalls):
* module/language/cps/compile-bytecode.scm (compile-function):
* module/system/vm/assembler.scm:
* module/language/cps/types.scm: Add support for new ops, and specialize
ursh and ulsh.
---
libguile/vm-engine.c | 34 ++++++++++++++++++++++++-
module/language/cps/compile-bytecode.scm | 6 ++++
module/language/cps/effects-analysis.scm | 2 +
module/language/cps/slot-allocation.scm | 4 ++-
module/language/cps/specialize-primcalls.scm | 5 ++++
module/language/cps/types.scm | 2 +
module/system/vm/assembler.scm | 2 +
7 files changed, 52 insertions(+), 3 deletions(-)
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 99ff780..c366315 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -3609,8 +3609,38 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
NEXT (1);
}
- VM_DEFINE_OP (168, unused_168, NULL, NOP)
- VM_DEFINE_OP (169, unused_169, NULL, NOP)
+ /* ursh/immediate dst:8 a:8 b:8
+ *
+ * Shift the u64 value in A right by the immediate B bits, and place
+ * the result in DST. Only the lower 6 bits of B are used.
+ */
+ VM_DEFINE_OP (168, ursh_immediate, "ursh/immediate", OP1 (X8_S8_S8_C8) |
OP_DST)
+ {
+ scm_t_uint8 dst, a, b;
+
+ UNPACK_8_8_8 (op, dst, a, b);
+
+ SP_SET_U64 (dst, SP_REF_U64 (a) >> (b & 63));
+
+ NEXT (1);
+ }
+
+ /* ulsh/immediate dst:8 a:8 b:8
+ *
+ * Shift the u64 value in A left by the immediate B bits, and place
+ * the result in DST. Only the lower 6 bits of B are used.
+ */
+ VM_DEFINE_OP (169, ulsh_immediate, "ulsh/immediate", OP1 (X8_S8_S8_C8) |
OP_DST)
+ {
+ scm_t_uint8 dst, a, b;
+
+ UNPACK_8_8_8 (op, dst, a, b);
+
+ SP_SET_U64 (dst, SP_REF_U64 (a) << (b & 63));
+
+ NEXT (1);
+ }
+
VM_DEFINE_OP (170, unused_170, NULL, NOP)
VM_DEFINE_OP (171, unused_171, NULL, NOP)
VM_DEFINE_OP (172, unused_172, NULL, NOP)
diff --git a/module/language/cps/compile-bytecode.scm
b/module/language/cps/compile-bytecode.scm
index d4a5345..dc28948 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -194,6 +194,12 @@
(($ $primcall 'umul/immediate (x y))
(emit-umul/immediate asm (from-sp dst) (from-sp (slot x))
(constant y)))
+ (($ $primcall 'ursh/immediate (x y))
+ (emit-ursh/immediate asm (from-sp dst) (from-sp (slot x))
+ (constant y)))
+ (($ $primcall 'ulsh/immediate (x y))
+ (emit-ulsh/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 fb64cac..37fb740 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -473,6 +473,8 @@ is or might be a read or a write to the same location as A."
((ulogsub . _))
((ursh . _))
((ulsh . _))
+ ((ursh/immediate . _))
+ ((ulsh/immediate . _))
((logtest a b) &type-check)
((logbit? a b) &type-check)
((sqrt _) &type-check)
diff --git a/module/language/cps/slot-allocation.scm
b/module/language/cps/slot-allocation.scm
index dd860be..6e9188a 100644
--- a/module/language/cps/slot-allocation.scm
+++ b/module/language/cps/slot-allocation.scm
@@ -350,7 +350,8 @@ the definitions that are live before and after LABEL, as
intsets."
(($ $primcall 'struct-set!/immediate (s n x))
(defs+* (intset s x)))
(($ $primcall (or 'add/immediate 'sub/immediate
- 'uadd/immediate 'usub/immediate 'umul/immediate)
+ 'uadd/immediate 'usub/immediate 'umul/immediate
+ 'ursh/immediate 'ulsh/immediate)
(x y))
(defs+ x))
(($ $primcall 'builtin-ref (idx))
@@ -805,6 +806,7 @@ are comparable with eqv?. A tmp slot may be used."
'uadd 'usub 'umul
'ulogand 'ulogior 'ulogsub 'ursh 'ulsh
'uadd/immediate 'usub/immediate 'umul/immediate
+ 'ursh/immediate 'ulsh/immediate
'bv-u8-ref 'bv-u16-ref 'bv-u32-ref 'bv-u64-ref))
(intmap-add representations var 'u64))
(($ $primcall (or 'scm->s64 'load-s64
diff --git a/module/language/cps/specialize-primcalls.scm
b/module/language/cps/specialize-primcalls.scm
index 710cc32..a52e344 100644
--- a/module/language/cps/specialize-primcalls.scm
+++ b/module/language/cps/specialize-primcalls.scm
@@ -33,6 +33,9 @@
(define (specialize-primcalls conts)
(let ((constants (compute-constant-values conts)))
+ (define (u6? var)
+ (let ((val (intmap-ref constants var (lambda (_) #f))))
+ (and (exact-integer? val) (<= 0 val 63))))
(define (u8? var)
(let ((val (intmap-ref constants var (lambda (_) #f))))
(and (exact-integer? val) (<= 0 val 255))))
@@ -64,6 +67,8 @@
(('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))))
+ (('ursh x (? u6? y)) (build-exp ($primcall 'ursh/immediate (x y))))
+ (('ulsh x (? u6? y)) (build-exp ($primcall 'ulsh/immediate (x y))))
(('scm->f64 (? f64?)) (rename 'load-f64))
(('scm->u64 (? u64?)) (rename 'load-u64))
(('scm->u64/truncate (? u64?)) (rename 'load-u64))
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index 6b035dc..a856170 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -1203,6 +1203,7 @@ minimum, and maximum."
(define! result &u64
(ash (&min a) (- (&max b)))
(ash (&max a) (- (&min b)))))
+(define-type-aliases ursh ursh/immediate)
(define-simple-type-checker (ulsh &u64 &u64))
(define-type-inferrer (ulsh a b result)
@@ -1214,6 +1215,7 @@ minimum, and maximum."
(define! result &u64 (ash (&min a) (&min b)) (ash (&max a) (&max b)))
;; Otherwise assume the whole range.
(define! result &u64 0 &u64-max)))
+(define-type-aliases ulsh ulsh/immediate)
(define (next-power-of-two n)
(let lp ((out 1))
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index ff7e53c..012d6ee 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -158,6 +158,8 @@
(emit-ulogsub* . emit-ulogsub)
(emit-ursh* . emit-ursh)
(emit-ulsh* . emit-ulsh)
+ (emit-ursh/immediate* . emit-ursh/immediate)
+ (emit-ulsh/immediate* . emit-ulsh/immediate)
(emit-make-vector* . emit-make-vector)
(emit-make-vector/immediate* . emit-make-vector/immediate)
(emit-vector-length* . emit-vector-length)