1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00

DRAFT: VM: Add a 'tag' argument to the 'static-patch!' instruction.

This commit is contained in:
Mark H Weaver 2019-06-08 01:06:55 -04:00
parent 90275c1c18
commit 92a7168fbe
3 changed files with 25 additions and 12 deletions

View file

@ -2385,9 +2385,11 @@ compile_static_set (scm_jit_state *j, uint32_t obj, void *loc)
} }
static void 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); emit_movi (j, T0, (uintptr_t) src);
if (tag)
emit_addi (j, T0, T0, tag);
jit_sti (j->jit, dst, T0); 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); \ 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) \ #define COMPILE_X8_F24__X8_C24__L32(j, comp) \
{ \ { \
uint32_t a, b; \ uint32_t a, b; \

View file

@ -2192,23 +2192,26 @@ VM_NAME (scm_thread *thread)
NEXT (2); 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 * Patch a pointer at DST-OFFSET to point to SRC-OFFSET, with TAG
* are signed 32-bit values, indicating a memory address as a number * added in the low bits. Both offsets are signed 32-bit values,
* of 32-bit words away from the current instruction pointer. * 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; int32_t dst_offset, src_offset;
void *src; void *src;
void** dst_loc; void** dst_loc;
uint32_t tag;
UNPACK_24 (op, tag);
dst_offset = ip[1]; dst_offset = ip[1];
src_offset = ip[2]; src_offset = ip[2];
dst_loc = (void **) (ip + dst_offset); dst_loc = (void **) (ip + dst_offset);
src = ip + src_offset; src = (char *) (ip + src_offset) + tag;
VM_ASSERT (ALIGNED_P (dst_loc, void*), abort()); VM_ASSERT (ALIGNED_P (dst_loc, void*), abort());
*dst_loc = src; *dst_loc = src;

View file

@ -1170,7 +1170,7 @@ table, its existing label is used directly."
(let ((src (recur obj))) (let ((src (recur obj)))
(if src (if src
(if (statically-allocatable? obj) (if (statically-allocatable? obj)
`((static-patch! ,dst ,n ,src)) `((static-patch! 0 ,dst ,n ,src))
`((static-ref 1 ,src) `((static-ref 1 ,src)
(static-set! 1 ,dst ,n))) (static-set! 1 ,dst ,n)))
'()))) '())))
@ -1192,7 +1192,7 @@ table, its existing label is used directly."
(field label 3 (syntax-module obj)))) (field label 3 (syntax-module obj))))
((stringbuf? obj) '()) ((stringbuf? obj) '())
((static-procedure? obj) ((static-procedure? obj)
`((static-patch! ,label 1 ,(static-procedure-code obj)))) `((static-patch! 0 ,label 1 ,(static-procedure-code obj))))
((cache-cell? obj) '()) ((cache-cell? obj) '())
((symbol? obj) ((symbol? obj)
(unless (symbol-interned? obj) (unless (symbol-interned? obj)
@ -1201,7 +1201,7 @@ table, its existing label is used directly."
(string->symbol 1 1) (string->symbol 1 1)
(static-set! 1 ,label 0))) (static-set! 1 ,label 0)))
((string? obj) ((string? obj)
`((static-patch! ,label 1 ,(recur (make-stringbuf obj))))) `((static-patch! 0 ,label 1 ,(recur (make-stringbuf obj)))))
((keyword? obj) ((keyword? obj)
`((static-ref 1 ,(recur (keyword->symbol obj))) `((static-ref 1 ,(recur (keyword->symbol obj)))
(symbol->keyword 1 1) (symbol->keyword 1 1)
@ -1222,12 +1222,12 @@ table, its existing label is used directly."
((u64 s64 f64 c64) 8) ((u64 s64 f64 c64) 8)
(else (else
(error "unhandled array type" obj))))) (error "unhandled array type" obj)))))
`((static-patch! ,label 2 `((static-patch! 0 ,label 2
,(recur (make-uniform-vector-backing-store ,(recur (make-uniform-vector-backing-store
(uniform-array->bytevector obj) (uniform-array->bytevector obj)
width)))))) width))))))
((array? obj) ((array? obj)
`((static-patch! ,label 1 ,(recur (shared-array-root obj))))) `((static-patch! 0 ,label 1 ,(recur (shared-array-root obj)))))
(else (else
(error "don't know how to intern" obj)))) (error "don't know how to intern" obj))))
(cond (cond