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

replace frame implementation with VM frames

Browse source 
* libguile/stacks.h: Rework so that a stack doesn't copy information out
  of VM frames, it just holds onto a VM frame, along with the stack id
  and length. VM frames are now the only representation of frames in
  Guile.
  (scm_t_info_frame, SCM_FRAME_N_SLOTS, SCM_FRAME_REF, SCM_FRAME_NUMBER)
  (SCM_FRAME_FLAGS, SCM_FRAME_SOURCE, SCM_FRAME_PROC, SCM_FRAME_ARGS)
  (SCM_FRAME_PREV, SCM_FRAME_NEXT)
  (SCM_FRAMEF_VOID, SCM_FRAMEF_REAL, SCM_FRAMEF_PROC)
  (SCM_FRAMEF_EVAL_ARGS, SCM_FRAMEF_OVERFLOW)
  (SCM_FRAME_VOID_P, SCM_FRAME_REAL_P, SCM_FRAME_PROC_P)
  (SCM_FRAME_EVAL_ARGS_P, SCM_FRAME_OVERFLOW_P): Remove these macros
  corresponding to the old frame implementation.
  (scm_frame_p scm_frame_source, scm_frame_procedure)
  (scm_frame_arguments): These definitions are now in frames.h.
  (scm_last_stack_frame): Remove declaration of previously-removed
  constructor. Probably should re-instate it though.
  (scm_frame_number, scm_frame_previous, scm_frame_next)
  (scm_frame_real_p, scm_frame_procedure_p, scm_frame_evaluating_args_p)
  (scm_frame_overflow_p) : Remove these procedures corresponding to the
  old stack implementation.

* libguile/stacks.c: Update for new frames implementation.

* libguile/frames.h:
* libguile/frames.c: Rename functions operating on VM frames to have a
  scm_frame prefix, not scm_vm_frame -- because they really are the only
  frames we have. Rename corresponding Scheme functions too, from
  vm-frame-foo to frame-foo.

* libguile/deprecated.h: Remove scm_stack and scm_info_frame data types.

* libguile/vm.c (vm_dispatch_hook): Adapt to scm_c_make_frame name
  change.

* module/system/vm/frame.scm: No need to export functions provided
  frames.c now, as we load those procedures into the default environment
  now. Rename functions, and remove a couple of outdated, unused
  functions. The bottom half of this file is still bitrotten, though.

* libguile/backtrace.c: Rework to operate on the new frame
  representation. Also fix a bug displaying file names for compiled
  procedures.

* libguile/init.c: Load the VM much earlier, just because we can. Also
  it allows us to have frames.[ch] loaded in time for stacks to be
  initialized, so that scm_frame_arguments can do the right thing.
This commit is contained in:
Andy Wingo 2009-12-03 13:09:58 +01:00
parent 14aa25e410
commit aa3f69519f
9 changed files with 249 additions and 542 deletions
Download patch file Download diff file Expand all files Collapse all files

345
libguile/stacks.c
View file

@ -1,4 +1,4 @@
/* Representation of stack frame debug information
/* A stack holds a frame chain
* Copyright (C) 1996,1997,2000,2001, 2006, 2007, 2008, 2009 Free Software Foundation
*
* This library is free software; you can redistribute it and/or
@ -42,14 +42,10 @@
/* {Frames and stacks}
/* {Stacks}
*
* The stack is represented as a struct with an id slot and a tail
* array of scm_t_info_frame structs.
*
* A frame is represented as a pair where the car contains a stack and
* the cdr an inum. The inum is an index to the first SCM value of
* the scm_t_info_frame struct.
* The stack is represented as a struct that holds a frame. The frame itself is
* linked to the next frame, or #f.
*
* Stacks
* Constructor
@ -59,71 +55,26 @@
* stack-ref
* Inspector
* stack-length
*
* Frames
* Constructor
* last-stack-frame
* Selectors
* frame-number
* frame-source
* frame-procedure
* frame-arguments
* frame-previous
* frame-next
* Predicates
* frame-real?
* frame-procedure?
* frame-evaluating-args?
* frame-overflow? */
*/
static SCM stack_id_with_fp (SCM vmframe, SCM **fp);
static SCM stack_id_with_fp (SCM frame, SCM **fp);
/* Count number of debug info frames on a stack, beginning with VMFRAME.
/* Count number of debug info frames on a stack, beginning with FRAME.
*/
static long
stack_depth (SCM vmframe, SCM *fp)
stack_depth (SCM frame, SCM *fp)
{
long n;
/* count vmframes, skipping boot frames */
for (; scm_is_true (vmframe) && SCM_VM_FRAME_FP (vmframe) > fp;
vmframe = scm_c_vm_frame_prev (vmframe))
if (!SCM_PROGRAM_IS_BOOT (scm_vm_frame_program (vmframe)))
/* count frames, skipping boot frames */
for (; scm_is_true (frame) && SCM_VM_FRAME_FP (frame) > fp;
frame = scm_c_frame_prev (frame))
if (!SCM_PROGRAM_IS_BOOT (scm_frame_procedure (frame)))
++n;
return n;
}
/* Fill the scm_t_info_frame vector IFRAME with data from N stack frames
* starting with the first stack frame represented by VMFRAME.
*/
static scm_t_bits
read_frames (SCM vmframe, long n, scm_t_info_frame *iframes)
{
scm_t_info_frame *iframe = iframes;
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 */
continue;
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)
break;
}
}
return iframe - iframes; /* Number of frames actually read */
}
/* Narrow STACK by cutting away stackframes (mutatingly).
*
* Inner frames (most recent) are cut by advancing the frames pointer.
@ -148,33 +99,48 @@ read_frames (SCM vmframe, long n, scm_t_info_frame *iframes)
static void
narrow_stack (SCM stack, long inner, SCM inner_key, long outer, SCM outer_key)
{
scm_t_stack *s = SCM_STACK (stack);
unsigned long int i;
long n = s->length;
unsigned long int len;
SCM frame;
len = SCM_STACK_LENGTH (stack);
frame = SCM_STACK_FRAME (stack);
/* Cut inner part. */
if (scm_is_eq (inner_key, SCM_BOOL_T))
{
/* Cut all frames up to user module code */
for (i = 0; inner; ++i, --inner)
;
/* Cut specified number of frames. */
for (; inner && len; --inner)
{
len--;
frame = scm_c_frame_prev (frame);
}
}
else
/* Use standard cutting procedure. */
{
for (i = 0; inner; --inner)
if (scm_is_eq (s->frames[i++].proc, inner_key))
break;
/* Cut until the given procedure is seen. */
for (; inner && len ; --inner)
{
SCM proc = scm_frame_procedure (frame);
len--;
frame = scm_c_frame_prev (frame);
if (scm_is_eq (proc, inner_key))
break;
}
}
s->frames = &s->frames[i];
n -= i;
SCM_SET_STACK_LENGTH (stack, len);
SCM_SET_STACK_FRAME (stack, frame);
/* Cut outer part. */
for (; n && outer; --outer)
if (scm_is_eq (s->frames[--n].proc, outer_key))
break;
for (; outer && len ; --outer)
{
frame = scm_stack_ref (stack, scm_from_long (len - 1));
len--;
if (scm_is_eq (scm_frame_procedure (frame), outer_key))
break;
}
s->length = n;
SCM_SET_STACK_LENGTH (stack, len);
}
@ -220,10 +186,9 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
"taken as 0.")
#define FUNC_NAME s_scm_make_stack
{
long n, size;
long n;
int maxp;
scm_t_info_frame *iframe;
SCM vmframe;
SCM frame;
SCM stack;
SCM id, *id_fp;
SCM inner_cut, outer_cut;
@ -232,11 +197,18 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
scm_make_stack was given. */
if (scm_is_eq (obj, SCM_BOOL_T))
{
struct scm_vm *vp = SCM_VM_DATA (scm_the_vm ());
vmframe = scm_c_make_vm_frame (scm_the_vm (), vp->fp, vp->sp, vp->ip, 0);
SCM cont;
struct scm_vm_cont *c;
cont = scm_cdar (scm_vm_capture_continuations ());
c = SCM_VM_CONT_DATA (cont);
frame = scm_c_make_frame (cont, c->fp + c->reloc,
c->sp + c->reloc, c->ip,
c->reloc);
}
else if (SCM_VM_FRAME_P (obj))
vmframe = obj;
frame = obj;
else if (SCM_CONTINUATIONP (obj))
{
scm_t_contregs *cont = SCM_CONTREGS (obj);
@ -245,13 +217,13 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
struct scm_vm_cont *data;
vm_cont = scm_cdr (scm_car (cont->vm_conts));
data = SCM_VM_CONT_DATA (vm_cont);
vmframe = scm_c_make_vm_frame (vm_cont,
data->fp + data->reloc,
data->sp + data->reloc,
data->ip,
data->reloc);
frame = scm_c_make_frame (vm_cont,
data->fp + data->reloc,
data->sp + data->reloc,
data->ip,
data->reloc);
} else
vmframe = SCM_BOOL_F;
frame = SCM_BOOL_F;
}
else
{
@ -259,36 +231,25 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
/* not reached */
}
if (scm_is_false (vmframe))
if (scm_is_false (frame))
return SCM_BOOL_F;
/* Get ID of the stack corresponding to the given frame. */
id = stack_id_with_fp (vmframe, &id_fp);
id = stack_id_with_fp (frame, &id_fp);
/* Count number of frames. Also get stack id tag and check whether
there are more stackframes than we want to record
(SCM_BACKTRACE_MAXDEPTH). */
id = SCM_BOOL_F;
maxp = 0;
n = stack_depth (vmframe, id_fp);
/* FIXME: redo maxp? */
size = n * SCM_FRAME_N_SLOTS;
n = stack_depth (frame, id_fp);
/* Make the stack object. */
stack = scm_make_struct (scm_stack_type, scm_from_long (size), SCM_EOL);
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 (vmframe, n, iframe);
if (n != SCM_STACK (stack)->length)
{
scm_puts ("warning: stack count incorrect!\n", scm_current_error_port ());
SCM_STACK (stack)->length = n;
}
stack = scm_make_struct (scm_stack_type, SCM_INUM0, SCM_EOL);
SCM_SET_STACK_LENGTH (stack, n);
SCM_SET_STACK_ID (stack, id);
SCM_SET_STACK_FRAME (stack, frame);
/* Narrow the stack according to the arguments given to scm_make_stack. */
SCM_VALIDATE_REST_ARGUMENT (args);
while (n > 0 && !scm_is_null (args))
@ -311,12 +272,9 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
scm_is_integer (outer_cut) ? scm_to_int (outer_cut) : n,
scm_is_integer (outer_cut) ? 0 : outer_cut);
n = SCM_STACK (stack) -> length;
n = SCM_STACK_LENGTH (stack);
}
if (n > 0 && maxp)
iframe[n - 1].flags |= SCM_FRAMEF_OVERFLOW;
if (n > 0)
return stack;
else
@ -329,15 +287,15 @@ SCM_DEFINE (scm_stack_id, "stack-id", 1, 0, 0,
"Return the identifier given to @var{stack} by @code{start-stack}.")
#define FUNC_NAME s_scm_stack_id
{
SCM vmframe, *id_fp;
SCM frame, *id_fp;
if (scm_is_eq (stack, SCM_BOOL_T))
{
struct scm_vm *vp = SCM_VM_DATA (scm_the_vm ());
vmframe = scm_c_make_vm_frame (scm_the_vm (), vp->fp, vp->sp, vp->ip, 0);
frame = scm_c_make_frame (scm_the_vm (), vp->fp, vp->sp, vp->ip, 0);
}
else if (SCM_VM_FRAME_P (stack))
vmframe = stack;
frame = stack;
else if (SCM_CONTINUATIONP (stack))
{
scm_t_contregs *cont = SCM_CONTREGS (stack);
@ -346,13 +304,13 @@ SCM_DEFINE (scm_stack_id, "stack-id", 1, 0, 0,
struct scm_vm_cont *data;
vm_cont = scm_cdr (scm_car (cont->vm_conts));
data = SCM_VM_CONT_DATA (vm_cont);
vmframe = scm_c_make_vm_frame (vm_cont,
data->fp + data->reloc,
data->sp + data->reloc,
data->ip,
data->reloc);
frame = scm_c_make_frame (vm_cont,
data->fp + data->reloc,
data->sp + data->reloc,
data->ip,
data->reloc);
} else
vmframe = SCM_BOOL_F;
frame = SCM_BOOL_F;
}
else
{
@ -360,14 +318,14 @@ SCM_DEFINE (scm_stack_id, "stack-id", 1, 0, 0,
/* not reached */
}
return stack_id_with_fp (vmframe, &id_fp);
return stack_id_with_fp (frame, &id_fp);
}
#undef FUNC_NAME
static SCM
stack_id_with_fp (SCM vmframe, SCM **fp)
stack_id_with_fp (SCM frame, SCM **fp)
{
SCM holder = SCM_VM_FRAME_STACK_HOLDER (vmframe);
SCM holder = SCM_VM_FRAME_STACK_HOLDER (frame);
if (SCM_VM_CONT_P (holder))
{
@ -387,10 +345,18 @@ SCM_DEFINE (scm_stack_ref, "stack-ref", 2, 0, 0,
#define FUNC_NAME s_scm_stack_ref
{
unsigned long int c_index;
SCM frame;
SCM_VALIDATE_STACK (1, stack);
c_index = scm_to_unsigned_integer (index, 0, SCM_STACK_LENGTH(stack)-1);
return scm_cons (stack, index);
frame = SCM_STACK_FRAME (stack);
while (c_index--)
{
frame = scm_c_frame_prev (frame);
while (SCM_PROGRAM_IS_BOOT (scm_frame_procedure (frame)))
frame = scm_c_frame_prev (frame);
}
return frame;
}
#undef FUNC_NAME
@ -400,134 +366,7 @@ SCM_DEFINE (scm_stack_length, "stack-length", 1, 0, 0,
#define FUNC_NAME s_scm_stack_length
{
SCM_VALIDATE_STACK (1, stack);
return scm_from_int (SCM_STACK_LENGTH (stack));
}
#undef FUNC_NAME
/* Frames
*/
SCM_DEFINE (scm_frame_p, "frame?", 1, 0, 0,
(SCM obj),
"Return @code{#t} if @var{obj} is a stack frame.")
#define FUNC_NAME s_scm_frame_p
{
return scm_from_bool(SCM_FRAMEP (obj));
}
#undef FUNC_NAME
SCM_DEFINE (scm_frame_number, "frame-number", 1, 0, 0,
(SCM frame),
"Return the frame number of @var{frame}.")
#define FUNC_NAME s_scm_frame_number
{
SCM_VALIDATE_FRAME (1, frame);
return scm_from_int (SCM_FRAME_NUMBER (frame));
}
#undef FUNC_NAME
SCM_DEFINE (scm_frame_source, "frame-source", 1, 0, 0,
(SCM frame),
"Return the source of @var{frame}.")
#define FUNC_NAME s_scm_frame_source
{
SCM_VALIDATE_FRAME (1, frame);
return SCM_FRAME_SOURCE (frame);
}
#undef FUNC_NAME
SCM_DEFINE (scm_frame_procedure, "frame-procedure", 1, 0, 0,
(SCM frame),
"Return the procedure for @var{frame}, or @code{#f} if no\n"
"procedure is associated with @var{frame}.")
#define FUNC_NAME s_scm_frame_procedure
{
SCM_VALIDATE_FRAME (1, frame);
return (SCM_FRAME_PROC_P (frame)
? SCM_FRAME_PROC (frame)
: SCM_BOOL_F);
}
#undef FUNC_NAME
SCM_DEFINE (scm_frame_arguments, "frame-arguments", 1, 0, 0,
(SCM frame),
"Return the arguments of @var{frame}.")
#define FUNC_NAME s_scm_frame_arguments
{
SCM_VALIDATE_FRAME (1, frame);
return SCM_FRAME_ARGS (frame);
}
#undef FUNC_NAME
SCM_DEFINE (scm_frame_previous, "frame-previous", 1, 0, 0,
(SCM frame),
"Return the previous frame of @var{frame}, or @code{#f} if\n"
"@var{frame} is the first frame in its stack.")
#define FUNC_NAME s_scm_frame_previous
{
unsigned long int n;
SCM_VALIDATE_FRAME (1, frame);
n = scm_to_ulong (SCM_CDR (frame)) + 1;
if (n >= SCM_STACK_LENGTH (SCM_CAR (frame)))
return SCM_BOOL_F;
else
return scm_cons (SCM_CAR (frame), scm_from_ulong (n));
}
#undef FUNC_NAME
SCM_DEFINE (scm_frame_next, "frame-next", 1, 0, 0,
(SCM frame),
"Return the next frame of @var{frame}, or @code{#f} if\n"
"@var{frame} is the last frame in its stack.")
#define FUNC_NAME s_scm_frame_next
{
unsigned long int n;
SCM_VALIDATE_FRAME (1, frame);
n = scm_to_ulong (SCM_CDR (frame));
if (n == 0)
return SCM_BOOL_F;
else
return scm_cons (SCM_CAR (frame), scm_from_ulong (n - 1));
}
#undef FUNC_NAME
SCM_DEFINE (scm_frame_real_p, "frame-real?", 1, 0, 0,
(SCM frame),
"Return @code{#t} if @var{frame} is a real frame.")
#define FUNC_NAME s_scm_frame_real_p
{
SCM_VALIDATE_FRAME (1, frame);
return scm_from_bool(SCM_FRAME_REAL_P (frame));
}
#undef FUNC_NAME
SCM_DEFINE (scm_frame_procedure_p, "frame-procedure?", 1, 0, 0,
(SCM frame),
"Return @code{#t} if a procedure is associated with @var{frame}.")
#define FUNC_NAME s_scm_frame_procedure_p
{
SCM_VALIDATE_FRAME (1, frame);
return scm_from_bool(SCM_FRAME_PROC_P (frame));
}
#undef FUNC_NAME
SCM_DEFINE (scm_frame_evaluating_args_p, "frame-evaluating-args?", 1, 0, 0,
(SCM frame),
"Return @code{#t} if @var{frame} contains evaluated arguments.")
#define FUNC_NAME s_scm_frame_evaluating_args_p
{
SCM_VALIDATE_FRAME (1, frame);
return scm_from_bool(SCM_FRAME_EVAL_ARGS_P (frame));
}
#undef FUNC_NAME
SCM_DEFINE (scm_frame_overflow_p, "frame-overflow?", 1, 0, 0,
(SCM frame),
"Return @code{#t} if @var{frame} is an overflow frame.")
#define FUNC_NAME s_scm_frame_overflow_p
{
SCM_VALIDATE_FRAME (1, frame);
return scm_from_bool(SCM_FRAME_OVERFLOW_P (frame));
return scm_from_long (SCM_STACK_LENGTH (stack));
}
#undef FUNC_NAME