1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
/*
Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
This file is part of GNU Common Lisp, herein referred to as GCL
GCL is free software; you can redistribute it and/or modify it under
the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GCL is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
License for more details.
You should have received a copy of the GNU Library General Public License
along with GCL; see the file COPYING. If not, write to the Free Software
Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*/
/*
frame.h
frame stack and non-local jump
*/
/* IHS Invocation History Stack */
typedef struct invocation_history {
object ihs_function;
object *ihs_base;
} *ihs_ptr;
EXTER ihs_ptr ihs_org;
EXTER ihs_ptr ihs_limit;
EXTER ihs_ptr ihs_top;
#define ihs_check \
if (ihs_top >= ihs_limit) \
ihs_overflow()
#define ihs_push(function) \
(++ihs_top)->ihs_function = (function); \
ihs_top->ihs_base = vs_base
#define ihs_push_base(function,base) \
(++ihs_top)->ihs_function = (function); \
ihs_top->ihs_base = base
#define ihs_pop() (ihs_top--)
#define make_nil_block() \
{ \
object x; \
\
lex_copy(); \
x = alloc_frame_id(); \
vs_push(x); \
lex_block_bind(Cnil, x); \
vs_popp; \
frs_push(FRS_CATCH, x); \
}
/* Frame Stack */
enum fr_class {
FRS_CATCH, /* for catch,block,tabbody */
FRS_CATCHALL, /* for catchall */
FRS_PROTECT /* for protect-all */
};
EXTER int in_signal_handler;
struct frame {
jmp_buf frs_jmpbuf;
object *frs_lex;
bds_ptr frs_bds_top;
char frs_class;
char frs_in_signal_handler;
object frs_val;
ihs_ptr frs_ihs;
};
typedef struct frame *frame_ptr;
#define alloc_frame_id() alloc_object(t_spice)
/*
frs_class | frs_value | frs_prev
----------+--------------------------------------+--------------
CATCH | frame-id, i.e. |
| throw-tag, |
| block-id (uninterned symbol), or | value of ihs_top
| tagbody-id (uninterned symbol) | when the frame
----------+--------------------------------------| was pushed
CATCHALL | NIL |
----------+--------------------------------------|
PROTECT | NIL |
----------------------------------------------------------------
*/
EXTER frame_ptr frs_org;
EXTER frame_ptr frs_limit;
EXTER frame_ptr frs_top; /* frame stack top */
#define frs_push(class, val) \
do { frame_ptr _frs_top = frs_top +1; \
if (_frs_top >= frs_limit) \
frs_overflow(); \
_frs_top->frs_lex = lex_env;\
_frs_top->frs_bds_top = bds_top; \
_frs_top->frs_class = (class); \
_frs_top->frs_in_signal_handler = in_signal_handler; \
_frs_top->frs_val = (val); \
_frs_top->frs_ihs = ihs_top; \
frs_top=_frs_top; \
setjmp(_frs_top->frs_jmpbuf); \
} while (0)
#define frs_pop() frs_top--
/* global variables used during non-local jump */
EXTER bool nlj_active; /* true during non-local jump */
EXTER frame_ptr nlj_fr; /* frame to return */
EXTER object nlj_tag; /* throw-tag, block-id, or */
/* (tagbody-id . label). */
|
