/* Representation of stack frame debug information
- * Copyright (C) 1996 Mikael Djurfeldt
+ * Copyright (C) 1996,1997 Free Software Foundation
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
- * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
* If you do not wish that, delete this exception notice.
*
* The author can be reached at djurfeldt@nada.kth.se
- * Mikael Djurfeldt, SANS/NADA KTH, 10044 STOCKHOLM, SWEDEN
- */
+ * Mikael Djurfeldt, SANS/NADA KTH, 10044 STOCKHOLM, SWEDEN */
+
+/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
+ gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
+
\f
#include <stdio.h>
#include "_scm.h"
+#include "eval.h"
#include "debug.h"
#include "continuations.h"
#include "struct.h"
+#include "macros.h"
+#include "procprop.h"
+#include "modules.h"
+#include "validate.h"
#include "stacks.h"
\f
* DFRAME. OFFSET is used for relocation of pointers when the stack
* is read from a continuation.
*/
-static int stack_depth SCM_P ((scm_debug_frame *dframe, long offset, SCM *id, int *maxp));
static int
-stack_depth (dframe, offset, id, maxp)
- scm_debug_frame *dframe;
- long offset;
- SCM *id;
- int *maxp;
+stack_depth (scm_debug_frame *dframe,long offset,SCM *id,int *maxp)
{
int n, size;
int max_depth = SCM_BACKTRACE_MAXDEPTH;
/* Read debug info from DFRAME into IFRAME.
*/
-static void read_frame SCM_P ((scm_debug_frame *dframe, long offset, scm_info_frame *iframe));
static void
-read_frame (dframe, offset, iframe)
- scm_debug_frame *dframe;
- long offset;
- scm_info_frame *iframe;
+read_frame (scm_debug_frame *dframe,long offset,scm_info_frame *iframe)
{
- SCM flags = SCM_INUM0;
+ scm_bits_t flags = SCM_UNPACK (SCM_INUM0); /* UGh. */
int size;
scm_debug_info *info;
if (SCM_EVALFRAMEP (*dframe))
iframe->flags = flags;
}
-/* Fill the scm_info_frame vector IFRAME with data from N stack frames
- * starting with the first stack frame represented by debug frame
- * DFRAME.
- */
+/* 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 proc = SCM_CDR (scm_sym2vcell (scm_sym_apply, SCM_BOOL_F, SCM_BOOL_F));
+ if (SCM_CLOSUREP (proc))
+ return SCM_CADR (SCM_CODE (proc));
+ else
+ return SCM_UNDEFINED;
+}
#define NEXT_FRAME(iframe, n, quit) \
-{ \
+do { \
+ if (SCM_NIMP (iframe->source) \
+ && SCM_MEMOIZED_EXP (iframe->source) == applybody) \
+ { \
+ iframe->source = SCM_BOOL_F; \
+ if (SCM_FALSEP (iframe->proc)) \
+ { \
+ --iframe; \
+ ++n; \
+ } \
+ } \
++iframe; \
if (--n == 0) \
goto quit; \
-} \
+} while (0)
-static void read_frames SCM_P ((scm_debug_frame *dframe, long offset, int nframes, scm_info_frame *iframes));
-static void
-read_frames (dframe, offset, n, iframes)
- scm_debug_frame *dframe;
- long offset;
- int n;
- scm_info_frame *iframes;
+/* Fill the scm_info_frame vector IFRAME with data from N stack frames
+ * starting with the first stack frame represented by debug frame
+ * DFRAME.
+ */
+
+static int
+read_frames (scm_debug_frame *dframe,long offset,int n,scm_info_frame *iframes)
{
int size;
scm_info_frame *iframe = iframes;
scm_debug_info *info;
+ 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))
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;
+ }
size = dframe->status & SCM_MAX_FRAME_SIZE;
info = RELOC_INFO (dframe->info, offset);
if ((info - dframe->vect) & 1)
&& !SCM_UNBNDP (info[1].a.proc))
{
NEXT_FRAME (iframe, n, quit);
- iframe->flags = SCM_INUM0 | SCM_FRAMEF_PROC;
+ iframe->flags = SCM_UNPACK(SCM_INUM0) | SCM_FRAMEF_PROC;
iframe->proc = info[1].a.proc;
iframe->args = info[1].a.args;
}
{
if (!SCM_UNBNDP (info[1].a.proc))
{
- iframe->flags = SCM_INUM0 | SCM_FRAMEF_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_INUM0;
+ iframe->flags = SCM_UNPACK (SCM_INUM0);
iframe->source = scm_make_memoized (info[0].e.exp,
info[0].e.env);
info -= 2;
NEXT_FRAME (iframe, n, quit);
}
}
+ else if (iframe->proc == scm_f_gsubr_apply)
+ /* Skip gsubr apply frames. */
+ continue;
else
{
NEXT_FRAME (iframe, n, quit);
if (iframe > iframes)
(iframe - 1) -> flags |= SCM_FRAMEF_REAL;
}
+ return iframe - iframes; /* Number of frames actually read */
}
-static void narrow_stack SCM_P ((SCM stack, int inner, SCM inner_key, int outer, SCM outer_key));
+/* Narrow STACK by cutting away stackframes (mutatingly).
+ *
+ * Inner frames (most recent) are cut by advancing the frames pointer.
+ * Outer frames are cut by decreasing the recorded length.
+ *
+ * Cut maximally INNER inner frames and OUTER outer frames using
+ * the keys INNER_KEY and OUTER_KEY.
+ *
+ * Frames are cut away starting at the end points and moving towards
+ * the center of the stack. The key is normally compared to the
+ * operator in application frames. Frames up to and including the key
+ * are cut.
+ *
+ * If INNER_KEY is #t a different scheme is used for inner frames:
+ *
+ * Frames up to but excluding the first source frame originating from
+ * a user module are cut, except for possible application frames
+ * between the user frame and the last system frame previously
+ * encountered.
+ */
static void
-narrow_stack (stack, inner, inner_key, outer, outer_key)
- SCM stack;
- int inner;
- SCM inner_key;
- int outer;
- SCM outer_key;
+narrow_stack (SCM stack,int inner,SCM inner_key,int outer,SCM outer_key)
{
scm_stack *s = SCM_STACK (stack);
int i;
int n = s->length;
/* Cut inner part. */
- for (i = 0; inner; --inner)
- if (s->frames[i++].proc == inner_key)
- break;
+ if (inner_key == SCM_BOOL_T)
+ /* Cut all frames up to user module code */
+ {
+ for (i = 0; inner; ++i, --inner)
+ {
+ SCM m = s->frames[i].source;
+ if ( SCM_MEMOIZEDP (m)
+ && SCM_NIMP (SCM_MEMOIZED_ENV (m))
+ && SCM_FALSEP (scm_system_module_env_p (SCM_MEMOIZED_ENV (m))))
+ {
+ /* Back up in order to include any non-source frames */
+ while (i > 0
+ && !((m = s->frames[i - 1].source, SCM_MEMOIZEDP (m))
+ || (SCM_NIMP (m = s->frames[i - 1].proc)
+ && SCM_NFALSEP (scm_procedure_p (m))
+ && SCM_NFALSEP (scm_procedure_property
+ (m, scm_sym_system_procedure)))))
+ {
+ --i;
+ ++inner;
+ }
+ break;
+ }
+ }
+ }
+ else
+ /* Use standard cutting procedure. */
+ {
+ for (i = 0; inner; --inner)
+ if (s->frames[i++].proc == inner_key)
+ break;
+ }
s->frames = &s->frames[i];
n -= i;
SCM scm_stack_type;
-SCM_PROC (s_stack_p, "stack?", 1, 0, 0, scm_stack_p);
-SCM
-scm_stack_p (obj)
- SCM obj;
+SCM_DEFINE (scm_stack_p, "stack?", 1, 0, 0,
+ (SCM obj),
+ "Return @code{#t} if @var{obj} is a calling stack.")
+#define FUNC_NAME s_scm_stack_p
{
- return SCM_NIMP (obj) && SCM_STACKP (obj) ? SCM_BOOL_T : SCM_BOOL_F;
+ return SCM_BOOL(SCM_STACKP (obj));
}
+#undef FUNC_NAME
-SCM_PROC (s_make_stack, "make-stack", 0, 0, 1, scm_make_stack);
-SCM
-scm_make_stack (args)
- SCM args;
+SCM_DEFINE (scm_make_stack, "make-stack", 0, 0, 1,
+ (SCM args),
+ "")
+#define FUNC_NAME s_scm_make_stack
{
int n, maxp, size;
- scm_debug_frame *dframe;
+ scm_debug_frame *dframe = scm_last_debug_frame;
scm_info_frame *iframe;
long offset = 0;
SCM stack, id;
SCM obj, inner_cut, outer_cut;
- SCM_ASSERT (SCM_NIMP (args) && SCM_CONSP (args), SCM_WNA, args, s_make_stack);
+ SCM_ASSERT (SCM_CONSP (args),
+ SCM_FUNC_NAME, SCM_WNA, NULL);
obj = SCM_CAR (args);
args = SCM_CDR (args);
/* Extract a pointer to the innermost frame of whatever object
scm_make_stack was given. */
- if (obj == SCM_BOOL_T)
- dframe = scm_last_debug_frame;
- else
+ /* just use dframe == scm_last_debug_frame
+ (from initialization of dframe, above) if obj is #t */
+ if (obj != SCM_BOOL_T)
{
- SCM_ASSERT (SCM_NIMP (obj), obj, SCM_ARG1, s_make_stack);
+ SCM_ASSERT (SCM_NIMP (obj), obj, SCM_ARG1, FUNC_NAME);
if (SCM_DEBUGOBJP (obj))
dframe = (scm_debug_frame *) SCM_DEBUGOBJ_FRAME (obj);
else if (scm_tc7_contin == SCM_TYP7 (obj))
}
else
{
- scm_wta (obj, (char *) SCM_ARG1, s_make_stack);
+ SCM_WTA (SCM_ARG1, obj);
abort ();
}
}
/* Make the stack object. */
stack = scm_make_struct (scm_stack_type, SCM_MAKINUM (size), SCM_EOL);
SCM_STACK (stack) -> id = id;
- SCM_STACK (stack) -> length = n;
iframe = &SCM_STACK (stack) -> tail[0];
SCM_STACK (stack) -> frames = iframe;
/* Translate the current chain of stack frames into debugging information. */
- read_frames (RELOC_FRAME (dframe, offset), offset, n, iframe);
+ n = read_frames (RELOC_FRAME (dframe, offset), offset, n, iframe);
+ SCM_STACK (stack) -> length = n;
/* Narrow the stack according to the arguments given to scm_make_stack. */
- while (n > 0 && SCM_NIMP (args) && SCM_CONSP (args))
+ while (n > 0 && SCM_CONSP (args))
{
inner_cut = SCM_CAR (args);
args = SCM_CDR (args);
- if (SCM_NIMP (args) && SCM_CONSP (args))
+ if (SCM_CONSP (args))
{
outer_cut = SCM_CAR (args);
args = SCM_CDR (args);
else
return SCM_BOOL_F;
}
+#undef FUNC_NAME
-SCM_PROC (s_stack_id, "stack-id", 1, 0, 0, scm_stack_id);
-SCM
-scm_stack_id (stack)
- SCM stack;
+SCM_DEFINE (scm_stack_id, "stack-id", 1, 0, 0,
+ (SCM stack),
+ "Return the identifier given to @var{stack} by @code{start-stack}.")
+#define FUNC_NAME s_scm_stack_id
{
scm_debug_frame *dframe;
long offset = 0;
dframe = scm_last_debug_frame;
else
{
- SCM_ASSERT (SCM_NIMP (stack), stack, SCM_ARG1, s_make_stack);
+ SCM_VALIDATE_NIM (1,stack);
if (SCM_DEBUGOBJP (stack))
dframe = (scm_debug_frame *) SCM_DEBUGOBJ_FRAME (stack);
else if (scm_tc7_contin == SCM_TYP7 (stack))
}
else if (SCM_STACKP (stack))
return SCM_STACK (stack) -> id;
- else scm_wrong_type_arg (s_stack_id, SCM_ARG1, stack);
+ else
+ SCM_WRONG_TYPE_ARG (1, stack);
}
while (dframe && !SCM_VOIDFRAMEP (*dframe))
dframe = RELOC_FRAME (dframe->prev, offset);
return dframe->vect[0].id;
return SCM_BOOL_F;
}
+#undef FUNC_NAME
-SCM_PROC (s_stack_ref, "stack-ref", 2, 0, 0, scm_stack_ref);
-SCM
-scm_stack_ref (stack, i)
- SCM stack;
- SCM i;
+SCM_DEFINE (scm_stack_ref, "stack-ref", 2, 0, 0,
+ (SCM stack, SCM i),
+ "")
+#define FUNC_NAME s_scm_stack_ref
{
- SCM_ASSERT (SCM_NIMP (stack)
- && SCM_STACKP (stack),
- stack,
- SCM_ARG1,
- s_stack_ref);
- SCM_ASSERT (SCM_INUMP (i), i, SCM_ARG2, s_stack_ref);
- SCM_ASSERT (SCM_INUM (i) >= 0
- && SCM_INUM (i) < SCM_STACK_LENGTH (stack),
- i,
- SCM_OUTOFRANGE,
- s_stack_ref);
+ SCM_VALIDATE_STACK (1,stack);
+ SCM_VALIDATE_INUM (2,i);
+ SCM_ASSERT_RANGE (1,i,
+ SCM_INUM (i) >= 0 &&
+ SCM_INUM (i) < SCM_STACK_LENGTH (stack));
return scm_cons (stack, i);
}
+#undef FUNC_NAME
-SCM_PROC(s_stack_length, "stack-length", 1, 0, 0, scm_stack_length);
-SCM
-scm_stack_length (stack)
- SCM stack;
+SCM_DEFINE (scm_stack_length, "stack-length", 1, 0, 0,
+ (SCM stack),
+ "")
+#define FUNC_NAME s_scm_stack_length
{
- SCM_ASSERT (SCM_NIMP (stack)
- && SCM_STACKP (stack),
- stack,
- SCM_ARG1,
- s_stack_length);
+ SCM_VALIDATE_STACK (1,stack);
return SCM_MAKINUM (SCM_STACK_LENGTH (stack));
}
+#undef FUNC_NAME
/* Frames
*/
-SCM_PROC (s_frame_p, "frame?", 1, 0, 0, scm_frame_p);
-SCM
-scm_frame_p (obj)
- SCM obj;
+SCM_DEFINE (scm_frame_p, "frame?", 1, 0, 0,
+ (SCM obj),
+ "")
+#define FUNC_NAME s_scm_frame_p
{
- return SCM_NIMP (obj) && SCM_FRAMEP (obj);
+ return SCM_BOOL(SCM_FRAMEP (obj));
}
+#undef FUNC_NAME
-SCM_PROC(s_last_stack_frame, "last-stack-frame", 1, 0, 0, scm_last_stack_frame);
-SCM
-scm_last_stack_frame (obj)
- SCM obj;
+SCM_DEFINE (scm_last_stack_frame, "last-stack-frame", 1, 0, 0,
+ (SCM obj),
+ "")
+#define FUNC_NAME s_scm_last_stack_frame
{
scm_debug_frame *dframe;
long offset = 0;
SCM stack;
- SCM_ASSERT (SCM_NIMP (obj), obj, SCM_ARG1, s_last_stack_frame);
+ SCM_VALIDATE_NIM (1,obj);
if (SCM_DEBUGOBJP (obj))
dframe = (scm_debug_frame *) SCM_DEBUGOBJ_FRAME (obj);
else if (scm_tc7_contin == SCM_TYP7 (obj))
}
else
{
- scm_wta (obj, (char *) SCM_ARG1, s_last_stack_frame);
+ SCM_WTA (1,obj);
abort ();
}
return scm_cons (stack, SCM_INUM0);;
}
+#undef FUNC_NAME
-SCM_PROC(s_frame_number, "frame-number", 1, 0, 0, scm_frame_number);
-SCM
-scm_frame_number (frame)
- SCM frame;
+SCM_DEFINE (scm_frame_number, "frame-number", 1, 0, 0,
+ (SCM frame),
+ "")
+#define FUNC_NAME s_scm_frame_number
{
- SCM_ASSERT (SCM_NIMP (frame) && SCM_FRAMEP (frame),
- frame,
- SCM_ARG1,
- s_frame_number);
+ SCM_VALIDATE_FRAME (1,frame);
return SCM_MAKINUM (SCM_FRAME_NUMBER (frame));
}
+#undef FUNC_NAME
-SCM_PROC(s_frame_source, "frame-source", 1, 0, 0, scm_frame_source);
-SCM
-scm_frame_source (frame)
- SCM frame;
+SCM_DEFINE (scm_frame_source, "frame-source", 1, 0, 0,
+ (SCM frame),
+ "")
+#define FUNC_NAME s_scm_frame_source
{
- SCM_ASSERT (SCM_NIMP (frame) && SCM_FRAMEP (frame),
- frame,
- SCM_ARG1,
- s_frame_source);
+ SCM_VALIDATE_FRAME (1,frame);
return SCM_FRAME_SOURCE (frame);
}
+#undef FUNC_NAME
-SCM_PROC(s_frame_procedure, "frame-procedure", 1, 0, 0, scm_frame_procedure);
-SCM
-scm_frame_procedure (frame)
- SCM frame;
+SCM_DEFINE (scm_frame_procedure, "frame-procedure", 1, 0, 0,
+ (SCM frame),
+ "")
+#define FUNC_NAME s_scm_frame_procedure
{
- SCM_ASSERT (SCM_NIMP (frame) && SCM_FRAMEP (frame),
- frame,
- SCM_ARG1,
- s_frame_procedure);
+ SCM_VALIDATE_FRAME (1,frame);
return (SCM_FRAME_PROC_P (frame)
- ? SCM_BOOL_F
- : SCM_FRAME_PROC (frame));
+ ? SCM_FRAME_PROC (frame)
+ : SCM_BOOL_F);
}
+#undef FUNC_NAME
-SCM_PROC(s_frame_arguments, "frame-arguments", 1, 0, 0, scm_frame_arguments);
-SCM
-scm_frame_arguments (frame)
- SCM frame;
+SCM_DEFINE (scm_frame_arguments, "frame-arguments", 1, 0, 0,
+ (SCM frame),
+ "")
+#define FUNC_NAME s_scm_frame_arguments
{
- SCM_ASSERT (SCM_NIMP (frame) && SCM_FRAMEP (frame),
- frame,
- SCM_ARG1,
- s_frame_arguments);
+ SCM_VALIDATE_FRAME (1,frame);
return SCM_FRAME_ARGS (frame);
}
+#undef FUNC_NAME
-SCM_PROC(s_frame_previous, "frame-previous", 1, 0, 0, scm_frame_previous);
-SCM
-scm_frame_previous (frame)
- SCM frame;
+SCM_DEFINE (scm_frame_previous, "frame-previous", 1, 0, 0,
+ (SCM frame),
+ "")
+#define FUNC_NAME s_scm_frame_previous
{
int n;
- SCM_ASSERT (SCM_NIMP (frame) && SCM_FRAMEP (frame),
- frame,
- SCM_ARG1,
- s_frame_previous);
+ SCM_VALIDATE_FRAME (1,frame);
n = SCM_INUM (SCM_CDR (frame)) + 1;
if (n >= SCM_STACK_LENGTH (SCM_CAR (frame)))
return SCM_BOOL_F;
else
return scm_cons (SCM_CAR (frame), SCM_MAKINUM (n));
}
+#undef FUNC_NAME
-SCM_PROC(s_frame_next, "frame-next", 1, 0, 0, scm_frame_next);
-SCM
-scm_frame_next (frame)
- SCM frame;
+SCM_DEFINE (scm_frame_next, "frame-next", 1, 0, 0,
+ (SCM frame),
+ "")
+#define FUNC_NAME s_scm_frame_next
{
int n;
- SCM_ASSERT (SCM_NIMP (frame) && SCM_FRAMEP (frame),
- frame,
- SCM_ARG1,
- s_frame_next);
+ SCM_VALIDATE_FRAME (1,frame);
n = SCM_INUM (SCM_CDR (frame)) - 1;
if (n < 0)
return SCM_BOOL_F;
else
return scm_cons (SCM_CAR (frame), SCM_MAKINUM (n));
}
+#undef FUNC_NAME
-SCM_PROC(s_frame_real_p, "frame-real?", 1, 0, 0, scm_frame_real_p);
-SCM
-scm_frame_real_p (frame)
- SCM frame;
+SCM_DEFINE (scm_frame_real_p, "frame-real?", 1, 0, 0,
+ (SCM frame),
+ "")
+#define FUNC_NAME s_scm_frame_real_p
{
- SCM_ASSERT (SCM_NIMP (frame) && SCM_FRAMEP (frame),
- frame,
- SCM_ARG1,
- s_frame_real_p);
- return SCM_FRAME_REAL_P (frame) ? SCM_BOOL_T : SCM_BOOL_F;
+ SCM_VALIDATE_FRAME (1,frame);
+ return SCM_BOOL(SCM_FRAME_REAL_P (frame));
}
+#undef FUNC_NAME
-SCM_PROC(s_frame_procedure_p, "frame-procedure?", 1, 0, 0, scm_frame_procedure_p);
-SCM
-scm_frame_procedure_p (frame)
- SCM frame;
+SCM_DEFINE (scm_frame_procedure_p, "frame-procedure?", 1, 0, 0,
+ (SCM frame),
+ "")
+#define FUNC_NAME s_scm_frame_procedure_p
{
- SCM_ASSERT (SCM_NIMP (frame) && SCM_FRAMEP (frame),
- frame,
- SCM_ARG1,
- s_frame_procedure_p);
- return SCM_FRAME_PROC_P (frame) ? SCM_BOOL_T : SCM_BOOL_F;
+ SCM_VALIDATE_FRAME (1,frame);
+ return SCM_BOOL(SCM_FRAME_PROC_P (frame));
}
+#undef FUNC_NAME
-SCM_PROC(s_frame_evaluating_args_p, "frame-evaluating-args?", 1, 0, 0, scm_frame_evaluating_args_p);
-SCM
-scm_frame_evaluating_args_p (frame)
- SCM frame;
+SCM_DEFINE (scm_frame_evaluating_args_p, "frame-evaluating-args?", 1, 0, 0,
+ (SCM frame),
+ "")
+#define FUNC_NAME s_scm_frame_evaluating_args_p
{
- SCM_ASSERT (SCM_NIMP (frame) && SCM_FRAMEP (frame),
- frame,
- SCM_ARG1,
- s_frame_evaluating_args_p);
- return SCM_FRAME_EVAL_ARGS_P (frame) ? SCM_BOOL_T : SCM_BOOL_F;
+ SCM_VALIDATE_FRAME (1,frame);
+ return SCM_BOOL(SCM_FRAME_EVAL_ARGS_P (frame));
}
+#undef FUNC_NAME
-SCM_PROC(s_frame_overflow_p, "frame-overflow?", 1, 0, 0, scm_frame_overflow_p);
-SCM
-scm_frame_overflow_p (frame)
- SCM frame;
+SCM_DEFINE (scm_frame_overflow_p, "frame-overflow?", 1, 0, 0,
+ (SCM frame),
+ "")
+#define FUNC_NAME s_scm_frame_overflow_p
{
- SCM_ASSERT (SCM_NIMP (frame) && SCM_FRAMEP (frame),
- frame,
- SCM_ARG1,
- s_frame_overflow_p);
- return SCM_FRAME_OVERFLOW_P (frame) ? SCM_BOOL_T : SCM_BOOL_F;
+ SCM_VALIDATE_FRAME (1,frame);
+ return SCM_BOOL(SCM_FRAME_OVERFLOW_P (frame));
}
+#undef FUNC_NAME
\f
= scm_permanent_object (scm_make_struct (vtable, SCM_INUM0,
scm_cons (stack_layout,
SCM_EOL)));
+ scm_set_struct_vtable_name_x (scm_stack_type,
+ SCM_CAR (scm_intern0 ("stack")));
#include "stacks.x"
}
HCoop / bpt / guile.git / blobdiff