From 3b9e095b44a618b9e5781adfaa287e14b0f44d03 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 5 Feb 2009 13:44:06 +0100 Subject: [PATCH] fix boot program detection, which in turn makes `make-stack' actually work * libguile/programs.h (SCM_F_PROGRAM_IS_BOOT, SCM_PROGRAM_IS_BOOT): Flags for determining if a program is a boot program. It turns out that our heuristics e.g. in stacks.c would catch non-boot programs, like programs that end with (goto/args 1), because the 1 is the same byte as `halt'. That took a while to find... * libguile/stacks.c (stack_depth, read_frames): Use the new boot prog macros. (scm_make_stack): Assert that we read the number of frames that we said we would. * libguile/vm.c (really_make_boot_program): Mark boot programs appropriately. --- libguile/programs.h | 3 ++ libguile/stacks.c | 79 +++++++++++++++++++++++---------------------- libguile/vm.c | 7 ++-- 3 files changed, 49 insertions(+), 40 deletions(-) diff --git a/libguile/programs.h b/libguile/programs.h index 7d9478877..263228bec 100644 --- a/libguile/programs.h +++ b/libguile/programs.h @@ -53,12 +53,15 @@ typedef unsigned char scm_byte_t; extern scm_t_bits scm_tc16_program; +#define SCM_F_PROGRAM_IS_BOOT (1<<0) + #define SCM_PROGRAM_P(x) (SCM_SMOB_PREDICATE (scm_tc16_program, x)) #define SCM_PROGRAM_OBJCODE(x) (SCM_SMOB_OBJECT (x)) #define SCM_PROGRAM_OBJTABLE(x) (SCM_SMOB_OBJECT_2 (x)) #define SCM_PROGRAM_EXTERNALS(x) (SCM_SMOB_OBJECT_3 (x)) #define SCM_PROGRAM_DATA(x) (SCM_OBJCODE_DATA (SCM_PROGRAM_OBJCODE (x))) #define SCM_VALIDATE_PROGRAM(p,x) SCM_MAKE_VALIDATE (p, x, PROGRAM_P) +#define SCM_PROGRAM_IS_BOOT(x) (SCM_SMOB_FLAGS (x) & SCM_F_PROGRAM_IS_BOOT) extern SCM scm_make_program (SCM objcode, SCM objtable, SCM externals); diff --git a/libguile/stacks.c b/libguile/stacks.c index cef01e475..8f4e88611 100644 --- a/libguile/stacks.c +++ b/libguile/stacks.c @@ -126,13 +126,6 @@ #define RELOC_FRAME(ptr, offset) \ ((scm_t_debug_frame *) ((SCM_STACKITEM *) (ptr) + (offset))) -/* FIXME: factor this out somewhere? */ -static int is_vm_bootstrap_frame (SCM f) -{ - struct scm_objcode *bp = SCM_PROGRAM_DATA (scm_vm_frame_program (f)); - return bp->base[bp->len-1] == scm_op_halt; -} - /* Count number of debug info frames on a stack, beginning with * DFRAME. OFFSET is used for relocation of pointers when the stack * is read from a continuation. @@ -163,19 +156,25 @@ stack_depth (scm_t_debug_frame *dframe, scm_t_ptrdiff offset, SCM vmframe, scm_t_debug_info *vect = RELOC_INFO (dframe->vect, offset); if (SCM_PROGRAM_P (vect[0].a.proc)) { - /* count vmframe back to previous bootstrap frame */ + /* count vmframe back to previous boot frame */ for (; scm_is_true (vmframe); vmframe = scm_c_vm_frame_prev (vmframe)) { - if (is_vm_bootstrap_frame (vmframe)) - { /* skip bootstrap frame, cut out of the vm backtrace */ + if (SCM_PROGRAM_IS_BOOT (scm_vm_frame_program (vmframe))) + { /* skip boot frame, cut out of the vm backtrace */ vmframe = scm_c_vm_frame_prev (vmframe); break; } else ++n; } + if (!SCM_PROGRAM_IS_BOOT (vect[0].a.proc)) + ++n; /* increment for apply frame if this isn't a boot frame */ } - ++n; /* increment for apply frame in any case */ + else if (scm_is_eq (vect[0].a.proc, scm_f_gsubr_apply)) + /* Skip gsubr apply frames. */ + continue; + else + ++n; /* increment for non-program apply frame */ } else ++n; @@ -321,36 +320,39 @@ read_frames (scm_t_debug_frame *dframe, scm_t_ptrdiff offset, else if (scm_is_eq (iframe->proc, scm_f_gsubr_apply)) /* Skip gsubr apply frames. */ continue; - else - { - if (SCM_PROGRAM_P (iframe->proc)) + else if (SCM_PROGRAM_P (iframe->proc)) + { + scm_t_info_frame saved = *iframe; + for (; scm_is_true (vmframe); + vmframe = scm_c_vm_frame_prev (vmframe)) { - scm_t_info_frame saved = *iframe; - for (; scm_is_true (vmframe); - vmframe = scm_c_vm_frame_prev (vmframe)) + if (SCM_PROGRAM_IS_BOOT (scm_vm_frame_program (vmframe))) + { /* skip boot frame, back to interpreted frames */ + vmframe = scm_c_vm_frame_prev (vmframe); + break; + } + else { - if (is_vm_bootstrap_frame (vmframe)) - { /* skip bootstrap frame, back to interpreted frames */ - vmframe = scm_c_vm_frame_prev (vmframe); - break; - } - else - { - /* Oh dear, oh dear, oh dear. */ - iframe->flags = SCM_UNPACK (SCM_INUM0) | SCM_FRAMEF_PROC; - iframe->source = scm_vm_frame_source (vmframe); - iframe->proc = scm_vm_frame_program (vmframe); - iframe->args = scm_vm_frame_arguments (vmframe); - ++iframe; - if (--n == 0) - goto quit; - } + /* Oh dear, oh dear, oh dear. */ + iframe->flags = SCM_UNPACK (SCM_INUM0) | SCM_FRAMEF_PROC; + iframe->source = scm_vm_frame_source (vmframe); + iframe->proc = scm_vm_frame_program (vmframe); + iframe->args = scm_vm_frame_arguments (vmframe); + ++iframe; + if (--n == 0) + goto quit; } + } + if (!SCM_PROGRAM_IS_BOOT (saved.proc)) + { *iframe = saved; + NEXT_FRAME (iframe, n, quit); } - - NEXT_FRAME (iframe, n, quit); - } + } + else + { + NEXT_FRAME (iframe, n, quit); + } quit: if (iframe > iframes) (iframe - 1) -> flags |= SCM_FRAMEF_REAL; @@ -543,10 +545,11 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1, SCM_STACK (stack) -> id = id; iframe = &SCM_STACK (stack) -> tail[0]; SCM_STACK (stack) -> frames = iframe; + SCM_STACK (stack) -> length = n; /* Translate the current chain of stack frames into debugging information. */ - n = read_frames (dframe, offset, vmframe, n, iframe); - SCM_STACK (stack) -> length = n; + if (read_frames (dframe, offset, vmframe, n, iframe) != n) + abort (); /* we counted wrong, this really shouldn't happen */ /* Narrow the stack according to the arguments given to scm_make_stack. */ SCM_VALIDATE_REST_ARGUMENT (args); diff --git a/libguile/vm.c b/libguile/vm.c index 5dcce1b77..ca60fc7f2 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -255,12 +255,15 @@ really_make_boot_program (long nargs) 0, 0, 0, 0, 0, 0, 0, 0, scm_op_mv_call, 0, 0, 1, scm_op_make_int8_1, scm_op_halt}; + SCM ret; ((scm_t_uint32*)bytes)[1] = 6; /* set len in current endianness, no meta */ if (SCM_UNLIKELY (nargs > 255 || nargs < 0)) abort (); bytes[13] = (scm_byte_t)nargs; - return scm_make_program (scm_bytecode_to_objcode (make_u8vector (bytes, sizeof(bytes))), - SCM_BOOL_F, SCM_EOL); + ret = scm_make_program (scm_bytecode_to_objcode (make_u8vector (bytes, sizeof(bytes))), + SCM_BOOL_F, SCM_EOL); + SCM_SET_SMOB_FLAGS (ret, SCM_F_PROGRAM_IS_BOOT); + return ret; } #define NUM_BOOT_PROGS 8 static SCM -- 2.20.1