summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclInt.decls8
-rw-r--r--generic/tclInt.h19
-rw-r--r--generic/tclIntDecls.h13
-rw-r--r--generic/tclProc.c10
-rw-r--r--generic/tclStubInit.c3
-rw-r--r--generic/tclVar.c21
6 files changed, 61 insertions, 13 deletions
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index f2abb35..54256ea 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -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.decls,v 1.111 2007/07/31 17:03:38 msofer Exp $
+# RCS: @(#) $Id: tclInt.decls,v 1.112 2007/08/04 18:32:27 msofer Exp $
library tcl
@@ -928,6 +928,12 @@ declare 233 generic {
void TclGetSrcInfoForPc(CmdFrame *contextPtr)
}
+# Exports for VarReform compat: Itcl likes to peek into our varTables :(
+declare 234 generic {
+ Var *TclVarHashCreateVar(TclVarHashTable *tablePtr, const char *key,
+ int *newPtr)
+}
+
##############################################################################
# Define the platform specific internal Tcl interface. These functions are
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 5f47fcc..5aae19d 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.327 2007/08/03 13:51:40 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.328 2007/08/04 18:32:27 msofer Exp $
*/
#ifndef _TCLINT
@@ -204,6 +204,13 @@ typedef struct TclVarHashTable {
struct Namespace *nsPtr;
} TclVarHashTable;
+/*
+ * This is for itcl - it likes to search our varTables directly :(
+ */
+
+#define TclVarHashFindVar(tablePtr, key) \
+ TclVarHashCreateVar((tablePtr), (key), NULL)
+
/*
* The structure below defines a namespace.
@@ -631,7 +638,7 @@ typedef struct VarInHash {
#define VAR_IN_HASHTABLE 0x4
#define VAR_DEAD_HASH 0x8
#define VAR_ARRAY_ELEMENT 0x1000
-#define VAR_NAMESPACE_VAR 0x2000
+#define VAR_NAMESPACE_VAR 0x80 /* KEEP OLD VALUE for Itcl */
#define VAR_ALL_HASH (VAR_IN_HASHTABLE|VAR_DEAD_HASH|VAR_NAMESPACE_VAR|VAR_ARRAY_ELEMENT)
@@ -641,7 +648,7 @@ typedef struct VarInHash {
#define VAR_TRACED_WRITE 0x20 /* TCL_TRACE_WRITES */
#define VAR_TRACED_UNSET 0x40 /* TCL_TRACE_UNSETS */
#define VAR_TRACED_ARRAY 0x800 /* TCL_TRACE_ARRAY */
-#define VAR_TRACE_ACTIVE 0x80
+#define VAR_TRACE_ACTIVE 0x2000
#define VAR_SEARCH_ACTIVE 0x4000
#define VAR_ALL_TRACES \
(VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_ARRAY|VAR_TRACED_UNSET)
@@ -690,10 +697,8 @@ typedef struct VarInHash {
(varPtr)->flags &= ~VAR_TRACE_ACTIVE
#define TclSetVarNamespaceVar(varPtr) \
- if (TclIsVarInHash(varPtr) && ! TclIsVarNamespaceVar(varPtr)) {\
- (varPtr)->flags |= VAR_NAMESPACE_VAR;\
- ((VarInHash *)(varPtr))->refCount++;\
- }
+ (varPtr)->flags |= VAR_NAMESPACE_VAR;\
+ ((VarInHash *)(varPtr))->refCount++
#define TclClearVarNamespaceVar(varPtr) \
if (TclIsVarNamespaceVar(varPtr)) {\
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index abef656..e08b38b 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -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: tclIntDecls.h,v 1.102 2007/07/31 17:03:38 msofer Exp $
+ * RCS: @(#) $Id: tclIntDecls.h,v 1.103 2007/08/04 18:32:27 msofer Exp $
*/
#ifndef _TCLINTDECLS
@@ -1039,6 +1039,12 @@ EXTERN int TclEvalObjEx (Tcl_Interp * interp, Tcl_Obj * objPtr,
/* 233 */
EXTERN void TclGetSrcInfoForPc (CmdFrame * contextPtr);
#endif
+#ifndef TclVarHashCreateVar_TCL_DECLARED
+#define TclVarHashCreateVar_TCL_DECLARED
+/* 234 */
+EXTERN Var * TclVarHashCreateVar (TclVarHashTable * tablePtr,
+ const char * key, int * newPtr);
+#endif
typedef struct TclIntStubs {
int magic;
@@ -1293,6 +1299,7 @@ typedef struct TclIntStubs {
int (*tclGetNamespaceFromObj) (Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_Namespace ** nsPtrPtr); /* 231 */
int (*tclEvalObjEx) (Tcl_Interp * interp, Tcl_Obj * objPtr, int flags, const CmdFrame * invoker, int word); /* 232 */
void (*tclGetSrcInfoForPc) (CmdFrame * contextPtr); /* 233 */
+ Var * (*tclVarHashCreateVar) (TclVarHashTable * tablePtr, const char * key, int * newPtr); /* 234 */
} TclIntStubs;
#ifdef __cplusplus
@@ -2014,6 +2021,10 @@ extern TclIntStubs *tclIntStubsPtr;
#define TclGetSrcInfoForPc \
(tclIntStubsPtr->tclGetSrcInfoForPc) /* 233 */
#endif
+#ifndef TclVarHashCreateVar
+#define TclVarHashCreateVar \
+ (tclIntStubsPtr->tclVarHashCreateVar) /* 234 */
+#endif
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
diff --git a/generic/tclProc.c b/generic/tclProc.c
index c6e0219..9a7a422 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.126 2007/07/31 17:03:39 msofer Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.127 2007/08/04 18:32:27 msofer Exp $
*/
#include "tclInt.h"
@@ -1130,6 +1130,14 @@ TclInitCompiledLocals(
}
codePtr = bodyPtr->internalRep.otherValuePtr;
+ if (framePtr->numCompiledLocals) {
+ if (!codePtr->localCachePtr) {
+ InitLocalCache(framePtr->procPtr) ;
+ }
+ framePtr->localCachePtr = codePtr->localCachePtr;
+ framePtr->localCachePtr->refCount++;
+ }
+
InitCompiledLocals(interp, codePtr, varPtr, nsPtr);
}
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 35bfa12..efde178 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclStubInit.c,v 1.141 2007/07/02 21:10:52 dgp Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.142 2007/08/04 18:32:28 msofer Exp $
*/
#include "tclInt.h"
@@ -323,6 +323,7 @@ TclIntStubs tclIntStubs = {
TclGetNamespaceFromObj, /* 231 */
TclEvalObjEx, /* 232 */
TclGetSrcInfoForPc, /* 233 */
+ TclVarHashCreateVar, /* 234 */
};
TclIntPlatStubs tclIntPlatStubs = {
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 8405c5f..acb2834 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.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: tclVar.c,v 1.148 2007/08/03 13:51:41 dkf Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.149 2007/08/04 18:32:28 msofer Exp $
*/
#include "tclInt.h"
@@ -238,6 +238,23 @@ Tcl_ObjType tclArraySearchType = {
"array search",
NULL, NULL, NULL, SetArraySearchObj
};
+
+Var *
+TclVarHashCreateVar(
+ TclVarHashTable *tablePtr,
+ const char *key,
+ int *newPtr)
+{
+ Tcl_Obj *keyPtr;
+ Var *varPtr;
+
+ keyPtr = Tcl_NewStringObj(key, -1);
+ Tcl_IncrRefCount(keyPtr);
+ varPtr = VarHashCreateVar(tablePtr, keyPtr, newPtr);
+ Tcl_DecrRefCount(keyPtr);
+
+ return varPtr;
+}
/*
*----------------------------------------------------------------------
@@ -2288,7 +2305,7 @@ UnsetVarStruct(
}
if ((dummyVar.flags & VAR_TRACED_UNSET)
- || (arrayPtr->flags & VAR_TRACED_UNSET)) {
+ || (arrayPtr && (arrayPtr->flags & VAR_TRACED_UNSET))) {
dummyVar.flags &= ~VAR_TRACE_ACTIVE;
TclObjCallVarTraces(iPtr, arrayPtr, (Var *) &dummyVar,
part1Ptr, part2Ptr,
generated by cgit v0.12 at 2024-07-23 06:55:26 (GMT)