mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-30 06:50:31 +02:00
Code Activity

Add load-label instruction

Browse source 
* libguile/vm-engine.c (load-label): New instruction.
* module/system/vm/assembler.scm: Add emit-load-label.
* module/system/vm/disassembler.scm (code-annotation):
  (fold-code-range): Add load-label support.
This commit is contained in:
Andy Wingo 2018-04-10 14:36:15 +02:00
parent 3047bcaefb
commit 70e3a4a311
3 changed files with 27 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

22
libguile/vm-engine.c
View file

@ -2126,13 +2126,25 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
}
/*
* Strings, symbols, and keywords
/* load-label dst:24 offset:32
*
* Load a label OFFSET words away from the current IP and write it to
* DST. OFFSET is a signed 32-bit integer.
*/
VM_DEFINE_OP (76, load_label, "load-label", OP2 (X8_S24, L32) | OP_DST)
{
scm_t_uint32 dst;
scm_t_int32 offset;
SCM closure;
UNPACK_24 (op, dst);
offset = ip[1];
SP_SET_U64 (dst, ip + offset);
NEXT (2);
}
VM_DEFINE_OP (76, unused_76, NULL, NOP)
VM_DEFINE_OP (77, unused_77, NULL, NOP)
{
vm_error_bad_instruction (op);

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

@ -216,6 +216,7 @@
emit-bind-kwargs
emit-bind-rest
emit-make-closure
emit-load-label
emit-current-module
emit-resolve
emit-define!

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

@ -250,6 +250,13 @@ address of that offset."
"anonymous procedure")))
(push-addr! addr name)
(list "~A at #x~X (~A free var~:p)" name addr nfree)))
(('load-label dst src)
(let* ((addr (u32-offset->addr (+ offset src) context))
(pdi (find-program-debug-info addr context))
(name (or (and pdi (program-debug-info-name pdi))
"anonymous procedure")))
(push-addr! addr name)
(list "~A at #x~X" name addr)))
(('call-label closure nlocals target)
(let* ((addr (u32-offset->addr (+ offset target) context))
(pdi (find-program-debug-info addr context))
@ -411,6 +418,8 @@ address of that offset."
`(make-closure ,dst
,(u32-offset->addr (+ offset target) context)
,nfree))
(('load-label dst src)
`(load-label ,dst ,(u32-offset->addr (+ offset src) context)))
(('make-non-immediate dst target)
`(make-non-immediate ,dst ,(reference-scm target)))
(('builtin-ref dst idx)