mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

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

Browse source
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
Download patch file Download diff file Expand all files Collapse all files

12
libguile/jit.c
View file

@ -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; \

15
libguile/vm-engine.c
View file

@ -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;

10
module/system/vm/assembler.scm
View file

@ -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