home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / src / debug.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-10-09  |  946 b   |  43 lines
  1. /* backtrace-list, etc.
  2.  */
  3.  
  4. #include "scheme.h"
  5.  
  6. Object P_Backtrace_List (argc, argv) Object *argv; {
  7.     register GCNODE *p, *gp = GC_List;
  8.     register delta = 0;
  9.     Object cp, list, tail, cell, vec;
  10.     GC_Node3;
  11.  
  12.     if (argc > 0) {
  13.     cp = argv[0];
  14.     Check_Type (cp, T_Control_Point);
  15.     delta = CONTROL(cp)->delta;
  16.     gp = CONTROL(cp)->gclist;
  17.     }
  18.     vec = list = tail = Null;
  19.     GC_Link3 (vec, list, tail);
  20.     for ( ; gp; gp = p->next) {
  21.     p = (GCNODE *)NORM(gp);
  22.     switch (p->gclen) {
  23.     case TAG_ENV:
  24.         vec = Make_Vector (3, Null);
  25.         VECTOR(vec)->data[2] = *(Object *)NORM(p->gcobj);
  26.         break;
  27.     case TAG_FUN: case TAG_TCFUN:
  28.         VECTOR(vec)->data[0] = *(Object *)NORM(p->gcobj);
  29.         break;
  30.     case TAG_ARGS:
  31.         VECTOR(vec)->data[1] = *(Object *)NORM(p->gcobj);
  32.         cell = Cons (vec, Null);
  33.         if (Nullp (list))
  34.         list = cell;
  35.         else
  36.         (void)P_Setcdr (tail, cell);
  37.         tail = cell;
  38.     }
  39.     }
  40.     GC_Unlink;
  41.     return list;
  42. }
  43.