Commit | Line | Data |
---|---|---|
98eaef1b | 1 | /* Copyright (C) 2012, 2013 Free Software Foundation, Inc. |
9ede013f AW |
2 | * |
3 | * This library is free software; you can redistribute it and/or | |
4 | * modify it under the terms of the GNU Lesser General Public License | |
5 | * as published by the Free Software Foundation; either version 3 of | |
6 | * the License, or (at your option) any later version. | |
7 | * | |
8 | * This library is distributed in the hope that it will be useful, but | |
9 | * WITHOUT ANY WARRANTY; without even the implied warranty of | |
10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
11 | * Lesser General Public License for more details. | |
12 | * | |
13 | * You should have received a copy of the GNU Lesser General Public | |
14 | * License along with this library; if not, write to the Free Software | |
15 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA | |
16 | * 02110-1301 USA | |
17 | */ | |
18 | ||
19 | ||
20 | \f | |
21 | ||
22 | #ifdef HAVE_CONFIG_H | |
23 | # include <config.h> | |
24 | #endif | |
25 | ||
26 | #include <assert.h> | |
27 | ||
28 | #include "libguile/_scm.h" | |
29 | #include "libguile/control.h" | |
30 | #include "libguile/eval.h" | |
31 | #include "libguile/fluids.h" | |
32 | #include "libguile/dynstack.h" | |
33 | ||
34 | ||
35 | \f | |
36 | ||
9d381ba4 | 37 | #define PROMPT_WORDS 5 |
9ede013f | 38 | #define PROMPT_KEY(top) (SCM_PACK ((top)[0])) |
0bca90aa AW |
39 | #define PROMPT_FP(top) ((scm_t_ptrdiff) ((top)[1])) |
40 | #define PROMPT_SP(top) ((scm_t_ptrdiff) ((top)[2])) | |
9121d9f1 | 41 | #define PROMPT_IP(top) ((scm_t_uint32 *) ((top)[3])) |
9d381ba4 | 42 | #define PROMPT_JMPBUF(top) ((scm_i_jmp_buf *) ((top)[4])) |
9ede013f AW |
43 | |
44 | #define WINDER_WORDS 2 | |
45 | #define WINDER_PROC(top) ((scm_t_guard) ((top)[0])) | |
46 | #define WINDER_DATA(top) ((void *) ((top)[1])) | |
47 | ||
48 | #define DYNWIND_WORDS 2 | |
49 | #define DYNWIND_ENTER(top) (SCM_PACK ((top)[0])) | |
50 | #define DYNWIND_LEAVE(top) (SCM_PACK ((top)[1])) | |
51 | ||
98eaef1b AW |
52 | #define WITH_FLUID_WORDS 2 |
53 | #define WITH_FLUID_FLUID(top) (SCM_PACK ((top)[0])) | |
54 | #define WITH_FLUID_VALUE_BOX(top) (SCM_PACK ((top)[1])) | |
9ede013f AW |
55 | |
56 | ||
57 | \f | |
58 | ||
59 | static void | |
60 | copy_scm_t_bits (scm_t_bits *dst, scm_t_bits *src, size_t n) | |
61 | { | |
62 | size_t i; | |
63 | ||
64 | for (i = 0; i < n; i++) | |
65 | dst[i] = src[i]; | |
66 | } | |
67 | ||
9ede013f AW |
68 | static void |
69 | clear_scm_t_bits (scm_t_bits *items, size_t n) | |
70 | { | |
71 | size_t i; | |
72 | ||
73 | for (i = 0; i < n; i++) | |
74 | items[i] = 0; | |
75 | } | |
76 | ||
77 | /* Ensure space for N additional words. */ | |
78 | static void | |
79 | dynstack_ensure_space (scm_t_dynstack *dynstack, size_t n) | |
80 | { | |
81 | size_t capacity = SCM_DYNSTACK_CAPACITY (dynstack); | |
82 | size_t height = SCM_DYNSTACK_HEIGHT (dynstack); | |
83 | ||
84 | n += SCM_DYNSTACK_HEADER_LEN; | |
85 | ||
86 | if (capacity < height + n) | |
87 | { | |
88 | scm_t_bits *new_base; | |
89 | ||
90 | while (capacity < height + n) | |
91 | capacity = (capacity < 4) ? 8 : (capacity * 2); | |
92 | ||
93 | new_base = scm_gc_malloc (capacity * sizeof(scm_t_bits), "dynstack"); | |
94 | ||
95 | copy_scm_t_bits (new_base, dynstack->base, height); | |
96 | clear_scm_t_bits (dynstack->base, height); | |
97 | ||
98 | dynstack->base = new_base; | |
99 | dynstack->top = new_base + height; | |
100 | dynstack->limit = new_base + capacity; | |
101 | } | |
102 | } | |
103 | ||
104 | static inline scm_t_bits * | |
105 | push_dynstack_entry_unchecked (scm_t_dynstack *dynstack, | |
106 | scm_t_dynstack_item_type type, | |
107 | scm_t_bits flags, size_t len) | |
108 | { | |
109 | scm_t_bits *ret = dynstack->top; | |
110 | ||
111 | SCM_DYNSTACK_SET_TAG (dynstack->top, SCM_MAKE_DYNSTACK_TAG (type, flags, len)); | |
112 | dynstack->top += SCM_DYNSTACK_HEADER_LEN + len; | |
113 | SCM_DYNSTACK_SET_PREV_OFFSET (dynstack->top, SCM_DYNSTACK_HEADER_LEN + len); | |
114 | ||
115 | return ret; | |
116 | } | |
117 | ||
118 | static inline scm_t_bits * | |
119 | push_dynstack_entry (scm_t_dynstack *dynstack, | |
120 | scm_t_dynstack_item_type type, | |
121 | scm_t_bits flags, size_t len) | |
122 | { | |
123 | if (SCM_UNLIKELY (!SCM_DYNSTACK_HAS_SPACE (dynstack, len))) | |
124 | dynstack_ensure_space (dynstack, len); | |
125 | return push_dynstack_entry_unchecked (dynstack, type, flags, len); | |
126 | } | |
127 | ||
128 | void | |
129 | scm_dynstack_push_frame (scm_t_dynstack *dynstack, | |
130 | scm_t_dynstack_frame_flags flags) | |
131 | { | |
132 | push_dynstack_entry (dynstack, SCM_DYNSTACK_TYPE_FRAME, flags, 0); | |
133 | } | |
134 | ||
135 | void | |
136 | scm_dynstack_push_rewinder (scm_t_dynstack *dynstack, | |
137 | scm_t_dynstack_winder_flags flags, | |
138 | scm_t_guard proc, void *data) | |
139 | { | |
140 | scm_t_bits *words; | |
141 | ||
98eaef1b AW |
142 | words = push_dynstack_entry (dynstack, SCM_DYNSTACK_TYPE_REWINDER, flags, |
143 | WINDER_WORDS); | |
9ede013f AW |
144 | words[0] = (scm_t_bits) proc; |
145 | words[1] = (scm_t_bits) data; | |
146 | } | |
147 | ||
148 | void | |
149 | scm_dynstack_push_unwinder (scm_t_dynstack *dynstack, | |
150 | scm_t_dynstack_winder_flags flags, | |
151 | scm_t_guard proc, void *data) | |
152 | { | |
153 | scm_t_bits *words; | |
154 | ||
98eaef1b AW |
155 | words = push_dynstack_entry (dynstack, SCM_DYNSTACK_TYPE_UNWINDER, flags, |
156 | WINDER_WORDS); | |
9ede013f AW |
157 | words[0] = (scm_t_bits) proc; |
158 | words[1] = (scm_t_bits) data; | |
159 | } | |
160 | ||
98eaef1b AW |
161 | /* The fluid is stored on the stack, but the value has to be stored on the heap, |
162 | so that all continuations that capture this dynamic scope capture the same | |
163 | binding. */ | |
9ede013f | 164 | void |
98eaef1b AW |
165 | scm_dynstack_push_fluid (scm_t_dynstack *dynstack, SCM fluid, SCM value, |
166 | SCM dynamic_state) | |
9ede013f AW |
167 | { |
168 | scm_t_bits *words; | |
98eaef1b AW |
169 | SCM value_box; |
170 | ||
171 | if (SCM_UNLIKELY (!SCM_FLUID_P (fluid))) | |
172 | scm_wrong_type_arg ("with-fluid*", 0, fluid); | |
9ede013f | 173 | |
98eaef1b | 174 | value_box = scm_make_variable (value); |
9ede013f | 175 | |
98eaef1b AW |
176 | words = push_dynstack_entry (dynstack, SCM_DYNSTACK_TYPE_WITH_FLUID, 0, |
177 | WITH_FLUID_WORDS); | |
178 | words[0] = SCM_UNPACK (fluid); | |
179 | words[1] = SCM_UNPACK (value_box); | |
9ede013f AW |
180 | |
181 | /* Go ahead and swap them. */ | |
98eaef1b | 182 | scm_swap_fluid (fluid, value_box, dynamic_state); |
9ede013f AW |
183 | } |
184 | ||
185 | void | |
186 | scm_dynstack_push_prompt (scm_t_dynstack *dynstack, | |
187 | scm_t_dynstack_prompt_flags flags, | |
9d381ba4 | 188 | SCM key, |
0bca90aa AW |
189 | scm_t_ptrdiff fp_offset, scm_t_ptrdiff sp_offset, |
190 | scm_t_uint32 *ip, scm_i_jmp_buf *registers) | |
9ede013f AW |
191 | { |
192 | scm_t_bits *words; | |
193 | ||
9d381ba4 AW |
194 | words = push_dynstack_entry (dynstack, SCM_DYNSTACK_TYPE_PROMPT, flags, |
195 | PROMPT_WORDS); | |
9ede013f | 196 | words[0] = SCM_UNPACK (key); |
0bca90aa AW |
197 | words[1] = (scm_t_bits) fp_offset; |
198 | words[2] = (scm_t_bits) sp_offset; | |
9d381ba4 AW |
199 | words[3] = (scm_t_bits) ip; |
200 | words[4] = (scm_t_bits) registers; | |
9ede013f AW |
201 | } |
202 | ||
203 | void | |
204 | scm_dynstack_push_dynwind (scm_t_dynstack *dynstack, SCM enter, SCM leave) | |
205 | { | |
206 | scm_t_bits *words; | |
207 | ||
98eaef1b AW |
208 | words = push_dynstack_entry (dynstack, SCM_DYNSTACK_TYPE_DYNWIND, 0, |
209 | DYNWIND_WORDS); | |
9ede013f AW |
210 | words[0] = SCM_UNPACK (enter); |
211 | words[1] = SCM_UNPACK (leave); | |
212 | } | |
213 | ||
214 | static inline scm_t_bits | |
215 | dynstack_pop (scm_t_dynstack *dynstack, scm_t_bits **words) | |
216 | { | |
217 | scm_t_bits *prev = SCM_DYNSTACK_PREV (dynstack->top); | |
218 | scm_t_bits tag; | |
219 | ||
220 | if (SCM_UNLIKELY (!prev)) | |
221 | abort (); | |
222 | ||
223 | SCM_DYNSTACK_SET_PREV_OFFSET (dynstack->top, 0); | |
224 | dynstack->top = prev; | |
225 | ||
226 | tag = SCM_DYNSTACK_TAG (dynstack->top); | |
227 | SCM_DYNSTACK_SET_TAG (dynstack->top, 0); | |
228 | *words = dynstack->top; | |
229 | ||
230 | return tag; | |
231 | } | |
232 | ||
233 | void | |
234 | scm_dynstack_pop (scm_t_dynstack *dynstack) | |
235 | { | |
236 | scm_t_bits tag, *words; | |
237 | tag = dynstack_pop (dynstack, &words); | |
238 | clear_scm_t_bits (words, SCM_DYNSTACK_TAG_LEN (tag)); | |
239 | } | |
240 | ||
241 | scm_t_dynstack * | |
242 | scm_dynstack_capture_all (scm_t_dynstack *dynstack) | |
243 | { | |
244 | return scm_dynstack_capture (dynstack, SCM_DYNSTACK_FIRST (dynstack)); | |
245 | } | |
246 | ||
247 | scm_t_dynstack * | |
248 | scm_dynstack_capture (scm_t_dynstack *dynstack, scm_t_bits *item) | |
249 | { | |
250 | char *mem; | |
251 | scm_t_dynstack *ret; | |
252 | size_t len; | |
253 | ||
254 | assert (item >= SCM_DYNSTACK_FIRST (dynstack)); | |
255 | assert (item <= dynstack->top); | |
256 | ||
257 | len = dynstack->top - item + SCM_DYNSTACK_HEADER_LEN; | |
258 | mem = scm_gc_malloc (sizeof (*ret) + len * sizeof(scm_t_bits), "dynstack"); | |
259 | ret = (scm_t_dynstack *) mem; | |
260 | ret->base = (scm_t_bits *) (mem + sizeof (*ret)); | |
261 | ret->limit = ret->base + len; | |
262 | ret->top = ret->base + len; | |
263 | ||
264 | copy_scm_t_bits (ret->base, item - SCM_DYNSTACK_HEADER_LEN, len); | |
265 | SCM_DYNSTACK_SET_PREV_OFFSET (SCM_DYNSTACK_FIRST (ret), 0); | |
266 | ||
267 | return ret; | |
268 | } | |
269 | ||
270 | void | |
271 | scm_dynstack_wind_1 (scm_t_dynstack *dynstack, scm_t_bits *item) | |
272 | { | |
273 | scm_t_bits tag = SCM_DYNSTACK_TAG (item); | |
274 | scm_t_dynstack_item_type type = SCM_DYNSTACK_TAG_TYPE (tag); | |
275 | scm_t_bits flags = SCM_DYNSTACK_TAG_FLAGS (tag); | |
276 | size_t len = SCM_DYNSTACK_TAG_LEN (tag); | |
277 | ||
278 | switch (type) | |
279 | { | |
280 | case SCM_DYNSTACK_TYPE_FRAME: | |
281 | if (!(flags & SCM_F_DYNSTACK_FRAME_REWINDABLE)) | |
282 | scm_misc_error ("scm_dynstack_wind_1", | |
283 | "cannot invoke continuation from this context", | |
284 | SCM_EOL); | |
285 | break; | |
286 | ||
287 | case SCM_DYNSTACK_TYPE_UNWINDER: | |
288 | break; | |
289 | ||
290 | case SCM_DYNSTACK_TYPE_REWINDER: | |
291 | WINDER_PROC (item) (WINDER_DATA (item)); | |
292 | break; | |
293 | ||
98eaef1b AW |
294 | case SCM_DYNSTACK_TYPE_WITH_FLUID: |
295 | scm_swap_fluid (WITH_FLUID_FLUID (item), | |
296 | WITH_FLUID_VALUE_BOX (item), | |
297 | SCM_I_CURRENT_THREAD->dynamic_state); | |
9ede013f AW |
298 | break; |
299 | ||
300 | case SCM_DYNSTACK_TYPE_PROMPT: | |
301 | /* see vm_reinstate_partial_continuation */ | |
302 | break; | |
303 | ||
304 | case SCM_DYNSTACK_TYPE_DYNWIND: | |
305 | scm_call_0 (DYNWIND_ENTER (item)); | |
306 | break; | |
307 | ||
308 | case SCM_DYNSTACK_TYPE_NONE: | |
309 | default: | |
310 | abort (); | |
311 | } | |
312 | ||
313 | { | |
314 | scm_t_bits *words = push_dynstack_entry (dynstack, type, flags, len); | |
315 | ||
316 | copy_scm_t_bits (words, item, len); | |
317 | } | |
318 | } | |
319 | ||
320 | scm_t_bits | |
321 | scm_dynstack_unwind_1 (scm_t_dynstack *dynstack) | |
322 | { | |
323 | scm_t_bits tag; | |
324 | scm_t_bits *words; | |
325 | scm_t_dynstack_item_type type; | |
9ede013f AW |
326 | |
327 | tag = dynstack_pop (dynstack, &words); | |
328 | ||
329 | type = SCM_DYNSTACK_TAG_TYPE (tag); | |
9ede013f AW |
330 | |
331 | switch (type) | |
332 | { | |
333 | case SCM_DYNSTACK_TYPE_FRAME: | |
334 | break; | |
335 | ||
336 | case SCM_DYNSTACK_TYPE_UNWINDER: | |
337 | WINDER_PROC (words) (WINDER_DATA (words)); | |
338 | clear_scm_t_bits (words, WINDER_WORDS); | |
339 | break; | |
340 | ||
341 | case SCM_DYNSTACK_TYPE_REWINDER: | |
342 | clear_scm_t_bits (words, WINDER_WORDS); | |
343 | break; | |
344 | ||
98eaef1b AW |
345 | case SCM_DYNSTACK_TYPE_WITH_FLUID: |
346 | scm_swap_fluid (WITH_FLUID_FLUID (words), | |
347 | WITH_FLUID_VALUE_BOX (words), | |
348 | SCM_I_CURRENT_THREAD->dynamic_state); | |
349 | clear_scm_t_bits (words, WITH_FLUID_WORDS); | |
9ede013f AW |
350 | break; |
351 | ||
352 | case SCM_DYNSTACK_TYPE_PROMPT: | |
353 | /* we could invalidate the prompt */ | |
354 | clear_scm_t_bits (words, PROMPT_WORDS); | |
355 | break; | |
356 | ||
357 | case SCM_DYNSTACK_TYPE_DYNWIND: | |
358 | { | |
359 | SCM proc = DYNWIND_LEAVE (words); | |
360 | clear_scm_t_bits (words, DYNWIND_WORDS); | |
361 | scm_call_0 (proc); | |
362 | } | |
363 | break; | |
364 | ||
365 | case SCM_DYNSTACK_TYPE_NONE: | |
366 | default: | |
367 | abort (); | |
368 | } | |
369 | ||
370 | return tag; | |
371 | } | |
372 | ||
373 | void | |
374 | scm_dynstack_wind (scm_t_dynstack *dynstack, scm_t_bits *item) | |
375 | { | |
376 | for (; SCM_DYNSTACK_TAG (item); item = SCM_DYNSTACK_NEXT (item)) | |
377 | scm_dynstack_wind_1 (dynstack, item); | |
378 | } | |
379 | ||
380 | void | |
381 | scm_dynstack_unwind (scm_t_dynstack *dynstack, scm_t_bits *base) | |
382 | { | |
383 | while (dynstack->top > base) | |
384 | scm_dynstack_unwind_1 (dynstack); | |
385 | } | |
386 | ||
387 | static int | |
388 | same_entries (scm_t_bits *walk_a, scm_t_bits *next_a, | |
389 | scm_t_bits *walk_b, scm_t_bits *next_b) | |
390 | { | |
391 | if (SCM_DYNSTACK_TAG (walk_a) != SCM_DYNSTACK_TAG (walk_b)) | |
392 | return 0; | |
393 | ||
394 | if (next_a - walk_a != next_b - walk_b) | |
395 | return 0; | |
396 | ||
397 | assert (SCM_DYNSTACK_PREV_OFFSET (next_a) == next_a - walk_a); | |
398 | assert (SCM_DYNSTACK_PREV_OFFSET (next_b) == next_b - walk_b); | |
399 | ||
400 | while (walk_a != next_a) | |
401 | if (*(walk_a++) != *(walk_b++)) | |
402 | return 0; | |
403 | ||
404 | return 1; | |
405 | } | |
406 | ||
407 | static ptrdiff_t | |
408 | shared_prefix_length (scm_t_dynstack *a, scm_t_dynstack *b) | |
409 | { | |
410 | scm_t_bits *walk_a, *next_a, *walk_b, *next_b; | |
411 | ||
412 | walk_a = SCM_DYNSTACK_FIRST (a); | |
413 | walk_b = SCM_DYNSTACK_FIRST (b); | |
414 | ||
415 | next_a = SCM_DYNSTACK_NEXT (walk_a); | |
416 | next_b = SCM_DYNSTACK_NEXT (walk_b); | |
417 | ||
418 | while (next_a && next_b && same_entries (walk_a, next_a, walk_b, next_b)) | |
419 | { | |
420 | walk_a = next_a; | |
421 | walk_b = next_b; | |
422 | ||
423 | next_a = SCM_DYNSTACK_NEXT (walk_a); | |
424 | next_b = SCM_DYNSTACK_NEXT (walk_b); | |
425 | } | |
426 | ||
427 | return walk_a - a->base; | |
428 | } | |
429 | ||
430 | scm_t_bits * | |
431 | scm_dynstack_unwind_fork (scm_t_dynstack *dynstack, scm_t_dynstack *branch) | |
432 | { | |
433 | ptrdiff_t join_height; | |
434 | ||
435 | join_height = shared_prefix_length (dynstack, branch); | |
436 | ||
437 | scm_dynstack_unwind (dynstack, dynstack->base + join_height); | |
438 | ||
439 | return branch->base + join_height; | |
440 | } | |
441 | ||
442 | scm_t_bits* | |
443 | scm_dynstack_find_prompt (scm_t_dynstack *dynstack, SCM key, | |
9d381ba4 | 444 | scm_t_dynstack_prompt_flags *flags, |
0bca90aa AW |
445 | scm_t_ptrdiff *fp_offset, scm_t_ptrdiff *sp_offset, |
446 | scm_t_uint32 **ip, scm_i_jmp_buf **registers) | |
9ede013f AW |
447 | { |
448 | scm_t_bits *walk; | |
449 | ||
450 | for (walk = SCM_DYNSTACK_PREV (dynstack->top); walk; | |
451 | walk = SCM_DYNSTACK_PREV (walk)) | |
452 | { | |
453 | scm_t_bits tag = SCM_DYNSTACK_TAG (walk); | |
454 | ||
455 | if (SCM_DYNSTACK_TAG_TYPE (tag) == SCM_DYNSTACK_TYPE_PROMPT | |
456 | && scm_is_eq (PROMPT_KEY (walk), key)) | |
457 | { | |
9ede013f AW |
458 | if (flags) |
459 | *flags = SCM_DYNSTACK_TAG_FLAGS (tag); | |
0bca90aa AW |
460 | if (fp_offset) |
461 | *fp_offset = PROMPT_FP (walk); | |
462 | if (sp_offset) | |
463 | *sp_offset = PROMPT_SP (walk); | |
9d381ba4 AW |
464 | if (ip) |
465 | *ip = PROMPT_IP (walk); | |
466 | if (registers) | |
467 | *registers = PROMPT_JMPBUF (walk); | |
9ede013f AW |
468 | return walk; |
469 | } | |
470 | } | |
471 | ||
472 | return NULL; | |
473 | } | |
474 | ||
9d381ba4 AW |
475 | void |
476 | scm_dynstack_wind_prompt (scm_t_dynstack *dynstack, scm_t_bits *item, | |
477 | scm_t_ptrdiff reloc, scm_i_jmp_buf *registers) | |
9ede013f | 478 | { |
9d381ba4 | 479 | scm_t_bits tag = SCM_DYNSTACK_TAG (item); |
9ede013f | 480 | |
9d381ba4 | 481 | if (SCM_DYNSTACK_TAG_TYPE (tag) != SCM_DYNSTACK_TYPE_PROMPT) |
9ede013f AW |
482 | abort (); |
483 | ||
9d381ba4 AW |
484 | scm_dynstack_push_prompt (dynstack, |
485 | SCM_DYNSTACK_TAG_FLAGS (tag), | |
486 | PROMPT_KEY (item), | |
487 | PROMPT_FP (item) + reloc, | |
488 | PROMPT_SP (item) + reloc, | |
489 | PROMPT_IP (item), | |
490 | registers); | |
9ede013f AW |
491 | } |
492 | ||
493 | void | |
494 | scm_dynstack_unwind_frame (scm_t_dynstack *dynstack) | |
495 | { | |
496 | /* Unwind up to and including the next frame entry. */ | |
497 | while (1) | |
498 | { | |
499 | scm_t_bits tag, *words; | |
500 | ||
501 | tag = dynstack_pop (dynstack, &words); | |
502 | ||
503 | switch (SCM_DYNSTACK_TAG_TYPE (tag)) | |
504 | { | |
505 | case SCM_DYNSTACK_TYPE_FRAME: | |
506 | return; | |
507 | case SCM_DYNSTACK_TYPE_REWINDER: | |
508 | clear_scm_t_bits (words, WINDER_WORDS); | |
509 | continue; | |
510 | case SCM_DYNSTACK_TYPE_UNWINDER: | |
511 | { | |
512 | scm_t_guard proc = WINDER_PROC (words); | |
513 | void *data = WINDER_DATA (words); | |
514 | clear_scm_t_bits (words, WINDER_WORDS); | |
515 | if (SCM_DYNSTACK_TAG_FLAGS (tag) & SCM_F_DYNSTACK_WINDER_EXPLICIT) | |
516 | proc (data); | |
517 | continue; | |
518 | } | |
519 | default: | |
520 | /* We should only see winders. */ | |
521 | abort (); | |
522 | } | |
523 | } | |
524 | } | |
525 | ||
526 | /* This function must not allocate. */ | |
527 | void | |
98eaef1b | 528 | scm_dynstack_unwind_fluid (scm_t_dynstack *dynstack, SCM dynamic_state) |
9ede013f AW |
529 | { |
530 | scm_t_bits tag, *words; | |
531 | size_t len; | |
532 | ||
533 | tag = dynstack_pop (dynstack, &words); | |
534 | len = SCM_DYNSTACK_TAG_LEN (tag); | |
535 | ||
98eaef1b AW |
536 | assert (SCM_DYNSTACK_TAG_TYPE (tag) == SCM_DYNSTACK_TYPE_WITH_FLUID); |
537 | assert (len == WITH_FLUID_WORDS); | |
9ede013f | 538 | |
98eaef1b AW |
539 | scm_swap_fluid (WITH_FLUID_FLUID (words), WITH_FLUID_VALUE_BOX (words), |
540 | dynamic_state); | |
9ede013f AW |
541 | clear_scm_t_bits (words, len); |
542 | } | |
543 | ||
544 | ||
545 | /* | |
546 | Local Variables: | |
547 | c-file-style: "gnu" | |
548 | End: | |
549 | */ |