summaryrefslogtreecommitdiff
path: root/libguile/stacks.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/stacks.c')
-rw-r--r--libguile/stacks.c92
1 files changed, 44 insertions, 48 deletions
diff --git a/libguile/stacks.c b/libguile/stacks.c
index 37a9161cd..c3ea624ce 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -95,23 +95,21 @@ stack_depth (SCM frame)
* encountered.
*/
-static SCM
+static SCM*
find_prompt (SCM key)
{
- SCM winds;
- for (winds = scm_i_dynwinds (); scm_is_pair (winds); winds = scm_cdr (winds))
- {
- SCM elt = scm_car (winds);
- if (SCM_PROMPT_P (elt) && scm_is_eq (SCM_PROMPT_TAG (elt), key))
- return elt;
- }
- scm_misc_error ("make-stack", "Prompt tag not found while narrowing stack",
- scm_list_1 (key));
- return SCM_BOOL_F; /* not reached */
+ SCM *fp;
+
+ if (!scm_dynstack_find_prompt (&SCM_I_CURRENT_THREAD->dynstack, key,
+ NULL, &fp, NULL, NULL, NULL))
+ scm_misc_error ("make-stack", "Prompt tag not found while narrowing stack",
+ scm_list_1 (key));
+
+ return fp;
}
static void
-narrow_stack (SCM stack, long inner, SCM inner_key, long outer, SCM outer_key)
+narrow_stack (SCM stack, SCM inner_cut, SCM outer_cut)
{
unsigned long int len;
SCM frame;
@@ -120,75 +118,75 @@ narrow_stack (SCM stack, long inner, SCM inner_key, long outer, SCM outer_key)
frame = SCM_STACK_FRAME (stack);
/* Cut inner part. */
- if (scm_is_true (scm_procedure_p (inner_key)))
+ if (scm_is_true (scm_procedure_p (inner_cut)))
{
/* Cut until the given procedure is seen. */
- for (; inner && len ; --inner)
+ for (; len ;)
{
SCM proc = scm_frame_procedure (frame);
len--;
frame = scm_frame_previous (frame);
- if (scm_is_eq (proc, inner_key))
+ if (scm_is_eq (proc, inner_cut))
break;
}
}
- else if (scm_is_symbol (inner_key))
- {
- /* Cut until the given prompt tag is seen. FIXME, assumes prompt tags are
- symbols. */
- SCM prompt = find_prompt (inner_key);
- for (; len; len--, frame = scm_frame_previous (frame))
- if (SCM_PROMPT_REGISTERS (prompt)->fp
- == SCM_VM_FRAME_FP (frame) - SCM_VM_FRAME_OFFSET (frame))
- break;
- }
- else
+ else if (scm_is_integer (inner_cut))
{
/* Cut specified number of frames. */
+ long inner = scm_to_int (inner_cut);
+
for (; inner && len; --inner)
{
len--;
frame = scm_frame_previous (frame);
}
}
+ else
+ {
+ /* Cut until the given prompt tag is seen. */
+ SCM *fp = find_prompt (inner_cut);
+ for (; len; len--, frame = scm_frame_previous (frame))
+ if (fp == SCM_VM_FRAME_FP (frame) - SCM_VM_FRAME_OFFSET (frame))
+ break;
+ }
SCM_SET_STACK_LENGTH (stack, len);
SCM_SET_STACK_FRAME (stack, frame);
/* Cut outer part. */
- if (scm_is_true (scm_procedure_p (outer_key)))
+ if (scm_is_true (scm_procedure_p (outer_cut)))
{
/* Cut until the given procedure is seen. */
- for (; outer && len ; --outer)
+ for (; len ;)
{
frame = scm_stack_ref (stack, scm_from_long (len - 1));
len--;
- if (scm_is_eq (scm_frame_procedure (frame), outer_key))
+ if (scm_is_eq (scm_frame_procedure (frame), outer_cut))
break;
}
}
- else if (scm_is_symbol (outer_key))
+ else if (scm_is_integer (outer_cut))
+ {
+ /* Cut specified number of frames. */
+ long outer = scm_to_int (outer_cut);
+
+ if (outer < len)
+ len -= outer;
+ else
+ len = 0;
+ }
+ else
{
- /* Cut until the given prompt tag is seen. FIXME, assumes prompt tags are
- symbols. */
- SCM prompt = find_prompt (outer_key);
+ /* Cut until the given prompt tag is seen. */
+ SCM *fp = find_prompt (outer_cut);
while (len)
{
frame = scm_stack_ref (stack, scm_from_long (len - 1));
len--;
- if (SCM_PROMPT_REGISTERS (prompt)->fp
- == SCM_VM_FRAME_FP (frame) - SCM_VM_FRAME_OFFSET (frame))
+ if (fp == SCM_VM_FRAME_FP (frame) - SCM_VM_FRAME_OFFSET (frame))
break;
}
}
- else
- {
- /* Cut specified number of frames. */
- if (outer < len)
- len -= outer;
- else
- len = 0;
- }
SCM_SET_STACK_LENGTH (stack, len);
}
@@ -257,7 +255,7 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
SCM cont;
struct scm_vm_cont *c;
- cont = scm_i_vm_capture_continuation (scm_the_vm ());
+ cont = scm_i_capture_current_stack ();
c = SCM_VM_CONT_DATA (cont);
frame = scm_c_make_frame (cont, c->fp + c->reloc,
@@ -313,10 +311,8 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
}
narrow_stack (stack,
- scm_is_integer (inner_cut) ? scm_to_int (inner_cut) : n,
- scm_is_integer (inner_cut) ? SCM_BOOL_T : inner_cut,
- scm_is_integer (outer_cut) ? scm_to_int (outer_cut) : n,
- scm_is_integer (outer_cut) ? SCM_BOOL_T : outer_cut);
+ inner_cut,
+ outer_cut);
n = SCM_STACK_LENGTH (stack);
}