diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2007-04-25 21:59:27 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2007-04-25 21:59:27 (GMT) |
commit | 98db0526c3675947ecfc371b9166d3a346ebbf45 (patch) | |
tree | ea604781e2bd47a162882dddab603cf67a732a8b /generic/tclProc.c | |
parent | 3e9935c9d0351de3a1b1da3f2c9dbb01e78799c7 (diff) | |
download | tcl-98db0526c3675947ecfc371b9166d3a346ebbf45.zip tcl-98db0526c3675947ecfc371b9166d3a346ebbf45.tar.gz tcl-98db0526c3675947ecfc371b9166d3a346ebbf45.tar.bz2 |
Fix [Bug 1705778, leak K15]
Diffstat (limited to 'generic/tclProc.c')
-rw-r--r-- | generic/tclProc.c | 493 |
1 files changed, 264 insertions, 229 deletions
diff --git a/generic/tclProc.c b/generic/tclProc.c index 218582b..07a4337 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclProc.c,v 1.111 2007/04/10 14:47:17 dkf Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.112 2007/04/25 21:59:28 dkf Exp $ */ #include "tclInt.h" @@ -195,8 +195,9 @@ Tcl_ProcObjCmd( procPtr->cmdPtr = (Command *) cmd; - /* TIP #280 Remember the line the procedure body is starting on. In a - * Byte code context we ask the engine to provide us with the necessary + /* + * TIP #280: Remember the line the procedure body is starting on. In a + * bytecode context we ask the engine to provide us with the necessary * information. This is for the initialization of the byte code compiler * when the body is used for the first time. * @@ -208,51 +209,58 @@ Tcl_ProcObjCmd( */ if (iPtr->cmdFramePtr) { - CmdFrame context = *iPtr->cmdFramePtr; + CmdFrame context = *iPtr->cmdFramePtr; if (context.type == TCL_LOCATION_BC) { - TclGetSrcInfoForPc (&context); - /* May get path in context */ + TclGetSrcInfoForPc(&context); + + /* + * May get path in context. + */ } else if (context.type == TCL_LOCATION_SOURCE) { - /* context now holds another reference */ - Tcl_IncrRefCount (context.data.eval.path); + /* + * Context now holds another reference. + */ + + Tcl_IncrRefCount(context.data.eval.path); } - /* type == TCL_LOCATION_PREBC implies that 'line' is NULL here! - * We cannot assume that 'line' is valid here, we have to check. + /* + * type == TCL_LOCATION_PREBC implies that 'line' is NULL here! We + * cannot assume that 'line' is valid here, we have to check. */ - if ((context.type == TCL_LOCATION_SOURCE) && - context.line && - (context.nline >= 4) && - (context.line [3] >= 0)) { - int new; - CmdFrame* cfPtr = (CmdFrame*) ckalloc (sizeof (CmdFrame)); - - cfPtr->level = -1; - cfPtr->type = context.type; - cfPtr->line = (int*) ckalloc (sizeof (int)); - cfPtr->line [0] = context.line [3]; - cfPtr->nline = 1; + if ((context.type == TCL_LOCATION_SOURCE) && context.line + && (context.nline >= 4) && (context.line[3] >= 0)) { + int isNew; + CmdFrame *cfPtr = (CmdFrame *) ckalloc(sizeof(CmdFrame)); + + cfPtr->level = -1; + cfPtr->type = context.type; + cfPtr->line = (int *) ckalloc(sizeof(int)); + cfPtr->line[0] = context.line[3]; + cfPtr->nline = 1; cfPtr->framePtr = NULL; - cfPtr->nextPtr = NULL; + cfPtr->nextPtr = NULL; if (context.type == TCL_LOCATION_SOURCE) { - cfPtr->data.eval.path = context.data.eval.path; - /* Transfer of reference. The reference going away (release of + cfPtr->data.eval.path = context.data.eval.path; + + /* + * Transfer of reference. The reference going away (release of * the context) is replaced by the reference in the - * constructed cmdframe */ + * constructed cmdframe. + */ } else { - cfPtr->type = TCL_LOCATION_EVAL; + cfPtr->type = TCL_LOCATION_EVAL; cfPtr->data.eval.path = NULL; } cfPtr->cmd.str.cmd = NULL; cfPtr->cmd.str.len = 0; - Tcl_SetHashValue (Tcl_CreateHashEntry (iPtr->linePBodyPtr, - (char*) procPtr, &new), - cfPtr); + Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, + (char *) procPtr, &isNew), cfPtr); } } @@ -347,7 +355,7 @@ TclCreateProc( Tcl_Obj *bodyPtr, /* command body */ Proc **procPtrPtr) /* returns: pointer to proc data */ { - Interp *iPtr = (Interp*)interp; + Interp *iPtr = (Interp *) interp; CONST char **argArray = NULL; register Proc *procPtr; @@ -681,7 +689,7 @@ TclGetFrame( */ for (framePtr = iPtr->varFramePtr; framePtr != NULL; - framePtr = framePtr->callerVarPtr) { + framePtr = framePtr->callerVarPtr) { if (framePtr->level == level) { break; } @@ -689,7 +697,7 @@ TclGetFrame( if (framePtr == NULL) { goto levelError; } - + *framePtrPtr = framePtr; return result; @@ -761,46 +769,44 @@ TclObjGetFrame( goto levelError; } level = curLevel - level; - } else { - if (*name == '#') { - if (Tcl_GetInt(interp, name+1, &level) != TCL_OK || level < 0) { - goto levelError; - } + } else if (*name == '#') { + if (Tcl_GetInt(interp, name+1, &level) != TCL_OK || level < 0) { + goto levelError; + } - /* - * Cache for future reference. - * - * TODO: Use the new ptrAndLongRep intrep - */ + /* + * Cache for future reference. + * + * TODO: Use the new ptrAndLongRep intrep + */ - TclFreeIntRep(objPtr); - objPtr->typePtr = &levelReferenceType; - objPtr->internalRep.twoPtrValue.ptr1 = (void *) 0; - objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(level); - } else if (isdigit(UCHAR(*name))) { /* INTL: digit */ - if (Tcl_GetInt(interp, name, &level) != TCL_OK) { - return -1; - } + TclFreeIntRep(objPtr); + objPtr->typePtr = &levelReferenceType; + objPtr->internalRep.twoPtrValue.ptr1 = (void *) 0; + objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(level); + } else if (isdigit(UCHAR(*name))) { /* INTL: digit */ + if (Tcl_GetInt(interp, name, &level) != TCL_OK) { + return -1; + } - /* - * Cache for future reference. - * - * TODO: Use the new ptrAndLongRep intrep - */ + /* + * Cache for future reference. + * + * TODO: Use the new ptrAndLongRep intrep + */ - TclFreeIntRep(objPtr); - objPtr->typePtr = &levelReferenceType; - objPtr->internalRep.twoPtrValue.ptr1 = (void *) 1; - objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(level); - level = curLevel - level; - } else { - /* - * Don't cache as the object *isn't* a level reference. - */ + TclFreeIntRep(objPtr); + objPtr->typePtr = &levelReferenceType; + objPtr->internalRep.twoPtrValue.ptr1 = (void *) 1; + objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(level); + level = curLevel - level; + } else { + /* + * Don't cache as the object *isn't* a level reference. + */ - level = curLevel - 1; - result = 0; - } + level = curLevel - 1; + result = 0; } /* @@ -808,7 +814,7 @@ TclObjGetFrame( */ for (framePtr = iPtr->varFramePtr; framePtr != NULL; - framePtr = framePtr->callerVarPtr) { + framePtr = framePtr->callerVarPtr) { if (framePtr->level == level) { break; } @@ -1020,23 +1026,24 @@ InitCompiledLocals( Var *varPtr, Namespace *nsPtr) /* Pointer to current namespace. */ { - Interp *iPtr = (Interp*) interp; + Interp *iPtr = (Interp *) interp; int haveResolvers = (nsPtr->compiledVarResProc || iPtr->resolverPtr); CompiledLocal *firstLocalPtr; if (!(haveResolvers && (codePtr->flags & TCL_BYTECODE_RESOLVE_VARS))) { /* - * Initialize the array of local variables stored in the call frame. Some - * variables may have special resolution rules. In that case, we call - * their "resolver" procs to get our hands on the variable, and we make - * the compiled local a link to the real variable. + * Initialize the array of local variables stored in the call frame. + * Some variables may have special resolution rules. In that case, we + * call their "resolver" procs to get our hands on the variable, and + * we make the compiled local a link to the real variable. */ - doInitCompiledLocals: + doInitCompiledLocals: if (!haveResolvers) { for (; localPtr != NULL; varPtr++, localPtr = localPtr->nextPtr) { varPtr->value.objPtr = NULL; - varPtr->name = localPtr->name; /* will be just '\0' if temp var */ + varPtr->name = localPtr->name; /* Will be just '\0' if temp + * var. */ varPtr->nsPtr = NULL; varPtr->hPtr = NULL; varPtr->refCount = 0; @@ -1047,25 +1054,27 @@ InitCompiledLocals( return; } else { Tcl_ResolvedVarInfo *resVarInfo; + for (; localPtr != NULL; varPtr++, localPtr = localPtr->nextPtr) { varPtr->value.objPtr = NULL; - varPtr->name = localPtr->name; /* will be just '\0' if temp var */ + varPtr->name = localPtr->name; /* Will be just '\0' if temp + * var. */ varPtr->nsPtr = NULL; varPtr->hPtr = NULL; varPtr->refCount = 0; varPtr->tracePtr = NULL; varPtr->searchPtr = NULL; varPtr->flags = localPtr->flags; - + /* - * Now invoke the resolvers to determine the exact variables that - * should be used. + * Now invoke the resolvers to determine the exact variables + * that should be used. */ resVarInfo = localPtr->resolveInfo; if (resVarInfo && resVarInfo->fetchProc) { - Var *resolvedVarPtr = (Var*) (*resVarInfo->fetchProc)(interp, - resVarInfo); + Var *resolvedVarPtr = (Var *) + (*resVarInfo->fetchProc)(interp, resVarInfo); if (resolvedVarPtr) { resolvedVarPtr->refCount++; varPtr->value.linkPtr = resolvedVarPtr; @@ -1083,12 +1092,11 @@ InitCompiledLocals( firstLocalPtr = localPtr; for (; localPtr != NULL; localPtr = localPtr->nextPtr) { - if (localPtr->resolveInfo) { if (localPtr->resolveInfo->deleteProc) { localPtr->resolveInfo->deleteProc(localPtr->resolveInfo); } else { - ckfree((char*)localPtr->resolveInfo); + ckfree((char *) localPtr->resolveInfo); } localPtr->resolveInfo = NULL; } @@ -1218,7 +1226,7 @@ ObjInterpProcEx( Namespace *nsPtr = procPtr->cmdPtr->nsPtr; CallFrame *framePtr, **framePtrPtr; int result; - + /* * If necessary, compile the procedure's body. The compiler will allocate * frame slots for the procedure's non-argument local variables. Note that @@ -1237,7 +1245,7 @@ ObjInterpProcEx( result = ProcCompileProc(interp, procPtr, procPtr->bodyPtr, nsPtr, (isLambda ? "body of lambda term" : "body of proc"), TclGetString(objv[isLambda]), &procPtr); - + if (result != TCL_OK) { return result; } @@ -1393,14 +1401,17 @@ TclObjInterpProcCore( if (localPtr->flags & VAR_IS_ARGS) { Tcl_Obj *listPtr = Tcl_NewListObj(argCt-i, argObjs+i); + varPtr->value.objPtr = listPtr; Tcl_IncrRefCount(listPtr); /* local var is a reference */ } else if (argCt == numArgs) { Tcl_Obj *objPtr = argObjs[i]; + varPtr->value.objPtr = objPtr; Tcl_IncrRefCount(objPtr); /* local var is a reference */ } else if ((argCt < numArgs) && (localPtr->defValuePtr != NULL)) { Tcl_Obj *objPtr = localPtr->defValuePtr; + varPtr->value.objPtr = objPtr; Tcl_IncrRefCount(objPtr); /* local var is a reference */ } else { @@ -1436,14 +1447,15 @@ TclObjInterpProcCore( for (i=1 ; i<=numArgs ; i++) { Tcl_Obj *argObj; - TclNewObj(argObj); if (localPtr->defValuePtr != NULL) { + TclNewObj(argObj); Tcl_AppendStringsToObj(argObj, "?", localPtr->name, "?", NULL); } else if ((i==numArgs) && !strcmp(localPtr->name, "args")) { numArgs--; final = "..."; + break; } else { - Tcl_AppendStringsToObj(argObj, localPtr->name, NULL); + argObj = Tcl_NewStringObj(localPtr->name, -1); } desiredObjs[i] = argObj; localPtr = localPtr->nextPtr; @@ -1510,7 +1522,8 @@ TclObjInterpProcCore( procPtr->refCount++; - /* TIP #280: No need to set the invoking context here. The body has + /* + * TIP #280: No need to set the invoking context here. The body has * already been compiled, so the part of CompEvalObj using it is bypassed. */ @@ -1520,68 +1533,69 @@ TclObjInterpProcCore( TclProcCleanupProc(procPtr); } - if (result == TCL_OK) { - /* - * Pop and free the call frame for this procedure invocation, then free - * the compiledLocals array if malloc'ed storage was used. - */ - - procDone: - /* - * Free the stack-allocated compiled locals and CallFrame. It is important - * to pop the call frame without freeing it first: the compiledLocals - * cannot be freed before the frame is popped, as the local variables must - * be deleted. But the compiledLocals must be freed first, as they were - * allocated later on the stack. - */ - - Tcl_PopCallFrame(interp); /* pop but do not free */ - TclStackFree(interp); /* free compiledLocals */ - TclStackFree(interp); /* free CallFrame */ - return result; - } else { - /* - * Non-standard results are processed by passing them through quickly. - * This means they all work as exceptions, unwinding the stack quickly - * and neatly. Who knows how well they are handled by third-party code - * though... - */ + /* + * If the procedure is completing normally, we can skip directly to the + * part where we clean up any associated memory. + */ - if ((result > TCL_CONTINUE) || (result < TCL_OK)) { - goto procDone; - } + if (result == TCL_OK) { + goto procDone; + } - /* - * If it is a 'return', do the TIP#90 processing now. - */ + /* + * Non-standard results are processed by passing them through quickly. + * This means they all work as exceptions, unwinding the stack quickly and + * neatly. Who knows how well they are handled by third-party code + * though... + */ - if (result == TCL_RETURN) { - result = TclUpdateReturnInfo((Interp *) interp); - goto procDone; - } + if ((result > TCL_CONTINUE) || (result < TCL_OK)) { + goto procDone; + } - /* - * Must be an error, a 'break' or a 'continue'. It's an error to get - * to this point from a 'break' or 'continue' though, so transform to - * an error now. - */ + /* + * If it is a 'return', do the TIP#90 processing now. + */ - if (result != TCL_ERROR) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "invoked \"", - ((result == TCL_BREAK) ? "break" : "continue"), - "\" outside of a loop", NULL); - result = TCL_ERROR; - } + if (result == TCL_RETURN) { + result = TclUpdateReturnInfo((Interp *) interp); + goto procDone; + } - /* - * Now it _must_ be an error, so we need to log it as such. This means - * filling out the error trace. - */ + /* + * Must be an error, a 'break' or a 'continue'. It's an error to get to + * this point from a 'break' or 'continue' though, so transform to an + * error now. + */ - (*errorProc)(interp, procNameObj); - goto procDone; + if (result != TCL_ERROR) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "invoked \"", + ((result == TCL_BREAK) ? "break" : "continue"), + "\" outside of a loop", NULL); + result = TCL_ERROR; } + + /* + * Now it _must_ be an error, so we need to log it as such. This means + * filling out the error trace. + */ + + (*errorProc)(interp, procNameObj); + + procDone: + /* + * Free the stack-allocated compiled locals and CallFrame. It is important + * to pop the call frame without freeing it first: the compiledLocals + * cannot be freed before the frame is popped, as the local variables must + * be deleted. But the compiledLocals must be freed first, as they were + * allocated later on the stack. + */ + + Tcl_PopCallFrame(interp); /* Pop but do not free. */ + TclStackFree(interp); /* Free compiledLocals. */ + TclStackFree(interp); /* Free CallFrame. */ + return result; } /* @@ -1632,7 +1646,7 @@ ProcCompileProc( Proc **procPtrPtr) /* Points to storage where a replacement * (Proc *) value may be written. */ { - Interp *iPtr = (Interp*)interp; + Interp *iPtr = (Interp *) interp; int i, result; Tcl_CallFrame *framePtr; Proc *saveProcPtr; @@ -1707,30 +1721,31 @@ ProcCompileProc( if (procPtrPtr != NULL && procPtr->refCount > 1) { Tcl_Command token; Tcl_CmdInfo info; - Proc *new = (Proc *) ckalloc(sizeof(Proc)); - - new->iPtr = procPtr->iPtr; - new->refCount = 1; - new->cmdPtr = procPtr->cmdPtr; - token = (Tcl_Command) new->cmdPtr; - new->bodyPtr = Tcl_DuplicateObj(bodyPtr); - bodyPtr = new->bodyPtr; + Proc *newProc = (Proc *) ckalloc(sizeof(Proc)); + + newProc->iPtr = procPtr->iPtr; + newProc->refCount = 1; + newProc->cmdPtr = procPtr->cmdPtr; + token = (Tcl_Command) newProc->cmdPtr; + newProc->bodyPtr = Tcl_DuplicateObj(bodyPtr); + bodyPtr = newProc->bodyPtr; Tcl_IncrRefCount(bodyPtr); - new->numArgs = procPtr->numArgs; + newProc->numArgs = procPtr->numArgs; - new->numCompiledLocals = new->numArgs; - new->firstLocalPtr = NULL; - new->lastLocalPtr = NULL; + newProc->numCompiledLocals = newProc->numArgs; + newProc->firstLocalPtr = NULL; + newProc->lastLocalPtr = NULL; localPtr = procPtr->firstLocalPtr; - for (i = 0; i < new->numArgs; i++, localPtr = localPtr->nextPtr) { + for (i=0; i<newProc->numArgs; i++, localPtr=localPtr->nextPtr) { CompiledLocal *copy = (CompiledLocal *) ckalloc((unsigned) - (sizeof(CompiledLocal) -sizeof(localPtr->name) + (sizeof(CompiledLocal) - sizeof(localPtr->name) + localPtr->nameLength + 1)); - if (new->firstLocalPtr == NULL) { - new->firstLocalPtr = new->lastLocalPtr = copy; + + if (newProc->firstLocalPtr == NULL) { + newProc->firstLocalPtr = newProc->lastLocalPtr = copy; } else { - new->lastLocalPtr->nextPtr = copy; - new->lastLocalPtr = copy; + newProc->lastLocalPtr->nextPtr = copy; + newProc->lastLocalPtr = copy; } copy->nextPtr = NULL; copy->nameLength = localPtr->nameLength; @@ -1747,18 +1762,18 @@ ProcCompileProc( /* Reset the ClientData */ Tcl_GetCommandInfoFromToken(token, &info); if (info.objClientData == (ClientData) procPtr) { - info.objClientData = (ClientData) new; + info.objClientData = (ClientData) newProc; } if (info.clientData == (ClientData) procPtr) { - info.clientData = (ClientData) new; + info.clientData = (ClientData) newProc; } if (info.deleteData == (ClientData) procPtr) { - info.deleteData = (ClientData) new; + info.deleteData = (ClientData) newProc; } Tcl_SetCommandInfoFromToken(token, &info); procPtr->refCount--; - *procPtrPtr = procPtr = new; + *procPtrPtr = procPtr = newProc; } iPtr->compiledProcPtr = procPtr; @@ -1766,18 +1781,21 @@ ProcCompileProc( (Tcl_Namespace *) nsPtr, /* isProcCallFrame */ 0); if (result == TCL_OK) { - /* TIP #280. We get the invoking context from the cmdFrame - * which was saved by 'Tcl_ProcObjCmd' (using linePBodyPtr). + /* + * TIP #280: We get the invoking context from the cmdFrame which + * was saved by 'Tcl_ProcObjCmd' (using linePBodyPtr). */ - Tcl_HashEntry* hePtr = Tcl_FindHashEntry (iPtr->linePBodyPtr, (char *) procPtr); + Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, + (char *) procPtr); - /* Constructed saved frame has body as word 0. See Tcl_ProcObjCmd. + /* + * Constructed saved frame has body as word 0. See Tcl_ProcObjCmd. */ - iPtr->invokeWord = 0; - iPtr->invokeCmdFramePtr = (hePtr - ? (CmdFrame*) Tcl_GetHashValue (hePtr) - : NULL); + + iPtr->invokeWord = 0; + iPtr->invokeCmdFramePtr = + (hePtr ? (CmdFrame *) Tcl_GetHashValue(hePtr) : NULL); result = tclByteCodeType.setFromAnyProc(interp, bodyPtr); iPtr->invokeCmdFramePtr = NULL; TclPopStackFrame(interp); @@ -1901,9 +1919,9 @@ TclProcCleanupProc( Tcl_Obj *bodyPtr = procPtr->bodyPtr; Tcl_Obj *defPtr; Tcl_ResolvedVarInfo *resVarInfo; - Tcl_HashEntry* hePtr = NULL; - CmdFrame* cfPtr = NULL; - Interp* iPtr = procPtr->iPtr; + Tcl_HashEntry *hePtr = NULL; + CmdFrame *cfPtr = NULL; + Interp *iPtr = procPtr->iPtr; if (bodyPtr != NULL) { Tcl_DecrRefCount(bodyPtr); @@ -1929,25 +1947,31 @@ TclProcCleanupProc( } ckfree((char *) procPtr); - /* TIP #280. Release the location data associated with this Proc + /* + * TIP #280: Release the location data associated with this Proc * structure, if any. The interpreter may not exist (For example for * procbody structurues created by tbcload. */ - if (!iPtr) return; + if (!iPtr) { + return; + } - hePtr = Tcl_FindHashEntry (iPtr->linePBodyPtr, (char *) procPtr); - if (!hePtr) return; + hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, (char *) procPtr); + if (!hePtr) { + return; + } - cfPtr = (CmdFrame*) Tcl_GetHashValue (hePtr); + cfPtr = (CmdFrame *) Tcl_GetHashValue(hePtr); if (cfPtr->type == TCL_LOCATION_SOURCE) { - Tcl_DecrRefCount (cfPtr->data.eval.path); + Tcl_DecrRefCount(cfPtr->data.eval.path); cfPtr->data.eval.path = NULL; } - ckfree ((char*) cfPtr->line); cfPtr->line = NULL; - ckfree ((char*) cfPtr); - Tcl_DeleteHashEntry (hePtr); + ckfree((char *) cfPtr->line); + cfPtr->line = NULL; + ckfree((char *) cfPtr); + Tcl_DeleteHashEntry(hePtr); } /* @@ -2166,12 +2190,11 @@ SetLambdaFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ register Tcl_Obj *objPtr) /* The object to convert. */ { - Interp* iPtr = (Interp*) interp; + Interp *iPtr = (Interp *) interp; char *name; Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv, *errPtr; - int objc; + int objc, result; Proc *procPtr; - int result; /* * Convert objPtr to list type first; if it cannot be converted, or if its @@ -2197,8 +2220,8 @@ SetLambdaFromAny( name = TclGetString(objPtr); - if (TclCreateProc(interp, /*ignored nsPtr*/ NULL, name, argsPtr, - bodyPtr, &procPtr) != TCL_OK) { + if (TclCreateProc(interp, /*ignored nsPtr*/ NULL, name, argsPtr, bodyPtr, + &procPtr) != TCL_OK) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (parsing lambda expression \"%s\")", name)); return TCL_ERROR; @@ -2211,7 +2234,8 @@ SetLambdaFromAny( procPtr->cmdPtr = NULL; - /* TIP #280 Remember the line the apply body is starting on. In a Byte + /* + * TIP #280: Remember the line the apply body is starting on. In a Byte * code context we ask the engine to provide us with the necessary * information. This is for the initialization of the byte code compiler * when the body is used for the first time. @@ -2231,55 +2255,65 @@ SetLambdaFromAny( */ if (iPtr->cmdFramePtr) { - CmdFrame context = *iPtr->cmdFramePtr; + CmdFrame context = *iPtr->cmdFramePtr; if (context.type == TCL_LOCATION_BC) { - TclGetSrcInfoForPc (&context); - /* May get path in context */ + TclGetSrcInfoForPc(&context); + + /* + * May get path in context. + */ } else if (context.type == TCL_LOCATION_SOURCE) { - /* context now holds another reference */ - Tcl_IncrRefCount (context.data.eval.path); + /* + * Context now holds another reference. + */ + + Tcl_IncrRefCount(context.data.eval.path); } - /* type == TCL_LOCATION_PREBC implies that 'line' is NULL here! - * We cannot assume that 'line' is valid here, we have to check. + /* + * type == TCL_LOCATION_PREBC implies that 'line' is NULL here! We + * cannot assume that 'line' is valid here, we have to check. */ - if ((context.type == TCL_LOCATION_SOURCE) && - context.line && - (context.nline >= 2) && - (context.line [1] >= 0)) { - int new, buf [2]; - CmdFrame* cfPtr = (CmdFrame*) ckalloc (sizeof (CmdFrame)); - - /* Move from approximation (line of list cmd word) to actual - * location (line of 2nd list element) */ - TclListLines (name, context.line [1], 2, buf); - - cfPtr->level = -1; - cfPtr->type = context.type; - cfPtr->line = (int*) ckalloc (sizeof (int)); - cfPtr->line [0] = buf [1]; - cfPtr->nline = 1; + if ((context.type == TCL_LOCATION_SOURCE) && context.line + && (context.nline >= 2) && (context.line[1] >= 0)) { + int isNew, buf[2]; + CmdFrame *cfPtr = (CmdFrame *) ckalloc(sizeof(CmdFrame)); + + /* + * Move from approximation (line of list cmd word) to actual + * location (line of 2nd list element). + */ + + TclListLines(name, context.line[1], 2, buf); + + cfPtr->level = -1; + cfPtr->type = context.type; + cfPtr->line = (int *) ckalloc(sizeof(int)); + cfPtr->line[0] = buf[1]; + cfPtr->nline = 1; cfPtr->framePtr = NULL; - cfPtr->nextPtr = NULL; + cfPtr->nextPtr = NULL; if (context.type == TCL_LOCATION_SOURCE) { - cfPtr->data.eval.path = context.data.eval.path; - /* Transfer of reference. The reference going away (release of + cfPtr->data.eval.path = context.data.eval.path; + + /* + * Transfer of reference. The reference going away (release of * the context) is replaced by the reference in the - * constructed cmdframe */ + * constructed cmdframe. + */ } else { - cfPtr->type = TCL_LOCATION_EVAL; + cfPtr->type = TCL_LOCATION_EVAL; cfPtr->data.eval.path = NULL; } cfPtr->cmd.str.cmd = NULL; cfPtr->cmd.str.len = 0; - Tcl_SetHashValue (Tcl_CreateHashEntry (iPtr->linePBodyPtr, - (char*) procPtr, &new), - cfPtr); + Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, + (char *) procPtr, &isNew), cfPtr); } } @@ -2391,19 +2425,20 @@ Tcl_ApplyObjCmd( procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1; } - memset (&cmd, 0, sizeof(Command)); + memset(&cmd, 0, sizeof(Command)); procPtr->cmdPtr = &cmd; - /* TIP#280 HACK ! + /* + * TIP#280 HACK! * * Using cmd.clientData to remember the 'lambdaPtr' for 'info frame'. The * InfoFrameCmd will detect this case by testing cmd.hPtr for NULL. This - * condition holds here because of the 'memset' above, and nowhere - * else. Regular commands always have a valid 'hPtr', and lambda's never. + * condition holds here because of the 'memset' above, and nowhere else. + * Regular commands always have a valid 'hPtr', and lambda's never. */ cmd.clientData = (ClientData) lambdaPtr; - + /* * Find the namespace where this lambda should run, and push a call frame * for that namespace. Note that TclObjInterpProc() will pop it. @@ -2443,7 +2478,7 @@ Tcl_ApplyObjCmd( iPtr->ensembleRewrite.numInsertedObjs = 0; } - return result; + return result; } /* |