diff options
| -rw-r--r-- | share/txr/stdlib/yield.tl | 27 | ||||
| -rw-r--r-- | txr.1 | 62 | ||||
| -rw-r--r-- | unwind.c | 18 | ||||
| -rw-r--r-- | unwind.h | 2 |
4 files changed, 50 insertions, 59 deletions
diff --git a/share/txr/stdlib/yield.tl b/share/txr/stdlib/yield.tl index 3b58ace2..43fa57ee 100644 --- a/share/txr/stdlib/yield.tl +++ b/share/txr/stdlib/yield.tl @@ -38,12 +38,6 @@ (lambda (cont) (call cont 'sys:cont-poison)))) -(defun sys:yield-impl (name fun ctx-form) - (let ((cont (sys:capture-cont name ctx-form))) - (if (car cont) - (call fun cont) - (cdr cont)))) - (defmacro obtain (. body) (let ((arg (gensym "arg"))) ^(sys:obtain-impl (lambda (,arg) @@ -55,20 +49,17 @@ (defmacro yield-from (:form ctx-form name form) (let ((cont-sym (gensym))) - ^(sys:yield-impl ',name - (lambda (,cont-sym) - (sys:abscond-from ,name - (new (sys:yld-item - ,form (cdr ,cont-sym))))) - ',ctx-form))) + ^(sys:capture-cont ',name + (lambda (,cont-sym) + (sys:abscond-from ,name + (new (sys:yld-item + ,form ,cont-sym)))) + ',ctx-form))) (defmacro yield (form) ^(yield-from nil ,form)) (defmacro suspend (:form form name var . body) - (with-gensyms (cap val) - ^(tree-bind (,cap . ,val) (sys:capture-cont ',name ',form) - (if ,cap - (let ((,var ,val)) - (sys:abscond-from ,name ,*body)) - ,val)))) + ^(sys:capture-cont ',name (lambda (,var) + (sys:abscond-from ,name ,*body)) + ',form)) @@ -27568,14 +27568,17 @@ as the closure body terminates. .coNP Function @ sys:capture-cont .synb -.mets (sys:capture-cont < name <> [ context-form ]) +.mets (sys:capture-cont < name < receive-fun <> [ context-form ]) .syne .desc The .code sys:capture-cont function captures a continuation, and also serves as the resume point for the resulting continuation. Which of these two situations is the -case (capture or resumption) is distinguished by the return value. +case (capture or resumption) is distinguished by the use of the +.meta receive-fun +argument, which must be a function capable of being called with one +argument. A block named .meta name @@ -27594,33 +27597,29 @@ uses its own name. The .code sys:capture-cont -function returns a cons cell. The -.code car -field of the cell distinguishes the capture and resume situations. -If the -.code car -is the object -.codn t , -then it indicates capture, and in this case, the -.code cdr -field contains the continuation function. When the continuation -function is called, the +function captures a continuation, represented as a function. +It immediately calls +.metn receive-fun , +passing it it the continuation function as an argument. +If +.meta receive-fun +returns normally, then .code sys:capture-cont -function appears to return again. This time the -.code car -of the returned cell is -.code nil -indicating that the -.code cdr -field holds the argument value which was passed to the continuation -function. +returns whatever value +.meta receive-fun +returns. -The invoked continuation function will terminate when the resumed context -terminates. If that context terminates normally (by returning from the -delimiting block named by -.metn name ), -then the result value of that block will appear as the return value -of the continuation function. +When the continuation function is called (thereby resuming the captured +continuation), inside that resumed continuation, +.code sys:capture-cont +function appears to return. Its return value is the argument +which was passed to the continuation function. The continuation function +appears suspended while the resumed continuation executes. +If the resumed continuation context terminates normally (by terminating +the continuation's delimiting block named by +.metn name ) +the continuation function terminates, and yields the value which emerged +from the terminated block. If the symbol .code sys:cont-poison @@ -27661,12 +27660,9 @@ operator. .cblk (defmacro suspend (:form form name var . body) - (with-gensyms (cap val) - ^(tree-bind (,cap . ,val) (sys:capture-cont ',name ',form) - (if ,cap - (let ((,var ,val)) - (sys:abscond-from ,name ,*body)) - ,val)))) + ^(sys:capture-cont ',name (lambda (,var) + (sys:abscond-from ,name ,*body)) + ',form)) .cble .coNP Operator @ sys:abscond-from @@ -754,7 +754,7 @@ static val revive_cont(val dc, val arg) bug_unless (uw_stack->uw.type == UW_BLOCK); - uw_stack->bl.result = cons(nil, arg); + uw_stack->bl.result = arg; uw_exit_point = if3(arg == sys_cont_poison_s, &uw_blk, uw_stack); uw_unwind_to_exit_point(); abort(); @@ -767,8 +767,9 @@ static val revive_cont(val dc, val arg) } } -static val capture_cont(val tag, uw_frame_t *block) +static val capture_cont(val tag, val fun, uw_frame_t *block) { + volatile val cont_obj = nil; uw_block_begin (nil, result); bug_unless (uw_stack < block); @@ -792,19 +793,22 @@ static val capture_cont(val tag, uw_frame_t *block) blcopy->uw.up = 0; blcopy->uw.type = UW_CAPTURED_BLOCK; - result = cobj(coerce(mem_t *, cont), sys_cont_s, &cont_ops); + cont_obj = cobj(coerce(mem_t *, cont), sys_cont_s, &cont_ops); cont->tag = tag; - result = cons(t, func_f1(result, revive_cont)); + result = nil; } uw_block_end; + if (cont_obj) + result = funcall1(fun, func_f1(cont_obj, revive_cont)); + return result; } -val uw_capture_cont(val tag, val ctx_form) +val uw_capture_cont(val tag, val fun, val ctx_form) { uw_frame_t *fr; @@ -825,7 +829,7 @@ val uw_capture_cont(val tag, val ctx_form) abort(); } - return capture_cont(tag, fr); + return capture_cont(tag, fun, fr); } void uw_init(void) @@ -874,5 +878,5 @@ void uw_late_init(void) reg_fun(intern(lit("invoke-catch"), user_package), func_n2v(uw_invoke_catch)); reg_fun(sys_capture_cont_s = intern(lit("capture-cont"), system_package), - func_n2o(uw_capture_cont, 1)); + func_n3o(uw_capture_cont, 2)); } @@ -125,7 +125,7 @@ uw_frame_t *uw_current_exit_point(void); val uw_get_frames(void); val uw_find_frame(val extype, val frtype); val uw_invoke_catch(val catch_frame, val sym, struct args *); -val uw_capture_cont(val tag, val ctx_form); +val uw_capture_cont(val tag, val fun, val ctx_form); void uw_init(void); void uw_late_init(void); |