[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/02: DRAFT: VM: Add a 'tag' argument to the 'static-pa
From: |
Mark H. Weaver |
Subject: |
[Guile-commits] 01/02: DRAFT: VM: Add a 'tag' argument to the 'static-patch!' instruction. |
Date: |
Mon, 10 Jun 2019 04:29:48 -0400 (EDT) |
mhw pushed a commit to branch wip-new-tagging-bis-broken
in repository guile.
commit 92a7168fbebbf94aff7bbfc9192d26b55a98d3e5
Author: Mark H Weaver <address@hidden>
Date: Sat Jun 8 01:06:55 2019 -0400
DRAFT: VM: Add a 'tag' argument to the 'static-patch!' instruction.
---
libguile/jit.c | 12 +++++++++++-
libguile/vm-engine.c | 15 +++++++++------
module/system/vm/assembler.scm | 10 +++++-----
3 files changed, 25 insertions(+), 12 deletions(-)
diff --git a/libguile/jit.c b/libguile/jit.c
index 6cea8bb..5350982 100644
--- a/libguile/jit.c
+++ b/libguile/jit.c
@@ -2385,9 +2385,11 @@ compile_static_set (scm_jit_state *j, uint32_t obj, void
*loc)
}
static void
-compile_static_patch (scm_jit_state *j, void *dst, const void *src)
+compile_static_patch (scm_jit_state *j, uint32_t tag, void *dst, const void
*src)
{
emit_movi (j, T0, (uintptr_t) src);
+ if (tag)
+ emit_addi (j, T0, T0, tag);
jit_sti (j->jit, dst, T0);
}
@@ -4392,6 +4394,14 @@ compile_f64_set (scm_jit_state *j, uint8_t ptr, uint8_t
idx, uint8_t v)
comp (j, j->ip + a, j->ip + b); \
}
+#define COMPILE_X8_S24__LO32__L32(j, comp) \
+ { \
+ uint32_t a; \
+ int32_t b = j->ip[1], c = j->ip[2]; \
+ UNPACK_24 (j->ip[0], a); \
+ comp (j, a, j->ip + b, j->ip + c); \
+ }
+
#define COMPILE_X8_F24__X8_C24__L32(j, comp) \
{ \
uint32_t a, b; \
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 062dc00..e089d4f 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -2192,23 +2192,26 @@ VM_NAME (scm_thread *thread)
NEXT (2);
}
- /* static-patch! _:24 dst-offset:32 src-offset:32
+ /* static-patch! tag:24 dst-offset:32 src-offset:32
*
- * Patch a pointer at DST-OFFSET to point to SRC-OFFSET. Both offsets
- * are signed 32-bit values, indicating a memory address as a number
- * of 32-bit words away from the current instruction pointer.
+ * Patch a pointer at DST-OFFSET to point to SRC-OFFSET, with TAG
+ * added in the low bits. Both offsets are signed 32-bit values,
+ * indicating a memory address as a number of 32-bit words away from
+ * the current instruction pointer.
*/
- VM_DEFINE_OP (86, static_patch, "static-patch!", OP3 (X32, LO32, L32))
+ VM_DEFINE_OP (86, static_patch, "static-patch!", OP3 (X8_S24, LO32, L32))
{
int32_t dst_offset, src_offset;
void *src;
void** dst_loc;
+ uint32_t tag;
+ UNPACK_24 (op, tag);
dst_offset = ip[1];
src_offset = ip[2];
dst_loc = (void **) (ip + dst_offset);
- src = ip + src_offset;
+ src = (char *) (ip + src_offset) + tag;
VM_ASSERT (ALIGNED_P (dst_loc, void*), abort());
*dst_loc = src;
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index f3682f7..241d285 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -1170,7 +1170,7 @@ table, its existing label is used directly."
(let ((src (recur obj)))
(if src
(if (statically-allocatable? obj)
- `((static-patch! ,dst ,n ,src))
+ `((static-patch! 0 ,dst ,n ,src))
`((static-ref 1 ,src)
(static-set! 1 ,dst ,n)))
'())))
@@ -1192,7 +1192,7 @@ table, its existing label is used directly."
(field label 3 (syntax-module obj))))
((stringbuf? obj) '())
((static-procedure? obj)
- `((static-patch! ,label 1 ,(static-procedure-code obj))))
+ `((static-patch! 0 ,label 1 ,(static-procedure-code obj))))
((cache-cell? obj) '())
((symbol? obj)
(unless (symbol-interned? obj)
@@ -1201,7 +1201,7 @@ table, its existing label is used directly."
(string->symbol 1 1)
(static-set! 1 ,label 0)))
((string? obj)
- `((static-patch! ,label 1 ,(recur (make-stringbuf obj)))))
+ `((static-patch! 0 ,label 1 ,(recur (make-stringbuf obj)))))
((keyword? obj)
`((static-ref 1 ,(recur (keyword->symbol obj)))
(symbol->keyword 1 1)
@@ -1222,12 +1222,12 @@ table, its existing label is used directly."
((u64 s64 f64 c64) 8)
(else
(error "unhandled array type" obj)))))
- `((static-patch! ,label 2
+ `((static-patch! 0 ,label 2
,(recur (make-uniform-vector-backing-store
(uniform-array->bytevector obj)
width))))))
((array? obj)
- `((static-patch! ,label 1 ,(recur (shared-array-root obj)))))
+ `((static-patch! 0 ,label 1 ,(recur (shared-array-root obj)))))
(else
(error "don't know how to intern" obj))))
(cond