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
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
|
/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program 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 General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
/* "continue.c" Scheme Continuations for C.
Author: Aubrey Jaffer */
/* "setjump.h" contains definitions for the `other' field (type
CONTINUATION_OTHER) the struct Continuation. "setjump.h" must
#include "continue.h". CONTINUATION_OTHER defaults to `long' */
#define IN_CONTINUE_C
#ifdef USE_CONTINUE_H
# include "continue.h"
#else
# include "setjump.h"
#endif
/* For platforms with short integers, we use thrown_value instead of
the value returned from setjmp so that any (long) value can be
returned. */
#ifdef SHORT_INT
long thrown_value;
#endif
/* stack_size() returns the number of units of size STACKITEM which
fit between @var{start} and the current top of stack. No check is
done in this routine to ensure that @var{start} is actually in the
current stack segment. */
long stack_size(start)
STACKITEM *start;
{
STACKITEM stack;
#ifdef STACK_GROWS_UP
return &stack - start;
#else
return start - &stack;
#endif /* def STACK_GROWS_UP */
}
/* make_root_continuation() allocates (malloc) storage for a
CONTINUATION near the current extent of stack. This newly
allocated CONTINUATION is returned if successful, 0 if not. After
make_root_continuation() returns, the calling routine still needs
to `setjmp(new_continuation->jmpbuf)' in order to complete the
capture of this continuation. */
CONTINUATION *make_root_continuation(stack_base)
STACKITEM *stack_base;
{
CONTINUATION *cont;
cont = (CONTINUATION *)malloc(sizeof(CONTINUATION));
if (!cont) return 0;
cont->length = 0;
cont->stkbse = stack_base;
cont->parent = cont;
return cont;
}
/* make_continuation() allocates storage for the current continuation,
copying (or encapsulating) the stack state from parent_cont->stkbse
to the current top of stack. The newly allocated CONTINUATION is
returned if successful, 0 if not. After make_continuation()
returns, the calling routine still needs to
`setjmp(new_continuation->jmpbuf)' in order to complete the capture
of this continuation. */
/* Note: allocating local (stack) storage for the CONTINUATION would
not work; Think about it. */
CONTINUATION *make_continuation(parent_cont)
CONTINUATION *parent_cont;
{
CONTINUATION *cont;
#ifdef CHEAP_CONTINUATIONS
cont = (CONTINUATION *)malloc(sizeof(CONTINUATION));
if (!cont) return 0;
cont->length = 0;
cont->stkbse = parent_cont->stkbse;
#else
long j;
register STACKITEM *src, *dst;
FLUSH_REGISTER_WINDOWS;
j = stack_size(parent_cont->stkbse);
cont = (CONTINUATION *)malloc((sizeof(CONTINUATION) + j*sizeof(STACKITEM)));
if (!cont) return 0;
cont->length = j;
cont->stkbse = parent_cont->stkbse;
src = cont->stkbse;
# ifdef STACK_GROWS_UP
src += parent_cont->length;
# else
src -= parent_cont->length + cont->length;
# endif/* ndef STACK_GROWS_UP */
dst = (STACKITEM *)(cont + 1);
for (j = cont->length; 0 <= --j; ) *dst++ = *src++;
#endif /* ndef CHEAP_CONTINUATIONS */
cont->parent = parent_cont;
return cont;
}
/* free_continuation() is trivial, but who knows what the future
holds. */
void free_continuation(cont)
CONTINUATION *cont;
{
free(cont);
}
/* Final routine involved in throw()ing to a continuation. After
ensuring that there is sufficient room on the stack for the saved
continuation, dynthrow() copies the continuation onto the stack and
longjmp()s into it. The routine does not return. */
/* If you use conservative GC and your Sparc(SUN-4) heap is growing
out of control:
You are experiencing a GC problem peculiar to the Sparc. The
problem is that contin doesn't know how to clear register windows.
Every location which is not reused still gets marked at GC time.
This causes lots of stuff which should be collected to not be.
This will be a problem with any *conservative* GC until we find
what instruction will clear the register windows. This problem is
exacerbated by using lots of make-CONTINUATION.
Possibly adding the following before the thrown_value = val; line
might help to clear out unused stack above the continuation (a
small part of the problem).
#ifdef sparc
bzero((void *)&a, sizeof(STACKITEM) *
(((STACKITEM *)&a) - (dst - cont->length)))
#endif
Let me know if you try it. */
void dynthrow(a)
long *a;
{
register CONTINUATION *cont = (CONTINUATION *)(a[0]);
long val = a[1];
#ifndef CHEAP_CONTINUATIONS
register long j;
register STACKITEM *src, *dst = cont->stkbse;
# ifdef STACK_GROWS_UP
if (a[2] && (a - ((long *)a[3]) < 100))
puts("grow_throw: check if long growth[100]; being optimized out");
/* if (a[2]) fprintf(stderr, " ct = %ld, dist = %ld\n", a[2], (((long *)a[3]) - a)); */
if PTR_GE(dst + (cont->length), (STACKITEM *)&a) grow_throw(a);
# else
if (a[2] && (((long *)a[3]) - a < 100))
puts("grow_throw: check if long growth[100]; being optimized out");
/* if (a[2]) fprintf(stderr, " ct = %ld, dist = %ld\n", a[2], (((long *)a[3]) - a)); */
dst -= cont->length;
if PTR_LE(dst, (STACKITEM *)&a) grow_throw(a);
# endif/* def STACK_GROWS_UP */
FLUSH_REGISTER_WINDOWS;
src = (STACKITEM *)(cont + 1);
for (j = cont->length;0 <= --j;) *dst++ = *src++;
#endif /* ndef CHEAP_CONTINUATIONS */
#ifdef SHORT_INT
thrown_value = val;
longjmp(cont->jmpbuf, 1);
#else
longjmp(cont->jmpbuf, val);
#endif
}
/* grow_throw() grows the stack by 100 long words. If the "sizeof
growth" assignment is not sufficient to restrain your overly
optimistic compiler, the stack will grow by much less and
grow_throw() and dynthrow() will waste time calling each other. To
fix this you will have to compile grow_throw() in a separate file
so the compiler won't be able to guess that the growth array isn't
all used. */
#ifndef CHEAP_CONTINUATIONS
void grow_throw(a) /* Grow the stack so that there is room */
long *a; /* to copy in the continuation. Then */
{ /* retry the throw. */
long growth[100];
growth[0] = a[0];
growth[1] = a[1];
growth[2] = a[2] + 1;
growth[3] = (long) a;
growth[99] = sizeof growth;
dynthrow(growth);
}
#endif /* ndef CHEAP_CONTINUATIONS */
/* throw_to_continuation() restores the stack in effect when
@var{cont} was made and resumes @var{cont}'s processor state. If
the stack cannot be resotred because @var{cont} and @var{root_cont}
do not have the same stkbase, @code{throw_to_continuation()
returns. */
/* Note: If 2 or more @var{cont}s share a parent continuation and if
the values of stack allocated variables in that parent continuation
are changed, the results are unspecified. This is because the
parent continuation may or may not be reloaded, depending on what
other throws have intervened. */
void throw_to_continuation(cont, val, root_cont)
CONTINUATION *cont;
long val;
CONTINUATION *root_cont;
{
long a[3];
a[0] = (long)cont;
a[1] = val;
a[2] = 0;
if (cont->stkbse != root_cont->stkbse)
return; /* Stale continuation */
dynthrow(a);
}
|
