home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / lisp / kcl_tar.z / kcl_tar / c / frame.c < prev    next >
Encoding:
C/C++ Source or Header  |  1987-06-04  |  1.1 KB  |  65 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.c
  10.  
  11.     frame and non-local jump
  12. */
  13.  
  14. #include "include.h"
  15.  
  16. unwind(fr, tag)
  17. frame_ptr fr;
  18. object tag;
  19. {
  20.     nlj_fr = fr;
  21.     nlj_tag = tag;
  22.     nlj_active = TRUE;
  23.     while (frs_top != fr
  24.         && frs_top->frs_class == FRS_CATCH
  25.         /*
  26.         && frs_top->frs_class != FRS_PROTECT
  27.         && frs_top->frs_class != FRS_CATCHALL
  28.         */
  29.           ) {
  30.         --frs_top;
  31.     }
  32.     lex_env = frs_top->frs_lex;
  33.     ihs_top = frs_top->frs_ihs;
  34.     bds_unwind(frs_top->frs_bds_top);
  35.     longjmp(frs_top->frs_jmpbuf, 0);
  36.     /* never reached */
  37. }
  38.  
  39. frame_ptr frs_sch (frame_id)
  40. object frame_id;
  41. {
  42.     frame_ptr top;
  43.  
  44.     for (top = frs_top;  top >= frs_org;  top--)
  45.         if (top->frs_val == frame_id && top->frs_class == FRS_CATCH)
  46.             return(top);
  47.     return(NULL);
  48. }
  49.  
  50. frame_ptr frs_sch_catch(frame_id)
  51. object frame_id;
  52. {
  53.     frame_ptr top;
  54.  
  55.     for(top = frs_top;  top >= frs_org  ;top--)
  56.         if (top->frs_val == frame_id && top->frs_class == FRS_CATCH
  57.             || top->frs_class == FRS_CATCHALL
  58.            )
  59.             return(top);
  60.     return(NULL);
  61. }
  62.  
  63.  
  64.  
  65.