home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / lisp / kcl_tar.z / kcl_tar / h / frame.h < prev    next >
Encoding:
C/C++ Source or Header  |  1987-06-04  |  2.7 KB  |  124 lines
  1. /*
  2. (c) Copyright Taiichi Yuasa and Masami Hagiya, 1984.  All rights reserved.
  3. Copying of this file is authorized to users who have executed the true and
  4. proper "License Agreement for Kyoto Common LISP" with SIGLISP.
  5. */
  6.  
  7. /*
  8.  
  9.     frame.h
  10.  
  11.     frame stack and non-local jump
  12. */
  13.  
  14.  
  15. /*  IHS    Invocation History Stack  */
  16.  
  17. typedef struct invocation_history {
  18.     object    ihs_function;
  19.     object    *ihs_base;
  20. } *ihs_ptr;
  21.  
  22. #define    IHSSIZE        1024
  23. #define    IHSGETA        32
  24.  
  25. struct invocation_history ihs_stack[IHSSIZE + IHSGETA + IHSGETA];
  26.  
  27. #define ihs_org        ihs_stack
  28.  
  29. ihs_ptr ihs_limit;
  30.  
  31. ihs_ptr ihs_top;
  32.  
  33. #define    ihs_check  \
  34.     if (ihs_top >= ihs_limit)  \
  35.         ihs_overflow()
  36.  
  37. #define ihs_push(function)  \
  38.     (++ihs_top)->ihs_function = (function);  \
  39.     ihs_top->ihs_base = vs_base
  40.  
  41. #define ihs_pop()     (ihs_top--)
  42.  
  43.  
  44. #define make_nil_block()  \
  45. {  \
  46.     object x;  \
  47.   \
  48.     lex_copy();  \
  49.     x = alloc_frame_id();  \
  50.     vs_push(x);  \
  51.     lex_block_bind(Cnil, x);  \
  52.     vs_pop;  \
  53.     frs_push(FRS_CATCH, x);  \
  54. }
  55.  
  56.  
  57. /*  Frame Stack  */
  58.  
  59. enum fr_class {
  60.     FRS_CATCH,            /* for catch,block,tabbody */
  61.     FRS_CATCHALL,                   /* for catchall */
  62.     FRS_PROTECT                    /* for protect-all */
  63. };
  64.  
  65. struct frame {
  66.     jmp_buf        frs_jmpbuf;
  67.     object        *frs_lex;
  68.     bds_ptr        frs_bds_top;
  69.     enum fr_class    frs_class;
  70.     object        frs_val;
  71.     ihs_ptr        frs_ihs;
  72. };
  73.  
  74. typedef struct frame *frame_ptr;
  75.  
  76. #define    alloc_frame_id()    alloc_object(t_spice)
  77.  
  78. /*
  79. frs_class |            frs_value                 |  frs_prev
  80. ----------+--------------------------------------+--------------
  81. CATCH     | frame-id, i.e.                       |
  82.       |    throw-tag,                        |
  83.       |    block-id (uninterned symbol), or  | value of ihs_top
  84.       |    tagbody-id (uninterned symbol)    | when the frame
  85. ----------+--------------------------------------| was pushed
  86. CATCHALL  |               NIL                    |
  87. ----------+--------------------------------------|
  88. PROTECT   |               NIL                    |
  89. ----------------------------------------------------------------
  90. */
  91.  
  92. #define FRSSIZE        1024
  93. #define    FRSGETA        16
  94.  
  95. struct frame frame_stack[FRSSIZE + FRSGETA + FRSGETA];
  96.  
  97. #define frs_org        frame_stack
  98.  
  99. frame_ptr frs_limit;
  100.  
  101. frame_ptr frs_top;        /* frame stack top */
  102.  
  103. #define frs_push(class, val)  \
  104.     if (++frs_top >= frs_limit)  \
  105.         frs_overflow();  \
  106.     frs_top->frs_lex = lex_env;\
  107.     frs_top->frs_bds_top = bds_top;  \
  108.     frs_top->frs_class = (class);  \
  109.     frs_top->frs_val = (val);  \
  110.     frs_top->frs_ihs = ihs_top;  \
  111.         setjmp(frs_top->frs_jmpbuf)
  112.  
  113. #define frs_pop()    frs_top--
  114.  
  115.  
  116. /*  global variables used during non-local jump  */
  117.  
  118. bool nlj_active;        /* true during non-local jump */
  119. frame_ptr nlj_fr;        /* frame to return  */
  120. object nlj_tag;            /* throw-tag, block-id, or */
  121.                 /* (tagbody-id . label).   */
  122.  
  123.  
  124.