~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to o/frame.c

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
/*
 
2
 Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
 
3
 
 
4
This file is part of GNU Common Lisp, herein referred to as GCL
 
5
 
 
6
GCL is free software; you can redistribute it and/or modify it under
 
7
the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
 
8
the Free Software Foundation; either version 2, or (at your option)
 
9
any later version.
 
10
 
 
11
GCL is distributed in the hope that it will be useful, but WITHOUT
 
12
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
 
13
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public 
 
14
License for more details.
 
15
 
 
16
You should have received a copy of the GNU Library General Public License 
 
17
along with GCL; see the file COPYING.  If not, write to the Free Software
 
18
Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
19
 
 
20
*/
 
21
 
 
22
/*
 
23
 
 
24
        frame.c
 
25
 
 
26
        frame and non-local jump
 
27
*/
 
28
 
 
29
#include "include.h"
 
30
 
 
31
void
 
32
unwind(frame_ptr fr, object tag)
 
33
{
 
34
        signals_allowed = 0;
 
35
        nlj_fr = fr;
 
36
        nlj_tag = tag;
 
37
        nlj_active = TRUE;
 
38
        while (frs_top != fr
 
39
               && frs_top->frs_class == FRS_CATCH
 
40
               && frs_top >= frs_org
 
41
                /*
 
42
                && frs_top->frs_class != FRS_PROTECT
 
43
                && frs_top->frs_class != FRS_CATCHALL
 
44
                */
 
45
              ) {
 
46
                --frs_top;
 
47
        }
 
48
        if (frs_top<frs_org) {
 
49
          frs_top=frs_org;
 
50
          FEerror("Cannot unwind frame", 0);
 
51
        }
 
52
        lex_env = frs_top->frs_lex;
 
53
        ihs_top = frs_top->frs_ihs;
 
54
        bds_unwind(frs_top->frs_bds_top);
 
55
        in_signal_handler = frs_top->frs_in_signal_handler;
 
56
        signals_allowed=sig_normal;
 
57
        longjmp(frs_top->frs_jmpbuf, 0);
 
58
        /* never reached */
 
59
}
 
60
 
 
61
frame_ptr frs_sch (object frame_id)
 
62
{
 
63
        frame_ptr top;
 
64
 
 
65
        for (top = frs_top;  top >= frs_org;  top--)
 
66
                if (top->frs_val == frame_id && top->frs_class == FRS_CATCH)
 
67
                        return(top);
 
68
        return(NULL);
 
69
}
 
70
 
 
71
frame_ptr frs_sch_catch(object frame_id)
 
72
{
 
73
  frame_ptr top;
 
74
  
 
75
  for(top = frs_top;  top >= frs_org  ;top--)
 
76
    if ((top->frs_val == frame_id && top->frs_class == FRS_CATCH)
 
77
        || top->frs_class == FRS_CATCHALL
 
78
        )
 
79
      return(top);
 
80
  return(NULL);
 
81
}
 
82
 
 
83
 
 
84