diff options
-rw-r--r-- | libguile/debug.c | 2 | ||||
-rw-r--r-- | libguile/debug.h | 3 | ||||
-rw-r--r-- | libguile/eval.c | 30 | ||||
-rw-r--r-- | libguile/stacks.c | 62 |
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" } |