diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2009-12-24 06:55:25 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2009-12-24 06:55:25 (GMT) |
commit | 350075b8e7a272ae98795eafe0ec94b44a473e63 (patch) | |
tree | 34fc4d4c4168a562b2305ee384503f8ae79b7cc8 /generic | |
parent | 53b2383376d8df00a050e489eb8474408de69c12 (diff) | |
download | tcl-350075b8e7a272ae98795eafe0ec94b44a473e63.zip tcl-350075b8e7a272ae98795eafe0ec94b44a473e63.tar.gz tcl-350075b8e7a272ae98795eafe0ec94b44a473e63.tar.bz2 |
Move declarations to the top of the file, add boilerplate comments to some
functions
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclBasic.c | 393 |
1 files changed, 203 insertions, 190 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index aecdfa0..43f484b 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.436 2009/12/19 14:22:00 msofer Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.437 2009/12/24 06:55:25 dkf Exp $ */ #include "tclInt.h" @@ -57,69 +57,96 @@ typedef struct OldMathFuncData { } OldMathFuncData; /* - * Static functions in this file: + * This is the script cancellation struct and hash table. The hash table is + * used to keep track of the information necessary to process script + * cancellation requests, including the original interp, asynchronous handler + * tokens (created by Tcl_AsyncCreate), and the clientData and flags arguments + * passed to Tcl_CancelEval on a per-interp basis. The cancelLock mutex is + * used for protecting calls to Tcl_CancelEval as well as protecting access to + * the hash table below. */ -static char * CallCommandTraces(Interp *iPtr, Command *cmdPtr, - const char *oldName, const char *newName, int flags); -static int CancelEvalProc(ClientData clientData, - Tcl_Interp *interp, int code); -static int CheckDoubleResult(Tcl_Interp *interp, double dResult); -static void DeleteInterpProc(Tcl_Interp *interp); -static void DeleteOpCmdClientData(ClientData clientData); -static Tcl_Obj *GetCommandSource(Interp *iPtr, int objc, - Tcl_Obj *const objv[], int lookup); -static void ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode); -static int OldMathFuncProc(ClientData clientData, Tcl_Interp *interp, - int argc, Tcl_Obj *const *objv); -static void OldMathFuncDeleteProc(ClientData clientData); -static int ExprAbsFunc(ClientData clientData, Tcl_Interp *interp, - int argc, Tcl_Obj *const *objv); -static int ExprBinaryFunc(ClientData clientData, Tcl_Interp *interp, - int argc, Tcl_Obj *const *objv); -static int ExprBoolFunc(ClientData clientData, Tcl_Interp *interp, - int argc, Tcl_Obj *const *objv); -static int ExprCeilFunc(ClientData clientData, Tcl_Interp *interp, - int argc, Tcl_Obj *const *objv); -static int ExprDoubleFunc(ClientData clientData, Tcl_Interp *interp, - int argc, Tcl_Obj *const *objv); -static int ExprEntierFunc(ClientData clientData, Tcl_Interp *interp, - int argc, Tcl_Obj *const *objv); -static int ExprFloorFunc(ClientData clientData, Tcl_Interp *interp, - int argc, Tcl_Obj *const *objv); -static int ExprIntFunc(ClientData clientData, Tcl_Interp *interp, - int argc, Tcl_Obj *const *objv); -static int ExprIsqrtFunc(ClientData clientData, Tcl_Interp *interp, - int argc, Tcl_Obj *const *objv); -static int ExprRandFunc(ClientData clientData, Tcl_Interp *interp, - int argc, Tcl_Obj *const *objv); -static int ExprRoundFunc(ClientData clientData, Tcl_Interp *interp, - int argc, Tcl_Obj *const *objv); -static int ExprSqrtFunc(ClientData clientData, Tcl_Interp *interp, - int argc, Tcl_Obj *const *objv); -static int ExprSrandFunc(ClientData clientData, Tcl_Interp *interp, - int argc, Tcl_Obj *const *objv); -static int ExprUnaryFunc(ClientData clientData, Tcl_Interp *interp, - int argc, Tcl_Obj *const *objv); -static int ExprWideFunc(ClientData clientData, Tcl_Interp *interp, - int argc, Tcl_Obj *const *objv); -static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, - int actual, Tcl_Obj *const *objv); -#ifdef USE_DTRACE -static int DTraceObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int DTraceCmdReturn(ClientData data[], Tcl_Interp *interp, - int result); -#else -#define DTraceCmdReturn NULL -#endif +typedef struct { + Tcl_Interp *interp; /* Interp this struct belongs to. */ + Tcl_AsyncHandler async; /* Async handler token for script + * cancellation. */ + char *result; /* The script cancellation result or NULL for + * a default result. */ + int length; /* Length of the above error message. */ + ClientData clientData; /* Ignored */ + int flags; /* Additional flags */ +} CancelInfo; +static Tcl_HashTable cancelTable; +static int cancelTableInitialized = 0; /* 0 means not yet initialized. */ +TCL_DECLARE_MUTEX(cancelLock) + +/* + * Declarations for managing contexts for non-recursive coroutines. Contexts + * are used to save the evaluation state between NR calls to each coro. + */ -MODULE_SCOPE const TclStubs * const tclConstStubsPtr; +static const CorContext NULL_CONTEXT = {NULL, NULL, NULL, NULL}; +#define SAVE_CONTEXT(context) \ + (context).framePtr = iPtr->framePtr; \ + (context).varFramePtr = iPtr->varFramePtr; \ + (context).cmdFramePtr = iPtr->cmdFramePtr; \ + (context).lineLABCPtr = iPtr->lineLABCPtr + +#define RESTORE_CONTEXT(context) \ + iPtr->framePtr = (context).framePtr; \ + iPtr->varFramePtr = (context).varFramePtr; \ + iPtr->cmdFramePtr = (context).cmdFramePtr; \ + iPtr->lineLABCPtr = (context).lineLABCPtr + /* - * Tcl_EvalObjv helpers + * Static functions in this file: */ +static char * CallCommandTraces(Interp *iPtr, Command *cmdPtr, + const char *oldName, const char *newName, + int flags); +static int CancelEvalProc(ClientData clientData, + Tcl_Interp *interp, int code); +static int CheckDoubleResult(Tcl_Interp *interp, double dResult); +static void DeleteCoroutine(ClientData clientData); +static void DeleteInterpProc(Tcl_Interp *interp); +static void DeleteOpCmdClientData(ClientData clientData); +#ifdef USE_DTRACE +static Tcl_ObjCmdProc DTraceObjCmd; +static Tcl_NRPostProc DTraceCmdReturn; +#else +# define DTraceCmdReturn NULL +#endif /* USE_DTRACE */ +static Tcl_ObjCmdProc ExprAbsFunc; +static Tcl_ObjCmdProc ExprBinaryFunc; +static Tcl_ObjCmdProc ExprBoolFunc; +static Tcl_ObjCmdProc ExprCeilFunc; +static Tcl_ObjCmdProc ExprDoubleFunc; +static Tcl_ObjCmdProc ExprEntierFunc; +static Tcl_ObjCmdProc ExprFloorFunc; +static Tcl_ObjCmdProc ExprIntFunc; +static Tcl_ObjCmdProc ExprIsqrtFunc; +static Tcl_ObjCmdProc ExprRandFunc; +static Tcl_ObjCmdProc ExprRoundFunc; +static Tcl_ObjCmdProc ExprSqrtFunc; +static Tcl_ObjCmdProc ExprSrandFunc; +static Tcl_ObjCmdProc ExprUnaryFunc; +static Tcl_ObjCmdProc ExprWideFunc; +static Tcl_Obj * GetCommandSource(Interp *iPtr, int objc, + Tcl_Obj *const objv[], int lookup); +static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, + int actual, Tcl_Obj *const *objv); +static Tcl_ObjCmdProc NRInterpCoroutine; +static Tcl_NRPostProc NRCoroutineCallerCallback; +static Tcl_NRPostProc NRCoroutineExitCallback; +static Tcl_NRPostProc NRRunObjProc; +static Tcl_NRPostProc NRTailcallEval; +static Tcl_ObjCmdProc OldMathFuncProc; +static void OldMathFuncDeleteProc(ClientData clientData); +static void ProcessUnexpectedResult(Tcl_Interp *interp, + int returnCode); +static int RewindCoroutine(CoroutineData *corPtr, int result); static void TEOV_SwitchVarFrame(Tcl_Interp *interp); static void TEOV_PushExceptionHandlers(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); @@ -130,22 +157,19 @@ static int TEOV_NotFound(Tcl_Interp *interp, int objc, static int TEOV_RunEnterTraces(Tcl_Interp *interp, Command **cmdPtrPtr, int objc, Tcl_Obj *const objv[], Namespace *lookupNsPtr); -static Tcl_NRPostProc TEOV_RestoreVarFrame; -static Tcl_NRPostProc TEOV_RunLeaveTraces; -static Tcl_NRPostProc TEOV_Exception; +static Tcl_NRPostProc RewindCoroutineCallback; +static Tcl_NRPostProc TailcallCleanup; +static Tcl_NRPostProc TEOEx_ByteCodeCallback; +static Tcl_NRPostProc TEOEx_ListCallback; static Tcl_NRPostProc TEOV_Error; +static Tcl_NRPostProc TEOV_Exception; static Tcl_NRPostProc TEOV_NotFoundCallback; +static Tcl_NRPostProc TEOV_RestoreVarFrame; +static Tcl_NRPostProc TEOV_RunLeaveTraces; +static Tcl_NRPostProc YieldToCallback; -static Tcl_NRPostProc TEOEx_ListCallback; -static Tcl_NRPostProc TEOEx_ByteCodeCallback; - -static Tcl_NRPostProc NRRunObjProc; - -static Tcl_NRPostProc TailcallCleanup; -static Tcl_NRPostProc NRTailcallEval; -static Tcl_NRPostProc RewindCoroutineCallback; -static Tcl_NRPostProc YieldToCallback; - +MODULE_SCOPE const TclStubs *const tclConstStubsPtr; + /* * The following structure define the commands in the Tcl core. */ @@ -215,7 +239,7 @@ static const CmdInfo builtInCmds[] = { {"split", Tcl_SplitObjCmd, NULL, NULL, 1}, {"subst", Tcl_SubstObjCmd, TclCompileSubstCmd, TclNRSubstObjCmd, 1}, {"switch", Tcl_SwitchObjCmd, TclCompileSwitchCmd, TclNRSwitchObjCmd, 1}, - {"tailcall", NULL, NULL, TclNRTailcallObjCmd, 1}, + {"tailcall", NULL, NULL, TclNRTailcallObjCmd, 1}, {"throw", Tcl_ThrowObjCmd, NULL, NULL, 1}, {"trace", Tcl_TraceObjCmd, NULL, NULL, 1}, {"try", Tcl_TryObjCmd, NULL, TclNRTryObjCmd, 1}, @@ -372,30 +396,6 @@ static const OpCmdInfo mathOpCmds[] = { }; /* - * This is the script cancellation struct and hash table. The hash table is - * used to keep track of the information necessary to process script - * cancellation requests, including the original interp, asynchronous handler - * tokens (created by Tcl_AsyncCreate), and the clientData and flags arguments - * passed to Tcl_CancelEval on a per-interp basis. The cancelLock mutex is - * used for protecting calls to Tcl_CancelEval as well as protecting access to - * the hash table below. - */ - -typedef struct { - Tcl_Interp *interp; /* Interp this struct belongs to. */ - Tcl_AsyncHandler async; /* Async handler token for script - * cancellation. */ - char *result; /* The script cancellation result or NULL for - * a default result. */ - int length; /* Length of the above error message. */ - ClientData clientData; /* Ignored */ - int flags; /* Additional flags */ -} CancelInfo; -static Tcl_HashTable cancelTable; -static int cancelTableInitialized = 0; /* 0 means not yet initialized. */ -TCL_DECLARE_MUTEX(cancelLock) - -/* *---------------------------------------------------------------------- * * TclFinalizeEvaluation -- @@ -555,7 +555,7 @@ Tcl_CreateInterp(void) } iPtr->cmdCount = 0; - TclInitLiteralTable(&(iPtr->literalTable)); + TclInitLiteralTable(&iPtr->literalTable); iPtr->compileEpoch = 0; iPtr->compiledProcPtr = NULL; iPtr->resolverPtr = NULL; @@ -648,7 +648,7 @@ Tcl_CreateInterp(void) */ #ifdef TCL_COMPILE_STATS - statsPtr = &(iPtr->stats); + statsPtr = &iPtr->stats; statsPtr->numExecutions = 0; statsPtr->numCompilations = 0; statsPtr->numByteCodesFreed = 0; @@ -720,7 +720,7 @@ Tcl_CreateInterp(void) * Tcl_CmdProc, set the Tcl_CmdProc to TclInvokeObjectCommand. */ - for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) { + for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) { if ((cmdInfoPtr->objProc == NULL) && (cmdInfoPtr->compileProc == NULL) && (cmdInfoPtr->nreProc == NULL)) { @@ -1386,7 +1386,7 @@ DeleteInterpProc( * table, as it will be freed later in this function without further use. */ - TclCleanupLiteralTable(interp, &(iPtr->literalTable)); + TclCleanupLiteralTable(interp, &iPtr->literalTable); TclHandleFree(iPtr->handle); TclTeardownNamespace(iPtr->globalNsPtr); @@ -1399,7 +1399,7 @@ DeleteInterpProc( /* * Non-pernicious deletion. The deletion callbacks will not be allowed * to create any new hidden or non-hidden commands. - * Tcl_DeleteCommandFromToken() will remove the entry from the + * Tcl_DeleteCommandFromToken will remove the entry from the * hiddenCmdTablePtr. */ @@ -1497,7 +1497,7 @@ DeleteInterpProc( * interpreter. */ - TclDeleteLiteralTable(interp, &(iPtr->literalTable)); + TclDeleteLiteralTable(interp, &iPtr->literalTable); /* * TIP #280 - Release the arrays for ByteCode/Proc extension, and @@ -1831,13 +1831,13 @@ Tcl_ExposeCommand( /* * Check that we have a true global namespace command (enforced by - * Tcl_HideCommand() but let's double check. (If it was not, we would not + * Tcl_HideCommand but let's double check. (If it was not, we would not * really know how to handle it). */ if (cmdPtr->nsPtr != iPtr->globalNsPtr) { /* - * This case is theoritically impossible, we might rather Tcl_Panic() + * This case is theoritically impossible, we might rather Tcl_Panic * than 'nicely' erroring out ? */ @@ -2450,7 +2450,7 @@ TclRenameCommand( /* * Warning: any changes done in the code here are likely to be needed in - * Tcl_HideCommand() code too (until the common parts are extracted out). + * Tcl_HideCommand code too (until the common parts are extracted out). * - dl */ @@ -2972,7 +2972,7 @@ Tcl_DeleteCommandFromToken( * If you are getting a crash during the call to deleteProc and * cmdPtr->deleteProc is a pointer to the function free(), the most * likely cause is that your extension allocated memory for the - * clientData argument to Tcl_CreateObjCommand() with the ckalloc() + * clientData argument to Tcl_CreateObjCommand with the ckalloc() * macro and you are now trying to deallocate this memory with free() * instead of ckfree(). You should pass a pointer to your own method * that calls ckfree(). @@ -3007,10 +3007,10 @@ Tcl_DeleteCommandFromToken( } /* - * A number of tests for particular kinds of commands are done by - * checking whether the objProc field holds a known value. Set the - * field to NULL so that such tests won't have false positives when - * applied to deleted commands. + * A number of tests for particular kinds of commands are done by checking + * whether the objProc field holds a known value. Set the field to NULL so + * that such tests won't have false positives when applied to deleted + * commands. */ cmdPtr->objProc = NULL; @@ -3028,6 +3028,23 @@ Tcl_DeleteCommandFromToken( return 0; } +/* + *---------------------------------------------------------------------- + * + * CallCommandTraces -- + * + * Abstraction of the code to call traces on a command. + * + * Results: + * Currently always NULL. + * + * Side effects: + * Anything; this may recursively evaluate scripts and code exists to do + * just that. + * + *---------------------------------------------------------------------- + */ + static char * CallCommandTraces( Interp *iPtr, /* Interpreter containing command. */ @@ -3129,6 +3146,26 @@ CallCommandTraces( Tcl_Release(iPtr); return result; } + +/* + *---------------------------------------------------------------------- + * + * CancelEvalProc -- + * + * Marks this interpreter as being canceled. This causes current + * executions to be unwound as the interpreter enters a state where it + * refuses to execute more commands or handle [catch] or [try], yet the + * interpreter is still able to execute further commands after the + * cancelation is cleared (unlike if it is deleted). + * + * Results: + * The value given for the code argument. + * + * Side effects: + * Transfers a message from the cancelation message to the interpreter. + * + *---------------------------------------------------------------------- + */ static int CancelEvalProc( @@ -3380,7 +3417,7 @@ OldMathFuncProc( args = (Tcl_Value *) ckalloc(dataPtr->numArgs * sizeof(Tcl_Value)); for (j = 1, k = 0; j < objc; ++j, ++k) { - /* TODO: Convert to TclGetNumberFromObj() ? */ + /* TODO: Convert to TclGetNumberFromObj? */ valuePtr = objv[j]; result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d); #ifdef ACCEPT_NAN @@ -3412,12 +3449,12 @@ OldMathFuncProc( args[k].type = dataPtr->argTypes[k]; switch (args[k].type) { case TCL_EITHER: - if (Tcl_GetLongFromObj(NULL, valuePtr, &(args[k].intValue)) + if (Tcl_GetLongFromObj(NULL, valuePtr, &args[k].intValue) == TCL_OK) { args[k].type = TCL_INT; break; } - if (Tcl_GetWideIntFromObj(interp, valuePtr, &(args[k].wideValue)) + if (Tcl_GetWideIntFromObj(interp, valuePtr, &args[k].wideValue) == TCL_OK) { args[k].type = TCL_WIDE_INT; break; @@ -3429,21 +3466,21 @@ OldMathFuncProc( args[k].doubleValue = d; break; case TCL_INT: - if (ExprIntFunc(NULL, interp, 2, &(objv[j-1])) != TCL_OK) { + if (ExprIntFunc(NULL, interp, 2, &objv[j-1]) != TCL_OK) { ckfree((char *) args); return TCL_ERROR; } valuePtr = Tcl_GetObjResult(interp); - Tcl_GetLongFromObj(NULL, valuePtr, &(args[k].intValue)); + Tcl_GetLongFromObj(NULL, valuePtr, &args[k].intValue); Tcl_ResetResult(interp); break; case TCL_WIDE_INT: - if (ExprWideFunc(NULL, interp, 2, &(objv[j-1])) != TCL_OK) { + if (ExprWideFunc(NULL, interp, 2, &objv[j-1]) != TCL_OK) { ckfree((char *) args); return TCL_ERROR; } valuePtr = Tcl_GetObjResult(interp); - Tcl_GetWideIntFromObj(NULL, valuePtr, &(args[k].wideValue)); + Tcl_GetWideIntFromObj(NULL, valuePtr, &args[k].wideValue); Tcl_ResetResult(interp); break; } @@ -4576,7 +4613,8 @@ TEOV_NotFound( savedNsPtr = varFramePtr->nsPtr; varFramePtr->nsPtr = lookupNsPtr; } - TclNRDeferCallback(interp, TEOV_NotFoundCallback, INT2PTR(handlerObjc), newObjv, savedNsPtr, NULL); + TclNRDeferCallback(interp, TEOV_NotFoundCallback, INT2PTR(handlerObjc), + newObjv, savedNsPtr, NULL); iPtr->evalFlags |= TCL_EVAL_REDIRECT; return TclNREvalObjv(interp, newObjc, newObjv, TCL_EVAL_NOERR, NULL); } @@ -4769,7 +4807,7 @@ Tcl_EvalTokensStandard( * Must be at least 1. */ { return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1, - NULL, NULL); + NULL, NULL); } /* @@ -4910,15 +4948,13 @@ TclEvalEx( int *linesStack = TclStackAlloc(interp, minObjs * sizeof(int)); /* TIP #280 Structures for tracking of command * locations. */ - /* - * Pointer for the tracking of invisible continuation lines. Initialized - * only if the caller gave us a table of locations to track, via - * scriptCLLocPtr. It always refers to the table entry holding the - * location of the next invisible continuation line to look for, while - * parsing the script. - */ - - int *clNext = NULL; + int *clNext = NULL; /* Pointer for the tracking of invisible + * continuation lines. Initialized only if the + * caller gave us a table of locations to + * track, via scriptCLLocPtr. It always refers + * to the table entry holding the location of + * the next invisible continuation line to + * look for, while parsing the script. */ if (iPtr->scriptCLLocPtr) { if (clNextOuter) { @@ -5044,14 +5080,13 @@ TclEvalEx( int wordLine = line; const char *wordStart = parsePtr->commandStart; int *wordCLNext = clNext; + unsigned int objectsNeeded = 0; + unsigned int numWords = parsePtr->numWords; /* * Generate an array of objects for the words of the command. */ - unsigned int objectsNeeded = 0; - unsigned int numWords = parsePtr->numWords; - if (numWords > minObjs) { expand = (int *) ckalloc(numWords * sizeof(int)); objvSpace = (Tcl_Obj **) @@ -5377,9 +5412,9 @@ TclAdvanceContinuations( int loc) { /* - * Track the invisible continuation lines embedded in a script, if - * any. Here they are just spaces (already). They were removed by - * EvalTokensStandard() via Tcl_UtfBackslash(). + * Track the invisible continuation lines embedded in a script, if any. + * Here they are just spaces (already). They were removed by + * EvalTokensStandard via Tcl_UtfBackslash. * * *clNextPtrPtr <=> We have continuation lines to track. * **clNextPtrPtr >= 0 <=> We are not beyond the last possible location. @@ -5507,8 +5542,8 @@ TclArgumentRelease( for (i = 1; i < objc; i++) { CFWord *cfwPtr; - Tcl_HashEntry *hPtr = Tcl_FindHashEntry(iPtr->lineLAPtr, - (char *) objv[i]); + Tcl_HashEntry *hPtr = + Tcl_FindHashEntry(iPtr->lineLAPtr, (char *) objv[i]); if (!hPtr) { continue; @@ -5589,10 +5624,10 @@ TclArgumentBCEnter( CFWordBC *cfwPtr = (CFWordBC *) ckalloc(sizeof(CFWordBC)); cfwPtr->framePtr = cfPtr; - cfwPtr->obj = objv[word]; - cfwPtr->pc = pc; - cfwPtr->word = word; - cfwPtr->nextPtr = lastPtr; + cfwPtr->obj = objv[word]; + cfwPtr->pc = pc; + cfwPtr->word = word; + cfwPtr->nextPtr = lastPtr; lastPtr = cfwPtr; if (isnew) { @@ -5896,9 +5931,9 @@ TclNREvalObjEx( * finally direct evaluation. Precisely one of these blocks will be run. */ - if ((objPtr->typePtr == &tclListType) && /* is a list... */ - ((objPtr->bytes == NULL || /* ...without a string rep */ - listRepPtr->canonicalFlag))) { /* ...or that is canonical */ + if ((objPtr->typePtr == &tclListType) && /* is a list */ + ((objPtr->bytes == NULL || /* no string rep */ + listRepPtr->canonicalFlag))) { /* or is canonical */ Tcl_Obj *listPtr = objPtr; CmdFrame *eoFramePtr = NULL; int objc; @@ -6030,7 +6065,7 @@ TclNREvalObjEx( * evaluator is using it, leading to the release of the associated * ContLineLoc structure as well. To ensure that the latter doesn't * happen we set a lock on it. We release this lock later in this - * function, after the evaluator is done. The relevant "lineCLPtr" + * function, after the evaluator is done. The relevant "lineCLPtr" * hashtable is managed in the file "tclObj.c". * * Another important action is to save (and later restore) the @@ -6912,7 +6947,8 @@ Tcl_VarEval( int Tcl_GlobalEval( - Tcl_Interp *interp, /* Interpreter in which to evaluate command. */ + Tcl_Interp *interp, /* Interpreter in which to evaluate + * command. */ const char *command) /* Command to evaluate. */ { register Interp *iPtr = (Interp *) interp; @@ -7826,7 +7862,7 @@ ExprSrandFunc( /* * Reset the seed. Make sure 1 <= randSeed <= 2^31 - 2. See comments in - * ExprRandFunc() for more details. + * ExprRandFunc for more details. */ iPtr->flags |= RAND_SEED_INITIALIZED; @@ -7974,7 +8010,7 @@ TclDTraceInfo( for (i = 0; i < 2; i++) { Tcl_DictObjGet(NULL, info, *k++, &val); if (val) { - TclGetIntFromObj(NULL, val, &(argsi[i])); + TclGetIntFromObj(NULL, val, &argsi[i]); } else { argsi[i] = 0; } @@ -8214,7 +8250,7 @@ TclSpliceTailcall( TEOV_callback *runPtr; ExecEnv *eePtr = NULL; int second = 0; - + restart: for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) { if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) { @@ -8269,8 +8305,8 @@ TclNRTailcallObjCmd( return TCL_ERROR; } - if (!iPtr->varFramePtr->isProcCallFrame || /* is not a body ... */ - (iPtr->framePtr != iPtr->varFramePtr)) { /* or is upleveled */ + if (!iPtr->varFramePtr->isProcCallFrame || /* is not a body */ + (iPtr->framePtr != iPtr->varFramePtr)) { /* or is upleveled */ Tcl_SetResult(interp, "tailcall can only be called from a proc or lambda", TCL_STATIC); @@ -8292,7 +8328,7 @@ TclNRTailcallObjCmd( * Create the callback to actually evaluate the tailcalled * command, then pass it to tebc so that it is stashed at the proper * place. Being lazy: exploit the TclNRAddCallBack macro to build the - * callback. + * callback. */ TclNRAddCallback(interp, NRTailcallEval, listPtr, nsObjPtr, NULL, NULL); @@ -8387,31 +8423,6 @@ Tcl_NRAddCallback( *---------------------------------------------------------------------- */ -static int NRInterpCoroutine(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static int RewindCoroutine(CoroutineData *corPtr, int result); -static void DeleteCoroutine(ClientData clientData); - -static int NRCoroutineExitCallback(ClientData data[], - Tcl_Interp *interp, int result); -static int NRCoroutineCallerCallback(ClientData data[], - Tcl_Interp *interp, int result); - -static const CorContext NULL_CONTEXT = {NULL, NULL, NULL, NULL}; - -#define SAVE_CONTEXT(context) \ - (context).framePtr = iPtr->framePtr; \ - (context).varFramePtr = iPtr->varFramePtr; \ - (context).cmdFramePtr = iPtr->cmdFramePtr; \ - (context).lineLABCPtr = iPtr->lineLABCPtr - -#define RESTORE_CONTEXT(context) \ - iPtr->framePtr = (context).framePtr; \ - iPtr->varFramePtr = (context).varFramePtr; \ - iPtr->cmdFramePtr = (context).cmdFramePtr; \ - iPtr->lineLABCPtr = (context).lineLABCPtr - #define iPtr ((Interp *) interp) int @@ -8490,15 +8501,16 @@ TclNRYieldToObjCmd( 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); + TclNRAddCallback(interp, YieldToCallback, corPtr, listPtr, nsObjPtr, + NULL); iPtr->execEnvPtr = corPtr->eePtr; - + TclNRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_YIELD_TYPE), NULL, NULL, NULL); return TCL_OK; @@ -8516,12 +8528,11 @@ YieldToCallback( /* yieldTo: invoke the command using tailcall tech */ TEOV_callback *cbPtr; - - TclNRAddCallback(interp, NRTailcallEval, listPtr, nsPtr, - NULL, NULL); + + TclNRAddCallback(interp, NRTailcallEval, listPtr, nsPtr, NULL, NULL); cbPtr = TOP_CB(interp); TOP_CB(interp) = cbPtr->nextPtr; - + TclSpliceTailcall(interp, cbPtr); return TCL_OK; } @@ -8621,7 +8632,7 @@ NRCoroutineExitCallback( { CoroutineData *corPtr = data[0]; Command *cmdPtr = corPtr->cmdPtr; - + /* * This runs at the bottom of the Coroutine's execEnv: it will be executed * when the coroutine returns or is wound down, but not when it yields. It @@ -8676,7 +8687,7 @@ NRInterpCoroutine( /* * objc==0 indicates a call to rewind the coroutine */ - + if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?arg?"); return TCL_ERROR; @@ -8730,7 +8741,7 @@ TclNRCoroutineObjCmd( const char *procName; Namespace *nsPtr, *altNsPtr, *cxtNsPtr; Tcl_DString ds; - + if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "name cmd ?arg ...?"); return TCL_ERROR; @@ -8766,9 +8777,9 @@ TclNRCoroutineObjCmd( /* * We ARE creating the coroutine command: allocate the corresponding * struct, add the callback in caller's env and record the caller's - * frames. + * frames. */ - + corPtr = (CoroutineData *) ckalloc(sizeof(CoroutineData)); TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, NULL, NULL, NULL); @@ -8837,12 +8848,12 @@ TclNRCoroutineObjCmd( * will be allocated in the Tcl stack. So signal TEBC that it has to * initialize the base cmdFramePtr by setting it to NULL. */ - + corPtr->base.cmdFramePtr = NULL; corPtr->running = NULL_CONTEXT; corPtr->stackLevel = NULL; corPtr->auxNumLevels = iPtr->numLevels; - + /* * Create the command that will run at the bottom of the coroutine. * Be sure not to pass a canonical list for the command so that we insure @@ -8859,7 +8870,7 @@ TclNRCoroutineObjCmd( * 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 * the callback to eval the coro body. - */ + */ corPtr->eePtr = TclCreateExecEnv(interp, CORO_STACK_INITIAL_SIZE); corPtr->callerEEPtr = iPtr->execEnvPtr; @@ -8902,6 +8913,8 @@ TclInfoCoroutineCmd( } return TCL_OK; } + +#undef iPtr /* * Local Variables: |