mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00
Code Activity

fix boot program detection, which in turn makes `make-stack' actually work

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2009-02-05 13:44:06 +01:00
parent e06e857c8d
commit 3b9e095b44
3 changed files with 51 additions and 42 deletions
Download patch file Download diff file Expand all files Collapse all files

3
libguile/programs.h
View file

@ -53,12 +53,15 @@ typedef unsigned char scm_byte_t;
extern scm_t_bits scm_tc16_program; 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_P(x) (SCM_SMOB_PREDICATE (scm_tc16_program, x))
#define SCM_PROGRAM_OBJCODE(x) (SCM_SMOB_OBJECT (x)) #define SCM_PROGRAM_OBJCODE(x) (SCM_SMOB_OBJECT (x))
#define SCM_PROGRAM_OBJTABLE(x) (SCM_SMOB_OBJECT_2 (x)) #define SCM_PROGRAM_OBJTABLE(x) (SCM_SMOB_OBJECT_2 (x))
#define SCM_PROGRAM_EXTERNALS(x) (SCM_SMOB_OBJECT_3 (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_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_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); extern SCM scm_make_program (SCM objcode, SCM objtable, SCM externals);

83
libguile/stacks.c
View file

@ -126,13 +126,6 @@
#define RELOC_FRAME(ptr, offset) \ #define RELOC_FRAME(ptr, offset) \
((scm_t_debug_frame *) ((SCM_STACKITEM *) (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 /* Count number of debug info frames on a stack, beginning with
* DFRAME. OFFSET is used for relocation of pointers when the stack * DFRAME. OFFSET is used for relocation of pointers when the stack
* is read from a continuation. * 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); scm_t_debug_info *vect = RELOC_INFO (dframe->vect, offset);
if (SCM_PROGRAM_P (vect[0].a.proc)) 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)) for (; scm_is_true (vmframe); vmframe = scm_c_vm_frame_prev (vmframe))
{ {
if (is_vm_bootstrap_frame (vmframe)) if (SCM_PROGRAM_IS_BOOT (scm_vm_frame_program (vmframe)))
{ /* skip bootstrap frame, cut out of the vm backtrace */ { /* skip boot frame, cut out of the vm backtrace */
vmframe = scm_c_vm_frame_prev (vmframe); vmframe = scm_c_vm_frame_prev (vmframe);
break; break;
} }
else else
++n; ++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 else
++n; ++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)) else if (scm_is_eq (iframe->proc, scm_f_gsubr_apply))
/* Skip gsubr apply frames. */ /* Skip gsubr apply frames. */
continue; continue;
else else if (SCM_PROGRAM_P (iframe->proc))
{ {
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; if (SCM_PROGRAM_IS_BOOT (scm_vm_frame_program (vmframe)))
for (; scm_is_true (vmframe); { /* skip boot frame, back to interpreted frames */
vmframe = scm_c_vm_frame_prev (vmframe)) vmframe = scm_c_vm_frame_prev (vmframe);
{ break;
if (is_vm_bootstrap_frame (vmframe)) }
{ /* skip bootstrap frame, back to interpreted frames */ else
vmframe = scm_c_vm_frame_prev (vmframe); {
break; /* Oh dear, oh dear, oh dear. */
} iframe->flags = SCM_UNPACK (SCM_INUM0) | SCM_FRAMEF_PROC;
else iframe->source = scm_vm_frame_source (vmframe);
{ iframe->proc = scm_vm_frame_program (vmframe);
/* Oh dear, oh dear, oh dear. */ iframe->args = scm_vm_frame_arguments (vmframe);
iframe->flags = SCM_UNPACK (SCM_INUM0) | SCM_FRAMEF_PROC; ++iframe;
iframe->source = scm_vm_frame_source (vmframe); if (--n == 0)
iframe->proc = scm_vm_frame_program (vmframe); goto quit;
iframe->args = scm_vm_frame_arguments (vmframe);
++iframe;
if (--n == 0)
goto quit;
}
} }
*iframe = saved;
} }
if (!SCM_PROGRAM_IS_BOOT (saved.proc))
NEXT_FRAME (iframe, n, quit); {
} *iframe = saved;
NEXT_FRAME (iframe, n, quit);
}
}
else
{
NEXT_FRAME (iframe, n, quit);
}
quit: quit:
if (iframe > iframes) if (iframe > iframes)
(iframe - 1) -> flags |= SCM_FRAMEF_REAL; (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; SCM_STACK (stack) -> id = id;
iframe = &SCM_STACK (stack) -> tail[0]; iframe = &SCM_STACK (stack) -> tail[0];
SCM_STACK (stack) -> frames = iframe; SCM_STACK (stack) -> frames = iframe;
SCM_STACK (stack) -> length = n;
/* Translate the current chain of stack frames into debugging information. */ /* Translate the current chain of stack frames into debugging information. */
n = read_frames (dframe, offset, vmframe, n, iframe); if (read_frames (dframe, offset, vmframe, n, iframe) != n)
SCM_STACK (stack) -> length = n; abort (); /* we counted wrong, this really shouldn't happen */
/* Narrow the stack according to the arguments given to scm_make_stack. */ /* Narrow the stack according to the arguments given to scm_make_stack. */
SCM_VALIDATE_REST_ARGUMENT (args); SCM_VALIDATE_REST_ARGUMENT (args);

7
libguile/vm.c
View file

@ -255,12 +255,15 @@ really_make_boot_program (long nargs)
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
scm_op_mv_call, 0, 0, 1, scm_op_make_int8_1, scm_op_halt}; 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 */ ((scm_t_uint32*)bytes)[1] = 6; /* set len in current endianness, no meta */
if (SCM_UNLIKELY (nargs > 255 || nargs < 0)) if (SCM_UNLIKELY (nargs > 255 || nargs < 0))
abort (); abort ();
bytes[13] = (scm_byte_t)nargs; bytes[13] = (scm_byte_t)nargs;
return scm_make_program (scm_bytecode_to_objcode (make_u8vector (bytes, sizeof(bytes))), ret = scm_make_program (scm_bytecode_to_objcode (make_u8vector (bytes, sizeof(bytes))),
SCM_BOOL_F, SCM_EOL); SCM_BOOL_F, SCM_EOL);
SCM_SET_SMOB_FLAGS (ret, SCM_F_PROGRAM_IS_BOOT);
return ret;
} }
#define NUM_BOOT_PROGS 8 #define NUM_BOOT_PROGS 8
static SCM static SCM