mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +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;
#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);

83
libguile/stacks.c
View file

@ -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 (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;
}
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
{
/* 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;
}
*iframe = saved;
}
NEXT_FRAME (iframe, n, quit);
}
if (!SCM_PROGRAM_IS_BOOT (saved.proc))
{
*iframe = saved;
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);

7
libguile/vm.c
View file

@ -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