summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/debug.c2
-rw-r--r--libguile/debug.h3
-rw-r--r--libguile/eval.c30
-rw-r--r--libguile/stacks.c62
4 files changed, 59 insertions, 38 deletions
diff --git a/libguile/debug.c b/libguile/debug.c
index b989d2d65..ac65c723c 100644
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -316,6 +316,7 @@ scm_m_start_stack (exp, env)
{
SCM answer;
scm_debug_frame vframe;
+ scm_debug_info vframe_vect_body;
exp = SCM_CDR (exp);
SCM_ASSERT (SCM_NIMP (exp)
&& SCM_ECONSP (exp)
@@ -327,6 +328,7 @@ scm_m_start_stack (exp, env)
s_start_stack);
vframe.prev = scm_last_debug_frame;
vframe.status = SCM_VOIDFRAME;
+ vframe.vect = &vframe_vect_body;
vframe.vect[0].id = scm_eval_car (exp, env);
scm_last_debug_frame = &vframe;
answer = scm_eval_car (SCM_CDR (exp), env);
diff --git a/libguile/debug.h b/libguile/debug.h
index 99d526e1b..f54156310 100644
--- a/libguile/debug.h
+++ b/libguile/debug.h
@@ -124,7 +124,8 @@ typedef struct scm_debug_frame
{
struct scm_debug_frame *prev;
long status;
- scm_debug_info vect[1];
+ scm_debug_info *vect;
+ scm_debug_info *info;
} scm_debug_frame;
#ifndef USE_THREADS
diff --git a/libguile/eval.c b/libguile/eval.c
index 6fee7e969..56a57e18b 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -1178,7 +1178,7 @@ scm_eval_args (l, env)
SCM_SET_TRACED_FRAME (debug);\
if (SCM_CHEAPTRAPS_P)\
{\
- tmp = scm_make_debugobj ((scm_debug_frame *) &debug);\
+ tmp = scm_make_debugobj (&debug);\
scm_ithrow (scm_i_apply_frame, scm_cons2 (tmp, tail, SCM_EOL), 0);\
}\
else\
@@ -1314,17 +1314,15 @@ SCM_CEVAL (x, env)
} t;
SCM proc, arg2;
#ifdef DEVAL
- struct
- {
- scm_debug_frame *prev;
- long status;
- scm_debug_info vect[scm_debug_eframe_size];
- scm_debug_info *info;
- } debug;
+ scm_debug_frame debug;
+ scm_debug_info *debug_info_end;
debug.prev = scm_last_debug_frame;
debug.status = scm_debug_eframe_size;
- debug.info = &debug.vect[0];
- scm_last_debug_frame = (scm_debug_frame *) &debug;
+ debug.vect = (scm_debug_info *) alloca (scm_debug_eframe_size
+ * sizeof (debug.vect[0]));
+ debug.info = debug.vect;
+ debug_info_end = debug.vect + scm_debug_eframe_size;
+ scm_last_debug_frame = &debug;
#endif
#ifdef EVAL_STACK_CHECKING
if (SCM_STACK_OVERFLOW_P ((SCM_STACKITEM *) &proc)
@@ -1362,7 +1360,7 @@ nextframe:
SCM_CLEAR_ARGSREADY (debug);
if (SCM_OVERFLOWP (debug))
--debug.info;
- else if (++debug.info == (scm_debug_info *) &debug.info)
+ else if (++debug.info >= debug_info_end)
{
SCM_SET_OVERFLOW (debug);
debug.info -= 2;
@@ -1378,7 +1376,7 @@ start:
SCM_ENTER_FRAME_P = 0;
SCM_RESET_DEBUG_MODE;
if (SCM_CHEAPTRAPS_P)
- t.arg1 = scm_make_debugobj ((scm_debug_frame *) &debug);
+ t.arg1 = scm_make_debugobj (&debug);
else
{
scm_make_cont (&t.arg1);
@@ -2163,7 +2161,7 @@ exit:
SCM_RESET_DEBUG_MODE;
SCM_CLEAR_TRACED_FRAME (debug);
if (SCM_CHEAPTRAPS_P)
- t.arg1 = scm_make_debugobj ((scm_debug_frame *) &debug);
+ t.arg1 = scm_make_debugobj (&debug);
else
{
scm_make_cont (&t.arg1);
@@ -2286,8 +2284,10 @@ SCM_APPLY (proc, arg1, args)
#ifdef DEBUG_EXTENSIONS
#ifdef DEVAL
scm_debug_frame debug;
+ scm_debug_info debug_vect_body;
debug.prev = scm_last_debug_frame;
debug.status = SCM_APPLYFRAME;
+ debug.vect = &debug_vect_body;
debug.vect[0].a.proc = proc;
debug.vect[0].a.args = SCM_EOL;
scm_last_debug_frame = &debug;
@@ -2321,7 +2321,7 @@ SCM_APPLY (proc, arg1, args)
SCM_ENTER_FRAME_P = 0;
SCM_RESET_DEBUG_MODE;
if (SCM_CHEAPTRAPS_P)
- tmp = scm_make_debugobj ((scm_debug_frame *) &debug);
+ tmp = scm_make_debugobj (&debug);
else
{
scm_make_cont (&tmp);
@@ -2468,7 +2468,7 @@ exit:
SCM_RESET_DEBUG_MODE;
SCM_CLEAR_TRACED_FRAME (debug);
if (SCM_CHEAPTRAPS_P)
- arg1 = scm_make_debugobj ((scm_debug_frame *) &debug);
+ arg1 = scm_make_debugobj (&debug);
else
{
scm_make_cont (&arg1);
diff --git a/libguile/stacks.c b/libguile/stacks.c
index fc595a3bc..f17221ca7 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -118,6 +118,26 @@
/* Some auxiliary functions for reading debug frames off the stack.
*/
+/* Stacks often contain pointers to other items on the stack; for
+ example, each scm_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_debug_info *) ((SCM_STACKITEM *) (ptr) + (offset)))
+#define RELOC_FRAME(ptr, offset) \
+ ((scm_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.
@@ -135,13 +155,12 @@ stack_depth (dframe, offset, id, maxp)
scm_debug_info *info;
for (n = 0;
dframe && !SCM_VOIDFRAMEP (*dframe) && n < max_depth;
- dframe = (scm_debug_frame *) ((SCM_STACKITEM *) dframe->prev + offset))
+ dframe = RELOC_FRAME (dframe->prev, offset))
{
if (SCM_EVALFRAMEP (*dframe))
{
size = dframe->status & SCM_MAX_FRAME_SIZE;
- info = (scm_debug_info *) (*((SCM_STACKITEM **) &dframe->vect[size])
- + offset);
+ info = RELOC_INFO (dframe->info, offset);
n += (info - dframe->vect) / 2 + 1;
/* Data in the apply part of an eval info frame comes from previous
stack frame if the scm_debug_info vector is overflowed. */
@@ -175,8 +194,7 @@ read_frame (dframe, offset, iframe)
if (SCM_EVALFRAMEP (*dframe))
{
size = dframe->status & SCM_MAX_FRAME_SIZE;
- info = (scm_debug_info *) (*((SCM_STACKITEM **) &dframe->vect[size])
- + offset);
+ info = RELOC_INFO (dframe->info, offset);
if ((info - dframe->vect) & 1)
{
/* Debug.vect ends with apply info. */
@@ -228,14 +246,13 @@ read_frames (dframe, offset, n, iframes)
for (;
dframe && !SCM_VOIDFRAMEP (*dframe) && n > 0;
- dframe = (scm_debug_frame *) ((SCM_STACKITEM *) dframe->prev + offset))
+ dframe = RELOC_FRAME (dframe->prev, offset))
{
read_frame (dframe, offset, iframe);
if (SCM_EVALFRAMEP (*dframe))
{
size = dframe->status & SCM_MAX_FRAME_SIZE;
- info = (scm_debug_info *) (*((SCM_STACKITEM **) &dframe->vect[size])
- + offset);
+ info = RELOC_INFO (dframe->info, offset);
if ((info - dframe->vect) & 1)
--info;
/* Data in the apply part of an eval info frame comes from
@@ -354,8 +371,7 @@ scm_make_stack (args)
#ifndef STACK_GROWS_UP
offset += SCM_LENGTH (obj);
#endif
- dframe = (scm_debug_frame *) ((SCM_STACKITEM *) SCM_DFRAME (obj)
- + offset);
+ dframe = RELOC_FRAME (SCM_DFRAME (obj), offset);
}
else
{
@@ -380,8 +396,7 @@ scm_make_stack (args)
SCM_STACK (stack) -> frames = iframe;
/* Translate the current chain of stack frames into debugging information. */
- read_frames ((scm_debug_frame *) ((SCM_STACKITEM *) dframe + offset),
- offset, n, iframe);
+ read_frames (RELOC_FRAME (dframe, offset), offset, n, iframe);
/* Narrow the stack according to the arguments given to scm_make_stack. */
while (n > 0 && SCM_NIMP (args) && SCM_CONSP (args))
@@ -436,15 +451,14 @@ scm_stack_id (stack)
#ifndef STACK_GROWS_UP
offset += SCM_LENGTH (stack);
#endif
- dframe = (scm_debug_frame *) ((SCM_STACKITEM *) SCM_DFRAME (stack)
- + offset);
+ dframe = RELOC_FRAME (SCM_DFRAME (stack), offset);
}
else if (SCM_STACKP (stack))
return SCM_STACK (stack) -> id;
else scm_wrong_type_arg (s_stack_id, SCM_ARG1, stack);
}
while (dframe && !SCM_VOIDFRAMEP (*dframe))
- dframe = (scm_debug_frame *) ((SCM_STACKITEM *) dframe->prev + offset);
+ dframe = RELOC_FRAME (dframe->prev, offset);
if (dframe && SCM_VOIDFRAMEP (*dframe))
return dframe->vect[0].id;
return SCM_BOOL_F;
@@ -513,7 +527,7 @@ scm_last_stack_frame (obj)
#ifndef STACK_GROWS_UP
offset += SCM_LENGTH (obj);
#endif
- dframe = (scm_debug_frame *) ((SCM_STACKITEM *) SCM_DFRAME (obj) + offset);
+ dframe = RELOC_FRAME (SCM_DFRAME (obj), offset);
}
else
{
@@ -524,10 +538,12 @@ scm_last_stack_frame (obj)
if (!dframe || SCM_VOIDFRAMEP (*dframe))
return SCM_BOOL_F;
- stack = scm_make_struct (scm_stack_type, SCM_MAKINUM (SCM_FRAME_N_SLOTS), SCM_EOL);
+ stack = scm_make_struct (scm_stack_type, SCM_MAKINUM (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_info_frame *) &SCM_STACK (stack) -> frames[0]);
+ read_frame (dframe, offset,
+ (scm_info_frame *) &SCM_STACK (stack) -> frames[0]);
return scm_cons (stack, SCM_INUM0);;
}
@@ -671,10 +687,12 @@ scm_init_stacks ()
{
SCM vtable;
SCM vtable_layout = scm_make_struct_layout (scm_nullstr);
- SCM stack_layout = scm_make_struct_layout (scm_makfrom0str (SCM_STACK_LAYOUT));
+ SCM stack_layout
+ = scm_make_struct_layout (scm_makfrom0str (SCM_STACK_LAYOUT));
vtable = scm_make_vtable_vtable (vtable_layout, SCM_INUM0, SCM_EOL);
- scm_stack_type = scm_permanent_object (scm_make_struct (vtable,
- SCM_INUM0,
- scm_cons (stack_layout, SCM_EOL)));
+ scm_stack_type
+ = scm_permanent_object (scm_make_struct (vtable, SCM_INUM0,
+ scm_cons (stack_layout,
+ SCM_EOL)));
#include "stacks.x"
}