[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 19/41: Add bv-length instruction
From: |
Andy Wingo |
Subject: |
[Guile-commits] 19/41: Add bv-length instruction |
Date: |
Wed, 02 Dec 2015 08:06:52 +0000 |
wingo pushed a commit to branch master
in repository guile.
commit 8464cc576c0fb9cf70a51450795338996cc785ce
Author: Andy Wingo <address@hidden>
Date: Thu Nov 19 22:12:04 2015 +0100
Add bv-length instruction
* libguile/vm-engine.c (bv-length): New instruction.
* module/language/cps/compile-bytecode.scm (compile-function):
* module/language/cps/effects-analysis.scm (bv-length):
* module/language/cps/primitives.scm (*instruction-aliases*):
* module/language/cps/slot-allocation.scm (compute-var-representations):
* module/language/cps/types.scm (bv-length):
* module/language/tree-il/compile-cps.scm (convert): Add support for
bv-length.
* module/system/vm/assembler.scm: Export emit-bv-length.
---
libguile/vm-engine.c | 14 +++++++++++++-
module/language/cps/compile-bytecode.scm | 2 ++
module/language/cps/effects-analysis.scm | 2 +-
module/language/cps/primitives.scm | 1 +
module/language/cps/slot-allocation.scm | 2 +-
module/language/cps/types.scm | 4 ++--
module/language/tree-il/compile-cps.scm | 7 +++++++
module/system/vm/assembler.scm | 1 +
8 files changed, 28 insertions(+), 5 deletions(-)
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 44bd256..3e068a1 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -3341,7 +3341,19 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
NEXT (1);
}
- VM_DEFINE_OP (145, unused_145, NULL, NOP)
+ /* bv-length dst:12 src:12
+ *
+ * Store the length of the bytevector in SRC in DST, as an untagged
+ * 64-bit integer.
+ */
+ VM_DEFINE_OP (145, bv_length, "bv-length", OP1 (X8_S12_S12) | OP_DST)
+ {
+ ARGS1 (bv);
+ VM_VALIDATE_BYTEVECTOR (bv, "bytevector-length");
+ SP_SET_U64 (dst, SCM_BYTEVECTOR_LENGTH (bv));
+ NEXT (1);
+ }
+
VM_DEFINE_OP (146, unused_146, NULL, NOP)
VM_DEFINE_OP (147, unused_147, NULL, NOP)
VM_DEFINE_OP (148, unused_148, NULL, NOP)
diff --git a/module/language/cps/compile-bytecode.scm
b/module/language/cps/compile-bytecode.scm
index 7fa5a00..9e659e2 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -185,6 +185,8 @@
(emit-scm->f64 asm (from-sp dst) (from-sp (slot src))))
(($ $primcall 'f64->scm (src))
(emit-f64->scm asm (from-sp dst) (from-sp (slot src))))
+ (($ $primcall 'bv-length (bv))
+ (emit-bv-length asm (from-sp dst) (from-sp (slot bv))))
(($ $primcall 'bv-u8-ref (bv idx))
(emit-bv-u8-ref asm (from-sp dst) (from-sp (slot bv))
(from-sp (slot idx))))
diff --git a/module/language/cps/effects-analysis.scm
b/module/language/cps/effects-analysis.scm
index 9c93346..5b5bf17 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -360,7 +360,7 @@ is or might be a read or a write to the same location as A."
;; Bytevectors.
(define-primitive-effects
- ((bytevector-length _) &type-check)
+ ((bv-length _) &type-check)
((bv-u8-ref bv n) (&read-object &bytevector) &type-check)
((bv-s8-ref bv n) (&read-object &bytevector) &type-check)
diff --git a/module/language/cps/primitives.scm
b/module/language/cps/primitives.scm
index 5074fb9..80c01f0 100644
--- a/module/language/cps/primitives.scm
+++ b/module/language/cps/primitives.scm
@@ -41,6 +41,7 @@
(modulo . mod)
(variable-ref . box-ref)
(variable-set! . box-set!)
+ (bytevector-length . bv-length)
(bytevector-u8-ref . bv-u8-ref)
(bytevector-u16-native-ref . bv-u16-ref)
(bytevector-u32-native-ref . bv-u32-ref)
diff --git a/module/language/cps/slot-allocation.scm
b/module/language/cps/slot-allocation.scm
index ca8e321..e540780 100644
--- a/module/language/cps/slot-allocation.scm
+++ b/module/language/cps/slot-allocation.scm
@@ -793,7 +793,7 @@ are comparable with eqv?. A tmp slot may be used."
(($ $primcall (or 'scm->f64 'bv-f32-ref 'bv-f64-ref
'fadd 'fsub 'fmul 'fdiv))
(intmap-add representations var 'f64))
- (($ $primcall (or 'scm->u64))
+ (($ $primcall (or 'scm->u64 'bv-length))
(intmap-add representations var 'u64))
(_
(intmap-add representations var 'scm))))
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index ea89131..b99d0f4 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -713,8 +713,8 @@ minimum, and maximum."
;;; Bytevectors.
;;;
-(define-simple-type-checker (bytevector-length &bytevector))
-(define-type-inferrer (bytevector-length bv result)
+(define-simple-type-checker (bv-length &bytevector))
+(define-type-inferrer (bv-length bv result)
(restrict! bv &bytevector 0 +inf.0)
(define! result &exact-integer (max (&min bv) 0) (&max bv)))
diff --git a/module/language/tree-il/compile-cps.scm
b/module/language/tree-il/compile-cps.scm
index 2ef751b..7b220b5 100644
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -576,6 +576,13 @@
(letk kbox ($kargs ('f64) (f64)
($continue k src ($primcall 'f64->scm (f64)))))
kbox))
+ ((bv-length)
+ (with-cps cps
+ (letv u64)
+ (let$ k (adapt-arity k src out))
+ (letk kbox ($kargs ('u64) (u64)
+ ($continue k src ($primcall 'u64->scm (u64)))))
+ kbox))
(else
(adapt-arity cps k src out))))
(define (unbox-arg cps arg have-arg)
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 21f4353..8155ebe 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -160,6 +160,7 @@
emit-make-array
(emit-scm->f64* . emit-scm->f64)
(emit-f64->scm* . emit-f64->scm)
+ (emit-bv-length* . emit-bv-length)
(emit-bv-u8-ref* . emit-bv-u8-ref)
(emit-bv-s8-ref* . emit-bv-s8-ref)
(emit-bv-u16-ref* . emit-bv-u16-ref)
- [Guile-commits] 07/41: Remove primitive?, add primitive-code?, (continued)
- [Guile-commits] 07/41: Remove primitive?, add primitive-code?, Andy Wingo, 2015/12/02
- [Guile-commits] 10/41: More robust low-level frame printer, Andy Wingo, 2015/12/02
- [Guile-commits] 05/41: All arities serialize a "closure" binding, Andy Wingo, 2015/12/02
- [Guile-commits] 12/41: ,registers doesn't use frame-procedure, Andy Wingo, 2015/12/02
- [Guile-commits] 11/41: Better frame-call-representation printing of GC clobbers, Andy Wingo, 2015/12/02
- [Guile-commits] 09/41: frame-call-representation avoids frame-procedure., Andy Wingo, 2015/12/02
- [Guile-commits] 15/41: Remove frame-procedure, Andy Wingo, 2015/12/02
- [Guile-commits] 13/41: Remove `procedure' repl command, Andy Wingo, 2015/12/02
- [Guile-commits] 14/41: VM traps don't match on value of slot 0, Andy Wingo, 2015/12/02
- [Guile-commits] 17/41: Remove frame->module, Andy Wingo, 2015/12/02
- [Guile-commits] 19/41: Add bv-length instruction,
Andy Wingo <=
- [Guile-commits] 18/41: Range inference over the full U64+S64 range, Andy Wingo, 2015/12/02
- [Guile-commits] 20/41: bv-f{32, 64}-{ref, set!} take unboxed u64 index, Andy Wingo, 2015/12/02
- [Guile-commits] 23/41: Beginning of u64 phi unboxing, Andy Wingo, 2015/12/02
- [Guile-commits] 16/41: Add low-level support for unboxed 64-bit unsigned ints, Andy Wingo, 2015/12/02
- [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