diff options
| -rw-r--r-- | ChangeLog | 25 | ||||
| -rw-r--r-- | generic/tclBasic.c | 49 |
2 files changed, 49 insertions, 25 deletions
@@ -1,25 +1,32 @@ +2010-04-30 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclBasic.c (TclNRYieldObjCmd, TclNRYieldmObjCmd) + (NRInterpCoroutine): Replace magic values for formal argument counts + for coroutine command implementations with #defines, for an increase + in readability. + 2010-04-30 Jan Nijtmans <nijtmans@users.sf.net> - * generic/tclMain.c. Unnecessary TCL_STORAGE_CLASS re-definition. - It was used for an ancient dummy reference to Tcl_LinkVar(), - but that's already gone since 2002-05-29. + * generic/tclMain.c: Unnecessary TCL_STORAGE_CLASS re-definition. It + was used for an ancient dummy reference to Tcl_LinkVar(), but that's + already gone since 2002-05-29. 2010-04-29 Miguel Sofer <msofer@users.sf.net> - * generic/tclCompExpr.c: Slight change in the literal sharing - * generic/tclCompile.c: mechanism to avoid shimmering of + * generic/tclCompExpr.c: Slight change in the literal sharing + * generic/tclCompile.c: mechanism to avoid shimmering of * generic/tclCompile.h: command names. * generic/tclLiteral.c: 2010-04-29 Andreas Kupries <andreask@activestate.com> * library/platform/platform.tcl: Another stab at getting the /lib, - * library/platform/pkgIndex.tcl: /lib64 difference right for - * unix/Makefile.in: linux. Package updated to version 1.0.7. + * library/platform/pkgIndex.tcl: /lib64 difference right for linux. + * unix/Makefile.in: Package updated to version 1.0.7. * win/Makefile.in: 2010-04-29 Kevin B. Kenny <kennykb@acm.org> - + * library/tzdata/Antarctica/Macquarie: * library/tzdata/Africa/Casablanca: * library/tzdata/Africa/Tunis: @@ -38,7 +45,7 @@ * library/tzdata/Pacific/Apia: * library/tzdata/Pacific/Easter: * library/tzdata/Pacific/Fiji: Olson's tzdata2010i. - + 2010-04-29 Donal K. Fellows <dkf@users.sf.net> * generic/tclBinary.c (TclAppendBytesToByteArray): [Bug 2992970]: Make diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 3a37aac..98dd87a 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -16,7 +16,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.453 2010/04/27 12:36:21 nijtmans Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.454 2010/04/30 07:56:31 dkf Exp $ */ #include "tclInt.h" @@ -166,6 +166,14 @@ static Tcl_NRPostProc TEOV_RunLeaveTraces; static Tcl_NRPostProc YieldToCallback; MODULE_SCOPE const TclStubs tclStubs; + +/* + * Magical counts for the number of arguments accepted by a coroutine command + * after particular kinds of [yield]. + */ + +#define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL (-1) +#define COROUTINE_ARGUMENTS_ARBITRARY (-2) /* * The following structure define the commands in the Tcl core. @@ -8486,8 +8494,8 @@ TclNRYieldObjCmd( iPtr->numLevels = corPtr->auxNumLevels; corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; - corPtr->nargs = -2; - + corPtr->nargs = COROUTINE_ARGUMENTS_ARBITRARY; + TclNRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_YIELD_TYPE), NULL, NULL, NULL); return TCL_OK; @@ -8504,7 +8512,7 @@ TclNRYieldmObjCmd( int result; result = TclNRYieldObjCmd(clientData, interp, objc, objv); - corPtr->nargs = -1; + corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL; return result; } @@ -8728,8 +8736,7 @@ NRInterpCoroutine( { CoroutineData *corPtr = clientData; int nestNumLevels = corPtr->auxNumLevels; - int nargs = corPtr->nargs; - + if (!COR_IS_SUSPENDED(corPtr)) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "coroutine \"", Tcl_GetString(objv[0]), @@ -8738,22 +8745,33 @@ NRInterpCoroutine( return TCL_ERROR; } - if (nargs == -2) { - if (objc > 2) { + switch (corPtr->nargs) { + case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL: + switch (objc) { + case 1: + Tcl_SetObjResult(interp, objv[1]); + /* fallthrough */ + case 0: + break; + default: Tcl_WrongNumArgs(interp, 1, objv, "?arg?"); return TCL_ERROR; - } else if (objc == 2) { - Tcl_SetObjResult(interp, objv[1]); } - } else { - if ((nargs != -1) && (nargs != (objc-1))) { + break; + default: + if (corPtr->nargs != objc-1) { Tcl_SetObjResult(interp, - Tcl_NewStringObj("wrong coro nargs; how did we get here? not implemeted!", -1)); - return TCL_ERROR; + Tcl_NewStringObj("wrong coro nargs; how did we get here? " + "not implemented!", -1)); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); + return TCL_ERROR; } + /* fallthrough */ + case COROUTINE_ARGUMENTS_ARBITRARY: if (objc > 1) { Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, objv+1)); } + break; } /* @@ -8916,7 +8934,6 @@ TclNRCoroutineObjCmd( TclFreeIntRep(cmdObjPtr); cmdObjPtr->typePtr = NULL; - /* * Create the coro's execEnv and switch to it so that any CallFrames or * callbacks refer to the new execEnv's stack. Add the exit callback, then @@ -8931,7 +8948,7 @@ TclNRCoroutineObjCmd( TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr, NULL, NULL, NULL); iPtr->evalFlags |= TCL_EVAL_REDIRECT; - iPtr->lookupNsPtr = iPtr->varFramePtr->nsPtr; + iPtr->lookupNsPtr = iPtr->varFramePtr->nsPtr; TclNREvalObjEx(interp, cmdObjPtr, 0, NULL, 0); return TCL_OK; |