From 2ab2a10d508b521d4a1909fdd362811418f1aba4 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 31 Oct 2013 09:44:59 +0100 Subject: [PATCH] static-patch! replaces link-procedure! * libguile/vm-engine.c (static-patch!): Replace link-procedure! with this more versatile primitive. * module/system/vm/assembler.scm (intern-constant): Emit static-patch! for static procedures and for strings. * module/system/vm/disassembler.scm (code-annotation): Remove annotation for link-procedure!. There can be no annotation for static-patch!, as neither operand is guaranteed to be a SCM value. --- libguile/vm-engine.c | 29 ++++++++++++++++------------- module/system/vm/assembler.scm | 6 ++---- module/system/vm/disassembler.scm | 7 ------- 3 files changed, 18 insertions(+), 24 deletions(-) diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index c4e0097c1..2f53b2092 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -2132,25 +2132,28 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) NEXT (2); } - /* link-procedure! src:24 offset:32 + /* static-patch! _:24 dst-offset:32 src-offset:32 * - * Set the code pointer of the procedure in SRC to point OFFSET 32-bit - * words away from the current instruction pointer. OFFSET is a - * signed value. + * 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. */ - VM_DEFINE_OP (55, link_procedure, "link-procedure!", OP2 (U8_U24, L32)) + VM_DEFINE_OP (55, static_patch, "static-patch!", OP3 (U8_X24, LO32, L32)) { - scm_t_uint32 src; - scm_t_int32 offset; - scm_t_uint32* loc; + scm_t_int32 dst_offset, src_offset; + void *src; + void** dst_loc; - SCM_UNPACK_RTL_24 (op, src); - offset = ip[1]; - loc = ip + offset; + dst_offset = ip[1]; + src_offset = ip[2]; - SCM_SET_CELL_WORD_1 (LOCAL_REF (src), (scm_t_bits) loc); + dst_loc = (void **) (ip + dst_offset); + src = ip + src_offset; + VM_ASSERT (ALIGNED_P (dst_loc, void*), abort()); - NEXT (2); + *dst_loc = src; + + NEXT (3); } diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index 749b69383..ec357167e 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -548,16 +548,14 @@ table, its existing label is used directly." (reverse inits)))) ((stringbuf? obj) '()) ((static-procedure? obj) - `((make-non-immediate 1 ,label) - (link-procedure! 1 ,(static-procedure-code obj)))) + `((static-patch! ,label 1 ,(static-procedure-code obj)))) ((cache-cell? obj) '()) ((symbol? obj) `((make-non-immediate 1 ,(recur (symbol->string obj))) (string->symbol 1 1) (static-set! 1 ,label 0))) ((string? obj) - `((make-non-immediate 1 ,(recur (make-stringbuf obj))) - (static-set! 1 ,label 1))) + `((static-patch! ,label 1 ,(recur (make-stringbuf obj))))) ((keyword? obj) `((static-ref 1 ,(recur (keyword->symbol obj))) (symbol->keyword 1 1) diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm index f5f7b7fe4..2ae35b06a 100644 --- a/module/system/vm/disassembler.scm +++ b/module/system/vm/disassembler.scm @@ -254,13 +254,6 @@ address of that offset." (list "~A" (builtin-index->name idx))) (((or 'static-ref 'static-set!) _ target) (list "~@Y" (dereference-scm target))) - (('link-procedure! src target) - (let* ((addr (u32-offset->addr (+ offset target) context)) - (pdi (find-program-debug-info addr context))) - (list "~A at 0x~X" - (or (and pdi (program-debug-info-name pdi)) - "(anonymous procedure)") - addr))) (('resolve-module dst name public) (list "~a" (if (zero? public) "private" "public"))) (('toplevel-box _ var-offset mod-offset sym-offset bound?)