diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index 83eefd8bd..5206b96b0 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -269,6 +269,9 @@ #define SP_REF_S64(i) (sp[i].as_s64) #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_SET(v,o) SCM_VARIABLE_SET (v, o) #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); } - VM_DEFINE_OP (45, unused_45, NULL, NOP) - VM_DEFINE_OP (46, unused_46, NULL, NOP) + VM_DEFINE_OP (45, gc_pointer_ref_immediate, "gc-pointer-ref/immediate", OP1 (X8_S8_S8_C8) | OP_DST) + { + 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_error_bad_instruction (op); diff --git a/libguile/vm.c b/libguile/vm.c index 2f9969240..0f107ea8b 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -970,7 +970,7 @@ enum slot_desc { SLOT_DESC_DEAD = 0, SLOT_DESC_LIVE_RAW = 1, - SLOT_DESC_LIVE_SCM = 2, + SLOT_DESC_LIVE_GC = 2, 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; 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) 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: break; case SLOT_DESC_UNUSED: - case SLOT_DESC_LIVE_SCM: + case SLOT_DESC_LIVE_GC: if (SCM_NIMP (sp->as_scm) && sp->as_ptr >= lower && sp->as_ptr <= upper) mark_stack_ptr = GC_mark_and_push (sp->as_ptr, diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index 77b2e51cb..9be3fcfe1 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -2128,8 +2128,9 @@ procedure with label @var{rw-init}. @var{rw-init} may be false. If ((f64) 1) ((u64) 2) ((s64) 3) + ((gc-ptr) 4) (else (error "what!" representation))))) - (put-uleb128 names-port (logior (ash slot 2) tag))) + (put-uleb128 names-port (logior (ash slot 3) tag))) (lp definitions)))))) (let lp ((metas metas) (pos arities-prefix-len) (relocs '())) (match metas diff --git a/module/system/vm/debug.scm b/module/system/vm/debug.scm index 09d076692..9818bfab3 100644 --- a/module/system/vm/debug.scm +++ b/module/system/vm/debug.scm @@ -1,6 +1,6 @@ ;;; 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 ;;; 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) (call-with-values (lambda () (read-uleb128 bv pos)) (lambda (slot+representation pos) - (let ((slot (ash slot+representation -2)) - (representation (case (logand slot+representation #x3) + (let ((slot (ash slot+representation -3)) + (representation (case (logand slot+representation #x7) ((0) 'scm) ((1) 'f64) ((2) 'u64) ((3) 's64) + ((4) 'gcptr) (else 'unknown)))) (cons (vector name def-offset slot representation) (lp pos names)))))))))))