libguile/stacks.c

   1 /* Representation of stack frame debug information
   2  * Copyright (C) 1996 Mikael Djurfeldt
   3  *
   4  * This program is free software; you can redistribute it and/or modify
   5  * it under the terms of the GNU General Public License as published by
   6  * the Free Software Foundation; either version 2, or (at your option)
   7  * any later version.
   8  *
   9  * This program 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
  12  * GNU General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU General Public License
  15  * along with this software; see the file COPYING.  If not, write to
  16  * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  17  *
  18  * As a special exception, the Free Software Foundation gives permission
  19  * for additional uses of the text contained in its release of GUILE.
  20  *
  21  * The exception is that, if you link the GUILE library with other files
  22  * to produce an executable, this does not by itself cause the
  23  * resulting executable to be covered by the GNU General Public License.
  24  * Your use of that executable is in no way restricted on account of
  25  * linking the GUILE library code into it.
  26  *
  27  * This exception does not however invalidate any other reasons why
  28  * the executable file might be covered by the GNU General Public License.
  29  *
  30  * This exception applies only to the code released by the
  31  * Free Software Foundation under the name GUILE.  If you copy
  32  * code from other Free Software Foundation releases into a copy of
  33  * GUILE, as the General Public License permits, the exception does
  34  * not apply to the code that you add in this way.  To avoid misleading
  35  * anyone as to the status of such modified files, you must delete
  36  * this exception notice from them.
  37  *
  38  * If you write modifications of your own for GUILE, it is your choice
  39  * whether to permit this exception to apply to your modifications.
  40  * If you do not wish that, delete this exception notice.
  41  *
  42  * The author can be reached at djurfeldt@nada.kth.se
  43  * Mikael Djurfeldt, SANS/NADA KTH, 10044 STOCKHOLM, SWEDEN
  44  */
  45 \f
  46
  47 #include <stdio.h>
  48 #include "_scm.h"
  49 #include "debug.h"
  50 #include "continuations.h"
  51 #include "struct.h"
  52
  53 #include "stacks.h"
  54
  55 \f
  56 /* {Frames and stacks}
  57  *
  58  * The debugging evaluator creates debug frames on the stack.  These
  59  * are linked from the innermost frame and outwards.  The last frame
  60  * created can always be accessed as SCM_LAST_DEBUG_FRAME.
  61  * Continuations contain a pointer to the innermost debug frame on the
  62  * continuation stack.
  63  *
  64  * Each debug frame contains a set of flags and information about one
  65  * or more stack frames.  The case of multiple frames occurs due to
  66  * tail recursion.  The maximal number of stack frames which can be
  67  * recorded in one debug frame can be set dynamically with the debug
  68  * option FRAMES.
  69  *
  70  * Stack frame information is of two types: eval information (the
  71  * expression being evaluated and its environment) and apply
  72  * information (the procedure being applied and its arguments).  A
  73  * stack frame normally corresponds to an eval/apply pair, but macros
  74  * and special forms (which are implemented as macros in Guile) only
  75  * have eval information and apply calls leads to apply only frames.
  76  *
  77  * Since we want to record the total stack information and later
  78  * manipulate this data at the scheme level in the debugger, we need
  79  * to transform it into a new representation.  In the following code
  80  * section you'll find the functions implementing this data type.
  81  *
  82  * Representation:
  83  *
  84  * The stack is represented as a struct with an id slot and a tail
  85  * array of scm_info_frame structs.
  86  *
  87  * A frame is represented as a pair where the car contains a stack and
  88  * the cdr an inum.  The inum is an index to the first SCM value of
  89  * the scm_info_frame struct.
  90  *
  91  * Stacks
  92  *   Constructor
  93  *     make-stack
  94  *   Selectors
  95  *     stack-id
  96  *     stack-ref
  97  *   Inspector
  98  *     stack-length
  99  *
 100  * Frames
 101  *   Constructor
 102  *     last-stack-frame
 103  *   Selectors
 104  *     frame-number
 105  *     frame-source
 106  *     frame-procedure
 107  *     frame-arguments
 108  *     frame-previous
 109  *     frame-next
 110  *   Predicates
 111  *     frame-real?
 112  *     frame-procedure?
 113  *     frame-evaluating-args?
 114  *     frame-overflow?  */
 115
 116 \f
 117
 118 /* Some auxiliary functions for reading debug frames off the stack.
 119  */
 120
 121 /* Count number of debug info frames on a stack, beginning with
 122  * DFRAME.  OFFSET is used for relocation of pointers when the stack
 123  * is read from a continuation.
 124  */
 125 static int stack_depth SCM_P ((scm_debug_frame *dframe, long offset, SCM *id, int *maxp));
 126 static int
 127 stack_depth (dframe, offset, id, maxp)
 128      scm_debug_frame *dframe;
 129      long offset;
 130      SCM *id;
 131      int *maxp;
 132 {
 133   int n, size;
 134   int max_depth = SCM_BACKTRACE_MAXDEPTH;
 135   scm_debug_info *info;
 136   for (n = 0;
 137        dframe && !SCM_VOIDFRAMEP (*dframe) && n < max_depth;
 138        dframe = (scm_debug_frame *) ((SCM_STACKITEM *) dframe->prev + offset))
 139     {
 140       if (SCM_EVALFRAMEP (*dframe))
 141         {
 142           size = dframe->status & SCM_MAX_FRAME_SIZE;
 143           info = (scm_debug_info *) (*((SCM_STACKITEM **) &dframe->vect[size])
 144                                      + offset);
 145           n += (info - dframe->vect) / 2 + 1;
 146           /* Data in the apply part of an eval info frame comes from previous
 147              stack frame if the scm_debug_info vector is overflowed. */
 148           if ((((info - dframe->vect) & 1) == 0)
 149               && SCM_OVERFLOWP (*dframe)
 150               && !SCM_UNBNDP (info[1].a.proc))
 151             ++n;
 152         }
 153       else
 154         ++n;
 155     }
 156   if (dframe && SCM_VOIDFRAMEP (*dframe))
 157     *id = dframe->vect[0].id;
 158   else if (dframe)
 159     *maxp = 1;
 160   return n;
 161 }
 162
 163 /* Read debug info from DFRAME into IFRAME.
 164  */
 165 static void read_frame SCM_P ((scm_debug_frame *dframe, long offset, scm_info_frame *iframe));
 166 static void
 167 read_frame (dframe, offset, iframe)
 168      scm_debug_frame *dframe;
 169      long offset;
 170      scm_info_frame *iframe;
 171 {
 172   SCM flags = SCM_INUM0;
 173   int size;
 174   scm_debug_info *info;
 175   if (SCM_EVALFRAMEP (*dframe))
 176     {
 177       size = dframe->status & SCM_MAX_FRAME_SIZE;
 178       info = (scm_debug_info *) (*((SCM_STACKITEM **) &dframe->vect[size])
 179                                  + offset);
 180       if ((info - dframe->vect) & 1)
 181         {
 182           /* Debug.vect ends with apply info. */
 183           --info;
 184           if (info[1].a.proc != SCM_UNDEFINED)
 185             {
 186               flags |= SCM_FRAMEF_PROC;
 187               iframe->proc = info[1].a.proc;
 188               iframe->args = info[1].a.args;
 189               if (!SCM_ARGS_READY_P (*dframe))
 190                 flags |= SCM_FRAMEF_EVAL_ARGS;
 191             }
 192         }
 193       iframe->source = scm_make_memoized (info[0].e.exp, info[0].e.env);
 194     }
 195   else
 196     {
 197       flags |= SCM_FRAMEF_PROC;
 198       iframe->proc = dframe->vect[0].a.proc;
 199       iframe->args = dframe->vect[0].a.args;
 200     }
 201   iframe->flags = flags;
 202 }
 203
 204 /* Fill the scm_info_frame vector IFRAME with data from N stack frames
 205  * starting with the first stack frame represented by debug frame
 206  * DFRAME.
 207  */
 208
 209 #define NEXT_FRAME(iframe, n, quit) \
 210 { \
 211   ++iframe; \
 212   if (--n == 0) \
 213     goto quit; \
 214 } \
 215
 216
 217 static void read_frames SCM_P ((scm_debug_frame *dframe, long offset, int nframes, scm_info_frame *iframes));
 218 static void
 219 read_frames (dframe, offset, n, iframes)
 220      scm_debug_frame *dframe;
 221      long offset;
 222      int n;
 223      scm_info_frame *iframes;
 224 {
 225   int size;
 226   scm_info_frame *iframe = iframes;
 227   scm_debug_info *info;
 228
 229   for (;
 230        dframe && !SCM_VOIDFRAMEP (*dframe) && n > 0;
 231        dframe = (scm_debug_frame *) ((SCM_STACKITEM *) dframe->prev + offset))
 232     {
 233       read_frame (dframe, offset, iframe);
 234       if (SCM_EVALFRAMEP (*dframe))
 235         {
 236           size = dframe->status & SCM_MAX_FRAME_SIZE;
 237           info = (scm_debug_info *) (*((SCM_STACKITEM **) &dframe->vect[size])
 238                                      + offset);
 239           if ((info - dframe->vect) & 1)
 240             --info;
 241           /* Data in the apply part of an eval info frame comes from
 242              previous stack frame if the scm_debug_info vector is overflowed. */
 243           else if (SCM_OVERFLOWP (*dframe)
 244                    && !SCM_UNBNDP (info[1].a.proc))
 245             {
 246               NEXT_FRAME (iframe, n, quit);
 247               iframe->flags = SCM_INUM0 | SCM_FRAMEF_PROC;
 248               iframe->proc = info[1].a.proc;
 249               iframe->args = info[1].a.args;
 250             }
 251           if (SCM_OVERFLOWP (*dframe))
 252             iframe->flags |= SCM_FRAMEF_OVERFLOW;
 253           info -= 2;
 254           NEXT_FRAME (iframe, n, quit);
 255           while (info >= dframe->vect)
 256             {
 257               if (!SCM_UNBNDP (info[1].a.proc))
 258                 {
 259                   iframe->flags = SCM_INUM0 | SCM_FRAMEF_PROC;
 260                   iframe->proc = info[1].a.proc;
 261                   iframe->args = info[1].a.args;
 262                 }
 263               else
 264                 iframe->flags = SCM_INUM0;
 265               iframe->source = scm_make_memoized (info[0].e.exp,
 266                                                   info[0].e.env);
 267               info -= 2;
 268               NEXT_FRAME (iframe, n, quit);
 269             }
 270         }
 271       else
 272         {
 273           NEXT_FRAME (iframe, n, quit);
 274         }
 275     quit:
 276       if (iframe > iframes)
 277         (iframe - 1) -> flags |= SCM_FRAMEF_REAL;
 278     }
 279 }
 280
 281 static void narrow_stack SCM_P ((SCM stack, int inner, SCM inner_key, int outer, SCM outer_key));
 282
 283 static void
 284 narrow_stack (stack, inner, inner_key, outer, outer_key)
 285      SCM stack;
 286      int inner;
 287      SCM inner_key;
 288      int outer;
 289      SCM outer_key;
 290 {
 291   scm_stack *s = SCM_STACK (stack);
 292   int i;
 293   int n = s->length;
 294
 295   /* Cut inner part. */
 296   for (i = 0; inner; --inner)
 297     if (s->frames[i++].proc == inner_key)
 298       break;
 299   s->frames = &s->frames[i];
 300   n -= i;
 301
 302   /* Cut outer part. */
 303   for (; n && outer; --outer)
 304     if (s->frames[--n].proc == outer_key)
 305       break;
 306
 307   s->length = n;
 308 }
 309
 310 \f
 311
 312 /* Stacks
 313  */
 314
 315 SCM scm_stack_type;
 316
 317 SCM_PROC (s_stack_p, "stack?", 1, 0, 0, scm_stack_p);
 318 SCM
 319 scm_stack_p (obj)
 320      SCM obj;
 321 {
 322   return SCM_NIMP (obj) && SCM_STACKP (obj) ? SCM_BOOL_T : SCM_BOOL_F;
 323 }
 324
 325 SCM_PROC (s_make_stack, "make-stack", 0, 0, 1, scm_make_stack);
 326 SCM
 327 scm_make_stack (args)
 328      SCM args;
 329 {
 330   int n, maxp, size;
 331   scm_debug_frame *dframe;
 332   scm_info_frame *iframe;
 333   long offset = 0;
 334   SCM stack, id;
 335   SCM obj, inner_cut, outer_cut;
 336
 337   SCM_ASSERT (SCM_NIMP (args) && SCM_CONSP (args), SCM_WNA, args, s_make_stack);
 338   obj = SCM_CAR (args);
 339   args = SCM_CDR (args);
 340
 341   /* Extract a pointer to the innermost frame of whatever object
 342      scm_make_stack was given.  */
 343   if (obj == SCM_BOOL_T)
 344     dframe = scm_last_debug_frame;
 345   else
 346     {
 347       SCM_ASSERT (SCM_NIMP (obj), obj, SCM_ARG1, s_make_stack);
 348       if (SCM_DEBUGOBJP (obj))
 349         dframe = (scm_debug_frame *) SCM_DEBUGOBJ_FRAME (obj);
 350       else if (scm_tc7_contin == SCM_TYP7 (obj))
 351         {
 352           offset = ((SCM_STACKITEM *) (SCM_CHARS (obj) + sizeof (scm_contregs))
 353                     - SCM_BASE (obj));
 354 #ifndef STACK_GROWS_UP
 355           offset += SCM_LENGTH (obj);
 356 #endif
 357           dframe = (scm_debug_frame *) ((SCM_STACKITEM *) SCM_DFRAME (obj)
 358                                        + offset);
 359         }
 360       else
 361         {
 362           scm_wta (obj, (char *) SCM_ARG1, s_make_stack);
 363           abort ();
 364         }
 365     }
 366
 367   /* Count number of frames.  Also get stack id tag and check whether
 368      there are more stackframes than we want to record
 369      (SCM_BACKTRACE_MAXDEPTH). */
 370   id = SCM_BOOL_F;
 371   maxp = 0;
 372   n = stack_depth (dframe, offset, &id, &maxp);
 373   size = n * SCM_FRAME_N_SLOTS;
 374
 375   /* Make the stack object. */
 376   stack = scm_make_struct (scm_stack_type, SCM_MAKINUM (size), SCM_EOL);
 377   SCM_STACK (stack) -> id = id;
 378   SCM_STACK (stack) -> length = n;
 379   iframe = &SCM_STACK (stack) -> tail[0];
 380   SCM_STACK (stack) -> frames = iframe;
 381
 382   /* Translate the current chain of stack frames into debugging information. */
 383   read_frames ((scm_debug_frame *) ((SCM_STACKITEM *) dframe + offset),
 384                offset, n, iframe);
 385
 386   /* Narrow the stack according to the arguments given to scm_make_stack. */
 387   while (n > 0 && SCM_NIMP (args) && SCM_CONSP (args))
 388     {
 389       inner_cut = SCM_CAR (args);
 390       args = SCM_CDR (args);
 391       if (SCM_NIMP (args) && SCM_CONSP (args))
 392         {
 393           outer_cut = SCM_CAR (args);
 394           args = SCM_CDR (args);
 395         }
 396       else
 397         outer_cut = SCM_INUM0;
 398
 399       narrow_stack (stack,
 400                     SCM_INUMP (inner_cut) ? SCM_INUM (inner_cut) : n,
 401                     SCM_INUMP (inner_cut) ? 0 : inner_cut,
 402                     SCM_INUMP (outer_cut) ? SCM_INUM (outer_cut) : n,
 403                     SCM_INUMP (outer_cut) ? 0 : outer_cut);
 404
 405       n = SCM_STACK (stack) -> length;
 406     }
 407
 408   if (n > 0)
 409     {
 410       if (maxp)
 411         iframe[n - 1].flags |= SCM_FRAMEF_OVERFLOW;
 412       return stack;
 413     }
 414   else
 415     return SCM_BOOL_F;
 416 }
 417
 418 SCM_PROC (s_stack_id, "stack-id", 1, 0, 0, scm_stack_id);
 419 SCM
 420 scm_stack_id (stack)
 421      SCM stack;
 422 {
 423   scm_debug_frame *dframe;
 424   long offset = 0;
 425   if (stack == SCM_BOOL_T)
 426     dframe = scm_last_debug_frame;
 427   else
 428     {
 429       SCM_ASSERT (SCM_NIMP (stack), stack, SCM_ARG1, s_make_stack);
 430       if (SCM_DEBUGOBJP (stack))
 431         dframe = (scm_debug_frame *) SCM_DEBUGOBJ_FRAME (stack);
 432       else if (scm_tc7_contin == SCM_TYP7 (stack))
 433         {
 434           offset = ((SCM_STACKITEM *) (SCM_CHARS (stack) + sizeof (scm_contregs))
 435                     - SCM_BASE (stack));
 436 #ifndef STACK_GROWS_UP
 437           offset += SCM_LENGTH (stack);
 438 #endif
 439           dframe = (scm_debug_frame *) ((SCM_STACKITEM *) SCM_DFRAME (stack)
 440                                        + offset);
 441         }
 442       else if (SCM_STACKP (stack))
 443         return SCM_STACK (stack) -> id;
 444       else scm_wrong_type_arg (s_stack_id, SCM_ARG1, stack);
 445     }
 446   while (dframe && !SCM_VOIDFRAMEP (*dframe))
 447     dframe = (scm_debug_frame *) ((SCM_STACKITEM *) dframe->prev + offset);
 448   if (dframe && SCM_VOIDFRAMEP (*dframe))
 449     return dframe->vect[0].id;
 450   return SCM_BOOL_F;
 451 }
 452
 453 SCM_PROC (s_stack_ref, "stack-ref", 2, 0, 0, scm_stack_ref);
 454 SCM
 455 scm_stack_ref (stack, i)
 456      SCM stack;
 457      SCM i;
 458 {
 459   SCM_ASSERT (SCM_NIMP (stack)
 460               && SCM_STACKP (stack),
 461               stack,
 462               SCM_ARG1,
 463               s_stack_ref);
 464   SCM_ASSERT (SCM_INUMP (i), i, SCM_ARG2, s_stack_ref);
 465   SCM_ASSERT (SCM_INUM (i) >= 0
 466               && SCM_INUM (i) < SCM_STACK_LENGTH (stack),
 467               i,
 468               SCM_OUTOFRANGE,
 469               s_stack_ref);
 470   return scm_cons (stack, i);
 471 }
 472
 473 SCM_PROC(s_stack_length, "stack-length", 1, 0, 0, scm_stack_length);
 474 SCM
 475 scm_stack_length (stack)
 476      SCM stack;
 477 {
 478   SCM_ASSERT (SCM_NIMP (stack)
 479               && SCM_STACKP (stack),
 480               stack,
 481               SCM_ARG1,
 482               s_stack_length);
 483   return SCM_MAKINUM (SCM_STACK_LENGTH (stack));
 484 }
 485
 486 /* Frames
 487  */
 488
 489 SCM_PROC (s_frame_p, "frame?", 1, 0, 0, scm_frame_p);
 490 SCM
 491 scm_frame_p (obj)
 492      SCM obj;
 493 {
 494   return SCM_NIMP (obj) && SCM_FRAMEP (obj);
 495 }
 496
 497 SCM_PROC(s_last_stack_frame, "last-stack-frame", 1, 0, 0, scm_last_stack_frame);
 498 SCM
 499 scm_last_stack_frame (obj)
 500      SCM obj;
 501 {
 502   scm_debug_frame *dframe;
 503   long offset = 0;
 504   SCM stack;
 505
 506   SCM_ASSERT (SCM_NIMP (obj), obj, SCM_ARG1, s_last_stack_frame);
 507   if (SCM_DEBUGOBJP (obj))
 508     dframe = (scm_debug_frame *) SCM_DEBUGOBJ_FRAME (obj);
 509   else if (scm_tc7_contin == SCM_TYP7 (obj))
 510     {
 511       offset = ((SCM_STACKITEM *) (SCM_CHARS (obj) + sizeof (scm_contregs))
 512                 - SCM_BASE (obj));
 513 #ifndef STACK_GROWS_UP
 514       offset += SCM_LENGTH (obj);
 515 #endif
 516       dframe = (scm_debug_frame *) ((SCM_STACKITEM *) SCM_DFRAME (obj) + offset);
 517     }
 518   else
 519     {
 520       scm_wta (obj, (char *) SCM_ARG1, s_last_stack_frame);
 521       abort ();
 522     }
 523
 524   if (!dframe || SCM_VOIDFRAMEP (*dframe))
 525     return SCM_BOOL_F;
 526
 527   stack = scm_make_struct (scm_stack_type, SCM_MAKINUM (SCM_FRAME_N_SLOTS), SCM_EOL);
 528   SCM_STACK (stack) -> length = 1;
 529   SCM_STACK (stack) -> frames = &SCM_STACK (stack) -> tail[0];
 530   read_frame (dframe, offset, (scm_info_frame *) &SCM_STACK (stack) -> frames[0]);
 531
 532   return scm_cons (stack, SCM_INUM0);;
 533 }
 534
 535 SCM_PROC(s_frame_number, "frame-number", 1, 0, 0, scm_frame_number);
 536 SCM
 537 scm_frame_number (frame)
 538      SCM frame;
 539 {
 540   SCM_ASSERT (SCM_NIMP (frame) && SCM_FRAMEP (frame),
 541               frame,
 542               SCM_ARG1,
 543               s_frame_number);
 544   return SCM_MAKINUM (SCM_FRAME_NUMBER (frame));
 545 }
 546
 547 SCM_PROC(s_frame_source, "frame-source", 1, 0, 0, scm_frame_source);
 548 SCM
 549 scm_frame_source (frame)
 550      SCM frame;
 551 {
 552   SCM_ASSERT (SCM_NIMP (frame) && SCM_FRAMEP (frame),
 553               frame,
 554               SCM_ARG1,
 555               s_frame_source);
 556   return SCM_FRAME_SOURCE (frame);
 557 }
 558
 559 SCM_PROC(s_frame_procedure, "frame-procedure", 1, 0, 0, scm_frame_procedure);
 560 SCM
 561 scm_frame_procedure (frame)
 562      SCM frame;
 563 {
 564   SCM_ASSERT (SCM_NIMP (frame) && SCM_FRAMEP (frame),
 565               frame,
 566               SCM_ARG1,
 567               s_frame_procedure);
 568   return (SCM_FRAME_PROC_P (frame)
 569           ? SCM_BOOL_F
 570           : SCM_FRAME_PROC (frame));
 571 }
 572
 573 SCM_PROC(s_frame_arguments, "frame-arguments", 1, 0, 0, scm_frame_arguments);
 574 SCM
 575 scm_frame_arguments (frame)
 576      SCM frame;
 577 {
 578   SCM_ASSERT (SCM_NIMP (frame) && SCM_FRAMEP (frame),
 579               frame,
 580               SCM_ARG1,
 581               s_frame_arguments);
 582   return SCM_FRAME_ARGS (frame);
 583 }
 584
 585 SCM_PROC(s_frame_previous, "frame-previous", 1, 0, 0, scm_frame_previous);
 586 SCM
 587 scm_frame_previous (frame)
 588      SCM frame;
 589 {
 590   int n;
 591   SCM_ASSERT (SCM_NIMP (frame) && SCM_FRAMEP (frame),
 592               frame,
 593               SCM_ARG1,
 594               s_frame_previous);
 595   n = SCM_INUM (SCM_CDR (frame)) + 1;
 596   if (n >= SCM_STACK_LENGTH (SCM_CAR (frame)))
 597     return SCM_BOOL_F;
 598   else
 599     return scm_cons (SCM_CAR (frame), SCM_MAKINUM (n));
 600 }
 601
 602 SCM_PROC(s_frame_next, "frame-next", 1, 0, 0, scm_frame_next);
 603 SCM
 604 scm_frame_next (frame)
 605      SCM frame;
 606 {
 607   int n;
 608   SCM_ASSERT (SCM_NIMP (frame) && SCM_FRAMEP (frame),
 609               frame,
 610               SCM_ARG1,
 611               s_frame_next);
 612   n = SCM_INUM (SCM_CDR (frame)) - 1;
 613   if (n < 0)
 614     return SCM_BOOL_F;
 615   else
 616     return scm_cons (SCM_CAR (frame), SCM_MAKINUM (n));
 617 }
 618
 619 SCM_PROC(s_frame_real_p, "frame-real?", 1, 0, 0, scm_frame_real_p);
 620 SCM
 621 scm_frame_real_p (frame)
 622      SCM frame;
 623 {
 624   SCM_ASSERT (SCM_NIMP (frame) && SCM_FRAMEP (frame),
 625               frame,
 626               SCM_ARG1,
 627               s_frame_real_p);
 628   return SCM_FRAME_REAL_P (frame) ? SCM_BOOL_T : SCM_BOOL_F;
 629 }
 630
 631 SCM_PROC(s_frame_procedure_p, "frame-procedure?", 1, 0, 0, scm_frame_procedure_p);
 632 SCM
 633 scm_frame_procedure_p (frame)
 634      SCM frame;
 635 {
 636   SCM_ASSERT (SCM_NIMP (frame) && SCM_FRAMEP (frame),
 637               frame,
 638               SCM_ARG1,
 639               s_frame_procedure_p);
 640   return SCM_FRAME_PROC_P (frame) ? SCM_BOOL_T : SCM_BOOL_F;
 641 }
 642
 643 SCM_PROC(s_frame_evaluating_args_p, "frame-evaluating-args?", 1, 0, 0, scm_frame_evaluating_args_p);
 644 SCM
 645 scm_frame_evaluating_args_p (frame)
 646      SCM frame;
 647 {
 648   SCM_ASSERT (SCM_NIMP (frame) && SCM_FRAMEP (frame),
 649               frame,
 650               SCM_ARG1,
 651               s_frame_evaluating_args_p);
 652   return SCM_FRAME_EVAL_ARGS_P (frame) ? SCM_BOOL_T : SCM_BOOL_F;
 653 }
 654
 655 SCM_PROC(s_frame_overflow_p, "frame-overflow?", 1, 0, 0, scm_frame_overflow_p);
 656 SCM
 657 scm_frame_overflow_p (frame)
 658      SCM frame;
 659 {
 660   SCM_ASSERT (SCM_NIMP (frame) && SCM_FRAMEP (frame),
 661               frame,
 662               SCM_ARG1,
 663               s_frame_overflow_p);
 664   return SCM_FRAME_OVERFLOW_P (frame) ? SCM_BOOL_T : SCM_BOOL_F;
 665 }
 666
 667 \f
 668
 669 void
 670 scm_init_stacks ()
 671 {
 672   SCM vtable;
 673   SCM vtable_layout = scm_make_struct_layout (scm_nullstr);
 674   SCM stack_layout = scm_make_struct_layout (scm_makfrom0str (SCM_STACK_LAYOUT));
 675   vtable = scm_make_vtable_vtable (vtable_layout, SCM_INUM0, SCM_EOL);
 676   scm_stack_type = scm_permanent_object (scm_make_struct (vtable,
 677                                                           SCM_INUM0,
 678                                                           scm_cons (stack_layout, SCM_EOL)));
 679 #include "stacks.x"
 680 }