summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog25
-rw-r--r--generic/tclBasic.c49
2 files changed, 49 insertions, 25 deletions
diff --git a/ChangeLog b/ChangeLog
index 58829fd..2c4915e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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;