summaryrefslogtreecommitdiff
path: root/module/system/vm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2015-11-21 11:50:15 +0100
committerAndy Wingo <wingo@pobox.com>2015-12-01 15:42:24 +0100
commita08b3d40f8d1093b96ca4fc8aa440fd71bd0f20e (patch)
treef9a643f52b93fca63b8cddf98ea4641d79dccc9f /module/system/vm
parent8bf77f7192dd319cf5391639310abb35b9e627d7 (diff)
downloadguile-a08b3d40f8d1093b96ca4fc8aa440fd71bd0f20e.tar.gz
Untag values and indexes for all bytevector instructions
* libguile/vm-engine.c (bv-s8-ref, bv-s16-ref, bv-s32-ref, bv-s64-ref): Unbox index and return unboxed S32 value. (bv-s8-set!, bv-s16-set!, bv-s32-set!, bv-s64-set!): Unbox index and take unboxed S32 value. (bv-u8-ref, bv-u16-ref, bv-u32-ref, bv-u64-ref) (bv-s8-set!, bv-s16-set!, bv-s32-set!, bv-s64-set!): Likewise, but with unsigned values. (bv-f32-ref, bv-f32-set!, bv-f64-ref, bv-f64-set!): Use memcpy to access the value so we don't have to think about alignment. GCC will inline this to a single instruction on architectures that support unaligned access. * libguile/vm.c (vm_error_out_of_range_uint64) (vm_error_out_of_range_int64): New helpers. * module/language/cps/slot-allocation.scm (compute-var-representations): All bytevector ref operations produce untagged values. * module/language/cps/types.scm (define-bytevector-accessors): Update for bytevector untagged indices and values. * module/language/cps/utils.scm (compute-constant-values): Fix s64 case. * module/language/tree-il/compile-cps.scm (convert): Box results of all bytevector accesses, and unbox incoming indices and values.
Diffstat (limited to 'module/system/vm')
-rw-r--r--module/system/vm/assembler.scm5
-rw-r--r--module/system/vm/disassembler.scm2
2 files changed, 6 insertions, 1 deletions
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 59b194d16..0e4bbf06c 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -582,8 +582,13 @@ later by the linker."
((AU32 u64)
(emit asm (ash u64 -32))
(emit asm (logand u64 (1- (ash 1 32)))))
+ ((AS32 s64)
+ (let ((u64 (u64vector-ref (s64vector s64) 0)))
+ (emit asm (ash u64 -32))
+ (emit asm (logand u64 (1- (ash 1 32))))))
((B32))
((BU32))
+ ((BS32))
((BF32))
((N32 label)
(record-far-label-reference asm label)
diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm
index 794caa759..6c21ad609 100644
--- a/module/system/vm/disassembler.scm
+++ b/module/system/vm/disassembler.scm
@@ -108,7 +108,7 @@
(define (parse-tail-word word type)
(with-syntax ((word word))
(case type
- ((C32 I32 A32 B32 AU32 BU32 AF32 BF32)
+ ((C32 I32 A32 B32 AU32 BU32 AS32 BS32 AF32 BF32)
#'(word))
((N32 R32 L32 LO32)
#'((unpack-s32 word)))