From 6e4bc775a32492b2994a525aec7ff0183252e0b8 Mon Sep 17 00:00:00 2001 From: dah Date: Sun, 18 Dec 2016 12:50:49 +0000 Subject: Refactor. Defaults for links removed. Support empty link names. --- generic/tclInt.h | 8 +- generic/tclProc.c | 314 ++++++++++++++++++++++++++---------------------------- 2 files changed, 156 insertions(+), 166 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index 8e13c2a..f0ddbcb 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -962,10 +962,9 @@ typedef struct Proc { Tcl_Obj *bodyPtr; /* Points to the ByteCode object for * procedure's body command. */ int numArgs; /* Number of formal parameters. */ - int numPreCompiledLocals; /* TIP #460: Count of locals recognized by - * the compiler including arguments and - * other locals, but not including - * variables that need resolvers. */ + + int numArgsCompiledLocals; /* TIP #460: Count of locals recognized by + * the compiler used in the arguments list. */ int numCompiledLocals; /* Count of local variables recognized by the * compiler including arguments and * temporaries. */ @@ -1700,7 +1699,6 @@ typedef struct Command { #define CMD_COMPILES_EXPANDED 0x08 #define CMD_REDEF_IN_PROGRESS 0x10 #define CMD_VIA_RESOLVER 0x20 -#define CMD_HAS_ARG_LINKS 0x40 /* *---------------------------------------------------------------- diff --git a/generic/tclProc.c b/generic/tclProc.c index 5dbb2af..49ca8eb 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -400,7 +400,7 @@ TclCreateProc( const char *args, *bytes, *p; register CompiledLocal *localPtr = NULL; Tcl_Obj *defPtr; - int precompiled = 0, frameIndex = 0; + int precompiled = 0; if (bodyPtr->typePtr == &tclProcBodyType) { /* @@ -463,7 +463,7 @@ TclCreateProc( procPtr->refCount = 1; procPtr->bodyPtr = bodyPtr; procPtr->numArgs = 0; /* Actual argument count is set below. */ - procPtr->numPreCompiledLocals = 0; + procPtr->numArgsCompiledLocals = 0; procPtr->numCompiledLocals = 0; procPtr->firstLocalPtr = NULL; procPtr->lastLocalPtr = NULL; @@ -497,11 +497,11 @@ TclCreateProc( localPtr = procPtr->firstLocalPtr; } else { procPtr->numArgs = numArgs; - procPtr->numPreCompiledLocals = numArgs; + procPtr->numArgsCompiledLocals = numArgs; procPtr->numCompiledLocals = numArgs; } - for (i = 0; i < numArgs; i++, frameIndex++) { + for (i = 0; i < numArgs; i++) { int fieldCount, nameLength, valueLength, varFlags = 0; const char **fieldValues, *varName; @@ -555,7 +555,7 @@ TclCreateProc( if (*q == ')') { /* We have an array element. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "formal parameter \"%s\" is an array element", - fieldValues[0])); + varName)); ckfree(fieldValues); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", NULL); @@ -564,7 +564,7 @@ TclCreateProc( } else if ((*p == ':') && (*(p+1) == ':')) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "formal parameter \"%s\" is not a simple name", - fieldValues[0])); + varName)); ckfree(fieldValues); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", NULL); @@ -573,12 +573,26 @@ TclCreateProc( p++; } - if (*varName == '*' && nameLength > 1) { + if (*varName == '*' && !precompiled) { /* - * TIP #460: Indicate this argument is to be a future link var. + * TIP #460: Indicate we want to create a link to this argument's + * value for when this proc is called. Also need to increase + * the locals count for args associated locals. */ - varFlags |= VAR_LINK; + if (fieldCount == 2) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "procedure \"%s\": formal parameter \"%s\" " + " is to be linked and must not have a default value", + procName, varName)); + ckfree(fieldValues); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", + "FORMALARGUMENTFORMAT", NULL); + goto procError; + } else { + varFlags |= VAR_LINK; + procPtr->numArgsCompiledLocals++; + } } else if ((i == numArgs - 1) && (nameLength == 4) && (*varName == 'a') @@ -627,7 +641,7 @@ TclCreateProc( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "procedure \"%s\": formal parameter \"%s\" has " "default value inconsistent with precompiled body", - procName, fieldValues[0])); + procName, varName)); ckfree(fieldValues); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "BYTECODELIES", NULL); @@ -656,40 +670,10 @@ TclCreateProc( procPtr->lastLocalPtr->nextPtr = localPtr; procPtr->lastLocalPtr = localPtr; } - /* - * TIP #460: If this parameter is to be a link then add a new - * local variable for the link and adjust the - * frameIndex and the Proc's numCompiledLocals to reflect it. - * For locality, we keep the link adjacent to the variable's - * value it'll be linking to. - */ - - if (varFlags & VAR_LINK) { - varFlags &= ~VAR_LINK; - - localPtr->nameLength = nameLength - 1; - localPtr->frameIndex = frameIndex++; - localPtr->flags = VAR_LINK; - localPtr->resolveInfo = NULL; - localPtr->defValuePtr = NULL; - - /* - * Here, varName length is always > 1. - */ - - memcpy(localPtr->name, varName + 1, localPtr->nameLength + 1); - localPtr = ckalloc(TclOffset(CompiledLocal, name) - + nameLength + 1); - - procPtr->numPreCompiledLocals++; - procPtr->numCompiledLocals++; - procPtr->lastLocalPtr->nextPtr = localPtr; - procPtr->lastLocalPtr = localPtr; - } localPtr->nextPtr = NULL; localPtr->nameLength = nameLength; - localPtr->frameIndex = frameIndex; + localPtr->frameIndex = i; localPtr->flags = (varFlags | VAR_ARGUMENT); localPtr->resolveInfo = NULL; @@ -705,6 +689,43 @@ TclCreateProc( ckfree(fieldValues); } + /* + * TIP #460: If there's any formals defined for linking then add a new + * local variable for the link. For compatibility, link variables must + * come after the list of arguments. + * The argument's index in the local table is stored in the link local's + * defValuePtr so it can be used for lookup later. + */ + + if (procPtr->numArgsCompiledLocals > procPtr->numCompiledLocals) { + int frameIndex = numArgs; + procPtr->numCompiledLocals = procPtr->numArgsCompiledLocals; + localPtr = procPtr->firstLocalPtr; + + for (i = 0; i < numArgs; i++, localPtr = localPtr->nextPtr) { + if (TclIsVarLink(localPtr)) { + CompiledLocal *linkLocalPtr; + const char *varName = localPtr->name; + int nameLength = localPtr->nameLength - 1; + localPtr->flags &= ~VAR_LINK; + + linkLocalPtr = ckalloc(TclOffset(CompiledLocal, name) + + nameLength + 1); + linkLocalPtr->nextPtr = NULL; + linkLocalPtr->nameLength = nameLength; + linkLocalPtr->frameIndex = frameIndex++; + linkLocalPtr->flags = VAR_LINK; + linkLocalPtr->resolveInfo = NULL; + + linkLocalPtr->defValuePtr = Tcl_NewIntObj(i); + Tcl_IncrRefCount(linkLocalPtr->defValuePtr); + memcpy(linkLocalPtr->name, varName + 1, nameLength + 1); + + procPtr->lastLocalPtr->nextPtr = linkLocalPtr; + procPtr->lastLocalPtr = linkLocalPtr; + } + } + } *procPtrPtr = procPtr; ckfree(argArray); @@ -1366,24 +1387,25 @@ InitLocalCache( Interp *iPtr = procPtr->iPtr; ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1; int localCt = procPtr->numCompiledLocals; - int numVars = procPtr->numPreCompiledLocals, i = 0; + int numArgVars = procPtr->numArgsCompiledLocals, i = 0; Tcl_Obj **namePtr; Var *varPtr; LocalCache *localCachePtr; CompiledLocal *localPtr; - int hasArgLinks = 0; int new; /* * Cache the names and initial values of local variables; store the * cache in both the framePtr for this execution and in the codePtr - * for future calls. + * for future calls. TIP #460: We may need to also allocate space for + * variables to be resolved inline. numArgVars = numArgs when there + * are none. */ localCachePtr = ckalloc(sizeof(LocalCache) + (localCt - 1) * sizeof(Tcl_Obj *) - + numVars * sizeof(Var)); + + numArgVars * sizeof(Var)); namePtr = &localCachePtr->varName0; varPtr = (Var *) (namePtr + localCt); @@ -1398,15 +1420,17 @@ InitLocalCache( Tcl_IncrRefCount(*namePtr); } - if (i < numVars) { + if (i < numArgVars) { + /* + * varPtr->flags used to be set to either VAR_IS_ARGS or 0. + * Assumed it is to remove VAR_ARGUMENT, but varPtr flags are set + * accordingly in InitArgsAndLocals. varPtr must have VAR_LINK + * if it exists in localPtr, checked by InitArgsAndLocals. + */ + varPtr->flags = (localPtr->flags & ~VAR_ARGUMENT); varPtr->value.objPtr = localPtr->defValuePtr; - if (!hasArgLinks && TclIsVarLink(varPtr)) { - hasArgLinks = 1; - procPtr->cmdPtr->flags |= CMD_HAS_ARG_LINKS; - } - varPtr++; i++; } @@ -1500,111 +1524,18 @@ InitArgsAndLocals( } } - /* - * TIP #460: If the command has any formals with the VAR_LINK flag then - * cmdPtr->flags will have CMD_HAS_ARG_LINKS. Walk through the - * the proc's local variable list and set things up as needed. - */ - - if (procPtr->cmdPtr->flags & CMD_HAS_ARG_LINKS) { - CallFrame *upFramePtr = NULL; - Var *otherPtr, *arrayPtr; - int done = 1; - - imax = ((argCt < numArgs) ? argCt : numArgs); - for (; i < numArgs; i++, varPtr++, defPtr++) { - Tcl_Obj *objPtr = i < argCt ? argObjs[i] : defPtr->value.objPtr; - - /* - * Now check if this formal was defined to be linked to its - * corresponding argument. The formal doesn't do - * any linking itself. - */ - - if (TclIsVarLink(defPtr)) { - defPtr++; - - if (!objPtr) { - if (defPtr->value.objPtr) { - objPtr = defPtr->value.objPtr; - } else { - goto incorrectArgs; - } - } - - if (upFramePtr == NULL) { - if (TclObjGetFrame(interp, NULL, &upFramePtr) == -1) { - i = -1; /* Tell incorrectArgs we set the error */ - goto incorrectArgs; - } - } - - /* - * Locate the other variable. - */ - - ((Interp *)interp)->varFramePtr = upFramePtr; - otherPtr = TclObjLookupVarEx(interp, objPtr, NULL, - TCL_LEAVE_ERR_MSG, "access", /*createPart1*/ 1, - /*createPart2*/ 1, &arrayPtr); - ((Interp *)interp)->varFramePtr = framePtr; - if (otherPtr == NULL) { - i = -1; /* Tell incorrectArgs we set the error */ - goto incorrectArgs; - } - - varPtr->flags = VAR_LINK; - varPtr->value.linkPtr = otherPtr; - if (TclIsVarInHash(otherPtr)) { - VarHashRefCount(otherPtr)++; - } - - varPtr++; - varPtr->flags = 0; - varPtr->value.objPtr = objPtr; - Tcl_IncrRefCount(objPtr); /* Local var is a reference */ - } else if (i != numArgs-1) { - if (!objPtr) { - goto incorrectArgs; - } - varPtr->flags = 0; - varPtr->value.objPtr = objPtr; - Tcl_IncrRefCount(objPtr); /* Local var is a reference */ - } else { - - /* - * The last non-linked formal could be 'args'. Let the 'args' - * checking code handle it. - */ - - done = 0; - break; - } - } - + imax = ((argCt < numArgs-1) ? argCt : numArgs-1); + for (; i < imax; i++, varPtr++, defPtr ? defPtr++ : defPtr) { /* - * Jumps to correctArgs only when there's no formal 'args' - * as the last parameter or when the last parameter isn't - * a link. - */ - - if (done) { - goto correctArgs; - } - } else { - imax = ((argCt < numArgs-1) ? argCt : numArgs-1); - for (; i < imax; i++, varPtr++, defPtr ? defPtr++ : defPtr) { - /* - * "Normal" arguments; last formal is special, depends on it being - * 'args'. - */ + * "Normal" arguments; last formal is special, depends on it being + * 'args'. + */ - Tcl_Obj *objPtr = argObjs[i]; + Tcl_Obj *objPtr = argObjs[i]; - varPtr->flags = 0; - varPtr->value.objPtr = objPtr; - Tcl_IncrRefCount(objPtr); /* Local var is a reference */ - } + varPtr->flags = 0; + varPtr->value.objPtr = objPtr; + Tcl_IncrRefCount(objPtr); /* Local var is a reference */ } for (; i < numArgs-1; i++, varPtr++, defPtr ? defPtr++ : defPtr) { @@ -1655,15 +1586,76 @@ InitArgsAndLocals( */ correctArgs: - if (procPtr->numPreCompiledLocals < localCt) { + { + /* + * TIP #460: Check for and construct links for any formals defined to be + * linked to their corresponding argument. The link locals will be + * immediately after the args list. The local's index they link to is + * stored in the link's default value. + */ + + int numArgVars = procPtr->numArgsCompiledLocals; + if (numArgVars > numArgs) { + CallFrame *upFramePtr = NULL; + Var *otherPtr, *arrayPtr; + + defPtr++; /* Here, defPtr cannot be NULL */ + for(i = numArgs; i < numArgVars; i++, varPtr++, defPtr++) { + + if (TclIsVarLink(defPtr)) { + int argIndex; + Tcl_Obj *objPtr; + + /* + * Something went horribly wrong if this comes to a Panic. + */ + + if (TCL_OK != (TclGetIntFromObj(interp, defPtr->value.objPtr, + &argIndex)) + || (argIndex < 0 || argIndex > numArgs - 1)) { + Tcl_Panic("Link variable points to an invalid local index."); + } + + objPtr = argObjs[argIndex]; + if (upFramePtr == NULL) { + if (TclObjGetFrame(interp, NULL, &upFramePtr) == -1) { + i = -1; /* Tell incorrectArgs we set the error */ + goto incorrectArgs; + } + } + + /* + * Locate the other variable. + */ + + ((Interp *)interp)->varFramePtr = upFramePtr; + otherPtr = TclObjLookupVarEx(interp, objPtr, NULL, + TCL_LEAVE_ERR_MSG, "access", /*createPart1*/ 1, + /*createPart2*/ 1, &arrayPtr); + ((Interp *)interp)->varFramePtr = framePtr; + if (otherPtr == NULL) { + i = -1; /* Tell incorrectArgs we set the error */ + goto incorrectArgs; + } + + varPtr->flags = VAR_LINK; + varPtr->value.linkPtr = otherPtr; + if (TclIsVarInHash(otherPtr)) { + VarHashRefCount(otherPtr)++; + } + } + } + } + + if (numArgVars < localCt) { if (!framePtr->nsPtr->compiledVarResProc && !((Interp *)interp)->resolverPtr) { - memset(varPtr, 0, (localCt - numArgs)*sizeof(Var)); + memset(varPtr, 0, (localCt - numArgVars)*sizeof(Var)); } else { InitResolvedLocals(interp, codePtr, varPtr, framePtr->nsPtr); } } - + } return TCL_OK; /* @@ -2142,15 +2134,15 @@ TclProcCompileProc( /* * TIP #460: We may need to hang on to more locals than just the - * Proc's formals. + * Proc's formals (i.e. locals to be linked to an arg's value). */ - if (procPtr->numCompiledLocals > procPtr->numPreCompiledLocals) { + if (procPtr->numCompiledLocals > procPtr->numArgsCompiledLocals) { CompiledLocal *clPtr = procPtr->firstLocalPtr; CompiledLocal *lastPtr = NULL; - int i, numVars = procPtr->numPreCompiledLocals; + int i, numArgVars = procPtr->numArgsCompiledLocals; - for (i = 0; i < numVars; i++) { + for (i = 0; i < numArgVars; i++) { lastPtr = clPtr; clPtr = clPtr->nextPtr; } @@ -2174,7 +2166,7 @@ TclProcCompileProc( } ckfree(toFree); } - procPtr->numCompiledLocals = procPtr->numPreCompiledLocals; + procPtr->numCompiledLocals = procPtr->numArgsCompiledLocals; } (void) TclPushStackFrame(interp, &framePtr, (Tcl_Namespace *) nsPtr, -- cgit v0.12