Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Implementation of TIP #396 |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
1d6747e53fa1fc82e7d7231e357048a9 |
User & Date: | dkf 2012-04-02 13:13:11 |
Context
2012-04-02
| ||
14:13 | cygwin should not use ExitProcess check-in: 810dc33bbd user: jan.nijtmans tags: trunk | |
13:13 | Implementation of TIP #396 check-in: 1d6747e53f user: dkf tags: trunk | |
09:45 | [Bug 3508771] load tclreg.dll in cygwin tclsh Implement TclWinGetTclInstance, TclpGetTZName, and var... check-in: 9e1a41ed83 user: jan.nijtmans tags: trunk | |
Changes
Changes to ChangeLog.
1 2 | 2012-04-02 Jan Nijtmans <[email protected]> | > > > > > > > | | > | | | | | | | | | | | 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 | 2012-04-02 Donal K. Fellows <[email protected]> IMPLEMENTATION OF TIP#396. * generic/tclBasic.c (builtInCmds, TclNRYieldToObjCmd): Convert the formerly-unsupported yieldm and yieldTo commands into [yieldto]. 2012-04-02 Jan Nijtmans <[email protected]> * generic/tclInt.decls: [Bug 3508771]: load tclreg.dll in cygwin tclsh * generic/tclIntPlatDecls.h: Implement TclWinGetTclInstance, * generic/tclStubInit.c: TclpGetTZName, and various more win32-specific internal functions for Cygwin, so win32 extensions using those can be loaded in the cygwin version of tclsh. 2012-03-30 Jan Nijtmans <[email protected]> * unix/tcl.m4: [Bug 3511806]: Compiler checks too early * unix/configure.in: This change allows to build the cygwin and * unix/tclUnixPort.h: mingw32 ports of Tcl/Tk to build out-of-the-box * win/tcl.m4: using a native or cross-compiler. * win/configure.in: * win/tclWinPort.h: * win/README Document how to build win32 or win64 executables with Linux, Cygwin or Darwin. 2012-03-29 Jan Nijtmans <[email protected]> * generic/tclCmdMZ.c (StringIsCmd): Faster mem-leak free implementation of [string is entier]. 2012-03-27 Donal K. Fellows <[email protected]> |
︙ | ︙ |
Changes to doc/coroutine.n.
1 2 3 4 5 6 7 8 9 10 11 | '\" '\" Copyright (c) 2009 Donal K. Fellows. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .so man.macros .TH coroutine n 8.6 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME | | > > | > | > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | '\" '\" Copyright (c) 2009 Donal K. Fellows. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .so man.macros .TH coroutine n 8.6 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME coroutine, yield, yieldto \- Create and produce values from coroutines .SH SYNOPSIS .nf \fBcoroutine \fIname command\fR ?\fIarg...\fR? \fByield\fR ?\fIvalue\fR? .VS TIP396 \fByieldto\fR \fIcommand\fR ?\fIarg...\fR? \fIname\fR ?\fIvalue...\fR? .VE TIP396 .fi .BE .SH DESCRIPTION .PP The \fBcoroutine\fR command creates a new coroutine context (with associated command) named \fIname\fR and executes that context by calling \fIcommand\fR, passing in the other remaining arguments without further interpretation. Once \fIcommand\fR returns normally or with an exception (e.g., an error) the coroutine context \fIname\fR is deleted. .PP Within the context, values may be generated as results by using the \fByield\fR command; if no \fIvalue\fR is supplied, the empty string is used. When that is called, the context will suspend execution and the \fBcoroutine\fR command will return the argument to \fByield\fR. The execution of the context can then be resumed by calling the context command, optionally passing in the \fIsingle\fR value to use as the result of the \fByield\fR call that caused the context to be suspended. If the coroutine context never yields and instead returns conventionally, the result of the \fBcoroutine\fR command will be the result of the evaluation of the context. .PP .VS TIP396 The coroutine may also suspend its execution by use of the \fByieldto\fR command, which instead of returning, cedes execution to some command called \fIcommand\fR (resolved in the context of the coroutine) and to which \fIany number\fR of arguments may be passed. Since every coroutine has a context command, \fByieldto\fR can be used to transfer control directly from one coroutine to another (this is only advisable if the two coroutines are expecting this to happen) but \fIany\fR command may be the target. If a coroutine is suspended by this mechanism, the coroutine processing can be resumed by calling the context command optionally passing in an arbitrary number of arguments. The return value of the \fByieldto\fR call will be the list of arguments passed to the context command; it is up to the caller to decide what to do with those values. .PP The recommended way of writing a version of \fByield\fR that allows resumption with multiple arguments is by using \fByieldto\fR and the \fBreturn\fR command, like this: .PP .CS proc yieldm {value} { \fByieldto\fR return -level 0 $value } .CE .VE TIP396 .PP The coroutine can also be deleted by destroying the command \fIname\fR, and the name of the current coroutine can be retrieved by using \fBinfo coroutine\fR. If there are deletion traces on variables in the coroutine's implementation, they will fire at the point when the coroutine is explicitly deleted (or, naturally, if the command returns conventionally). |
︙ | ︙ | |||
104 105 106 107 108 109 110 111 112 113 114 115 116 117 | set c [\fBcoroutine\fR prime$n filterByFactor $c $n] } }} allNumbers for {set i 1} {$i <= 20} {incr i} { puts "prime#$i = [\fIeratosthenes\fR]" } .CE .SS "DETAILED SEMANTICS" .PP This example demonstrates that coroutines start from the global namespace, and that \fIcommand\fR resolution happens before the coroutine stack is created. .PP .CS proc report {where level} { | > > > > > > > > > > > > > > > > > > > > > | 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 | set c [\fBcoroutine\fR prime$n filterByFactor $c $n] } }} allNumbers for {set i 1} {$i <= 20} {incr i} { puts "prime#$i = [\fIeratosthenes\fR]" } .CE .PP .VS TIP396 This example shows how a value can be passed around a group of three coroutines that yield to each other: .PP .CS proc juggler {name target {value ""}} { if {$value eq ""} { set value [\fByield\fR [info coroutine]] } while {$value ne ""} { puts "$name : $value" set value [string range $value 0 end-1] lassign [\fByieldto\fR $target $value] value } } \fBcoroutine\fR j1 juggler Larry [ \fBcoroutine\fR j2 juggler Curly [ \fBcoroutine\fR j3 juggler Moe j1]] "Nyuck!Nyuck!Nyuck!" .CE .VE TIP396 .SS "DETAILED SEMANTICS" .PP This example demonstrates that coroutines start from the global namespace, and that \fIcommand\fR resolution happens before the coroutine stack is created. .PP .CS proc report {where level} { |
︙ | ︙ |
Changes to generic/tclBasic.c.
︙ | ︙ | |||
254 255 256 257 258 259 260 261 262 263 264 265 266 267 | {"try", Tcl_TryObjCmd, TclCompileTryCmd, TclNRTryObjCmd, 1}, {"unset", Tcl_UnsetObjCmd, TclCompileUnsetCmd, NULL, 1}, {"uplevel", Tcl_UplevelObjCmd, NULL, TclNRUplevelObjCmd, 1}, {"upvar", Tcl_UpvarObjCmd, TclCompileUpvarCmd, NULL, 1}, {"variable", Tcl_VariableObjCmd, TclCompileVariableCmd, NULL, 1}, {"while", Tcl_WhileObjCmd, TclCompileWhileCmd, TclNRWhileObjCmd, 1}, {"yield", NULL, NULL, TclNRYieldObjCmd, 1}, /* * Commands in the OS-interface. Note that many of these are unsafe. */ {"after", Tcl_AfterObjCmd, NULL, NULL, 1}, {"cd", Tcl_CdObjCmd, NULL, NULL, 0}, | > | 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 | {"try", Tcl_TryObjCmd, TclCompileTryCmd, TclNRTryObjCmd, 1}, {"unset", Tcl_UnsetObjCmd, TclCompileUnsetCmd, NULL, 1}, {"uplevel", Tcl_UplevelObjCmd, NULL, TclNRUplevelObjCmd, 1}, {"upvar", Tcl_UpvarObjCmd, TclCompileUpvarCmd, NULL, 1}, {"variable", Tcl_VariableObjCmd, TclCompileVariableCmd, NULL, 1}, {"while", Tcl_WhileObjCmd, TclCompileWhileCmd, TclNRWhileObjCmd, 1}, {"yield", NULL, NULL, TclNRYieldObjCmd, 1}, {"yieldto", NULL, NULL, TclNRYieldToObjCmd, 1}, /* * Commands in the OS-interface. Note that many of these are unsafe. */ {"after", Tcl_AfterObjCmd, NULL, NULL, 1}, {"cd", Tcl_CdObjCmd, NULL, NULL, 0}, |
︙ | ︙ | |||
826 827 828 829 830 831 832 | /* Adding the bytecode assembler command */ cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::tcl::unsupported::assemble", Tcl_AssembleObjCmd, TclNRAssembleObjCmd, NULL, NULL); cmdPtr->compileProc = &TclCompileAssembleCmd; | < < < < | 827 828 829 830 831 832 833 834 835 836 837 838 839 840 | /* Adding the bytecode assembler command */ cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::tcl::unsupported::assemble", Tcl_AssembleObjCmd, TclNRAssembleObjCmd, NULL, NULL); cmdPtr->compileProc = &TclCompileAssembleCmd; Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL, NRCoroInjectObjCmd, NULL, NULL); #ifdef USE_DTRACE /* * Register the tcl::dtrace command. */ |
︙ | ︙ | |||
8507 8508 8509 8510 8511 8512 8513 | if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?"); return TCL_ERROR; } if (!corPtr) { | | | | | 8504 8505 8506 8507 8508 8509 8510 8511 8512 8513 8514 8515 8516 8517 8518 8519 8520 8521 8522 8523 8524 8525 8526 8527 8528 8529 8530 8531 8532 8533 8534 8535 8536 8537 8538 8539 8540 8541 8542 8543 8544 8545 8546 8547 8548 8549 | if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?"); return TCL_ERROR; } if (!corPtr) { Tcl_SetResult(interp, "yieldto can only be called in a coroutine", TCL_STATIC); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL); return TCL_ERROR; } /* * Add the tailcall in the caller env, then just yield. * * This is essentially code from TclNRTailcallObjCmd */ listPtr = Tcl_NewListObj(objc-1, objv+1); Tcl_IncrRefCount(listPtr); nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr)) || (nsPtr != ns1Ptr)) { Tcl_Panic("yieldto failed to find the proper namespace"); } Tcl_IncrRefCount(nsObjPtr); /* * Add the callback in the caller's env, then instruct TEBC to yield. */ iPtr->execEnvPtr = corPtr->callerEEPtr; TclNRAddCallback(interp, YieldToCallback, corPtr, listPtr, nsObjPtr, NULL); iPtr->execEnvPtr = corPtr->eePtr; return TclNRYieldObjCmd(INT2PTR(CORO_ACTIVATE_YIELDM), interp, 1, objv); } static int YieldToCallback( ClientData data[], Tcl_Interp *interp, int result) |
︙ | ︙ |
Changes to tests/coroutine.test.
︙ | ︙ | |||
553 554 555 556 557 558 559 | } -result 0 test coroutine-6.3 {coroutine nargs} -body { coroutine a ::apply $lambda a a a } -cleanup { rename a {} } -returnCodes error -result {wrong # args: should be "a ?arg?"} | | > > > > > > > > > > > > > | > > > > | < > | > | < < < > > | > | > | > | < | | 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 | } -result 0 test coroutine-6.3 {coroutine nargs} -body { coroutine a ::apply $lambda a a a } -cleanup { rename a {} } -returnCodes error -result {wrong # args: should be "a ?arg?"} test coroutine-7.1 {yieldto} -body { coroutine c apply {{} { yield yieldto return -level 0 -code 1 quux return quuy }} set res [list [catch c msg] $msg] lappend res [catch c msg] $msg lappend res [catch c msg] $msg } -cleanup { unset res } -result [list 1 quux 0 quuy 1 {invalid command name "c"}] test coroutine-7.2 {multi-argument yielding with yieldto} -body { proc corobody {} { set a 1 while 1 { set a [yield $a] set a [yieldto return -level 0 $a] lappend a [llength $a] } } coroutine a corobody coroutine b corobody list [a x] [a y z] [a \{p] [a \{q r] [a] [a] [rename a {}] \ [b ok] [rename b {}] } -cleanup { rename corobody {} } -result {x {y z 2} \{p {\{q r 2} {} 0 {} ok {}} test coroutine-7.3 {yielding between coroutines} -body { proc juggler {target {value ""}} { if {$value eq ""} { set value [yield [info coroutine]] } while {[llength $value]} { lappend ::result $value [info coroutine] set value [lrange $value 0 end-1] lassign [yieldto $target $value] value } # Clear nested collection of coroutines catch $target } set result "" coroutine j1 juggler [coroutine j2 juggler [coroutine j3 juggler j1]]\ {a b c d e} list $result [info command j1] [info command j2] [info command j3] } -cleanup { catch {rename juggler ""} } -result {{{a b c d e} ::j1 {a b c d} ::j2 {a b c} ::j3 {a b} ::j1 a ::j2} {} {} {}} # cleanup unset lambda ::tcltest::cleanupTests return |
︙ | ︙ |