summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-12-03 11:03:39 +0100
committerAndy Wingo <wingo@pobox.com>2009-12-03 11:03:39 +0100
commit14aa25e410d49586c8ff9b4a80d2b6046b769905 (patch)
tree89a58226d6c994a23498585bf79546b0b4e1fabd
parentb2b554efd3fee1bd110cb286a1b185042db0a27f (diff)
downloadguile-14aa25e410d49586c8ff9b4a80d2b6046b769905.tar.gz
remove debug frames
* libguile/debug.h (scm_t_debug_frame): Remove this type, as it was internal to the old evaluator. (SCM_EVALFRAME, SCM_APPLYFRAME, SCM_VOIDFRAME, SCM_MACROEXPF) (SCM_TAILREC, SCM_TRACED_FRAME, SCM_ARGS_READY, SCM_DOVERFLOW) (SCM_MAX_FRAME_SIZE, SCM_FRAMETYPE) (SCM_EVALFRAMEP, SCM_APPLYFRAMEP, SCM_VOIDFRAMEP, SCM_MACROEXPFP) (SCM_TAILRECP, SCM_TRACED_FRAME_P, SCM_ARGS_READY_P, SCM_OVERFLOWP) (SCM_SET_MACROEXP, SCM_SET_TAILREC, SCM_SET_TRACED_FRAME) (SCM_SET_ARGSREADY, SCM_SET_OVERFLOW) (SCM_CLEAR_MACROEXP, SCM_CLEAR_TRACED_FRAME, SCM_CLEAR_ARGSREADY): Remove macro accessors to scm_t_debug_frame. (SCM_DEBUGOBJP, SCM_DEBUGOBJ_FRAME, SCM_SET_DEBUGOBJ_FRAME): (scm_debug_object_p, scm_make_debugobj): Remove debugobj accessors. (scm_i_unmemoize_expr): Remove unused declaration. * libguile/debug.c (scm_debug_options): No more max limit on frame sizes. (scm_start_stack): Just call out to scm_vm_call_with_new_stack. (scm_debug_object_p, scm_make_debugobj, scm_init_debug): No more debugobj smob type. * libguile/deprecated.h: * libguile/deprecated.c (scm_i_deprecated_last_debug_frame) (scm_last_debug_frame): Remove deprecated debug-frame bits. * libguile/stacks.c (scm_make_stack): Rework this function and its dependents to only walk VM frames. (scm_stack_id): Call out to the holder of the VM frame in question, which should be a VM or a VM continuation, for the stack ID. Currently this bit is stubbed out. (scm_last_stack_frame): Removed. It seems this is mainly useful for a debugger, and we need to rewrite the debugger to work on the Scheme level. * test-suite/tests/continuations.test ("continuations"): Remove test for last-stack-frame. * libguile/continuations.h (struct scm_t_contregs): * libguile/continuations.c (scm_make_continuation): (copy_stack_and_call, scm_i_with_continuation_barrier): No need to save and restore debug frames. * libguile/threads.h (scm_i_thread): Don't track debug frames. (scm_i_last_debug_frame, scm_i_set_last_debug_frame): Remove macro accessors. * libguile/threads.c (guilify_self_1): Don't track debug frames. * libguile/throw.c: No need to track debug frames in a jmpbuf. * libguile/vm-engine.c (vm_engine, VM_PUSH_DEBUG_FRAMES): Don't push debug frames. * libguile/vm.h: * libguile/vm.c (scm_vm_call_with_new_stack): New function. Currently stubbed out though.
-rw-r--r--libguile/continuations.c9
-rw-r--r--libguile/continuations.h7
-rw-r--r--libguile/debug.c50
-rw-r--r--libguile/debug.h67
-rw-r--r--libguile/deprecated.c8
-rw-r--r--libguile/deprecated.h2
-rw-r--r--libguile/stacks.c401
-rw-r--r--libguile/threads.c1
-rw-r--r--libguile/threads.h4
-rw-r--r--libguile/throw.c4
-rw-r--r--libguile/vm-engine.c21
-rw-r--r--libguile/vm.c6
-rw-r--r--libguile/vm.h1
-rw-r--r--test-suite/tests/continuations.test7
14 files changed, 88 insertions, 500 deletions
diff --git a/libguile/continuations.c b/libguile/continuations.c
index a0e2f6d4f..7013e3d66 100644
--- a/libguile/continuations.c
+++ b/libguile/continuations.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,2000,2001,2004, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000,2001,2004, 2006, 2008, 2009 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 License
@@ -84,7 +84,6 @@ scm_make_continuation (int *first)
continuation->dynenv = scm_i_dynwinds ();
continuation->throw_value = SCM_EOL;
continuation->root = thread->continuation_root;
- continuation->dframe = scm_i_last_debug_frame ();
src = thread->continuation_base;
#if ! SCM_STACK_GROWS_UP
src -= stack_size;
@@ -190,8 +189,6 @@ copy_stack_and_call (scm_t_contregs *continuation, SCM val,
data.dst = dst;
scm_i_dowinds (continuation->dynenv, delta, copy_stack, &data);
- scm_i_set_last_debug_frame (continuation->dframe);
-
continuation->throw_value = val;
SCM_I_LONGJMP (continuation->jmpbuf, 1);
}
@@ -276,17 +273,14 @@ scm_i_with_continuation_barrier (scm_t_catch_body body,
scm_i_thread *thread = SCM_I_CURRENT_THREAD;
SCM old_controot;
SCM_STACKITEM *old_contbase;
- scm_t_debug_frame *old_lastframe;
SCM result;
/* Establish a fresh continuation root.
*/
old_controot = thread->continuation_root;
old_contbase = thread->continuation_base;
- old_lastframe = thread->last_debug_frame;
thread->continuation_root = scm_cons (thread->handle, old_controot);
thread->continuation_base = &stack_item;
- thread->last_debug_frame = NULL;
/* Call FUNC inside a catch all. This is now guaranteed to return
directly and exactly once.
@@ -298,7 +292,6 @@ scm_i_with_continuation_barrier (scm_t_catch_body body,
/* Return to old continuation root.
*/
- thread->last_debug_frame = old_lastframe;
thread->continuation_base = old_contbase;
thread->continuation_root = old_controot;
diff --git a/libguile/continuations.h b/libguile/continuations.h
index 82cf178b0..8f7e38eba 100644
--- a/libguile/continuations.h
+++ b/libguile/continuations.h
@@ -3,7 +3,7 @@
#ifndef SCM_CONTINUATIONS_H
#define SCM_CONTINUATIONS_H
-/* Copyright (C) 1995,1996,2000,2001, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,2000,2001, 2006, 2008, 2009 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 License
@@ -64,11 +64,6 @@ typedef struct
*/
scm_t_ptrdiff offset;
- /* The most recently created debug frame on the live stack, before
- it was saved. This needs to be adjusted with OFFSET, above.
- */
- struct scm_t_debug_frame *dframe;
-
SCM_STACKITEM stack[1]; /* copied stack of size num_stack_items. */
} scm_t_contregs;
diff --git a/libguile/debug.c b/libguile/debug.c
index f0dd29a0a..91eef165b 100644
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -49,6 +49,7 @@
#include "libguile/fluids.h"
#include "libguile/programs.h"
#include "libguile/memoize.h"
+#include "libguile/vm.h"
#include "libguile/validate.h"
#include "libguile/debug.h"
@@ -73,7 +74,7 @@ SCM_DEFINE (scm_debug_options, "debug-options-interface", 0, 1, 0,
scm_dynwind_critical_section (SCM_BOOL_F);
ans = scm_options (setting, scm_debug_opts, FUNC_NAME);
- if (!(1 <= SCM_N_FRAMES && SCM_N_FRAMES <= SCM_MAX_FRAME_SIZE))
+ if (SCM_N_FRAMES < 1)
{
scm_options (ans, scm_debug_opts, FUNC_NAME);
SCM_OUT_OF_RANGE (1, setting);
@@ -246,52 +247,10 @@ SCM_DEFINE (scm_sys_start_stack, "%start-stack", 2, 0, 0,
"Call @var{thunk} on an evaluator stack tagged with @var{id}.")
#define FUNC_NAME s_scm_sys_start_stack
{
- SCM answer;
- scm_t_debug_frame vframe;
- scm_t_debug_info vframe_vect_body;
- vframe.prev = scm_i_last_debug_frame ();
- vframe.status = SCM_VOIDFRAME;
- vframe.vect = &vframe_vect_body;
- vframe.vect[0].id = id;
- scm_i_set_last_debug_frame (&vframe);
- answer = scm_call_0 (thunk);
- scm_i_set_last_debug_frame (vframe.prev);
- return answer;
+ return scm_vm_call_with_new_stack (scm_the_vm (), thunk, id);
}
#undef FUNC_NAME
-/* {Debug Objects}
- *
- * The debugging evaluator throws these on frame traps.
- */
-
-scm_t_bits scm_tc16_debugobj;
-
-static int
-debugobj_print (SCM obj, SCM port, scm_print_state *pstate SCM_UNUSED)
-{
- scm_puts ("#<debug-object ", port);
- scm_intprint ((long) SCM_DEBUGOBJ_FRAME (obj), 16, port);
- scm_putc ('>', port);
- return 1;
-}
-
-SCM_DEFINE (scm_debug_object_p, "debug-object?", 1, 0, 0,
- (SCM obj),
- "Return @code{#t} if @var{obj} is a debug object.")
-#define FUNC_NAME s_scm_debug_object_p
-{
- return scm_from_bool(SCM_DEBUGOBJP (obj));
-}
-#undef FUNC_NAME
-
-
-SCM
-scm_make_debugobj (scm_t_debug_frame *frame)
-{
- return scm_cell (scm_tc16_debugobj, (scm_t_bits) frame);
-}
-
/* Undocumented debugging procedure */
@@ -337,9 +296,6 @@ scm_init_debug ()
init_stack_limit ();
scm_init_opts (scm_debug_options, scm_debug_opts);
- scm_tc16_debugobj = scm_make_smob_type ("debug-object", 0);
- scm_set_smob_print (scm_tc16_debugobj, debugobj_print);
-
scm_add_feature ("debug-extensions");
#include "libguile/debug.x"
diff --git a/libguile/debug.h b/libguile/debug.h
index 24c6b9e94..2ca0b529a 100644
--- a/libguile/debug.h
+++ b/libguile/debug.h
@@ -29,22 +29,6 @@
#include "libguile/options.h"
-/*
- * Here comes some definitions for the debugging machinery.
- * It might seem strange to represent debug flags as ints,
- * but consider that any particular piece of code is normally
- * only interested in one flag at a time. This is then
- * the most efficient representation.
- */
-
-/* {Options}
- */
-
-/* scm_debug_opts is defined in eval.c.
- */
-
-
-
/* {Evaluator}
*/
@@ -55,57 +39,8 @@ typedef union scm_t_debug_info
SCM id;
} scm_t_debug_info;
-typedef struct scm_t_debug_frame
-{
- struct scm_t_debug_frame *prev;
- long status;
- scm_t_debug_info *vect;
- scm_t_debug_info *info;
-} scm_t_debug_frame;
-
-#define SCM_EVALFRAME (0L << 11)
-#define SCM_APPLYFRAME (1L << 11)
-#define SCM_VOIDFRAME (3L << 11)
-#define SCM_MACROEXPF (1L << 10)
-#define SCM_TAILREC (1L << 9)
-#define SCM_TRACED_FRAME (1L << 8)
-#define SCM_ARGS_READY (1L << 7)
-#define SCM_DOVERFLOW (1L << 6)
-#define SCM_MAX_FRAME_SIZE 63
-
-#define SCM_FRAMETYPE (3L << 11)
-
-#define SCM_EVALFRAMEP(x) (((x).status & SCM_FRAMETYPE) == SCM_EVALFRAME)
-#define SCM_APPLYFRAMEP(x) (((x).status & SCM_FRAMETYPE) == SCM_APPLYFRAME)
-#define SCM_VOIDFRAMEP(x) (((x).status & SCM_FRAMETYPE) == SCM_VOIDFRAME)
-#define SCM_OVERFLOWP(x) (((x).status & SCM_DOVERFLOW) != 0)
-#define SCM_ARGS_READY_P(x) (((x).status & SCM_ARGS_READY) != 0)
-#define SCM_TRACED_FRAME_P(x) (((x).status & SCM_TRACED_FRAME) != 0)
-#define SCM_TAILRECP(x) (((x).status & SCM_TAILREC) != 0)
-#define SCM_MACROEXPP(x) (((x).status & SCM_MACROEXPF) != 0)
-#define SCM_SET_OVERFLOW(x) ((x).status |= SCM_DOVERFLOW)
-#define SCM_SET_ARGSREADY(x) ((x).status |= SCM_ARGS_READY)
-#define SCM_CLEAR_ARGSREADY(x) ((x).status &= ~SCM_ARGS_READY)
-#define SCM_SET_TRACED_FRAME(x) ((x).status |= SCM_TRACED_FRAME)
-#define SCM_CLEAR_TRACED_FRAME(x) ((x).status &= ~SCM_TRACED_FRAME)
-#define SCM_SET_TAILREC(x) ((x).status |= SCM_TAILREC)
-#define SCM_SET_MACROEXP(x) ((x).status |= SCM_MACROEXPF)
-#define SCM_CLEAR_MACROEXP(x) ((x).status &= ~SCM_MACROEXPF)
-
-/* {Debug Objects}
- */
-
-SCM_API scm_t_bits scm_tc16_debugobj;
-
-#define SCM_DEBUGOBJP(x) \
- SCM_TYP16_PREDICATE (scm_tc16_debugobj, x)
-#define SCM_DEBUGOBJ_FRAME(x) \
- ((scm_t_debug_frame *) SCM_CELL_WORD_1 (x))
-#define SCM_SET_DEBUGOBJ_FRAME(x, f) SCM_SET_CELL_WORD_1 (x, f)
-
-SCM_API SCM scm_debug_object_p (SCM obj);
SCM_API SCM scm_reverse_lookup (SCM env, SCM data);
SCM_API SCM scm_sys_start_stack (SCM info_id, SCM thunk);
SCM_API SCM scm_procedure_module (SCM proc);
@@ -114,9 +49,7 @@ SCM_API SCM scm_procedure_name (SCM proc);
SCM_API SCM scm_with_traps (SCM thunk);
SCM_API SCM scm_evaluator_traps (SCM setting);
SCM_API SCM scm_debug_options (SCM setting);
-SCM_API SCM scm_make_debugobj (scm_t_debug_frame *debug);
-SCM_INTERNAL SCM scm_i_unmemoize_expr (SCM memoized);
SCM_INTERNAL void scm_init_debug (void);
#ifdef GUILE_DEBUG
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index 1f35d2a55..8b1fce81a 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -1416,14 +1416,6 @@ scm_i_deprecated_dynwinds (void)
return scm_i_dynwinds ();
}
-scm_t_debug_frame *
-scm_i_deprecated_last_debug_frame (void)
-{
- scm_c_issue_deprecation_warning
- ("scm_last_debug_frame is deprecated. Do not use it.");
- return scm_i_last_debug_frame ();
-}
-
SCM_STACKITEM *
scm_i_stack_base (void)
{
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index 5570a4386..1c8a6442b 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -499,7 +499,6 @@ SCM_DEPRECATED scm_t_array_dim *scm_i_array_dims (SCM a);
#define scm_cur_loadp scm_i_cur_loadp ()
#define scm_progargs scm_i_progargs ()
#define scm_dynwinds scm_i_deprecated_dynwinds ()
-#define scm_last_debug_frame scm_i_deprecated_last_debug_frame ()
#define scm_stack_base scm_i_stack_base ()
SCM_DEPRECATED SCM scm_i_cur_inp (void);
@@ -508,7 +507,6 @@ SCM_DEPRECATED SCM scm_i_cur_errp (void);
SCM_DEPRECATED SCM scm_i_cur_loadp (void);
SCM_DEPRECATED SCM scm_i_progargs (void);
SCM_DEPRECATED SCM scm_i_deprecated_dynwinds (void);
-SCM_DEPRECATED scm_t_debug_frame *scm_i_deprecated_last_debug_frame (void);
SCM_DEPRECATED SCM_STACKITEM *scm_i_stack_base (void);
/* Deprecated because it evaluates its argument twice.
diff --git a/libguile/stacks.c b/libguile/stacks.c
index 79fe2bda6..16c851f6e 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -44,32 +44,6 @@
/* {Frames and stacks}
*
- * The debugging evaluator creates debug frames on the stack. These
- * are linked from the innermost frame and outwards. The last frame
- * created can always be accessed as SCM_LAST_DEBUG_FRAME.
- * Continuations contain a pointer to the innermost debug frame on the
- * continuation stack.
- *
- * Each debug frame contains a set of flags and information about one
- * or more stack frames. The case of multiple frames occurs due to
- * tail recursion. The maximal number of stack frames which can be
- * recorded in one debug frame can be set dynamically with the debug
- * option FRAMES.
- *
- * Stack frame information is of two types: eval information (the
- * expression being evaluated and its environment) and apply
- * information (the procedure being applied and its arguments). A
- * stack frame normally corresponds to an eval/apply pair, but macros
- * and special forms (which are implemented as macros in Guile) only
- * have eval information and apply calls leads to apply only frames.
- *
- * Since we want to record the total stack information and later
- * manipulate this data at the scheme level in the debugger, we need
- * to transform it into a new representation. In the following code
- * section you'll find the functions implementing this data type.
- *
- * Representation:
- *
* The stack is represented as a struct with an id slot and a tail
* array of scm_t_info_frame structs.
*
@@ -104,248 +78,48 @@
-/* Some auxiliary functions for reading debug frames off the stack.
- */
+static SCM stack_id_with_fp (SCM vmframe, SCM **fp);
-/* Stacks often contain pointers to other items on the stack; for
- example, each scm_t_debug_frame structure contains a pointer to the
- next frame out. When we capture a continuation, we copy the stack
- into the heap, and just leave all the pointers unchanged. This
- makes it simple to restore the continuation --- just copy the stack
- back! However, if we retrieve a pointer from the heap copy to
- another item that was originally on the stack, we have to add an
- offset to the pointer to discover the new referent.
-
- If PTR is a pointer retrieved from a continuation, whose original
- target was on the stack, and OFFSET is the appropriate offset from
- the original stack to the continuation, then RELOC_MUMBLE (PTR,
- OFFSET) is a pointer to the copy in the continuation of the
- original referent, cast to an scm_debug_MUMBLE *. */
-#define RELOC_INFO(ptr, offset) \
- ((scm_t_debug_info *) ((SCM_STACKITEM *) (ptr) + (offset)))
-#define RELOC_FRAME(ptr, offset) \
- ((scm_t_debug_frame *) ((SCM_STACKITEM *) (ptr) + (offset)))
-
-/* 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.
+/* Count number of debug info frames on a stack, beginning with VMFRAME.
*/
static long
-stack_depth (scm_t_debug_frame *dframe, scm_t_ptrdiff offset, SCM vmframe,
- SCM *id)
+stack_depth (SCM vmframe, SCM *fp)
{
long n;
- for (n = 0;
- dframe && !SCM_VOIDFRAMEP (*dframe);
- dframe = RELOC_FRAME (dframe->prev, offset))
- {
- if (SCM_EVALFRAMEP (*dframe))
- {
- scm_t_debug_info *info = RELOC_INFO (dframe->info, offset);
- scm_t_debug_info *vect = RELOC_INFO (dframe->vect, offset);
- /* If current frame is a macro during expansion, we should
- skip the previously recorded macro transformer
- application frame. */
- if (SCM_MACROEXPP (*dframe) && n > 0)
- --n;
- n += (info - vect) / 2 + 1;
- /* Data in the apply part of an eval info frame comes from previous
- stack frame if the scm_t_debug_info vector is overflowed. */
- if ((((info - vect) & 1) == 0)
- && SCM_OVERFLOWP (*dframe)
- && !SCM_UNBNDP (info[1].a.proc))
- ++n;
- }
- else
- {
- scm_t_debug_info *vect = RELOC_INFO (dframe->vect, offset);
- if (SCM_PROGRAM_P (vect[0].a.proc))
- {
- if (!SCM_PROGRAM_IS_BOOT (vect[0].a.proc))
- /* Programs can end up in the debug stack via deval; but we just
- ignore those, because we know that the debugging VM engine
- pushes one dframe per invocation, with the boot program as
- the proc, so we only count those. */
- continue;
- /* count vmframe back to previous boot frame */
- for (; scm_is_true (vmframe); vmframe = scm_c_vm_frame_prev (vmframe))
- {
- if (!SCM_PROGRAM_IS_BOOT (scm_vm_frame_program (vmframe)))
- ++n;
- else
- { /* skip boot frame, cut out of the vm backtrace */
- vmframe = scm_c_vm_frame_prev (vmframe);
- break;
- }
- }
- }
- else
- ++n; /* increment for non-program apply frame */
- }
- }
- if (dframe && SCM_VOIDFRAMEP (*dframe))
- *id = RELOC_INFO(dframe->vect, offset)[0].id;
+ /* 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)))
+ ++n;
return n;
}
-/* Read debug info from DFRAME into IFRAME.
- */
-static void
-read_frame (scm_t_debug_frame *dframe, scm_t_ptrdiff offset,
- scm_t_info_frame *iframe)
-{
- scm_t_bits flags = SCM_UNPACK (SCM_INUM0); /* UGh. */
- if (SCM_EVALFRAMEP (*dframe))
- {
- scm_t_debug_info *info = RELOC_INFO (dframe->info, offset);
- scm_t_debug_info *vect = RELOC_INFO (dframe->vect, offset);
- if ((info - vect) & 1)
- {
- /* Debug.vect ends with apply info. */
- --info;
- if (!SCM_UNBNDP (info[1].a.proc))
- {
- flags |= SCM_FRAMEF_PROC;
- iframe->proc = info[1].a.proc;
- iframe->args = info[1].a.args;
- if (!SCM_ARGS_READY_P (*dframe))
- flags |= SCM_FRAMEF_EVAL_ARGS;
- }
- }
- }
- else
- {
- scm_t_debug_info *vect = RELOC_INFO (dframe->vect, offset);
- flags |= SCM_FRAMEF_PROC;
- iframe->proc = vect[0].a.proc;
- iframe->args = vect[0].a.args;
- }
- iframe->flags = flags;
-}
-
-/* Look up the first body form of the apply closure. We'll use this
- below to prevent it from being displayed.
-*/
-static SCM
-get_applybody ()
-{
- SCM var = scm_sym2var (scm_sym_apply, SCM_BOOL_F, SCM_BOOL_F);
- if (SCM_VARIABLEP (var) && SCM_CLOSUREP (SCM_VARIABLE_REF (var)))
- return SCM_CAR (SCM_CLOSURE_BODY (SCM_VARIABLE_REF (var)));
- else
- return SCM_UNDEFINED;
-}
-
-#define NEXT_FRAME(iframe, n, quit) \
-do { \
- ++iframe; \
- if (--n == 0) \
- goto quit; \
-} while (0)
-
-
/* Fill the scm_t_info_frame vector IFRAME with data from N stack frames
- * starting with the first stack frame represented by debug frame
- * DFRAME.
+ * starting with the first stack frame represented by VMFRAME.
*/
static scm_t_bits
-read_frames (scm_t_debug_frame *dframe, scm_t_ptrdiff offset,
- SCM vmframe, long n, scm_t_info_frame *iframes)
+read_frames (SCM vmframe, long n, scm_t_info_frame *iframes)
{
scm_t_info_frame *iframe = iframes;
- scm_t_debug_info *info, *vect;
- static SCM applybody = SCM_UNDEFINED;
-
- /* The value of applybody has to be setup after r4rs.scm has executed. */
- if (SCM_UNBNDP (applybody))
- applybody = get_applybody ();
- for (;
- dframe && !SCM_VOIDFRAMEP (*dframe) && n > 0;
- dframe = RELOC_FRAME (dframe->prev, offset))
+
+ for (; scm_is_true (vmframe);
+ vmframe = scm_c_vm_frame_prev (vmframe))
{
- read_frame (dframe, offset, iframe);
- if (SCM_EVALFRAMEP (*dframe))
- {
- /* If current frame is a macro during expansion, we should
- skip the previously recorded macro transformer
- application frame. */
- if (SCM_MACROEXPP (*dframe) && iframe > iframes)
- {
- *(iframe - 1) = *iframe;
- --iframe;
- ++n;
- }
- info = RELOC_INFO (dframe->info, offset);
- vect = RELOC_INFO (dframe->vect, offset);
- if ((info - vect) & 1)
- --info;
- /* Data in the apply part of an eval info frame comes from
- previous stack frame if the scm_t_debug_info vector is
- overflowed. */
- else if (SCM_OVERFLOWP (*dframe)
- && !SCM_UNBNDP (info[1].a.proc))
- {
- NEXT_FRAME (iframe, n, quit);
- iframe->flags = SCM_UNPACK(SCM_INUM0) | SCM_FRAMEF_PROC;
- iframe->proc = info[1].a.proc;
- iframe->args = info[1].a.args;
- }
- if (SCM_OVERFLOWP (*dframe))
- iframe->flags |= SCM_FRAMEF_OVERFLOW;
- info -= 2;
- NEXT_FRAME (iframe, n, quit);
- while (info >= vect)
- {
- if (!SCM_UNBNDP (info[1].a.proc))
- {
- iframe->flags = SCM_UNPACK(SCM_INUM0) | SCM_FRAMEF_PROC;
- iframe->proc = info[1].a.proc;
- iframe->args = info[1].a.args;
- }
- else
- iframe->flags = SCM_UNPACK (SCM_INUM0);
- iframe->source = SCM_BOOL_F;
- info -= 2;
- NEXT_FRAME (iframe, n, quit);
- }
- }
- else if (SCM_PROGRAM_P (iframe->proc))
+ if (SCM_PROGRAM_IS_BOOT (scm_vm_frame_program (vmframe)))
+ /* skip boot frame */
+ continue;
+ else
{
- if (!SCM_PROGRAM_IS_BOOT (iframe->proc))
- /* Programs can end up in the debug stack via deval; but we just
- ignore those, because we know that the debugging VM engine
- pushes one dframe per invocation, with the boot program as
- the proc, so we only count those. */
- continue;
- 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
- {
- /* 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)
+ break;
}
- else
- {
- NEXT_FRAME (iframe, n, quit);
- }
- quit:
- if (iframe > iframes)
- (iframe - 1) -> flags |= SCM_FRAMEF_REAL;
}
return iframe - iframes; /* Number of frames actually read */
}
@@ -448,11 +222,10 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
{
long n, size;
int maxp;
- scm_t_debug_frame *dframe;
scm_t_info_frame *iframe;
SCM vmframe;
- long offset = 0;
- SCM stack, id;
+ SCM stack;
+ SCM id, *id_fp;
SCM inner_cut, outer_cut;
/* Extract a pointer to the innermost frame of whatever object
@@ -460,24 +233,13 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
if (scm_is_eq (obj, SCM_BOOL_T))
{
struct scm_vm *vp = SCM_VM_DATA (scm_the_vm ());
- dframe = scm_i_last_debug_frame ();
vmframe = scm_c_make_vm_frame (scm_the_vm (), vp->fp, vp->sp, vp->ip, 0);
}
- else if (SCM_DEBUGOBJP (obj))
- {
- dframe = SCM_DEBUGOBJ_FRAME (obj);
- vmframe = SCM_BOOL_F;
- }
else if (SCM_VM_FRAME_P (obj))
- {
- dframe = NULL;
- vmframe = obj;
- }
+ vmframe = obj;
else if (SCM_CONTINUATIONP (obj))
{
scm_t_contregs *cont = SCM_CONTREGS (obj);
- offset = cont->offset;
- dframe = RELOC_FRAME (cont->dframe, offset);
if (!scm_is_null (cont->vm_conts))
{ SCM vm_cont;
struct scm_vm_cont *data;
@@ -497,12 +259,18 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
/* not reached */
}
+ if (scm_is_false (vmframe))
+ return SCM_BOOL_F;
+
+ /* Get ID of the stack corresponding to the given frame. */
+ id = stack_id_with_fp (vmframe, &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 (dframe, offset, vmframe, &id);
+ n = stack_depth (vmframe, id_fp);
/* FIXME: redo maxp? */
size = n * SCM_FRAME_N_SLOTS;
@@ -514,7 +282,7 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
SCM_STACK (stack) -> length = n;
/* Translate the current chain of stack frames into debugging information. */
- n = read_frames (dframe, offset, vmframe, n, iframe);
+ n = read_frames (vmframe, n, iframe);
if (n != SCM_STACK (stack)->length)
{
scm_puts ("warning: stack count incorrect!\n", scm_current_error_port ());
@@ -561,39 +329,58 @@ 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_t_debug_frame *dframe;
- long offset = 0;
+ SCM vmframe, *id_fp;
+
if (scm_is_eq (stack, SCM_BOOL_T))
{
- dframe = scm_i_last_debug_frame ();
- }
- else if (SCM_DEBUGOBJP (stack))
- {
- dframe = SCM_DEBUGOBJ_FRAME (stack);
+ 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);
}
+ else if (SCM_VM_FRAME_P (stack))
+ vmframe = stack;
else if (SCM_CONTINUATIONP (stack))
{
scm_t_contregs *cont = SCM_CONTREGS (stack);
- offset = cont->offset;
- dframe = RELOC_FRAME (cont->dframe, offset);
- }
- else if (SCM_STACKP (stack))
- {
- return SCM_STACK (stack) -> id;
+ if (!scm_is_null (cont->vm_conts))
+ { SCM vm_cont;
+ 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);
+ } else
+ vmframe = SCM_BOOL_F;
}
else
{
- SCM_WRONG_TYPE_ARG (1, stack);
+ SCM_WRONG_TYPE_ARG (SCM_ARG1, stack);
+ /* not reached */
}
- while (dframe && !SCM_VOIDFRAMEP (*dframe))
- dframe = RELOC_FRAME (dframe->prev, offset);
- if (dframe && SCM_VOIDFRAMEP (*dframe))
- return RELOC_INFO (dframe->vect, offset)[0].id;
- return SCM_BOOL_F;
+ return stack_id_with_fp (vmframe, &id_fp);
}
#undef FUNC_NAME
+static SCM
+stack_id_with_fp (SCM vmframe, SCM **fp)
+{
+ SCM holder = SCM_VM_FRAME_STACK_HOLDER (vmframe);
+
+ if (SCM_VM_CONT_P (holder))
+ {
+ *fp = NULL;
+ return SCM_BOOL_F;
+ }
+ else
+ {
+ *fp = NULL;
+ return SCM_BOOL_F;
+ }
+}
+
SCM_DEFINE (scm_stack_ref, "stack-ref", 2, 0, 0,
(SCM stack, SCM index),
"Return the @var{index}'th frame from @var{stack}.")
@@ -629,46 +416,6 @@ SCM_DEFINE (scm_frame_p, "frame?", 1, 0, 0,
}
#undef FUNC_NAME
-SCM_DEFINE (scm_last_stack_frame, "last-stack-frame", 1, 0, 0,
- (SCM obj),
- "Return the last (innermost) frame of @var{obj}, which must be\n"
- "either a debug object or a continuation.")
-#define FUNC_NAME s_scm_last_stack_frame
-{
- scm_t_debug_frame *dframe;
- long offset = 0;
- SCM stack;
-
- if (SCM_DEBUGOBJP (obj))
- {
- dframe = SCM_DEBUGOBJ_FRAME (obj);
- }
- else if (SCM_CONTINUATIONP (obj))
- {
- scm_t_contregs *cont = SCM_CONTREGS (obj);
- offset = cont->offset;
- dframe = RELOC_FRAME (cont->dframe, offset);
- }
- else
- {
- SCM_WRONG_TYPE_ARG (1, obj);
- /* not reached */
- }
-
- if (!dframe || SCM_VOIDFRAMEP (*dframe))
- return SCM_BOOL_F;
-
- stack = scm_make_struct (scm_stack_type, scm_from_int (SCM_FRAME_N_SLOTS),
- SCM_EOL);
- SCM_STACK (stack) -> length = 1;
- SCM_STACK (stack) -> frames = &SCM_STACK (stack) -> tail[0];
- read_frame (dframe, offset,
- (scm_t_info_frame *) &SCM_STACK (stack) -> frames[0]);
-
- return scm_cons (stack, SCM_INUM0);
-}
-#undef FUNC_NAME
-
SCM_DEFINE (scm_frame_number, "frame-number", 1, 0, 0,
(SCM frame),
"Return the frame number of @var{frame}.")
diff --git a/libguile/threads.c b/libguile/threads.c
index 1527e01d1..bf2fdb226 100644
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -338,7 +338,6 @@ guilify_self_1 (SCM_STACKITEM *base)
t->block_asyncs = 1;
t->pending_asyncs = 1;
t->critical_section_level = 0;
- t->last_debug_frame = NULL;
t->base = base;
#ifdef __ia64__
/* Calculate and store off the base of this thread's register
diff --git a/libguile/threads.h b/libguile/threads.h
index 5afe45faa..4b06590e4 100644
--- a/libguile/threads.h
+++ b/libguile/threads.h
@@ -79,7 +79,6 @@ typedef struct scm_i_thread {
/* Other thread local things.
*/
SCM dynamic_state;
- scm_t_debug_frame *last_debug_frame;
SCM dynwinds;
/* For system asyncs.
@@ -209,9 +208,6 @@ SCM_INTERNAL scm_i_pthread_key_t scm_i_thread_key;
# define scm_i_dynwinds() (SCM_I_CURRENT_THREAD->dynwinds)
# define scm_i_set_dynwinds(w) (SCM_I_CURRENT_THREAD->dynwinds = (w))
-# define scm_i_last_debug_frame() (SCM_I_CURRENT_THREAD->last_debug_frame)
-# define scm_i_set_last_debug_frame(f) \
- (SCM_I_CURRENT_THREAD->last_debug_frame = (f))
#endif /* BUILDING_LIBGUILE */
diff --git a/libguile/throw.c b/libguile/throw.c
index 14153cf91..051f6d382 100644
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -62,8 +62,6 @@ static scm_t_bits tc16_jmpbuffer;
#define JBJMPBUF(OBJ) ((scm_i_jmp_buf *) SCM_CELL_WORD_1 (OBJ))
#define SETJBJMPBUF(x, v) (SCM_SET_CELL_WORD_1 ((x), (scm_t_bits) (v)))
-#define SCM_JBDFRAME(x) ((scm_t_debug_frame *) SCM_CELL_WORD_2 (x))
-#define SCM_SETJBDFRAME(x, v) (SCM_SET_CELL_WORD_2 ((x), (scm_t_bits) (v)))
#define SCM_JBPREUNWIND(x) ((struct pre_unwind_data *) SCM_CELL_WORD_3 (x))
#define SCM_SETJBPREUNWIND(x, v) (SCM_SET_CELL_WORD_3 ((x), (scm_t_bits) (v)))
@@ -187,7 +185,6 @@ scm_c_catch (SCM tag,
answer = SCM_EOL;
scm_i_set_dynwinds (scm_acons (tag, jmpbuf, scm_i_dynwinds ()));
SETJBJMPBUF(jmpbuf, &jbr.buf);
- SCM_SETJBDFRAME(jmpbuf, scm_i_last_debug_frame ());
pre_unwind.handler = pre_unwind_handler;
pre_unwind.handler_data = pre_unwind_handler_data;
@@ -888,7 +885,6 @@ scm_ithrow (SCM key, SCM args, int noreturn SCM_UNUSED)
jbr = (struct jmp_buf_and_retval *)JBJMPBUF (jmpbuf);
jbr->throw_tag = key;
jbr->retval = args;
- scm_i_set_last_debug_frame (SCM_JBDFRAME (jmpbuf));
SCM_I_LONGJMP (*JBJMPBUF (jmpbuf), 1);
}
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 03993ec7e..2f3320c29 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -23,13 +23,11 @@
#define VM_USE_CLOCK 0 /* Bogoclock */
#define VM_CHECK_OBJECT 1 /* Check object table */
#define VM_CHECK_FREE_VARIABLES 1 /* Check free variable access */
-#define VM_PUSH_DEBUG_FRAMES 0 /* Push frames onto the evaluator debug stack */
#elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE)
#define VM_USE_HOOKS 1
#define VM_USE_CLOCK 1
#define VM_CHECK_OBJECT 1
#define VM_CHECK_FREE_VARIABLES 1
-#define VM_PUSH_DEBUG_FRAMES 1
#else
#error unknown debug engine VM_ENGINE
#endif
@@ -66,12 +64,6 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
static void **jump_table = NULL;
#endif
-#if VM_PUSH_DEBUG_FRAMES
- scm_t_debug_frame debug;
- scm_t_debug_info debug_vect_body;
- debug.status = SCM_VOIDFRAME;
-#endif
-
#ifdef HAVE_LABELS_AS_VALUES
if (SCM_UNLIKELY (!jump_table))
{
@@ -95,15 +87,6 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
/* Boot program */
program = vm_make_boot_program (nargs);
-#if VM_PUSH_DEBUG_FRAMES
- debug.prev = scm_i_last_debug_frame ();
- debug.status = SCM_APPLYFRAME;
- debug.vect = &debug_vect_body;
- debug.vect[0].a.proc = program; /* the boot program */
- debug.vect[0].a.args = SCM_EOL;
- scm_i_set_last_debug_frame (&debug);
-#endif
-
/* Initial frame */
CACHE_REGISTER ();
PUSH ((SCM)fp); /* dynamic link */
@@ -147,9 +130,6 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
vm_done:
SYNC_ALL ();
-#if VM_PUSH_DEBUG_FRAMES
- scm_i_set_last_debug_frame (debug.prev);
-#endif
return finish_args;
/* Errors */
@@ -278,7 +258,6 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
#undef VM_USE_CLOCK
#undef VM_CHECK_OBJECT
#undef VM_CHECK_FREE_VARIABLE
-#undef VM_PUSH_DEBUG_FRAMES
/*
Local Variables:
diff --git a/libguile/vm.c b/libguile/vm.c
index 247bb7d09..4652cc03d 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -531,6 +531,12 @@ scm_vm_apply (SCM vm, SCM program, SCM args)
}
#undef FUNC_NAME
+SCM
+scm_vm_call_with_new_stack (SCM vm, SCM thunk, SCM id)
+{
+ return scm_c_vm_run (vm, thunk, NULL, 0);
+}
+
/* Scheme interface */
SCM_DEFINE (scm_vm_version, "vm-version", 0, 0, 0,
diff --git a/libguile/vm.h b/libguile/vm.h
index eace1cb69..8ec26826d 100644
--- a/libguile/vm.h
+++ b/libguile/vm.h
@@ -65,6 +65,7 @@ SCM_API SCM scm_the_vm ();
SCM_API SCM scm_make_vm (void);
SCM_API SCM scm_vm_apply (SCM vm, SCM program, SCM args);
SCM_API SCM scm_c_vm_run (SCM vm, SCM program, SCM *argv, int nargs);
+SCM_API SCM scm_vm_call_with_new_stack (SCM vm, SCM thunk, SCM id);
SCM_API SCM scm_vm_option_ref (SCM vm, SCM key);
SCM_API SCM scm_vm_option_set_x (SCM vm, SCM key, SCM val);
diff --git a/test-suite/tests/continuations.test b/test-suite/tests/continuations.test
index d96274e32..f6db40e58 100644
--- a/test-suite/tests/continuations.test
+++ b/test-suite/tests/continuations.test
@@ -1,7 +1,7 @@
;;;; -*- scheme -*-
;;;; continuations.test --- test suite for continutations
;;;;
-;;;; Copyright (C) 2003, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 2003, 2006, 2009 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
@@ -87,9 +87,6 @@
(pass-if "get a continuation's stack ID"
(let ((id (call-with-current-continuation stack-id)))
- (or (boolean? id) (symbol? id))))
-
- (pass-if "get a continuation's innermost frame"
- (pair? (call-with-current-continuation last-stack-frame))))
+ (or (boolean? id) (symbol? id)))))
)