/* Representation of stack frame debug information
- * Copyright (C) 1996,1997 Free Software Foundation
+ * Copyright (C) 1996,1997,2000,2001 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
- * the Free Software Foundation; either version 2, or (at your option)
- * any later version.
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version.
*
- * This program is distributed in the hope that it will be useful,
+ * This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * Lesser General Public License for more details.
*
- * 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, 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.
- *
- * The exception is that, if you link the GUILE library with other files
- * to produce an executable, this does not by itself cause the
- * resulting executable to be covered by the GNU General Public License.
- * Your use of that executable is in no way restricted on account of
- * linking the GUILE library code into it.
- *
- * This exception does not however invalidate any other reasons why
- * the executable file might be covered by the GNU General Public License.
- *
- * This exception applies only to the code released by the
- * Free Software Foundation under the name GUILE. If you copy
- * code from other Free Software Foundation releases into a copy of
- * GUILE, as the General Public License permits, the exception does
- * not apply to the code that you add in this way. To avoid misleading
- * anyone as to the status of such modified files, you must delete
- * this exception notice from them.
- *
- * If you write modifications of your own for GUILE, it is your choice
- * whether to permit this exception to apply to your modifications.
- * 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 */
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ */
-/* 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 "libguile/_scm.h"
#include "libguile/eval.h"
#include "libguile/debug.h"
* Representation:
*
* The stack is represented as a struct with an id slot and a tail
- * array of scm_info_frame structs.
+ * array of scm_t_info_frame structs.
*
* A frame is represented as a pair where the car contains a stack and
* the cdr an inum. The inum is an index to the first SCM value of
- * the scm_info_frame struct.
+ * the scm_t_info_frame struct.
*
* Stacks
* Constructor
*/
/* Stacks often contain pointers to other items on the stack; for
- example, each scm_debug_frame structure contains a pointer to the
+ example, each scm_t_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
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)))
+ ((scm_t_debug_info *) ((SCM_STACKITEM *) (ptr) + (offset)))
#define RELOC_FRAME(ptr, offset) \
- ((scm_debug_frame *) ((SCM_STACKITEM *) (ptr) + (offset)))
+ ((scm_t_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.
*/
-static int
-stack_depth (scm_debug_frame *dframe,long offset,SCM *id,int *maxp)
+static scm_t_bits
+stack_depth (scm_t_debug_frame *dframe, long offset, SCM *id, int *maxp)
{
- int n;
- int max_depth = SCM_BACKTRACE_MAXDEPTH;
+ long n;
+ long max_depth = SCM_BACKTRACE_MAXDEPTH;
for (n = 0;
dframe && !SCM_VOIDFRAMEP (*dframe) && n < max_depth;
dframe = RELOC_FRAME (dframe->prev, offset))
{
if (SCM_EVALFRAMEP (*dframe))
{
- scm_debug_info * info = RELOC_INFO (dframe->info, offset);
+ scm_t_debug_info * 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. */
+ stack frame if the scm_t_debug_info vector is overflowed. */
if ((((info - dframe->vect) & 1) == 0)
&& SCM_OVERFLOWP (*dframe)
&& !SCM_UNBNDP (info[1].a.proc))
/* Read debug info from DFRAME into IFRAME.
*/
static void
-read_frame (scm_debug_frame *dframe,long offset,scm_info_frame *iframe)
+read_frame (scm_t_debug_frame *dframe, long offset, scm_t_info_frame *iframe)
{
- scm_bits_t flags = SCM_UNPACK (SCM_INUM0); /* UGh. */
+ scm_t_bits flags = SCM_UNPACK (SCM_INUM0); /* UGh. */
if (SCM_EVALFRAMEP (*dframe))
{
- scm_debug_info * info = RELOC_INFO (dframe->info, offset);
+ scm_t_debug_info * info = RELOC_INFO (dframe->info, offset);
if ((info - dframe->vect) & 1)
{
/* Debug.vect ends with apply info. */
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));
+ SCM var = scm_sym2var (scm_sym_apply, SCM_BOOL_F, SCM_BOOL_F);
+ if (SCM_VARIABLEP (var) && SCM_CLOSUREP (SCM_VARIABLE_REF (var)))
+ return SCM_CAR (SCM_CLOSURE_BODY (SCM_VARIABLE_REF (var)));
else
return SCM_UNDEFINED;
}
#define NEXT_FRAME(iframe, n, quit) \
do { \
- if (SCM_NIMP (iframe->source) \
+ if (SCM_MEMOIZEDP (iframe->source) \
&& SCM_EQ_P (SCM_MEMOIZED_EXP (iframe->source), applybody)) \
{ \
iframe->source = SCM_BOOL_F; \
- if (SCM_FALSEP (iframe->proc)) \
+ if (scm_is_false (iframe->proc)) \
{ \
--iframe; \
++n; \
} while (0)
-/* Fill the scm_info_frame vector IFRAME with data from N stack frames
+/* Fill the scm_t_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)
+static scm_t_bits
+read_frames (scm_t_debug_frame *dframe, long offset, long n, scm_t_info_frame *iframes)
{
- scm_info_frame *iframe = iframes;
- scm_debug_info *info;
+ scm_t_info_frame *iframe = iframes;
+ scm_t_debug_info *info;
static SCM applybody = SCM_UNDEFINED;
/* The value of applybody has to be setup after r4rs.scm has executed. */
if ((info - dframe->vect) & 1)
--info;
/* Data in the apply part of an eval info frame comes from
- previous stack frame if the scm_debug_info vector is overflowed. */
+ previous stack frame if the scm_t_debug_info vector is
+ overflowed. */
else if (SCM_OVERFLOWP (*dframe)
&& !SCM_UNBNDP (info[1].a.proc))
{
*/
static void
-narrow_stack (SCM stack,int inner,SCM inner_key,int outer,SCM outer_key)
+narrow_stack (SCM stack, long inner, SCM inner_key, long outer, SCM outer_key)
{
- scm_stack *s = SCM_STACK (stack);
- int i;
- int n = s->length;
+ scm_t_stack *s = SCM_STACK (stack);
+ unsigned long int i;
+ long n = s->length;
/* Cut inner part. */
- if (SCM_TRUE_P (inner_key))
- /* Cut all frames up to user module code */
+ if (SCM_EQ_P (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))))
+ if (SCM_MEMOIZEDP (m)
+ && !SCM_IMP (SCM_MEMOIZED_ENV (m))
+ && scm_is_false (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)))))
+ while (i > 0)
{
+ m = s->frames[i - 1].source;
+ if (SCM_MEMOIZEDP (m))
+ break;
+
+ m = s->frames[i - 1].proc;
+ if (scm_is_true (scm_procedure_p (m))
+ && scm_is_true (scm_procedure_property
+ (m, scm_sym_system_procedure)))
+ break;
+
--i;
++inner;
}
"Return @code{#t} if @var{obj} is a calling stack.")
#define FUNC_NAME s_scm_stack_p
{
- return SCM_BOOL(SCM_STACKP (obj));
+ return scm_from_bool(SCM_STACKP (obj));
}
#undef FUNC_NAME
SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
(SCM obj, SCM args),
- "")
+ "Create a new stack. If @var{obj} is @code{#t}, the current\n"
+ "evaluation stack is used for creating the stack frames,\n"
+ "otherwise the frames are taken from @var{obj} (which must be\n"
+ "either a debug object or a continuation).\n\n"
+ "@var{args} should be a list containing any combination of\n"
+ "integer, procedure and @code{#t} values.\n\n"
+ "These values specify various ways of cutting away uninteresting\n"
+ "stack frames from the top and bottom of the stack that\n"
+ "@code{make-stack} returns. They come in pairs like this:\n"
+ "@code{(@var{inner_cut_1} @var{outer_cut_1} @var{inner_cut_2}\n"
+ "@var{outer_cut_2} @dots{})}.\n\n"
+ "Each @var{inner_cut_N} can be @code{#t}, an integer, or a\n"
+ "procedure. @code{#t} means to cut away all frames up to but\n"
+ "excluding the first user module frame. An integer means to cut\n"
+ "away exactly that number of frames. A procedure means to cut\n"
+ "away all frames up to but excluding the application frame whose\n"
+ "procedure matches the specified one.\n\n"
+ "Each @var{outer_cut_N} can be an integer or a procedure. An\n"
+ "integer means to cut away that number of frames. A procedure\n"
+ "means to cut away frames down to but excluding the application\n"
+ "frame whose procedure matches the specified one.\n\n"
+ "If the @var{outer_cut_N} of the last pair is missing, it is\n"
+ "taken as 0.")
#define FUNC_NAME s_scm_make_stack
{
- int n, maxp, size;
- scm_debug_frame *dframe = scm_last_debug_frame;
- scm_info_frame *iframe;
+ long n, size;
+ int maxp;
+ scm_t_debug_frame *dframe;
+ scm_t_info_frame *iframe;
long offset = 0;
SCM stack, id;
SCM inner_cut, outer_cut;
/* Extract a pointer to the innermost frame of whatever object
scm_make_stack was given. */
- /* just use dframe == scm_last_debug_frame
- (from initialization of dframe, above) if obj is #t */
- if (!SCM_TRUE_P (obj))
+ if (SCM_EQ_P (obj, SCM_BOOL_T))
{
- 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))
- {
- offset = ((SCM_STACKITEM *) (SCM_CHARS (obj) + sizeof (scm_contregs))
- - SCM_BASE (obj));
-#ifndef STACK_GROWS_UP
- offset += SCM_LENGTH (obj);
+ dframe = scm_last_debug_frame;
+ }
+ else if (SCM_DEBUGOBJP (obj))
+ {
+ dframe = SCM_DEBUGOBJ_FRAME (obj);
+ }
+ else if (SCM_CONTINUATIONP (obj))
+ {
+ offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (obj) + sizeof (scm_t_contregs))
+ - SCM_BASE (obj));
+#if SCM_STACK_GROWS_UP
+ offset += SCM_CONTINUATION_LENGTH (obj);
#endif
- dframe = RELOC_FRAME (SCM_DFRAME (obj), offset);
- }
- else
- {
- SCM_WTA (SCM_ARG1, obj);
- abort ();
- }
+ dframe = RELOC_FRAME (SCM_DFRAME (obj), offset);
+ }
+ else
+ {
+ SCM_WRONG_TYPE_ARG (SCM_ARG1, obj);
+ /* not reached */
}
/* Count number of frames. Also get stack id tag and check whether
args = SCM_CDR (args);
if (SCM_NULLP (args))
{
- outer_cut = SCM_INUM0;
+ outer_cut = SCM_INUM0;
}
else
{
"Return the identifier given to @var{stack} by @code{start-stack}.")
#define FUNC_NAME s_scm_stack_id
{
- scm_debug_frame *dframe;
+ scm_t_debug_frame *dframe;
long offset = 0;
- if (SCM_TRUE_P (stack))
- dframe = scm_last_debug_frame;
- else
+ if (SCM_EQ_P (stack, SCM_BOOL_T))
{
- 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))
- {
- offset = ((SCM_STACKITEM *) (SCM_CHARS (stack) + sizeof (scm_contregs))
- - SCM_BASE (stack));
-#ifndef STACK_GROWS_UP
- offset += SCM_LENGTH (stack);
+ dframe = scm_last_debug_frame;
+ }
+ else if (SCM_DEBUGOBJP (stack))
+ {
+ dframe = SCM_DEBUGOBJ_FRAME (stack);
+ }
+ else if (SCM_CONTINUATIONP (stack))
+ {
+ offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (stack) + sizeof (scm_t_contregs))
+ - SCM_BASE (stack));
+#if SCM_STACK_GROWS_UP
+ offset += SCM_CONTINUATION_LENGTH (stack);
#endif
- dframe = RELOC_FRAME (SCM_DFRAME (stack), offset);
- }
- else if (SCM_STACKP (stack))
- return SCM_STACK (stack) -> id;
- else
- SCM_WRONG_TYPE_ARG (1, stack);
+ dframe = RELOC_FRAME (SCM_DFRAME (stack), offset);
}
+ else if (SCM_STACKP (stack))
+ {
+ return SCM_STACK (stack) -> id;
+ }
+ else
+ {
+ SCM_WRONG_TYPE_ARG (1, stack);
+ }
+
while (dframe && !SCM_VOIDFRAMEP (*dframe))
dframe = RELOC_FRAME (dframe->prev, offset);
if (dframe && SCM_VOIDFRAMEP (*dframe))
#undef FUNC_NAME
SCM_DEFINE (scm_stack_ref, "stack-ref", 2, 0, 0,
- (SCM stack, SCM i),
- "")
+ (SCM stack, SCM index),
+ "Return the @var{index}'th frame from @var{stack}.")
#define FUNC_NAME s_scm_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);
+ unsigned long int c_index;
+
+ SCM_VALIDATE_STACK (1, stack);
+ SCM_VALIDATE_INUM (2, index);
+ SCM_ASSERT_RANGE (1, index, SCM_INUM (index) >= 0);
+ c_index = SCM_INUM (index);
+ SCM_ASSERT_RANGE (1, index, c_index < SCM_STACK_LENGTH (stack));
+ return scm_cons (stack, index);
}
#undef FUNC_NAME
SCM_DEFINE (scm_stack_length, "stack-length", 1, 0, 0,
- (SCM stack),
- "")
+ (SCM stack),
+ "Return the length of @var{stack}.")
#define FUNC_NAME s_scm_stack_length
{
- SCM_VALIDATE_STACK (1,stack);
+ SCM_VALIDATE_STACK (1, stack);
return SCM_MAKINUM (SCM_STACK_LENGTH (stack));
}
#undef FUNC_NAME
SCM_DEFINE (scm_frame_p, "frame?", 1, 0, 0,
(SCM obj),
- "")
+ "Return @code{#t} if @var{obj} is a stack frame.")
#define FUNC_NAME s_scm_frame_p
{
- return SCM_BOOL(SCM_FRAMEP (obj));
+ return scm_from_bool(SCM_FRAMEP (obj));
}
#undef FUNC_NAME
SCM_DEFINE (scm_last_stack_frame, "last-stack-frame", 1, 0, 0,
- (SCM obj),
- "")
+ (SCM obj),
+ "Return a stack which consists of a single frame, which is the\n"
+ "last stack frame for @var{obj}. @var{obj} must be either a\n"
+ "debug object or a continuation.")
#define FUNC_NAME s_scm_last_stack_frame
{
- scm_debug_frame *dframe;
+ scm_t_debug_frame *dframe;
long offset = 0;
SCM stack;
- 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))
{
- offset = ((SCM_STACKITEM *) (SCM_CHARS (obj) + sizeof (scm_contregs))
+ dframe = SCM_DEBUGOBJ_FRAME (obj);
+ }
+ else if (SCM_CONTINUATIONP (obj))
+ {
+ offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (obj) + sizeof (scm_t_contregs))
- SCM_BASE (obj));
-#ifndef STACK_GROWS_UP
- offset += SCM_LENGTH (obj);
+#if SCM_STACK_GROWS_UP
+ offset += SCM_CONTINUATION_LENGTH (obj);
#endif
dframe = RELOC_FRAME (SCM_DFRAME (obj), offset);
}
else
{
- SCM_WTA (1,obj);
- abort ();
+ SCM_WRONG_TYPE_ARG (1, obj);
+ /* not reached */
}
if (!dframe || SCM_VOIDFRAMEP (*dframe))
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]);
+ (scm_t_info_frame *) &SCM_STACK (stack) -> frames[0]);
- return scm_cons (stack, SCM_INUM0);;
+ return scm_cons (stack, SCM_INUM0);
}
#undef FUNC_NAME
SCM_DEFINE (scm_frame_number, "frame-number", 1, 0, 0,
- (SCM frame),
- "")
+ (SCM frame),
+ "Return the frame number of @var{frame}.")
#define FUNC_NAME s_scm_frame_number
{
- SCM_VALIDATE_FRAME (1,frame);
+ SCM_VALIDATE_FRAME (1, frame);
return SCM_MAKINUM (SCM_FRAME_NUMBER (frame));
}
#undef FUNC_NAME
SCM_DEFINE (scm_frame_source, "frame-source", 1, 0, 0,
- (SCM frame),
- "")
+ (SCM frame),
+ "Return the source of @var{frame}.")
#define FUNC_NAME s_scm_frame_source
{
- SCM_VALIDATE_FRAME (1,frame);
+ SCM_VALIDATE_FRAME (1, frame);
return SCM_FRAME_SOURCE (frame);
}
#undef FUNC_NAME
SCM_DEFINE (scm_frame_procedure, "frame-procedure", 1, 0, 0,
- (SCM frame),
- "")
+ (SCM frame),
+ "Return the procedure for @var{frame}, or @code{#f} if no\n"
+ "procedure is associated with @var{frame}.")
#define FUNC_NAME s_scm_frame_procedure
{
- SCM_VALIDATE_FRAME (1,frame);
+ SCM_VALIDATE_FRAME (1, frame);
return (SCM_FRAME_PROC_P (frame)
? SCM_FRAME_PROC (frame)
: SCM_BOOL_F);
#undef FUNC_NAME
SCM_DEFINE (scm_frame_arguments, "frame-arguments", 1, 0, 0,
- (SCM frame),
- "")
+ (SCM frame),
+ "Return the arguments of @var{frame}.")
#define FUNC_NAME s_scm_frame_arguments
{
- SCM_VALIDATE_FRAME (1,frame);
+ SCM_VALIDATE_FRAME (1, frame);
return SCM_FRAME_ARGS (frame);
}
#undef FUNC_NAME
SCM_DEFINE (scm_frame_previous, "frame-previous", 1, 0, 0,
- (SCM frame),
- "")
+ (SCM frame),
+ "Return the previous frame of @var{frame}, or @code{#f} if\n"
+ "@var{frame} is the first frame in its stack.")
#define FUNC_NAME s_scm_frame_previous
{
- int n;
- SCM_VALIDATE_FRAME (1,frame);
+ unsigned long int n;
+ SCM_VALIDATE_FRAME (1, frame);
n = SCM_INUM (SCM_CDR (frame)) + 1;
if (n >= SCM_STACK_LENGTH (SCM_CAR (frame)))
return SCM_BOOL_F;
SCM_DEFINE (scm_frame_next, "frame-next", 1, 0, 0,
(SCM frame),
- "")
+ "Return the next frame of @var{frame}, or @code{#f} if\n"
+ "@var{frame} is the last frame in its stack.")
#define FUNC_NAME s_scm_frame_next
{
- int n;
- SCM_VALIDATE_FRAME (1,frame);
- n = SCM_INUM (SCM_CDR (frame)) - 1;
- if (n < 0)
+ unsigned long int n;
+ SCM_VALIDATE_FRAME (1, frame);
+ n = SCM_INUM (SCM_CDR (frame));
+ if (n == 0)
return SCM_BOOL_F;
else
- return scm_cons (SCM_CAR (frame), SCM_MAKINUM (n));
+ return scm_cons (SCM_CAR (frame), SCM_MAKINUM (n - 1));
}
#undef FUNC_NAME
SCM_DEFINE (scm_frame_real_p, "frame-real?", 1, 0, 0,
- (SCM frame),
- "")
+ (SCM frame),
+ "Return @code{#t} if @var{frame} is a real frame.")
#define FUNC_NAME s_scm_frame_real_p
{
- SCM_VALIDATE_FRAME (1,frame);
- return SCM_BOOL(SCM_FRAME_REAL_P (frame));
+ SCM_VALIDATE_FRAME (1, frame);
+ return scm_from_bool(SCM_FRAME_REAL_P (frame));
}
#undef FUNC_NAME
SCM_DEFINE (scm_frame_procedure_p, "frame-procedure?", 1, 0, 0,
- (SCM frame),
- "")
+ (SCM frame),
+ "Return @code{#t} if a procedure is associated with @var{frame}.")
#define FUNC_NAME s_scm_frame_procedure_p
{
- SCM_VALIDATE_FRAME (1,frame);
- return SCM_BOOL(SCM_FRAME_PROC_P (frame));
+ SCM_VALIDATE_FRAME (1, frame);
+ return scm_from_bool(SCM_FRAME_PROC_P (frame));
}
#undef FUNC_NAME
SCM_DEFINE (scm_frame_evaluating_args_p, "frame-evaluating-args?", 1, 0, 0,
- (SCM frame),
- "")
+ (SCM frame),
+ "Return @code{#t} if @var{frame} contains evaluated arguments.")
#define FUNC_NAME s_scm_frame_evaluating_args_p
{
- SCM_VALIDATE_FRAME (1,frame);
- return SCM_BOOL(SCM_FRAME_EVAL_ARGS_P (frame));
+ SCM_VALIDATE_FRAME (1, frame);
+ return scm_from_bool(SCM_FRAME_EVAL_ARGS_P (frame));
}
#undef FUNC_NAME
SCM_DEFINE (scm_frame_overflow_p, "frame-overflow?", 1, 0, 0,
- (SCM frame),
- "")
+ (SCM frame),
+ "Return @code{#t} if @var{frame} is an overflow frame.")
#define FUNC_NAME s_scm_frame_overflow_p
{
- SCM_VALIDATE_FRAME (1,frame);
- return SCM_BOOL(SCM_FRAME_OVERFLOW_P (frame));
+ SCM_VALIDATE_FRAME (1, frame);
+ return scm_from_bool(SCM_FRAME_OVERFLOW_P (frame));
}
#undef FUNC_NAME
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));
- vtable = scm_make_vtable_vtable (vtable_layout, SCM_INUM0, SCM_EOL);
+ vtable = scm_make_vtable_vtable (scm_nullstr, SCM_INUM0, SCM_EOL);
scm_stack_type
= 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")));
+ scm_set_struct_vtable_name_x (scm_stack_type, scm_str2symbol ("stack"));
#include "libguile/stacks.x"
}
HCoop / bpt / guile.git / blobdiff