From b3eb9436b469f5095d4d6b59a10b9d01efe5bfb5 Mon Sep 17 00:00:00 2001 From: msofer Date: Wed, 8 Aug 2007 18:34:38 +0000 Subject: * generic/tclInt.h: remove comments refering to VAR_SCALAR, as that flag bit does not exist any longer. * generic/tclProc.c (InitCompiledLocals): removed optimisation for non-resolved case, as the function is never called in that case. FossilOrigin-Name: b9cc3486dd8ef1b6413f1fca7b05c9b086b3d1dd --- ChangeLog | 7 +++ generic/tclInt.h | 7 ++- generic/tclProc.c | 135 ++++++++++++++++++++++++------------------------------ 3 files changed, 69 insertions(+), 80 deletions(-) diff --git a/ChangeLog b/ChangeLog index 01df74f..ef4418b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,12 @@ 2007-08-07 Miguel Sofer + * generic/tclInt.h: remove comments refering to VAR_SCALAR, as + that flag bit does not exist any longer. + * generic/tclProc.c (InitCompiledLocals): removed optimisation for + non-resolved case, as the function is never called in that case. + +2007-08-07 Miguel Sofer + * generic/tclInt.decls: Exporting via stubs to help * generic/tclInt.h: xotcl adapt to VarReform. * generic/tclIntDecls.h: diff --git a/generic/tclInt.h b/generic/tclInt.h index c55bf93..f5f7c9b 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.329 2007/08/07 17:28:39 msofer Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.330 2007/08/08 18:34:40 msofer Exp $ */ #ifndef _TCLINT @@ -834,9 +834,8 @@ typedef struct CompiledLocal { * variables in the procedure call frame. */ int flags; /* Flag bits for the local variable. Same as * the flags for the Var structure above, - * although only VAR_SCALAR, VAR_ARRAY, - * VAR_LINK, VAR_ARGUMENT, VAR_TEMPORARY, and - * VAR_RESOLVED make sense. */ + * although only VAR_ARGUMENT, VAR_TEMPORARY, + * and VAR_RESOLVED make sense. */ Tcl_Obj *defValuePtr; /* Pointer to the default value of an * argument, if any. NULL if not an argument * or, if an argument, no default value. */ diff --git a/generic/tclProc.c b/generic/tclProc.c index 9a7a422..eb3f7e8 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.127 2007/08/04 18:32:27 msofer Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.128 2007/08/08 18:34:40 msofer Exp $ */ #include "tclInt.h" @@ -1170,6 +1170,8 @@ InitCompiledLocals( int haveResolvers = (nsPtr->compiledVarResProc || iPtr->resolverPtr); CompiledLocal *firstLocalPtr, *localPtr; int varNum; + Tcl_ResolvedVarInfo *resVarInfo; + /* * Find the localPtr corresponding to varPtr @@ -1181,11 +1183,6 @@ InitCompiledLocals( localPtr = localPtr->nextPtr; } - /* - //FIXME: old bytecompiled code: drop whatever flags are coming in (except - //maybe for VAR_TEMPORARY? Who cares really?) A job for tbcload, not us. - */ - if (!(haveResolvers && (codePtr->flags & TCL_BYTECODE_RESOLVE_VARS))) { /* * Initialize the array of local variables stored in the call frame. @@ -1195,91 +1192,77 @@ InitCompiledLocals( */ doInitCompiledLocals: - if (!haveResolvers) { + for (; localPtr != NULL; varPtr++, localPtr = localPtr->nextPtr) { + varPtr->flags = 0; + varPtr->value.objPtr = NULL; + /* - * Should not be called: deadwood. + * Now invoke the resolvers to determine the exact variables + * that should be used. */ - for (; localPtr != NULL; varPtr++, localPtr = localPtr->nextPtr) { - varPtr->flags = localPtr->flags; - varPtr->value.objPtr = NULL; - } - return; - } else { - Tcl_ResolvedVarInfo *resVarInfo; - - for (; localPtr != NULL; varPtr++, localPtr = localPtr->nextPtr) { - varPtr->flags = localPtr->flags; - varPtr->value.objPtr = NULL; - - /* - * 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); - if (resolvedVarPtr) { - VarHashRefCount(resolvedVarPtr)++; - varPtr->flags = VAR_LINK; - varPtr->value.linkPtr = resolvedVarPtr; - } + resVarInfo = localPtr->resolveInfo; + if (resVarInfo && resVarInfo->fetchProc) { + Var *resolvedVarPtr = (Var *) + (*resVarInfo->fetchProc)(interp, resVarInfo); + if (resolvedVarPtr) { + VarHashRefCount(resolvedVarPtr)++; + varPtr->flags = VAR_LINK; + varPtr->value.linkPtr = resolvedVarPtr; } } - return; } - } else { - /* - * This is the first run after a recompile, or else the resolver epoch - * has changed: update the resolver cache. - */ + return; + } - 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); - } - localPtr->resolveInfo = NULL; + /* + * This is the first run after a recompile, or else the resolver epoch + * has changed: update the resolver cache. + */ + + 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); + } + localPtr->resolveInfo = NULL; + } + localPtr->flags &= ~VAR_RESOLVED; + + if (haveResolvers && + !(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY))) { + ResolverScheme *resPtr = iPtr->resolverPtr; + Tcl_ResolvedVarInfo *vinfo; + int result; + + if (nsPtr->compiledVarResProc) { + result = (*nsPtr->compiledVarResProc)(nsPtr->interp, + localPtr->name, localPtr->nameLength, + (Tcl_Namespace *) nsPtr, &vinfo); + } else { + result = TCL_CONTINUE; } - localPtr->flags &= ~VAR_RESOLVED; - - if (haveResolvers && - !(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY))) { - ResolverScheme *resPtr = iPtr->resolverPtr; - Tcl_ResolvedVarInfo *vinfo; - int result; - if (nsPtr->compiledVarResProc) { - result = (*nsPtr->compiledVarResProc)(nsPtr->interp, + while ((result == TCL_CONTINUE) && resPtr) { + if (resPtr->compiledVarResProc) { + result = (*resPtr->compiledVarResProc)(nsPtr->interp, localPtr->name, localPtr->nameLength, (Tcl_Namespace *) nsPtr, &vinfo); - } else { - result = TCL_CONTINUE; - } - - while ((result == TCL_CONTINUE) && resPtr) { - if (resPtr->compiledVarResProc) { - result = (*resPtr->compiledVarResProc)(nsPtr->interp, - localPtr->name, localPtr->nameLength, - (Tcl_Namespace *) nsPtr, &vinfo); - } - resPtr = resPtr->nextPtr; - } - if (result == TCL_OK) { - localPtr->resolveInfo = vinfo; - localPtr->flags |= VAR_RESOLVED; } + resPtr = resPtr->nextPtr; + } + if (result == TCL_OK) { + localPtr->resolveInfo = vinfo; + localPtr->flags |= VAR_RESOLVED; } } - localPtr = firstLocalPtr; - codePtr->flags &= ~TCL_BYTECODE_RESOLVE_VARS; - goto doInitCompiledLocals; } + localPtr = firstLocalPtr; + codePtr->flags &= ~TCL_BYTECODE_RESOLVE_VARS; + goto doInitCompiledLocals; } void -- cgit v0.12