mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-11 00:00:49 +02:00
Code Activity

static-patch! replaces link-procedure!

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2013-10-31 09:44:59 +01:00
parent 11eff82685
commit 2ab2a10d50
3 changed files with 18 additions and 24 deletions
Download patch file Download diff file Expand all files Collapse all files

29
libguile/vm-engine.c
View file

@ -2132,25 +2132,28 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
NEXT (2); 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 * Patch a pointer at DST-OFFSET to point to SRC-OFFSET. Both offsets
* words away from the current instruction pointer. OFFSET is a * are signed 32-bit values, indicating a memory address as a number
* signed value. * 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 dst_offset, src_offset;
scm_t_int32 offset; void *src;
scm_t_uint32* loc; void** dst_loc;
SCM_UNPACK_RTL_24 (op, src); dst_offset = ip[1];
offset = ip[1]; src_offset = ip[2];
loc = ip + offset;
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);
} }

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

@ -548,16 +548,14 @@ table, its existing label is used directly."
(reverse inits)))) (reverse inits))))
((stringbuf? obj) '()) ((stringbuf? obj) '())
((static-procedure? obj) ((static-procedure? obj)
`((make-non-immediate 1 ,label) `((static-patch! ,label 1 ,(static-procedure-code obj))))
(link-procedure! 1 ,(static-procedure-code obj))))
((cache-cell? obj) '()) ((cache-cell? obj) '())
((symbol? obj) ((symbol? obj)
`((make-non-immediate 1 ,(recur (symbol->string obj))) `((make-non-immediate 1 ,(recur (symbol->string obj)))
(string->symbol 1 1) (string->symbol 1 1)
(static-set! 1 ,label 0))) (static-set! 1 ,label 0)))
((string? obj) ((string? obj)
`((make-non-immediate 1 ,(recur (make-stringbuf obj))) `((static-patch! ,label 1 ,(recur (make-stringbuf obj)))))
(static-set! 1 ,label 1)))
((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)

7
module/system/vm/disassembler.scm
View file

@ -254,13 +254,6 @@ address of that offset."
(list "~A" (builtin-index->name idx))) (list "~A" (builtin-index->name idx)))
(((or 'static-ref 'static-set!) _ target) (((or 'static-ref 'static-set!) _ target)
(list "~@Y" (dereference-scm 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) (('resolve-module dst name public)
(list "~a" (if (zero? public) "private" "public"))) (list "~a" (if (zero? public) "private" "public")))
(('toplevel-box _ var-offset mod-offset sym-offset bound?) (('toplevel-box _ var-offset mod-offset sym-offset bound?)