diff options
Diffstat (limited to 'generic/tclProc.c')
| -rw-r--r-- | generic/tclProc.c | 123 |
1 files changed, 120 insertions, 3 deletions
diff --git a/generic/tclProc.c b/generic/tclProc.c index aae5008..3ecf243 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -10,7 +10,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.44.2.5 2006/05/15 16:07:04 dgp Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.44.2.6 2006/11/28 22:20:02 andreas_kupries Exp $ */ #include "tclInt.h" @@ -152,6 +152,65 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv) procPtr->cmdPtr = (Command *) cmd; +#ifdef TCL_TIP280 + /* 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 + * information. This is for the initialization of the byte code compiler + * when the body is used for the first time. + */ + + if (iPtr->cmdFramePtr) { + CmdFrame context = *iPtr->cmdFramePtr; + + if (context.type == TCL_LOCATION_BC) { + 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); + } + + /* type == TCL_LOCATION_PREBC implies that 'line' is NULL here! We + * cannot assume that 'line' is valid here, we have to check. If the + * outer context is an eval (bc, prebc, eval) we do not save any + * information. Counting relative to the beginning of the proc body is + * more sensible than counting relative to the outer eval block. + */ + + 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; + cfPtr->framePtr = 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 + * the context) is replaced by the reference in the + * constructed cmdframe */ + } else { + 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); + } + } +#endif /* * Optimize for noop procs: if the body is not precompiled (like a TclPro @@ -1101,7 +1160,15 @@ TclObjInterpProc(clientData, interp, objc, objv) iPtr->returnCode = TCL_OK; procPtr->refCount++; +#ifndef TCL_TIP280 result = TclCompEvalObj(interp, procPtr->bodyPtr); +#else + /* 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. + */ + + result = TclCompEvalObj(interp, procPtr->bodyPtr, NULL, 0); +#endif procPtr->refCount--; if (procPtr->refCount <= 0) { TclProcCleanupProc(procPtr); @@ -1313,7 +1380,24 @@ ProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, (Tcl_Namespace*)nsPtr, /* isProcCallFrame */ 0); if (result == TCL_OK) { +#ifdef TCL_TIP280 + /* 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); + + /* Constructed saved frame has body as word 0. See Tcl_ProcObjCmd. + */ + iPtr->invokeWord = 0; + iPtr->invokeCmdFramePtr = (hePtr + ? (CmdFrame*) Tcl_GetHashValue (hePtr) + : NULL); +#endif result = tclByteCodeType.setFromAnyProc(interp, bodyPtr); +#ifdef TCL_TIP280 + iPtr->invokeCmdFramePtr = NULL; +#endif Tcl_PopCallFrame(interp); } @@ -1492,6 +1576,11 @@ TclProcCleanupProc(procPtr) Tcl_Obj *bodyPtr = procPtr->bodyPtr; Tcl_Obj *defPtr; Tcl_ResolvedVarInfo *resVarInfo; +#ifdef TCL_TIP280 + Tcl_HashEntry* hePtr = NULL; + CmdFrame* cfPtr = NULL; + Interp* iPtr = procPtr->iPtr; +#endif if (bodyPtr != NULL) { Tcl_DecrRefCount(bodyPtr); @@ -1516,6 +1605,28 @@ TclProcCleanupProc(procPtr) localPtr = nextPtr; } ckfree((char *) procPtr); + +#ifdef TCL_TIP280 + /* 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; + + hePtr = Tcl_FindHashEntry (iPtr->linePBodyPtr, (char *) procPtr); + if (!hePtr) return; + + cfPtr = (CmdFrame*) Tcl_GetHashValue (hePtr); + + if (cfPtr->type == TCL_LOCATION_SOURCE) { + Tcl_DecrRefCount (cfPtr->data.eval.path); + cfPtr->data.eval.path = NULL; + } + ckfree ((char*) cfPtr->line); cfPtr->line = NULL; + ckfree ((char*) cfPtr); + Tcl_DeleteHashEntry (hePtr); +#endif } /* @@ -1821,6 +1932,12 @@ TclCompileNoOp(interp, parsePtr, envPtr) TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr); return TCL_OK; } - - + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |