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);
}
/* 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);
}

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

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

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

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