mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-19 18:20:22 +02:00
Code Activity

Add support for raw gc-managed pointer locals

Browse source 
* libguile/vm-engine.c (gc-pointer-ref/immediate)
  (gc-pointer-set!/immediate): New instructions.
  (SP_REF_PTR, SP_SET_PTR): New helper definitions.
* libguile/vm.c (SLOT_DESC_LIVE_GC): Rename from SLOT_DESC_LIVE_SCM, as
  it can indicate GC-protected raw pointers also.
  (scm_i_vm_mark_stack): Adapt.
* module/system/vm/assembler.scm (write-arities):
* module/system/vm/debug.scm (arity-definitions): Add gcptr
  representation.  This is a binary-incompatible change!
This commit is contained in:
Andy Wingo 2018-01-10 21:05:16 +01:00
parent c7b3379a4c
commit 9222e4df4b
4 changed files with 34 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

27
libguile/vm-engine.c
View file

@ -269,6 +269,9 @@
#define SP_REF_S64(i) (sp[i].as_s64) #define SP_REF_S64(i) (sp[i].as_s64)
#define SP_SET_S64(i,o) (sp[i].as_s64 = o) #define SP_SET_S64(i,o) (sp[i].as_s64 = o)
#define SP_REF_PTR(i) (sp[i].as_ptr)
#define SP_SET_PTR(i,o) (sp[i].as_ptr = o)
#define VARIABLE_REF(v) SCM_VARIABLE_REF (v) #define VARIABLE_REF(v) SCM_VARIABLE_REF (v)
#define VARIABLE_SET(v,o) SCM_VARIABLE_SET (v, o) #define VARIABLE_SET(v,o) SCM_VARIABLE_SET (v, o)
#define VARIABLE_BOUNDP(v) (!scm_is_eq (VARIABLE_REF (v), SCM_UNDEFINED)) #define VARIABLE_BOUNDP(v) (!scm_is_eq (VARIABLE_REF (v), SCM_UNDEFINED))
@ -1418,8 +1421,28 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
NEXT (1); NEXT (1);
} }
VM_DEFINE_OP (45, unused_45, NULL, NOP) VM_DEFINE_OP (45, gc_pointer_ref_immediate, "gc-pointer-ref/immediate", OP1 (X8_S8_S8_C8) | OP_DST)
VM_DEFINE_OP (46, unused_46, NULL, NOP) {
scm_t_uint8 dst, obj, idx;
UNPACK_8_8_8 (op, dst, obj, idx);
SP_SET_PTR (dst, (void*) SCM_CELL_WORD (SP_REF (obj), idx));
NEXT (1);
}
VM_DEFINE_OP (46, gc_pointer_set_immediate, "gc-pointer-set!/immediate", OP1 (X8_S8_C8_S8))
{
scm_t_uint8 obj, idx, val;
UNPACK_8_8_8 (op, obj, idx, val);
SCM_SET_CELL_WORD (SP_REF (obj), idx, (scm_t_uintptr) SP_REF_PTR (val));
NEXT (1);
}
VM_DEFINE_OP (47, unused_47, NULL, NOP) VM_DEFINE_OP (47, unused_47, NULL, NOP)
{ {
vm_error_bad_instruction (op); vm_error_bad_instruction (op);

6
libguile/vm.c
View file

@ -970,7 +970,7 @@ enum slot_desc
{ {
SLOT_DESC_DEAD = 0, SLOT_DESC_DEAD = 0,
SLOT_DESC_LIVE_RAW = 1, SLOT_DESC_LIVE_RAW = 1,
SLOT_DESC_LIVE_SCM = 2, SLOT_DESC_LIVE_GC = 2,
SLOT_DESC_UNUSED = 3 SLOT_DESC_UNUSED = 3
}; };
@ -1000,7 +1000,7 @@ scm_i_vm_mark_stack (struct scm_vm *vp, struct GC_ms_entry *mark_stack_ptr,
size_t slot = nlocals - 1; size_t slot = nlocals - 1;
for (slot = nlocals - 1; sp < fp; sp++, slot--) for (slot = nlocals - 1; sp < fp; sp++, slot--)
{ {
enum slot_desc desc = SLOT_DESC_LIVE_SCM; enum slot_desc desc = SLOT_DESC_LIVE_GC;
if (slot_map) if (slot_map)
desc = (slot_map[slot / 4U] >> ((slot % 4U) * 2)) & 3U; desc = (slot_map[slot / 4U] >> ((slot % 4U) * 2)) & 3U;
@ -1010,7 +1010,7 @@ scm_i_vm_mark_stack (struct scm_vm *vp, struct GC_ms_entry *mark_stack_ptr,
case SLOT_DESC_LIVE_RAW: case SLOT_DESC_LIVE_RAW:
break; break;
case SLOT_DESC_UNUSED: case SLOT_DESC_UNUSED:
case SLOT_DESC_LIVE_SCM: case SLOT_DESC_LIVE_GC:
if (SCM_NIMP (sp->as_scm) && if (SCM_NIMP (sp->as_scm) &&
sp->as_ptr >= lower && sp->as_ptr <= upper) sp->as_ptr >= lower && sp->as_ptr <= upper)
mark_stack_ptr = GC_mark_and_push (sp->as_ptr, mark_stack_ptr = GC_mark_and_push (sp->as_ptr,

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

@ -2128,8 +2128,9 @@ procedure with label @var{rw-init}. @var{rw-init} may be false. If
((f64) 1) ((f64) 1)
((u64) 2) ((u64) 2)
((s64) 3) ((s64) 3)
((gc-ptr) 4)
(else (error "what!" representation))))) (else (error "what!" representation)))))
(put-uleb128 names-port (logior (ash slot 2) tag))) (put-uleb128 names-port (logior (ash slot 3) tag)))
(lp definitions)))))) (lp definitions))))))
(let lp ((metas metas) (pos arities-prefix-len) (relocs '())) (let lp ((metas metas) (pos arities-prefix-len) (relocs '()))
(match metas (match metas

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

@ -1,6 +1,6 @@
;;; Guile runtime debug information ;;; Guile runtime debug information
;;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc. ;;; Copyright (C) 2013, 2014, 2015, 2018 Free Software Foundation, Inc.
;;; ;;;
;;; This library is free software; you can redistribute it and/or ;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public ;;; modify it under the terms of the GNU Lesser General Public
@ -382,12 +382,13 @@ section of the ELF image. Returns an ELF symbol, or @code{#f}."
(lambda (def-offset pos) (lambda (def-offset pos)
(call-with-values (lambda () (read-uleb128 bv pos)) (call-with-values (lambda () (read-uleb128 bv pos))
(lambda (slot+representation pos) (lambda (slot+representation pos)
(let ((slot (ash slot+representation -2)) (let ((slot (ash slot+representation -3))
(representation (case (logand slot+representation #x3) (representation (case (logand slot+representation #x7)
((0) 'scm) ((0) 'scm)
((1) 'f64) ((1) 'f64)
((2) 'u64) ((2) 'u64)
((3) 's64) ((3) 's64)
((4) 'gcptr)
(else 'unknown)))) (else 'unknown))))
(cons (vector name def-offset slot representation) (cons (vector name def-offset slot representation)
(lp pos names))))))))))) (lp pos names)))))))))))