diff --git a/libguile/jit.c b/libguile/jit.c index 6cea8bbc5..5350982d2 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 062dc00bd..e089d4faa 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 f3682f7e8..241d285d3 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