continuations.c 18 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621
  1. /* Copyright (C) 1995,1996,1998,2000,2001,2004, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
  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. #ifdef HAVE_CONFIG_H
  19. # include <config.h>
  20. #endif
  21. #include "libguile/_scm.h"
  22. #include <string.h>
  23. #include <stdio.h>
  24. #include "libguile/async.h"
  25. #include "libguile/debug.h"
  26. #include "libguile/root.h"
  27. #include "libguile/stackchk.h"
  28. #include "libguile/smob.h"
  29. #include "libguile/ports.h"
  30. #include "libguile/dynwind.h"
  31. #include "libguile/eval.h"
  32. #include "libguile/vm.h"
  33. #include "libguile/instructions.h"
  34. #include "libguile/validate.h"
  35. #include "libguile/continuations.h"
  36. static scm_t_bits tc16_continuation;
  37. #define SCM_CONTREGSP(x) SCM_TYP16_PREDICATE (tc16_continuation, x)
  38. #define SCM_CONTREGS(x) ((scm_t_contregs *) SCM_SMOB_DATA_1 (x))
  39. #define SCM_CONTINUATION_LENGTH(x) (SCM_CONTREGS (x)->num_stack_items)
  40. #define SCM_SET_CONTINUATION_LENGTH(x, n)\
  41. (SCM_CONTREGS (x)->num_stack_items = (n))
  42. #define SCM_JMPBUF(x) ((SCM_CONTREGS (x))->jmpbuf)
  43. #define SCM_DYNENV(x) ((SCM_CONTREGS (x))->dynenv)
  44. #define SCM_CONTINUATION_ROOT(x) ((SCM_CONTREGS (x))->root)
  45. #define SCM_DFRAME(x) ((SCM_CONTREGS (x))->dframe)
  46. /* scm_i_make_continuation will return a procedure whose objcode contains an
  47. instruction to reinstate the continuation. Here, as in gsubr.c and smob.c, we
  48. define the form of that trampoline function.
  49. */
  50. #ifdef WORDS_BIGENDIAN
  51. #define OBJCODE_HEADER(main,meta) 0, 0, 0, main, 0, 0, 0, meta+8
  52. #define META_HEADER(meta) 0, 0, 0, meta, 0, 0, 0, 0
  53. #else
  54. #define OBJCODE_HEADER(main,meta) main, 0, 0, 0, meta+8, 0, 0, 0
  55. #define META_HEADER(meta) meta, 0, 0, 0, 0, 0, 0, 0
  56. #endif
  57. #define ALIGN_PTR(type,p,align) (type*)(ROUND_UP (((scm_t_bits)p), align))
  58. #ifdef SCM_ALIGNED
  59. #define SCM_DECLARE_STATIC_ALIGNED_ARRAY(type, sym) \
  60. static const type sym[]
  61. #define SCM_STATIC_ALIGNED_ARRAY(alignment, type, sym) \
  62. static SCM_ALIGNED (alignment) const type sym[]
  63. #else
  64. #define SCM_DECLARE_STATIC_ALIGNED_ARRAY(type, sym) \
  65. static type *sym
  66. #define SCM_STATIC_ALIGNED_ARRAY(alignment, type, sym) \
  67. SCM_SNARF_INIT(sym = scm_malloc_pointerless (sizeof(sym##__unaligned)); \
  68. memcpy (sym, sym##__unaligned, sizeof(sym##__unaligned));) \
  69. static type *sym = NULL; \
  70. static const type sym##__unaligned[]
  71. #endif
  72. #define STATIC_OBJCODE_TAG \
  73. SCM_PACK (SCM_MAKE_OBJCODE_TAG (SCM_OBJCODE_TYPE_STATIC, 0))
  74. #define SCM_STATIC_OBJCODE(sym) \
  75. SCM_DECLARE_STATIC_ALIGNED_ARRAY (scm_t_uint8, sym##__bytecode); \
  76. SCM_STATIC_ALIGNED_ARRAY (8, scm_t_cell, sym##__cells) = { \
  77. { STATIC_OBJCODE_TAG, SCM_PACK (sym##__bytecode) }, \
  78. { SCM_BOOL_F, SCM_PACK (0) } \
  79. }; \
  80. static const SCM sym = SCM_PACK (sym##__cells); \
  81. SCM_STATIC_ALIGNED_ARRAY (8, scm_t_uint8, sym##__bytecode)
  82. SCM_STATIC_OBJCODE (cont_objcode) = {
  83. /* This code is the same as in gsubr.c, except we use continuation_call
  84. instead of subr_call. */
  85. OBJCODE_HEADER (8, 19),
  86. /* leave args on the stack */
  87. /* 0 */ scm_op_object_ref, 0, /* push scm_t_contregs smob */
  88. /* 2 */ scm_op_continuation_call, /* and longjmp (whee) */
  89. /* 3 */ scm_op_nop, /* pad to 8 bytes */
  90. /* 4 */ scm_op_nop, scm_op_nop, scm_op_nop, scm_op_nop,
  91. /* 8 */
  92. /* We could put some meta-info to say that this proc is a continuation. Not sure
  93. how to do that, though. */
  94. META_HEADER (19),
  95. /* 0 */ scm_op_make_eol, /* bindings */
  96. /* 1 */ scm_op_make_eol, /* sources */
  97. /* 2 */ scm_op_make_int8, 0, scm_op_make_int8, 3, /* arity: from ip 0 to ip 3 */
  98. /* 6 */ scm_op_make_int8_0, /* the arity is 0 required args */
  99. /* 7 */ scm_op_make_int8_0, /* 0 optionals */
  100. /* 8 */ scm_op_make_true, /* and a rest arg */
  101. /* 9 */ scm_op_list, 0, 5, /* make a list of those 5 vals */
  102. /* 12 */ scm_op_list, 0, 1, /* and the arities will be a list of that one list */
  103. /* 15 */ scm_op_list, 0, 3, /* pack bindings, sources, and arities into list */
  104. /* 18 */ scm_op_return /* and return */
  105. /* 19 */
  106. };
  107. SCM_STATIC_OBJCODE (call_cc_objcode) = {
  108. /* Before Scheme's call/cc is compiled, eval.c will use this hand-coded
  109. call/cc. */
  110. OBJCODE_HEADER (8, 17),
  111. /* 0 */ scm_op_assert_nargs_ee, 0, 1, /* assert that nargs==1 */
  112. /* 3 */ scm_op_local_ref, 0, /* push the proc */
  113. /* 5 */ scm_op_tail_call_cc, /* and call/cc */
  114. /* 6 */ scm_op_nop, scm_op_nop, /* pad to 8 bytes */
  115. /* 8 */
  116. META_HEADER (17),
  117. /* 0 */ scm_op_make_eol, /* bindings */
  118. /* 1 */ scm_op_make_eol, /* sources */
  119. /* 2 */ scm_op_make_int8, 3, scm_op_make_int8, 6, /* arity: from ip 0 to ip 6 */
  120. /* 6 */ scm_op_make_int8_1, /* the arity is 0 required args */
  121. /* 7 */ scm_op_list, 0, 3, /* make a list of those 5 vals */
  122. /* 10 */ scm_op_list, 0, 1, /* and the arities will be a list of that one list */
  123. /* 13 */ scm_op_list, 0, 3, /* pack bindings, sources, and arities into list */
  124. /* 16 */ scm_op_return /* and return */
  125. /* 17 */
  126. };
  127. static SCM
  128. make_continuation_trampoline (SCM contregs)
  129. {
  130. SCM ret = scm_make_program (cont_objcode,
  131. scm_c_make_vector (1, contregs),
  132. SCM_BOOL_F);
  133. SCM_SET_CELL_WORD_0 (ret,
  134. SCM_CELL_WORD_0 (ret) | SCM_F_PROGRAM_IS_CONTINUATION);
  135. return ret;
  136. }
  137. /* {Continuations}
  138. */
  139. static int
  140. continuation_print (SCM obj, SCM port, scm_print_state *state SCM_UNUSED)
  141. {
  142. scm_t_contregs *continuation = SCM_CONTREGS (obj);
  143. scm_puts_unlocked ("#<continuation ", port);
  144. scm_intprint (continuation->num_stack_items, 10, port);
  145. scm_puts_unlocked (" @ ", port);
  146. scm_uintprint (SCM_SMOB_DATA_1 (obj), 16, port);
  147. scm_putc_unlocked ('>', port);
  148. return 1;
  149. }
  150. /* James Clark came up with this neat one instruction fix for
  151. * continuations on the SPARC. It flushes the register windows so
  152. * that all the state of the process is contained in the stack.
  153. */
  154. #if defined (sparc) || defined (__sparc__) || defined (__sparc)
  155. # define SCM_FLUSH_REGISTER_WINDOWS asm("ta 3")
  156. #else
  157. # define SCM_FLUSH_REGISTER_WINDOWS /* empty */
  158. #endif
  159. /* this may return more than once: the first time with the escape
  160. procedure, then subsequently with SCM_UNDEFINED (the vals already having been
  161. placed on the VM stack). */
  162. #define FUNC_NAME "scm_i_make_continuation"
  163. SCM
  164. scm_i_make_continuation (int *first, SCM vm, SCM vm_cont)
  165. {
  166. scm_i_thread *thread = SCM_I_CURRENT_THREAD;
  167. SCM cont;
  168. scm_t_contregs *continuation;
  169. long stack_size;
  170. SCM_STACKITEM * src;
  171. SCM_FLUSH_REGISTER_WINDOWS;
  172. stack_size = scm_stack_size (thread->continuation_base);
  173. continuation = scm_gc_malloc (sizeof (scm_t_contregs)
  174. + (stack_size - 1) * sizeof (SCM_STACKITEM),
  175. "continuation");
  176. continuation->num_stack_items = stack_size;
  177. continuation->dynenv = scm_i_dynwinds ();
  178. continuation->root = thread->continuation_root;
  179. src = thread->continuation_base;
  180. #if ! SCM_STACK_GROWS_UP
  181. src -= stack_size;
  182. #endif
  183. continuation->offset = continuation->stack - src;
  184. memcpy (continuation->stack, src, sizeof (SCM_STACKITEM) * stack_size);
  185. continuation->vm = vm;
  186. continuation->vm_cont = vm_cont;
  187. SCM_NEWSMOB (cont, tc16_continuation, continuation);
  188. *first = !SCM_I_SETJMP (continuation->jmpbuf);
  189. if (*first)
  190. {
  191. #ifdef __ia64__
  192. continuation->backing_store_size =
  193. (char *) scm_ia64_ar_bsp(&continuation->jmpbuf.ctx)
  194. -
  195. (char *) thread->register_backing_store_base;
  196. continuation->backing_store = NULL;
  197. continuation->backing_store =
  198. scm_gc_malloc (continuation->backing_store_size,
  199. "continuation backing store");
  200. memcpy (continuation->backing_store,
  201. (void *) thread->register_backing_store_base,
  202. continuation->backing_store_size);
  203. #endif /* __ia64__ */
  204. return make_continuation_trampoline (cont);
  205. }
  206. else
  207. return SCM_UNDEFINED;
  208. }
  209. #undef FUNC_NAME
  210. SCM
  211. scm_i_call_with_current_continuation (SCM proc)
  212. {
  213. static SCM call_cc = SCM_BOOL_F;
  214. if (scm_is_false (call_cc))
  215. call_cc = scm_make_program (call_cc_objcode, SCM_BOOL_F, SCM_BOOL_F);
  216. return scm_call_1 (call_cc, proc);
  217. }
  218. SCM
  219. scm_i_continuation_to_frame (SCM continuation)
  220. {
  221. SCM contregs;
  222. scm_t_contregs *cont;
  223. contregs = scm_c_vector_ref (scm_program_objects (continuation), 0);
  224. cont = SCM_CONTREGS (contregs);
  225. if (scm_is_true (cont->vm_cont))
  226. {
  227. struct scm_vm_cont *data = SCM_VM_CONT_DATA (cont->vm_cont);
  228. return scm_c_make_frame (cont->vm_cont,
  229. data->fp + data->reloc,
  230. data->sp + data->reloc,
  231. data->ra,
  232. data->reloc);
  233. }
  234. else
  235. return SCM_BOOL_F;
  236. }
  237. SCM
  238. scm_i_contregs_vm (SCM contregs)
  239. {
  240. return SCM_CONTREGS (contregs)->vm;
  241. }
  242. SCM
  243. scm_i_contregs_vm_cont (SCM contregs)
  244. {
  245. return SCM_CONTREGS (contregs)->vm_cont;
  246. }
  247. /* {Apply}
  248. */
  249. /* Invoking a continuation proceeds as follows:
  250. *
  251. * - the stack is made large enough for the called continuation
  252. * - the old windchain is unwound down to the branching point
  253. * - the continuation stack is copied into place
  254. * - the windchain is rewound up to the continuation's context
  255. * - the continuation is invoked via longjmp (or setcontext)
  256. *
  257. * This order is important so that unwind and rewind handlers are run
  258. * with their correct stack.
  259. */
  260. static void scm_dynthrow (SCM);
  261. /* Grow the stack by a fixed amount to provide space to copy in the
  262. * continuation. Possibly this function has to be called several times
  263. * recursively before enough space is available. Make sure the compiler does
  264. * not optimize the growth array away by storing it's address into a global
  265. * variable.
  266. */
  267. static scm_t_bits scm_i_dummy;
  268. static void
  269. grow_stack (SCM cont)
  270. {
  271. scm_t_bits growth[100];
  272. scm_i_dummy = (scm_t_bits) growth;
  273. scm_dynthrow (cont);
  274. }
  275. /* Copy the continuation stack into the current stack. Calling functions from
  276. * within this function is safe, since only stack frames below this function's
  277. * own frame are overwritten. Thus, memcpy can be used for best performance.
  278. */
  279. typedef struct {
  280. scm_t_contregs *continuation;
  281. SCM_STACKITEM *dst;
  282. } copy_stack_data;
  283. static void
  284. copy_stack (void *data)
  285. {
  286. copy_stack_data *d = (copy_stack_data *)data;
  287. memcpy (d->dst, d->continuation->stack,
  288. sizeof (SCM_STACKITEM) * d->continuation->num_stack_items);
  289. #ifdef __ia64__
  290. SCM_I_CURRENT_THREAD->pending_rbs_continuation = d->continuation;
  291. #endif
  292. }
  293. static void
  294. copy_stack_and_call (scm_t_contregs *continuation,
  295. SCM_STACKITEM * dst)
  296. {
  297. long delta;
  298. copy_stack_data data;
  299. delta = scm_ilength (scm_i_dynwinds ()) - scm_ilength (continuation->dynenv);
  300. data.continuation = continuation;
  301. data.dst = dst;
  302. scm_i_dowinds (continuation->dynenv, delta, copy_stack, &data);
  303. SCM_I_LONGJMP (continuation->jmpbuf, 1);
  304. }
  305. #ifdef __ia64__
  306. void
  307. scm_ia64_longjmp (scm_i_jmp_buf *JB, int VAL)
  308. {
  309. scm_i_thread *t = SCM_I_CURRENT_THREAD;
  310. if (t->pending_rbs_continuation)
  311. {
  312. memcpy (t->register_backing_store_base,
  313. t->pending_rbs_continuation->backing_store,
  314. t->pending_rbs_continuation->backing_store_size);
  315. t->pending_rbs_continuation = NULL;
  316. }
  317. setcontext (&JB->ctx);
  318. }
  319. #endif
  320. /* Call grow_stack until the stack space is large enough, then, as the current
  321. * stack frame might get overwritten, let copy_stack_and_call perform the
  322. * actual copying and continuation calling.
  323. */
  324. static void
  325. scm_dynthrow (SCM cont)
  326. {
  327. scm_i_thread *thread = SCM_I_CURRENT_THREAD;
  328. scm_t_contregs *continuation = SCM_CONTREGS (cont);
  329. SCM_STACKITEM *dst = thread->continuation_base;
  330. SCM_STACKITEM stack_top_element;
  331. if (thread->critical_section_level)
  332. {
  333. fprintf (stderr, "continuation invoked from within critical section.\n");
  334. abort ();
  335. }
  336. #if SCM_STACK_GROWS_UP
  337. if (dst + continuation->num_stack_items >= &stack_top_element)
  338. grow_stack (cont);
  339. #else
  340. dst -= continuation->num_stack_items;
  341. if (dst <= &stack_top_element)
  342. grow_stack (cont);
  343. #endif /* def SCM_STACK_GROWS_UP */
  344. SCM_FLUSH_REGISTER_WINDOWS;
  345. copy_stack_and_call (continuation, dst);
  346. }
  347. void
  348. scm_i_check_continuation (SCM cont)
  349. {
  350. scm_i_thread *thread = SCM_I_CURRENT_THREAD;
  351. scm_t_contregs *continuation = SCM_CONTREGS (cont);
  352. if (!scm_is_eq (continuation->root, thread->continuation_root))
  353. scm_misc_error
  354. ("%continuation-call",
  355. "invoking continuation would cross continuation barrier: ~A",
  356. scm_list_1 (cont));
  357. }
  358. void
  359. scm_i_reinstate_continuation (SCM cont)
  360. {
  361. scm_dynthrow (cont);
  362. }
  363. SCM
  364. scm_i_with_continuation_barrier (scm_t_catch_body body,
  365. void *body_data,
  366. scm_t_catch_handler handler,
  367. void *handler_data,
  368. scm_t_catch_handler pre_unwind_handler,
  369. void *pre_unwind_handler_data)
  370. {
  371. SCM_STACKITEM stack_item;
  372. scm_i_thread *thread = SCM_I_CURRENT_THREAD;
  373. SCM old_controot;
  374. SCM_STACKITEM *old_contbase;
  375. SCM result;
  376. /* Establish a fresh continuation root.
  377. */
  378. old_controot = thread->continuation_root;
  379. old_contbase = thread->continuation_base;
  380. thread->continuation_root = scm_cons (thread->handle, old_controot);
  381. thread->continuation_base = &stack_item;
  382. /* Call FUNC inside a catch all. This is now guaranteed to return
  383. directly and exactly once.
  384. */
  385. result = scm_c_catch (SCM_BOOL_T,
  386. body, body_data,
  387. handler, handler_data,
  388. pre_unwind_handler, pre_unwind_handler_data);
  389. /* Return to old continuation root.
  390. */
  391. thread->continuation_base = old_contbase;
  392. thread->continuation_root = old_controot;
  393. return result;
  394. }
  395. static int
  396. should_print_backtrace (SCM tag, SCM stack)
  397. {
  398. return SCM_BACKTRACE_P
  399. && scm_is_true (stack)
  400. && scm_initialized_p
  401. /* It's generally not useful to print backtraces for errors reading
  402. or expanding code in these fallback catch statements. */
  403. && !scm_is_eq (tag, scm_from_latin1_symbol ("read-error"))
  404. && !scm_is_eq (tag, scm_from_latin1_symbol ("syntax-error"));
  405. }
  406. static void
  407. print_exception_and_backtrace (SCM port, SCM tag, SCM args)
  408. {
  409. SCM stack, frame;
  410. /* We get here via a throw to a catch-all. In that case there is the
  411. throw frame active, and this catch closure, so narrow by two
  412. frames. */
  413. stack = scm_make_stack (SCM_BOOL_T, scm_list_1 (scm_from_int (2)));
  414. frame = scm_is_true (stack) ? scm_stack_ref (stack, SCM_INUM0) : SCM_BOOL_F;
  415. if (should_print_backtrace (tag, stack))
  416. {
  417. scm_puts_unlocked ("Backtrace:\n", port);
  418. scm_display_backtrace_with_highlights (stack, port,
  419. SCM_BOOL_F, SCM_BOOL_F,
  420. SCM_EOL);
  421. scm_newline (port);
  422. }
  423. scm_print_exception (port, frame, tag, args);
  424. }
  425. struct c_data {
  426. void *(*func) (void *);
  427. void *data;
  428. void *result;
  429. };
  430. static SCM
  431. c_body (void *d)
  432. {
  433. struct c_data *data = (struct c_data *)d;
  434. data->result = data->func (data->data);
  435. return SCM_UNSPECIFIED;
  436. }
  437. static SCM
  438. c_handler (void *d, SCM tag, SCM args)
  439. {
  440. struct c_data *data;
  441. /* If TAG is `quit', exit() the process. */
  442. if (scm_is_eq (tag, scm_from_latin1_symbol ("quit")))
  443. exit (scm_exit_status (args));
  444. data = (struct c_data *)d;
  445. data->result = NULL;
  446. return SCM_UNSPECIFIED;
  447. }
  448. static SCM
  449. pre_unwind_handler (void *error_port, SCM tag, SCM args)
  450. {
  451. /* Print the exception unless TAG is `quit'. */
  452. if (!scm_is_eq (tag, scm_from_latin1_symbol ("quit")))
  453. print_exception_and_backtrace (SCM_PACK_POINTER (error_port), tag, args);
  454. return SCM_UNSPECIFIED;
  455. }
  456. void *
  457. scm_c_with_continuation_barrier (void *(*func) (void *), void *data)
  458. {
  459. struct c_data c_data;
  460. c_data.func = func;
  461. c_data.data = data;
  462. scm_i_with_continuation_barrier (c_body, &c_data,
  463. c_handler, &c_data,
  464. pre_unwind_handler,
  465. SCM_UNPACK_POINTER (scm_current_error_port ()));
  466. return c_data.result;
  467. }
  468. struct scm_data {
  469. SCM proc;
  470. };
  471. static SCM
  472. scm_body (void *d)
  473. {
  474. struct scm_data *data = (struct scm_data *)d;
  475. return scm_call_0 (data->proc);
  476. }
  477. static SCM
  478. scm_handler (void *d, SCM tag, SCM args)
  479. {
  480. /* Print a message. Note that if TAG is `quit', this will exit() the
  481. process. */
  482. scm_handle_by_message_noexit (NULL, tag, args);
  483. return SCM_BOOL_F;
  484. }
  485. SCM_DEFINE (scm_with_continuation_barrier, "with-continuation-barrier", 1,0,0,
  486. (SCM proc),
  487. "Call @var{proc} and return its result. Do not allow the invocation of\n"
  488. "continuations that would leave or enter the dynamic extent of the call\n"
  489. "to @code{with-continuation-barrier}. Such an attempt causes an error\n"
  490. "to be signaled.\n"
  491. "\n"
  492. "Throws (such as errors) that are not caught from within @var{proc} are\n"
  493. "caught by @code{with-continuation-barrier}. In that case, a short\n"
  494. "message is printed to the current error port and @code{#f} is returned.\n"
  495. "\n"
  496. "Thus, @code{with-continuation-barrier} returns exactly once.\n")
  497. #define FUNC_NAME s_scm_with_continuation_barrier
  498. {
  499. struct scm_data scm_data;
  500. scm_data.proc = proc;
  501. return scm_i_with_continuation_barrier (scm_body, &scm_data,
  502. scm_handler, &scm_data,
  503. pre_unwind_handler,
  504. SCM_UNPACK_POINTER (scm_current_error_port ()));
  505. }
  506. #undef FUNC_NAME
  507. void
  508. scm_init_continuations ()
  509. {
  510. tc16_continuation = scm_make_smob_type ("continuation", 0);
  511. scm_set_smob_print (tc16_continuation, continuation_print);
  512. #include "libguile/continuations.x"
  513. }
  514. /*
  515. Local Variables:
  516. c-file-style: "gnu"
  517. End:
  518. */