1 /* Representation of stack frame debug information
2 * Copyright (C) 1996,1997,2000,2001, 2006, 2007, 2008, 2009 Free Software Foundation
4 * This library is free software; you can redistribute it and/or
5 * modify it under the terms of the GNU Lesser General Public
6 * License as published by the Free Software Foundation; either
7 * version 2.1 of the License, or (at your option) any later version.
9 * This library is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 * Lesser General Public License for more details.
14 * You should have received a copy of the GNU Lesser General Public
15 * License along with this library; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
25 #include "libguile/_scm.h"
26 #include "libguile/eval.h"
27 #include "libguile/debug.h"
28 #include "libguile/continuations.h"
29 #include "libguile/struct.h"
30 #include "libguile/macros.h"
31 #include "libguile/procprop.h"
32 #include "libguile/modules.h"
33 #include "libguile/root.h"
34 #include "libguile/strings.h"
35 #include "libguile/vm.h" /* to capture vm stacks */
36 #include "libguile/frames.h" /* vm frames */
38 #include "libguile/validate.h"
39 #include "libguile/stacks.h"
40 #include "libguile/private-options.h"
44 /* {Frames and stacks}
46 * The debugging evaluator creates debug frames on the stack. These
47 * are linked from the innermost frame and outwards. The last frame
48 * created can always be accessed as SCM_LAST_DEBUG_FRAME.
49 * Continuations contain a pointer to the innermost debug frame on the
52 * Each debug frame contains a set of flags and information about one
53 * or more stack frames. The case of multiple frames occurs due to
54 * tail recursion. The maximal number of stack frames which can be
55 * recorded in one debug frame can be set dynamically with the debug
58 * Stack frame information is of two types: eval information (the
59 * expression being evaluated and its environment) and apply
60 * information (the procedure being applied and its arguments). A
61 * stack frame normally corresponds to an eval/apply pair, but macros
62 * and special forms (which are implemented as macros in Guile) only
63 * have eval information and apply calls leads to apply only frames.
65 * Since we want to record the total stack information and later
66 * manipulate this data at the scheme level in the debugger, we need
67 * to transform it into a new representation. In the following code
68 * section you'll find the functions implementing this data type.
72 * The stack is represented as a struct with an id slot and a tail
73 * array of scm_t_info_frame structs.
75 * A frame is represented as a pair where the car contains a stack and
76 * the cdr an inum. The inum is an index to the first SCM value of
77 * the scm_t_info_frame struct.
101 * frame-evaluating-args?
106 /* Some auxiliary functions for reading debug frames off the stack.
109 /* Stacks often contain pointers to other items on the stack; for
110 example, each scm_t_debug_frame structure contains a pointer to the
111 next frame out. When we capture a continuation, we copy the stack
112 into the heap, and just leave all the pointers unchanged. This
113 makes it simple to restore the continuation --- just copy the stack
114 back! However, if we retrieve a pointer from the heap copy to
115 another item that was originally on the stack, we have to add an
116 offset to the pointer to discover the new referent.
118 If PTR is a pointer retrieved from a continuation, whose original
119 target was on the stack, and OFFSET is the appropriate offset from
120 the original stack to the continuation, then RELOC_MUMBLE (PTR,
121 OFFSET) is a pointer to the copy in the continuation of the
122 original referent, cast to an scm_debug_MUMBLE *. */
123 #define RELOC_INFO(ptr, offset) \
124 ((scm_t_debug_info *) ((SCM_STACKITEM *) (ptr) + (offset)))
125 #define RELOC_FRAME(ptr, offset) \
126 ((scm_t_debug_frame *) ((SCM_STACKITEM *) (ptr) + (offset)))
128 /* Count number of debug info frames on a stack, beginning with
129 * DFRAME. OFFSET is used for relocation of pointers when the stack
130 * is read from a continuation.
133 stack_depth (scm_t_debug_frame
*dframe
, scm_t_ptrdiff offset
, SCM vmframe
,
138 dframe
&& !SCM_VOIDFRAMEP (*dframe
);
139 dframe
= RELOC_FRAME (dframe
->prev
, offset
))
141 if (SCM_EVALFRAMEP (*dframe
))
143 scm_t_debug_info
*info
= RELOC_INFO (dframe
->info
, offset
);
144 scm_t_debug_info
*vect
= RELOC_INFO (dframe
->vect
, offset
);
145 n
+= (info
- vect
) / 2 + 1;
146 /* Data in the apply part of an eval info frame comes from previous
147 stack frame if the scm_t_debug_info vector is overflowed. */
148 if ((((info
- vect
) & 1) == 0)
149 && SCM_OVERFLOWP (*dframe
)
150 && !SCM_UNBNDP (info
[1].a
.proc
))
153 else if (SCM_APPLYFRAMEP (*dframe
))
155 scm_t_debug_info
*vect
= RELOC_INFO (dframe
->vect
, offset
);
156 if (SCM_PROGRAM_P (vect
[0].a
.proc
))
158 if (!SCM_PROGRAM_IS_BOOT (vect
[0].a
.proc
))
159 /* Programs can end up in the debug stack via deval; but we just
160 ignore those, because we know that the debugging VM engine
161 pushes one dframe per invocation, with the boot program as
162 the proc, so we only count those. */
164 /* count vmframe back to previous boot frame */
165 for (; scm_is_true (vmframe
); vmframe
= scm_c_vm_frame_prev (vmframe
))
167 if (!SCM_PROGRAM_IS_BOOT (scm_vm_frame_program (vmframe
)))
170 { /* skip boot frame, cut out of the vm backtrace */
171 vmframe
= scm_c_vm_frame_prev (vmframe
);
177 ++n
; /* increment for non-program apply frame */
182 if (dframe
&& SCM_VOIDFRAMEP (*dframe
))
183 *id
= RELOC_INFO(dframe
->vect
, offset
)[0].id
;
187 /* Read debug info from DFRAME into IFRAME.
190 read_frame (scm_t_debug_frame
*dframe
, scm_t_ptrdiff offset
,
191 scm_t_info_frame
*iframe
)
193 scm_t_bits flags
= SCM_UNPACK (SCM_INUM0
); /* UGh. */
194 if (SCM_EVALFRAMEP (*dframe
))
196 scm_t_debug_info
*info
= RELOC_INFO (dframe
->info
, offset
);
197 scm_t_debug_info
*vect
= RELOC_INFO (dframe
->vect
, offset
);
198 if ((info
- vect
) & 1)
200 /* Debug.vect ends with apply info. */
202 if (!SCM_UNBNDP (info
[1].a
.proc
))
204 flags
|= SCM_FRAMEF_PROC
;
205 iframe
->proc
= info
[1].a
.proc
;
206 iframe
->args
= info
[1].a
.args
;
207 if (!SCM_ARGS_READY_P (*dframe
))
208 flags
|= SCM_FRAMEF_EVAL_ARGS
;
211 iframe
->source
= scm_make_memoized (info
[0].e
.exp
, info
[0].e
.env
);
215 scm_t_debug_info
*vect
= RELOC_INFO (dframe
->vect
, offset
);
216 flags
|= SCM_FRAMEF_PROC
;
217 iframe
->proc
= vect
[0].a
.proc
;
218 iframe
->args
= vect
[0].a
.args
;
220 iframe
->flags
= flags
;
223 /* Look up the first body form of the apply closure. We'll use this
224 below to prevent it from being displayed.
229 SCM var
= scm_sym2var (scm_sym_apply
, SCM_BOOL_F
, SCM_BOOL_F
);
230 if (SCM_VARIABLEP (var
) && SCM_CLOSUREP (SCM_VARIABLE_REF (var
)))
231 return SCM_CAR (SCM_CLOSURE_BODY (SCM_VARIABLE_REF (var
)));
233 return SCM_UNDEFINED
;
236 #define NEXT_FRAME(iframe, n, quit) \
238 if (SCM_MEMOIZEDP (iframe->source) \
239 && scm_is_eq (SCM_MEMOIZED_EXP (iframe->source), applybody)) \
241 iframe->source = SCM_BOOL_F; \
242 if (scm_is_false (iframe->proc)) \
254 /* Fill the scm_t_info_frame vector IFRAME with data from N stack frames
255 * starting with the first stack frame represented by debug frame
260 read_frames (scm_t_debug_frame
*dframe
, scm_t_ptrdiff offset
,
261 SCM vmframe
, long n
, scm_t_info_frame
*iframes
)
263 scm_t_info_frame
*iframe
= iframes
;
264 scm_t_debug_info
*info
, *vect
;
265 static SCM applybody
= SCM_UNDEFINED
;
267 /* The value of applybody has to be setup after r4rs.scm has executed. */
268 if (SCM_UNBNDP (applybody
))
269 applybody
= get_applybody ();
271 dframe
&& !SCM_VOIDFRAMEP (*dframe
) && n
> 0;
272 dframe
= RELOC_FRAME (dframe
->prev
, offset
))
274 read_frame (dframe
, offset
, iframe
);
275 if (SCM_EVALFRAMEP (*dframe
))
277 /* If current frame is a macro during expansion, we should
278 skip the previously recorded macro transformer
279 application frame. */
280 if (SCM_MACROEXPP (*dframe
) && iframe
> iframes
)
282 *(iframe
- 1) = *iframe
;
285 info
= RELOC_INFO (dframe
->info
, offset
);
286 vect
= RELOC_INFO (dframe
->vect
, offset
);
287 if ((info
- vect
) & 1)
289 /* Data in the apply part of an eval info frame comes from
290 previous stack frame if the scm_t_debug_info vector is
292 else if (SCM_OVERFLOWP (*dframe
)
293 && !SCM_UNBNDP (info
[1].a
.proc
))
295 NEXT_FRAME (iframe
, n
, quit
);
296 iframe
->flags
= SCM_UNPACK(SCM_INUM0
) | SCM_FRAMEF_PROC
;
297 iframe
->proc
= info
[1].a
.proc
;
298 iframe
->args
= info
[1].a
.args
;
300 if (SCM_OVERFLOWP (*dframe
))
301 iframe
->flags
|= SCM_FRAMEF_OVERFLOW
;
303 NEXT_FRAME (iframe
, n
, quit
);
306 if (!SCM_UNBNDP (info
[1].a
.proc
))
308 iframe
->flags
= SCM_UNPACK(SCM_INUM0
) | SCM_FRAMEF_PROC
;
309 iframe
->proc
= info
[1].a
.proc
;
310 iframe
->args
= info
[1].a
.args
;
313 iframe
->flags
= SCM_UNPACK (SCM_INUM0
);
314 iframe
->source
= scm_make_memoized (info
[0].e
.exp
,
317 NEXT_FRAME (iframe
, n
, quit
);
320 else if (SCM_PROGRAM_P (iframe
->proc
))
322 if (!SCM_PROGRAM_IS_BOOT (iframe
->proc
))
323 /* Programs can end up in the debug stack via deval; but we just
324 ignore those, because we know that the debugging VM engine
325 pushes one dframe per invocation, with the boot program as
326 the proc, so we only count those. */
328 for (; scm_is_true (vmframe
);
329 vmframe
= scm_c_vm_frame_prev (vmframe
))
331 if (SCM_PROGRAM_IS_BOOT (scm_vm_frame_program (vmframe
)))
332 { /* skip boot frame, back to interpreted frames */
333 vmframe
= scm_c_vm_frame_prev (vmframe
);
338 /* Oh dear, oh dear, oh dear. */
339 iframe
->flags
= SCM_UNPACK (SCM_INUM0
) | SCM_FRAMEF_PROC
;
340 iframe
->source
= scm_vm_frame_source (vmframe
);
341 iframe
->proc
= scm_vm_frame_program (vmframe
);
342 iframe
->args
= scm_vm_frame_arguments (vmframe
);
351 NEXT_FRAME (iframe
, n
, quit
);
354 if (iframe
> iframes
)
355 (iframe
- 1) -> flags
|= SCM_FRAMEF_REAL
;
357 return iframe
- iframes
; /* Number of frames actually read */
360 /* Narrow STACK by cutting away stackframes (mutatingly).
362 * Inner frames (most recent) are cut by advancing the frames pointer.
363 * Outer frames are cut by decreasing the recorded length.
365 * Cut maximally INNER inner frames and OUTER outer frames using
366 * the keys INNER_KEY and OUTER_KEY.
368 * Frames are cut away starting at the end points and moving towards
369 * the center of the stack. The key is normally compared to the
370 * operator in application frames. Frames up to and including the key
373 * If INNER_KEY is #t a different scheme is used for inner frames:
375 * Frames up to but excluding the first source frame originating from
376 * a user module are cut, except for possible application frames
377 * between the user frame and the last system frame previously
382 narrow_stack (SCM stack
, long inner
, SCM inner_key
, long outer
, SCM outer_key
)
384 scm_t_stack
*s
= SCM_STACK (stack
);
388 /* Cut inner part. */
389 if (scm_is_eq (inner_key
, SCM_BOOL_T
))
391 /* Cut all frames up to user module code */
392 for (i
= 0; inner
; ++i
, --inner
)
394 SCM m
= s
->frames
[i
].source
;
395 if (SCM_MEMOIZEDP (m
)
396 && !SCM_IMP (SCM_MEMOIZED_ENV (m
))
397 && scm_is_false (scm_system_module_env_p (SCM_MEMOIZED_ENV (m
))))
399 /* Back up in order to include any non-source frames */
402 m
= s
->frames
[i
- 1].source
;
403 if (SCM_MEMOIZEDP (m
))
406 m
= s
->frames
[i
- 1].proc
;
407 if (scm_is_true (scm_procedure_p (m
))
408 && scm_is_true (scm_procedure_property
409 (m
, scm_sym_system_procedure
)))
420 /* Use standard cutting procedure. */
422 for (i
= 0; inner
; --inner
)
423 if (scm_is_eq (s
->frames
[i
++].proc
, inner_key
))
426 s
->frames
= &s
->frames
[i
];
429 /* Cut outer part. */
430 for (; n
&& outer
; --outer
)
431 if (scm_is_eq (s
->frames
[--n
].proc
, outer_key
))
444 SCM_DEFINE (scm_stack_p
, "stack?", 1, 0, 0,
446 "Return @code{#t} if @var{obj} is a calling stack.")
447 #define FUNC_NAME s_scm_stack_p
449 return scm_from_bool(SCM_STACKP (obj
));
453 SCM_DEFINE (scm_make_stack
, "make-stack", 1, 0, 1,
455 "Create a new stack. If @var{obj} is @code{#t}, the current\n"
456 "evaluation stack is used for creating the stack frames,\n"
457 "otherwise the frames are taken from @var{obj} (which must be\n"
458 "either a debug object or a continuation).\n\n"
459 "@var{args} should be a list containing any combination of\n"
460 "integer, procedure and @code{#t} values.\n\n"
461 "These values specify various ways of cutting away uninteresting\n"
462 "stack frames from the top and bottom of the stack that\n"
463 "@code{make-stack} returns. They come in pairs like this:\n"
464 "@code{(@var{inner_cut_1} @var{outer_cut_1} @var{inner_cut_2}\n"
465 "@var{outer_cut_2} @dots{})}.\n\n"
466 "Each @var{inner_cut_N} can be @code{#t}, an integer, or a\n"
467 "procedure. @code{#t} means to cut away all frames up to but\n"
468 "excluding the first user module frame. An integer means to cut\n"
469 "away exactly that number of frames. A procedure means to cut\n"
470 "away all frames up to but excluding the application frame whose\n"
471 "procedure matches the specified one.\n\n"
472 "Each @var{outer_cut_N} can be an integer or a procedure. An\n"
473 "integer means to cut away that number of frames. A procedure\n"
474 "means to cut away frames down to but excluding the application\n"
475 "frame whose procedure matches the specified one.\n\n"
476 "If the @var{outer_cut_N} of the last pair is missing, it is\n"
478 #define FUNC_NAME s_scm_make_stack
482 scm_t_debug_frame
*dframe
;
483 scm_t_info_frame
*iframe
;
487 SCM inner_cut
, outer_cut
;
489 /* Extract a pointer to the innermost frame of whatever object
490 scm_make_stack was given. */
491 if (scm_is_eq (obj
, SCM_BOOL_T
))
493 struct scm_vm
*vp
= SCM_VM_DATA (scm_the_vm ());
494 dframe
= scm_i_last_debug_frame ();
495 vmframe
= scm_c_make_vm_frame (scm_the_vm (), vp
->fp
, vp
->sp
, vp
->ip
, 0);
497 else if (SCM_DEBUGOBJP (obj
))
499 dframe
= SCM_DEBUGOBJ_FRAME (obj
);
500 vmframe
= SCM_BOOL_F
;
502 else if (SCM_VM_FRAME_P (obj
))
507 else if (SCM_CONTINUATIONP (obj
))
509 scm_t_contregs
*cont
= SCM_CONTREGS (obj
);
510 offset
= cont
->offset
;
511 dframe
= RELOC_FRAME (cont
->dframe
, offset
);
512 if (!scm_is_null (cont
->vm_conts
))
514 struct scm_vm_cont
*data
;
515 vm_cont
= scm_cdr (scm_car (cont
->vm_conts
));
516 data
= SCM_VM_CONT_DATA (vm_cont
);
517 vmframe
= scm_c_make_vm_frame (vm_cont
,
518 data
->fp
+ data
->reloc
,
519 data
->sp
+ data
->reloc
,
523 vmframe
= SCM_BOOL_F
;
527 SCM_WRONG_TYPE_ARG (SCM_ARG1
, obj
);
531 /* Count number of frames. Also get stack id tag and check whether
532 there are more stackframes than we want to record
533 (SCM_BACKTRACE_MAXDEPTH). */
536 n
= stack_depth (dframe
, offset
, vmframe
, &id
);
537 /* FIXME: redo maxp? */
538 size
= n
* SCM_FRAME_N_SLOTS
;
540 /* Make the stack object. */
541 stack
= scm_make_struct (scm_stack_type
, scm_from_long (size
), SCM_EOL
);
542 SCM_STACK (stack
) -> id
= id
;
543 iframe
= &SCM_STACK (stack
) -> tail
[0];
544 SCM_STACK (stack
) -> frames
= iframe
;
545 SCM_STACK (stack
) -> length
= n
;
547 /* Translate the current chain of stack frames into debugging information. */
548 n
= read_frames (dframe
, offset
, vmframe
, n
, iframe
);
549 if (n
!= SCM_STACK (stack
)->length
)
551 scm_puts ("warning: stack count incorrect!\n", scm_current_error_port ());
552 SCM_STACK (stack
)->length
= n
;
555 /* Narrow the stack according to the arguments given to scm_make_stack. */
556 SCM_VALIDATE_REST_ARGUMENT (args
);
557 while (n
> 0 && !scm_is_null (args
))
559 inner_cut
= SCM_CAR (args
);
560 args
= SCM_CDR (args
);
561 if (scm_is_null (args
))
563 outer_cut
= SCM_INUM0
;
567 outer_cut
= SCM_CAR (args
);
568 args
= SCM_CDR (args
);
572 scm_is_integer (inner_cut
) ? scm_to_int (inner_cut
) : n
,
573 scm_is_integer (inner_cut
) ? 0 : inner_cut
,
574 scm_is_integer (outer_cut
) ? scm_to_int (outer_cut
) : n
,
575 scm_is_integer (outer_cut
) ? 0 : outer_cut
);
577 n
= SCM_STACK (stack
) -> length
;
581 iframe
[n
- 1].flags
|= SCM_FRAMEF_OVERFLOW
;
590 SCM_DEFINE (scm_stack_id
, "stack-id", 1, 0, 0,
592 "Return the identifier given to @var{stack} by @code{start-stack}.")
593 #define FUNC_NAME s_scm_stack_id
595 scm_t_debug_frame
*dframe
;
597 if (scm_is_eq (stack
, SCM_BOOL_T
))
599 dframe
= scm_i_last_debug_frame ();
601 else if (SCM_DEBUGOBJP (stack
))
603 dframe
= SCM_DEBUGOBJ_FRAME (stack
);
605 else if (SCM_CONTINUATIONP (stack
))
607 scm_t_contregs
*cont
= SCM_CONTREGS (stack
);
608 offset
= cont
->offset
;
609 dframe
= RELOC_FRAME (cont
->dframe
, offset
);
611 else if (SCM_STACKP (stack
))
613 return SCM_STACK (stack
) -> id
;
617 SCM_WRONG_TYPE_ARG (1, stack
);
620 while (dframe
&& !SCM_VOIDFRAMEP (*dframe
))
621 dframe
= RELOC_FRAME (dframe
->prev
, offset
);
622 if (dframe
&& SCM_VOIDFRAMEP (*dframe
))
623 return RELOC_INFO (dframe
->vect
, offset
)[0].id
;
628 SCM_DEFINE (scm_stack_ref
, "stack-ref", 2, 0, 0,
629 (SCM stack
, SCM index
),
630 "Return the @var{index}'th frame from @var{stack}.")
631 #define FUNC_NAME s_scm_stack_ref
633 unsigned long int c_index
;
635 SCM_VALIDATE_STACK (1, stack
);
636 c_index
= scm_to_unsigned_integer (index
, 0, SCM_STACK_LENGTH(stack
)-1);
637 return scm_cons (stack
, index
);
641 SCM_DEFINE (scm_stack_length
, "stack-length", 1, 0, 0,
643 "Return the length of @var{stack}.")
644 #define FUNC_NAME s_scm_stack_length
646 SCM_VALIDATE_STACK (1, stack
);
647 return scm_from_int (SCM_STACK_LENGTH (stack
));
654 SCM_DEFINE (scm_frame_p
, "frame?", 1, 0, 0,
656 "Return @code{#t} if @var{obj} is a stack frame.")
657 #define FUNC_NAME s_scm_frame_p
659 return scm_from_bool(SCM_FRAMEP (obj
));
663 SCM_DEFINE (scm_last_stack_frame
, "last-stack-frame", 1, 0, 0,
665 "Return the last (innermost) frame of @var{obj}, which must be\n"
666 "either a debug object or a continuation.")
667 #define FUNC_NAME s_scm_last_stack_frame
669 scm_t_debug_frame
*dframe
;
673 if (SCM_DEBUGOBJP (obj
))
675 dframe
= SCM_DEBUGOBJ_FRAME (obj
);
677 else if (SCM_CONTINUATIONP (obj
))
679 scm_t_contregs
*cont
= SCM_CONTREGS (obj
);
680 offset
= cont
->offset
;
681 dframe
= RELOC_FRAME (cont
->dframe
, offset
);
685 SCM_WRONG_TYPE_ARG (1, obj
);
689 if (!dframe
|| SCM_VOIDFRAMEP (*dframe
))
692 stack
= scm_make_struct (scm_stack_type
, scm_from_int (SCM_FRAME_N_SLOTS
),
694 SCM_STACK (stack
) -> length
= 1;
695 SCM_STACK (stack
) -> frames
= &SCM_STACK (stack
) -> tail
[0];
696 read_frame (dframe
, offset
,
697 (scm_t_info_frame
*) &SCM_STACK (stack
) -> frames
[0]);
699 return scm_cons (stack
, SCM_INUM0
);
703 SCM_DEFINE (scm_frame_number
, "frame-number", 1, 0, 0,
705 "Return the frame number of @var{frame}.")
706 #define FUNC_NAME s_scm_frame_number
708 SCM_VALIDATE_FRAME (1, frame
);
709 return scm_from_int (SCM_FRAME_NUMBER (frame
));
713 SCM_DEFINE (scm_frame_source
, "frame-source", 1, 0, 0,
715 "Return the source of @var{frame}.")
716 #define FUNC_NAME s_scm_frame_source
718 SCM_VALIDATE_FRAME (1, frame
);
719 return SCM_FRAME_SOURCE (frame
);
723 SCM_DEFINE (scm_frame_procedure
, "frame-procedure", 1, 0, 0,
725 "Return the procedure for @var{frame}, or @code{#f} if no\n"
726 "procedure is associated with @var{frame}.")
727 #define FUNC_NAME s_scm_frame_procedure
729 SCM_VALIDATE_FRAME (1, frame
);
730 return (SCM_FRAME_PROC_P (frame
)
731 ? SCM_FRAME_PROC (frame
)
736 SCM_DEFINE (scm_frame_arguments
, "frame-arguments", 1, 0, 0,
738 "Return the arguments of @var{frame}.")
739 #define FUNC_NAME s_scm_frame_arguments
741 SCM_VALIDATE_FRAME (1, frame
);
742 return SCM_FRAME_ARGS (frame
);
746 SCM_DEFINE (scm_frame_previous
, "frame-previous", 1, 0, 0,
748 "Return the previous frame of @var{frame}, or @code{#f} if\n"
749 "@var{frame} is the first frame in its stack.")
750 #define FUNC_NAME s_scm_frame_previous
753 SCM_VALIDATE_FRAME (1, frame
);
754 n
= scm_to_ulong (SCM_CDR (frame
)) + 1;
755 if (n
>= SCM_STACK_LENGTH (SCM_CAR (frame
)))
758 return scm_cons (SCM_CAR (frame
), scm_from_ulong (n
));
762 SCM_DEFINE (scm_frame_next
, "frame-next", 1, 0, 0,
764 "Return the next frame of @var{frame}, or @code{#f} if\n"
765 "@var{frame} is the last frame in its stack.")
766 #define FUNC_NAME s_scm_frame_next
769 SCM_VALIDATE_FRAME (1, frame
);
770 n
= scm_to_ulong (SCM_CDR (frame
));
774 return scm_cons (SCM_CAR (frame
), scm_from_ulong (n
- 1));
778 SCM_DEFINE (scm_frame_real_p
, "frame-real?", 1, 0, 0,
780 "Return @code{#t} if @var{frame} is a real frame.")
781 #define FUNC_NAME s_scm_frame_real_p
783 SCM_VALIDATE_FRAME (1, frame
);
784 return scm_from_bool(SCM_FRAME_REAL_P (frame
));
788 SCM_DEFINE (scm_frame_procedure_p
, "frame-procedure?", 1, 0, 0,
790 "Return @code{#t} if a procedure is associated with @var{frame}.")
791 #define FUNC_NAME s_scm_frame_procedure_p
793 SCM_VALIDATE_FRAME (1, frame
);
794 return scm_from_bool(SCM_FRAME_PROC_P (frame
));
798 SCM_DEFINE (scm_frame_evaluating_args_p
, "frame-evaluating-args?", 1, 0, 0,
800 "Return @code{#t} if @var{frame} contains evaluated arguments.")
801 #define FUNC_NAME s_scm_frame_evaluating_args_p
803 SCM_VALIDATE_FRAME (1, frame
);
804 return scm_from_bool(SCM_FRAME_EVAL_ARGS_P (frame
));
808 SCM_DEFINE (scm_frame_overflow_p
, "frame-overflow?", 1, 0, 0,
810 "Return @code{#t} if @var{frame} is an overflow frame.")
811 #define FUNC_NAME s_scm_frame_overflow_p
813 SCM_VALIDATE_FRAME (1, frame
);
814 return scm_from_bool(SCM_FRAME_OVERFLOW_P (frame
));
825 (scm_make_vtable (scm_from_locale_string (SCM_STACK_LAYOUT
),
827 scm_set_struct_vtable_name_x (scm_stack_type
,
828 scm_from_locale_symbol ("stack"));
829 #include "libguile/stacks.x"