summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog10
-rw-r--r--generic/tclDictObj.c235
-rw-r--r--generic/tclInt.h406
-rw-r--r--generic/tclNamesp.c5
4 files changed, 374 insertions, 282 deletions
diff --git a/ChangeLog b/ChangeLog
index f17c207..c087901 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2008-08-23 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclInt.h (EnsembleImplMap): Added extra field to make it
+ * generic/tclNamesp.c (TclMakeEnsemble): easier to build non-recursive
+ ensembles in the core.
+
+ * generic/tclDictObj.c (DictForNRCmd): Converted the [dict for]
+ command to have an NRE-aware non-compiled implementation. Part of the
+ [Bug 2017632] project.
+
2008-08-22 Miguel Sofer <msofer@users.sf.net>
* generic/tclBasic.c:
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 9531f22..6253e43 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclDictObj.c,v 1.67 2008/07/31 14:43:44 msofer Exp $
+ * RCS: @(#) $Id: tclDictObj.c,v 1.68 2008/08/23 11:35:43 dkf Exp $
*/
#include "tclInt.h"
@@ -78,6 +78,11 @@ static int FinalizeDictUpdate(ClientData data[],
Tcl_Interp *interp, int result);
static int FinalizeDictWith(ClientData data[],
Tcl_Interp *interp, int result);
+static int DictForNRCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictForLoopCallback(ClientData data[],
+ Tcl_Interp *interp, int result);
+
/*
* Table of dict subcommand names and implementations.
@@ -85,25 +90,25 @@ static int FinalizeDictWith(ClientData data[],
static const EnsembleImplMap implementationMap[] = {
{"append", DictAppendCmd, TclCompileDictAppendCmd },
- {"create", DictCreateCmd, NULL },
- {"exists", DictExistsCmd, NULL },
- {"filter", DictFilterCmd, NULL },
- {"for", DictForCmd, TclCompileDictForCmd },
+ {"create", DictCreateCmd },
+ {"exists", DictExistsCmd },
+ {"filter", DictFilterCmd },
+ {"for", DictForCmd, TclCompileDictForCmd, DictForNRCmd },
{"get", DictGetCmd, TclCompileDictGetCmd },
{"incr", DictIncrCmd, TclCompileDictIncrCmd },
- {"info", DictInfoCmd, NULL },
- {"keys", DictKeysCmd, NULL },
+ {"info", DictInfoCmd },
+ {"keys", DictKeysCmd },
{"lappend", DictLappendCmd, TclCompileDictLappendCmd },
- {"merge", DictMergeCmd, NULL },
- {"remove", DictRemoveCmd, NULL },
- {"replace", DictReplaceCmd, NULL },
+ {"merge", DictMergeCmd },
+ {"remove", DictRemoveCmd },
+ {"replace", DictReplaceCmd },
{"set", DictSetCmd, TclCompileDictSetCmd },
- {"size", DictSizeCmd, NULL },
- {"unset", DictUnsetCmd, NULL },
+ {"size", DictSizeCmd },
+ {"unset", DictUnsetCmd },
{"update", DictUpdateCmd, TclCompileDictUpdateCmd },
- {"values", DictValuesCmd, NULL },
- {"with", DictWithCmd, NULL },
- {NULL, NULL, NULL }
+ {"values", DictValuesCmd },
+ {"with", DictWithCmd },
+ {NULL}
};
/*
@@ -1554,7 +1559,7 @@ DictGetCmd(
*/
if (objc == 2) {
- Tcl_Obj *keyPtr, *listPtr;
+ Tcl_Obj *keyPtr = NULL, *listPtr;
Tcl_DictSearch search;
int done;
@@ -1734,7 +1739,7 @@ DictMergeCmd(
int objc,
Tcl_Obj *const *objv)
{
- Tcl_Obj *targetObj, *keyObj, *valueObj;
+ Tcl_Obj *targetObj, *keyObj = NULL, *valueObj = NULL;
int allocatedDict = 0;
int i, done;
Tcl_DictSearch search;
@@ -1858,8 +1863,8 @@ DictKeysCmd(
}
} else {
Tcl_DictSearch search;
- Tcl_Obj *keyPtr;
- int done;
+ Tcl_Obj *keyPtr = NULL;
+ int done = 0;
/*
* At this point, we know we have a dictionary (or at least something
@@ -1906,7 +1911,7 @@ DictValuesCmd(
int objc,
Tcl_Obj *const *objv)
{
- Tcl_Obj *valuePtr, *listPtr;
+ Tcl_Obj *valuePtr = NULL, *listPtr;
Tcl_DictSearch search;
int done;
char *pattern;
@@ -2377,11 +2382,21 @@ DictForCmd(
int objc,
Tcl_Obj *const *objv)
{
+ return Tcl_NRCallObjProc(interp, DictForNRCmd, dummy, objc, objv);
+}
+
+static int
+DictForNRCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
Tcl_Obj **varv, *keyObj, *valueObj;
- Tcl_DictSearch search;
- int varc, done, result;
+ Tcl_DictSearch *searchPtr;
+ int varc, done;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv,
@@ -2389,6 +2404,10 @@ DictForCmd(
return TCL_ERROR;
}
+ /*
+ * Parse arguments.
+ */
+
if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) {
return TCL_ERROR;
}
@@ -2397,14 +2416,20 @@ DictForCmd(
TCL_STATIC);
return TCL_ERROR;
}
- keyVarObj = varv[0];
- valueVarObj = varv[1];
- scriptObj = objv[3];
-
- if (Tcl_DictObjFirst(interp, objv[2], &search, &keyObj, &valueObj,
+ searchPtr = TclStackAlloc(interp, sizeof(Tcl_DictSearch));
+ if (Tcl_DictObjFirst(interp, objv[2], searchPtr, &keyObj, &valueObj,
&done) != TCL_OK) {
+ TclStackFree(interp, searchPtr);
return TCL_ERROR;
}
+ if (done) {
+ TclStackFree(interp, searchPtr);
+ return TCL_OK;
+ }
+ TclListObjGetElements(NULL, objv[1], &varc, &varv);
+ keyVarObj = varv[0];
+ valueVarObj = varv[1];
+ scriptObj = objv[3];
/*
* Make sure that these objects (which we need throughout the body of the
@@ -2416,64 +2441,130 @@ DictForCmd(
Tcl_IncrRefCount(valueVarObj);
Tcl_IncrRefCount(scriptObj);
- result = TCL_OK;
- while (!done) {
- /*
- * Stop the value from getting hit in any way by any traces on the key
- * variable.
- */
+ /*
+ * Stop the value from getting hit in any way by any traces on the key
+ * variable.
+ */
- Tcl_IncrRefCount(valueObj);
- if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, 0) == NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't set key variable: \"",
- TclGetString(keyVarObj), "\"", NULL);
- TclDecrRefCount(valueObj);
- result = TCL_ERROR;
- break;
- }
+ Tcl_IncrRefCount(valueObj);
+ if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, 0) == NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "couldn't set key variable: \"",
+ TclGetString(keyVarObj), "\"", NULL);
TclDecrRefCount(valueObj);
- if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, 0) == NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't set value variable: \"",
- TclGetString(valueVarObj), "\"", NULL);
- result = TCL_ERROR;
- break;
- }
+ goto error;
+ }
+ TclDecrRefCount(valueObj);
+ if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, 0) == NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "couldn't set value variable: \"",
+ TclGetString(valueVarObj), "\"", NULL);
+ goto error;
+ }
- /*
- * TIP #280. Make invoking context available to loop body.
- */
+ /*
+ * Run the script.
+ */
+
+ TclNRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj,
+ valueVarObj, scriptObj);
+ return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
+
+ /*
+ * For unwinding everything on error.
+ */
+
+ error:
+ TclDecrRefCount(keyVarObj);
+ TclDecrRefCount(valueVarObj);
+ TclDecrRefCount(scriptObj);
+ Tcl_DictObjDone(searchPtr);
+ TclStackFree(interp, searchPtr);
+ return TCL_ERROR;
+}
+
+static int
+DictForLoopCallback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_DictSearch *searchPtr = data[0];
+ Tcl_Obj *keyVarObj = data[1];
+ Tcl_Obj *valueVarObj = data[2];
+ Tcl_Obj *scriptObj = data[3];
+ Tcl_Obj *keyObj, *valueObj;
+ int done;
+
+ /*
+ * Process the result from the previous execution of the script body.
+ */
- result = TclEvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
- if (result == TCL_CONTINUE) {
+ if (result == TCL_CONTINUE) {
+ result = TCL_OK;
+ } else if (result != TCL_OK) {
+ if (result == TCL_BREAK) {
+ Tcl_ResetResult(interp);
result = TCL_OK;
- } else if (result != TCL_OK) {
- if (result == TCL_BREAK) {
- result = TCL_OK;
- } else if (result == TCL_ERROR) {
- Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
- "\n (\"dict for\" body line %d)",
- interp->errorLine));
- }
- break;
+ } else if (result == TCL_ERROR) {
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (\"dict for\" body line %d)", interp->errorLine));
}
+ goto done;
+ }
+
+ /*
+ * Get the next mapping from the dictionary.
+ */
- Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
+ Tcl_DictObjNext(searchPtr, &keyObj, &valueObj, &done);
+ if (done) {
+ Tcl_ResetResult(interp);
+ goto done;
}
/*
- * Stop holding a reference to these objects.
+ * Stop the value from getting hit in any way by any traces on the key
+ * variable.
*/
+ Tcl_IncrRefCount(valueObj);
+ if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, 0) == NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "couldn't set key variable: \"",
+ TclGetString(keyVarObj), "\"", NULL);
+ TclDecrRefCount(valueObj);
+ result = TCL_ERROR;
+ goto done;
+ }
+ TclDecrRefCount(valueObj);
+ if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, 0) == NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "couldn't set value variable: \"",
+ TclGetString(valueVarObj), "\"", NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * Run the script.
+ */
+
+ TclNRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj,
+ valueVarObj, scriptObj);
+ return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
+
+ /*
+ * For unwinding everything once the iterating is done.
+ */
+
+ done:
TclDecrRefCount(keyVarObj);
TclDecrRefCount(valueVarObj);
TclDecrRefCount(scriptObj);
-
- Tcl_DictObjDone(&search);
- if (result == TCL_OK) {
- Tcl_ResetResult(interp);
- }
+ Tcl_DictObjDone(searchPtr);
+ TclStackFree(interp, searchPtr);
return result;
}
@@ -2629,7 +2720,7 @@ DictFilterCmd(
FILTER_KEYS, FILTER_SCRIPT, FILTER_VALUES
};
Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
- Tcl_Obj **varv, *keyObj, *valueObj, *resultObj, *boolObj;
+ Tcl_Obj **varv, *keyObj = NULL, *valueObj = NULL, *resultObj, *boolObj;
Tcl_DictSearch search;
int index, varc, done, result, satisfied;
char *pattern;
@@ -3041,7 +3132,7 @@ DictWithCmd(
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
- Tcl_Obj *dictPtr, *keysPtr, *keyPtr, *valPtr, *pathPtr;
+ Tcl_Obj *dictPtr, *keysPtr, *keyPtr = NULL, *valPtr = NULL, *pathPtr;
Tcl_DictSearch s;
int done;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 7084cd1..f5b7ba5 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -15,7 +15,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.394 2008/08/21 23:57:43 msofer Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.395 2008/08/23 11:35:52 dkf Exp $
*/
#ifndef _TCLINT
@@ -123,19 +123,19 @@ typedef int ptrdiff_t;
#if !defined(INT2PTR) && !defined(PTR2INT)
# if defined(HAVE_INTPTR_T) || defined(intptr_t)
-# define INT2PTR(p) ((void*)(intptr_t)(p))
+# define INT2PTR(p) ((void *)(intptr_t)(p))
# define PTR2INT(p) ((int)(intptr_t)(p))
# else
-# define INT2PTR(p) ((void*)(p))
+# define INT2PTR(p) ((void *)(p))
# define PTR2INT(p) ((int)(p))
# endif
#endif
#if !defined(UINT2PTR) && !defined(PTR2UINT)
# if defined(HAVE_UINTPTR_T) || defined(uintptr_t)
-# define UINT2PTR(p) ((void*)(uintptr_t)(p))
+# define UINT2PTR(p) ((void *)(uintptr_t)(p))
# define PTR2UINT(p) ((unsigned int)(uintptr_t)(p))
# else
-# define UINT2PTR(p) ((void*)(p))
+# define UINT2PTR(p) ((void *)(p))
# define PTR2UINT(p) ((unsigned int)(p))
# endif
#endif
@@ -163,14 +163,14 @@ typedef struct Tcl_ResolvedVarInfo {
Tcl_ResolveVarDeleteProc *deleteProc;
} Tcl_ResolvedVarInfo;
-typedef int (Tcl_ResolveCompiledVarProc) (Tcl_Interp *interp,
+typedef int (Tcl_ResolveCompiledVarProc)(Tcl_Interp *interp,
const char *name, int length, Tcl_Namespace *context,
Tcl_ResolvedVarInfo **rPtr);
-typedef int (Tcl_ResolveVarProc) (Tcl_Interp *interp, const char *name,
+typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp, const char *name,
Tcl_Namespace *context, int flags, Tcl_Var *rPtr);
-typedef int (Tcl_ResolveCmdProc) (Tcl_Interp *interp, const char *name,
+typedef int (Tcl_ResolveCmdProc)(Tcl_Interp *interp, const char *name,
Tcl_Namespace *context, int flags, Tcl_Command *rPtr);
typedef struct Tcl_ResolverInfo {
@@ -214,7 +214,6 @@ typedef struct TclVarHashTable {
#define TclVarHashFindVar(tablePtr, key) \
TclVarHashCreateVar((tablePtr), (key), NULL)
-
/*
* The structure below defines a namespace.
* Note: the first five fields must match exactly the fields in a
@@ -361,7 +360,7 @@ struct NamespacePathEntry {
* unit that refers to the namespace has been freed (i.e., when
* the namespace's refCount is 0), the namespace's storage will
* be freed.
- * NS_KILLED - 1 means that TclTeardownNamespace has already been called on
+ * NS_KILLED - 1 means that TclTeardownNamespace has already been called on
* this namespace and it should not be called again [Bug 1355942]
* NS_SUPPRESS_COMPILATION -
* Marks the commands in this namespace for not being compiled,
@@ -590,8 +589,8 @@ typedef struct VarInHash {
* local variable that was assigned a slot in a
* procedure frame by the compiler so the Var
* storage is part of the call frame.
- * VAR_DEAD_HASH 1 means that this var's entry in the hashtable
- * has already been deleted.
+ * VAR_DEAD_HASH 1 means that this var's entry in the hashtable
+ * has already been deleted.
* VAR_ARRAY_ELEMENT - 1 means that this variable is an array
* element, so it is not legal for it to be an
* array itself (the VAR_ARRAY flag had better
@@ -628,8 +627,8 @@ typedef struct VarInHash {
* name.
* VAR_RESOLVED - 1 if name resolution has been done for this
* variable.
- * VAR_IS_ARGS 1 if this variable is the last argument and is
- * named "args".
+ * VAR_IS_ARGS 1 if this variable is the last argument and is
+ * named "args".
*/
/*
@@ -642,35 +641,33 @@ typedef struct VarInHash {
* in precompiled scripts keep working.
*/
-
/* Type of value (0 is scalar) */
#define VAR_ARRAY 0x1
#define VAR_LINK 0x2
/* Type of storage (0 is compiled local) */
#define VAR_IN_HASHTABLE 0x4
-#define VAR_DEAD_HASH 0x8
+#define VAR_DEAD_HASH 0x8
#define VAR_ARRAY_ELEMENT 0x1000
-#define VAR_NAMESPACE_VAR 0x80 /* KEEP OLD VALUE for Itcl */
+#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)
/* Trace and search state */
-#define VAR_TRACED_READ 0x10 /* TCL_TRACE_READS */
-#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 0x2000
-#define VAR_SEARCH_ACTIVE 0x4000
+#define VAR_TRACED_READ 0x10 /* TCL_TRACE_READS */
+#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 0x2000
+#define VAR_SEARCH_ACTIVE 0x4000
#define VAR_ALL_TRACES \
(VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_ARRAY|VAR_TRACED_UNSET)
-
/* Special handling on initialisation (only CompiledLocal) */
-#define VAR_ARGUMENT 0x100 /* KEEP OLD VALUE! See tclProc.c */
-#define VAR_TEMPORARY 0x200 /* KEEP OLD VALUE! See tclProc.c */
+#define VAR_ARGUMENT 0x100 /* KEEP OLD VALUE! See tclProc.c */
+#define VAR_TEMPORARY 0x200 /* KEEP OLD VALUE! See tclProc.c */
#define VAR_IS_ARGS 0x400
#define VAR_RESOLVED 0x8000
@@ -767,7 +764,7 @@ typedef struct VarInHash {
((varPtr)->flags & VAR_TRACE_ACTIVE)
#define TclIsVarTraced(varPtr) \
- ((varPtr)->flags & VAR_ALL_TRACES)
+ ((varPtr)->flags & VAR_ALL_TRACES)
#define TclIsVarInHash(varPtr) \
((varPtr)->flags & VAR_IN_HASHTABLE)
@@ -777,8 +774,8 @@ typedef struct VarInHash {
#define TclGetVarNsPtr(varPtr) \
(TclIsVarInHash(varPtr) \
- ? ((TclVarHashTable *) ((((VarInHash *) (varPtr))->entry.tablePtr)))->nsPtr \
- : NULL)
+ ? ((TclVarHashTable *) ((((VarInHash *) (varPtr))->entry.tablePtr)))->nsPtr \
+ : NULL)
#define VarHashRefCount(varPtr) \
((VarInHash *) (varPtr))->refCount
@@ -800,16 +797,15 @@ typedef struct VarInHash {
#define TclIsVarDirectReadable2(varPtr, arrayPtr) \
(TclIsVarDirectReadable(varPtr) &&\
- (!(arrayPtr) || !((arrayPtr)->flags & VAR_TRACED_READ)))
+ (!(arrayPtr) || !((arrayPtr)->flags & VAR_TRACED_READ)))
#define TclIsVarDirectWritable2(varPtr, arrayPtr) \
(TclIsVarDirectWritable(varPtr) &&\
- (!(arrayPtr) || !((arrayPtr)->flags & VAR_TRACED_WRITE)))
+ (!(arrayPtr) || !((arrayPtr)->flags & VAR_TRACED_WRITE)))
#define TclIsVarDirectModifyable2(varPtr, arrayPtr) \
(TclIsVarDirectModifyable(varPtr) &&\
- (!(arrayPtr) || !((arrayPtr)->flags & (VAR_TRACED_READ|VAR_TRACED_WRITE))))
-
+ (!(arrayPtr) || !((arrayPtr)->flags & (VAR_TRACED_READ|VAR_TRACED_WRITE))))
/*
*----------------------------------------------------------------
@@ -909,7 +905,7 @@ typedef struct Proc {
* of a procedure (or lambda term or ...).
*/
-typedef void (*ProcErrorProc)(Tcl_Interp *interp, Tcl_Obj *procNameObj);
+typedef void (ProcErrorProc)(Tcl_Interp *interp, Tcl_Obj *procNameObj);
/*
* The structure below defines a command trace. This is used to allow Tcl
@@ -924,7 +920,7 @@ typedef struct Trace {
struct Trace *nextPtr; /* Next in list of traces for this interp. */
int flags; /* Flags governing the trace - see
* Tcl_CreateObjTrace for details */
- Tcl_CmdObjTraceDeleteProc* delProc;
+ Tcl_CmdObjTraceDeleteProc *delProc;
/* Procedure to call when trace is deleted */
} Trace;
@@ -1040,7 +1036,7 @@ typedef struct CallFrame {
* (local variables assigned entries ["slots"]
* in the compiledLocals array below). */
TclVarHashTable *varTablePtr;
- /* Hash table containing local variables not
+ /* Hash table containing local variables not
* recognized by the compiler, or created at
* execution time through, e.g., upvar.
* Initially NULL and created if needed. */
@@ -1062,7 +1058,7 @@ typedef struct CallFrame {
LocalCache *localCachePtr;
} CallFrame;
-#define FRAME_IS_PROC 0x1
+#define FRAME_IS_PROC 0x1
#define FRAME_IS_LAMBDA 0x2
#define FRAME_IS_METHOD 0x4 /* The frame is a method body, and the frame's
* clientData field contains a CallContext
@@ -1099,11 +1095,10 @@ typedef struct CmdFrame {
int type; /* Values see below. */
int level; /* #Frames in stack, prevent O(n) scan of
* list. */
- int numLevels; /* value of interp's numLevels when the frame
+ int numLevels; /* value of interp's numLevels when the frame
* was pushed */
int *line; /* Lines the words of the command start on. */
int nline;
-
CallFrame *framePtr; /* Procedure activation record, may be
* NULL. */
struct CmdFrame *nextPtr; /* Link to calling frame */
@@ -1158,22 +1153,23 @@ typedef struct CmdFrame {
} CmdFrame;
typedef struct CFWord {
- CmdFrame* framePtr; /* CmdFrame to acess */
- int word; /* Index of the word in the command */
- int refCount; /* #times the word is on the stack */
+ CmdFrame *framePtr; /* CmdFrame to acess */
+ int word; /* Index of the word in the command */
+ int refCount; /* #times the word is on the stack */
} CFWord;
typedef struct ExtIndex {
- Tcl_Obj* obj; /* Reference to the word */
- int pc; /* Instruction pointer of a command in ExtCmdLoc.loc[.] */
- int word; /* Index of word in ExtCmdLoc.loc[cmd]->line[.] */
+ Tcl_Obj *obj; /* Reference to the word */
+ int pc; /* Instruction pointer of a command in
+ * ExtCmdLoc.loc[.] */
+ int word; /* Index of word in
+ * ExtCmdLoc.loc[cmd]->line[.] */
} ExtIndex;
-
typedef struct CFWordBC {
- CmdFrame* framePtr; /* CmdFrame to acess */
- ExtIndex* eiPtr; /* Word info: PC and index */
- int refCount; /* #times the word is on the stack */
+ CmdFrame *framePtr; /* CmdFrame to acess */
+ ExtIndex *eiPtr; /* Word info: PC and index */
+ int refCount; /* #times the word is on the stack */
} CFWordBC;
/*
@@ -1194,16 +1190,15 @@ typedef struct CFWordBC {
* types, per the context of the byte code in execution.
*/
-#define TCL_LOCATION_EVAL (0) /* Location in a dynamic eval script */
-#define TCL_LOCATION_EVAL_LIST (1) /* Location in a dynamic eval script,
- * list-path */
-#define TCL_LOCATION_BC (2) /* Location in byte code */
-#define TCL_LOCATION_PREBC (3) /* Location in precompiled byte code, no
- * location */
-#define TCL_LOCATION_SOURCE (4) /* Location in a file */
-#define TCL_LOCATION_PROC (5) /* Location in a dynamic proc */
-
-#define TCL_LOCATION_LAST (6) /* Number of values in the enum */
+#define TCL_LOCATION_EVAL (0) /* Location in a dynamic eval script */
+#define TCL_LOCATION_EVAL_LIST (1) /* Location in a dynamic eval script,
+ * list-path */
+#define TCL_LOCATION_BC (2) /* Location in byte code */
+#define TCL_LOCATION_PREBC (3) /* Location in precompiled byte code, no
+ * location */
+#define TCL_LOCATION_SOURCE (4) /* Location in a file */
+#define TCL_LOCATION_PROC (5) /* Location in a dynamic proc */
+#define TCL_LOCATION_LAST (6) /* Number of values in the enum */
/*
* Structure passed to describe procedure-like "procedures" that are not
@@ -1264,7 +1259,6 @@ MODULE_SCOPE void TclThreadDataKeySet(Tcl_ThreadDataKey *keyPtr,
#define TCL_TSD_INIT(keyPtr) \
(ThreadSpecificData *)Tcl_GetThreadData((keyPtr), sizeof(ThreadSpecificData))
-
/*
*----------------------------------------------------------------
* Data structures related to bytecode compilation and execution. These are
@@ -1302,7 +1296,7 @@ struct CompileEnv;
#define TCL_OUT_LINE_COMPILE TCL_ERROR
-typedef int (CompileProc) (Tcl_Interp *interp, Tcl_Parse *parsePtr,
+typedef int (CompileProc)(Tcl_Interp *interp, Tcl_Parse *parsePtr,
struct Command *cmdPtr, struct CompileEnv *compEnvPtr);
/*
@@ -1310,7 +1304,7 @@ typedef int (CompileProc) (Tcl_Interp *interp, Tcl_Parse *parsePtr,
* SetByteCodeFromAny.
*/
-typedef int (CompileHookProc) (Tcl_Interp *interp,
+typedef int (CompileHookProc)(Tcl_Interp *interp,
struct CompileEnv *compEnvPtr, ClientData clientData);
/*
@@ -1351,13 +1345,12 @@ typedef struct CoroutineData {
} CoroutineData;
typedef struct ExecEnv {
- ExecStack *execStackPtr; /* Points to the first item in the
- * evaluation stack on the heap. */
- Tcl_Obj *constants[2]; /* Pointers to constant "0" and "1"
- * objs. */
+ ExecStack *execStackPtr; /* Points to the first item in the evaluation
+ * stack on the heap. */
+ Tcl_Obj *constants[2]; /* Pointers to constant "0" and "1" objs. */
struct Tcl_Interp *interp;
struct TEOV_callback *callbackPtr;
- /* Top callback in TEOV's stack */
+ /* Top callback in TEOV's stack */
struct CoroutineData *corPtr;
struct BottomData *bottomPtr;
int rewind;
@@ -1462,6 +1455,7 @@ typedef struct {
const char *name; /* The name of the subcommand. */
Tcl_ObjCmdProc *proc; /* The implementation of the subcommand. */
CompileProc *compileProc; /* The compiler for the subcommand. */
+ Tcl_ObjCmdProc *nreProc; /* NRE implementation of this command */
} EnsembleImplMap;
/*
@@ -1903,23 +1897,24 @@ typedef struct Interp {
* TIP #285, Script cancellation support.
*/
- Tcl_AsyncHandler asyncCancel; /* Async handler token for Tcl_CancelEval. */
- Tcl_Obj* asyncCancelMsg; /* Error message set by async cancel handler
- * for the propagation of arbitrary Tcl
- * errors. This information, if present
- * (asyncCancelMsg not NULL), takes precedence
- * over the default error messages returned by
- * a script cancellation operation. */
+ Tcl_AsyncHandler asyncCancel;
+ /* Async handler token for Tcl_CancelEval. */
+ Tcl_Obj *asyncCancelMsg; /* Error message set by async cancel handler
+ * for the propagation of arbitrary Tcl
+ * errors. This information, if present
+ * (asyncCancelMsg not NULL), takes precedence
+ * over the default error messages returned by
+ * a script cancellation operation. */
/* TIP #280 */
- CmdFrame *cmdFramePtr; /* Points to the command frame containing
- * the location information for the current
+ CmdFrame *cmdFramePtr; /* Points to the command frame containing the
+ * location information for the current
* command. */
const CmdFrame *invokeCmdFramePtr;
/* Points to the command frame which is the
* invoking context of the bytecode compiler.
* NULL when the byte code compiler is not
- * active */
+ * active. */
int invokeWord; /* Index of the word in the command which
* is getting compiled. */
Tcl_HashTable *linePBodyPtr;/* This table remembers for each statically
@@ -1931,9 +1926,10 @@ typedef struct Interp {
* object the location information for its
* body. It is keyed by the address of the
* Proc structure for a procedure. The values
- * are "struct ExtCmdLoc*" (See tclCompile.h) */
- Tcl_HashTable* lineLABCPtr;
- Tcl_HashTable* lineLAPtr; /* This table remembers for each argument of a
+ * are "struct ExtCmdLoc*". (See
+ * tclCompile.h) */
+ Tcl_HashTable *lineLABCPtr;
+ Tcl_HashTable *lineLAPtr; /* This table remembers for each argument of a
* command on the execution stack the index of
* the argument in the command, and the
* location data of the command. It is keyed
@@ -1992,7 +1988,7 @@ typedef struct Interp {
* and setup. */
struct TEOV_callback *atExitPtr;
- /* Callbacks to be run after a command exited;
+ /* Callbacks to be run after a command exited;
* this is only set for atProcExirt or
* tailcalls that fall back out of tebc. */
@@ -2014,7 +2010,6 @@ typedef struct Interp {
#define TclAsyncReady(iPtr) \
*((iPtr)->asyncReadyPtr)
-
/*
* General list of interpreters. Doubly linked for easier removal of items
* deep in the list.
@@ -2061,9 +2056,9 @@ typedef struct InterpList {
* other than these should be turned into errors.
*/
-#define TCL_ALLOW_EXCEPTIONS 4
-#define TCL_EVAL_FILE 2
-#define TCL_EVAL_CTX 8
+#define TCL_ALLOW_EXCEPTIONS 4
+#define TCL_EVAL_FILE 2
+#define TCL_EVAL_CTX 8
/*
* Flag bits for Interp structures:
@@ -2094,29 +2089,30 @@ typedef struct InterpList {
* Makes it append instead of replacing and uses
* different intermediate text.
* CANCELED: Non-zero means that the script in progress should be
- * canceled as soon as possible. This can be checked by
+ * canceled as soon as possible. This can be checked by
* extensions (and the core itself) by calling
* Tcl_Canceled and checking if TCL_ERROR is returned.
* This is a one-shot flag that is reset immediately upon
* being detected; however, if the TCL_CANCEL_UNWIND flag
* is set Tcl_Canceled will continue to report that the
* script in progress has been canceled thereby allowing
- * the evaluation stack for the interp to be fully unwound.
+ * the evaluation stack for the interp to be fully
+ * unwound.
*
* WARNING: For the sake of some extensions that have made use of former
* internal values, do not re-use the flag values 2 (formerly ERR_IN_PROGRESS)
* or 8 (formerly ERROR_CODE_SET).
*/
-#define DELETED 1
-#define ERR_ALREADY_LOGGED 4
-#define DONT_COMPILE_CMDS_INLINE 0x20
-#define RAND_SEED_INITIALIZED 0x40
-#define SAFE_INTERP 0x80
-#define INTERP_TRACE_IN_PROGRESS 0x200
-#define INTERP_ALTERNATE_WRONG_ARGS 0x400
-#define ERR_LEGACY_COPY 0x800
-#define CANCELED 0x1000
+#define DELETED 1
+#define ERR_ALREADY_LOGGED 4
+#define DONT_COMPILE_CMDS_INLINE 0x20
+#define RAND_SEED_INITIALIZED 0x40
+#define SAFE_INTERP 0x80
+#define INTERP_TRACE_IN_PROGRESS 0x200
+#define INTERP_ALTERNATE_WRONG_ARGS 0x400
+#define ERR_LEGACY_COPY 0x800
+#define CANCELED 0x1000
/*
* Maximum number of levels of nesting permitted in Tcl commands (used to
@@ -2190,7 +2186,6 @@ struct LimitHandler {
#define TCL_ALIGN(x) (((int)(x) + 7) & ~7)
-
/*
* The following enum values are used to specify the runtime platform setting
* of the tclPlatform variable.
@@ -2346,7 +2341,7 @@ typedef struct List {
*/
#define TCL_FILESYSTEM_VERSION_2 ((Tcl_FSVersion) 0x2)
-typedef ClientData (TclFSGetCwdProc2) (ClientData clientData);
+typedef ClientData (TclFSGetCwdProc2)(ClientData clientData);
/*
* The following types are used for getting and storing platform-specific file
@@ -2356,9 +2351,9 @@ typedef ClientData (TclFSGetCwdProc2) (ClientData clientData);
* tclFCmd.c.
*/
-typedef int (TclGetFileAttrProc) (Tcl_Interp *interp, int objIndex,
+typedef int (TclGetFileAttrProc)(Tcl_Interp *interp, int objIndex,
Tcl_Obj *fileName, Tcl_Obj **attrObjPtrPtr);
-typedef int (TclSetFileAttrProc) (Tcl_Interp *interp, int objIndex,
+typedef int (TclSetFileAttrProc)(Tcl_Interp *interp, int objIndex,
Tcl_Obj *fileName, Tcl_Obj *attrObjPtr);
typedef struct TclFileAttrProcs {
@@ -2396,9 +2391,9 @@ typedef enum Tcl_PathPart {
*----------------------------------------------------------------
*/
-typedef int (TclStatProc_) (const char *path, struct stat *buf);
-typedef int (TclAccessProc_) (const char *path, int mode);
-typedef Tcl_Channel (TclOpenFileChannelProc_) (Tcl_Interp *interp,
+typedef int (TclStatProc_)(const char *path, struct stat *buf);
+typedef int (TclAccessProc_)(const char *path, int mode);
+typedef Tcl_Channel (TclOpenFileChannelProc_)(Tcl_Interp *interp,
const char *fileName, const char *modeString, int permissions);
/*
@@ -2416,7 +2411,7 @@ typedef Tcl_ObjCmdProc *TclObjCmdProcType;
*----------------------------------------------------------------
*/
-typedef void (TclInitProcessGlobalValueProc) (char **valuePtr, int *lengthPtr,
+typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, int *lengthPtr,
Tcl_Encoding *encodingPtr);
/*
@@ -2481,9 +2476,9 @@ typedef struct ProcessGlobalValue {
*----------------------------------------------------------------
*/
-MODULE_SCOPE char * tclNativeExecutableName;
-MODULE_SCOPE int tclFindExecutableSearchDone;
-MODULE_SCOPE char * tclMemDumpFileName;
+MODULE_SCOPE char *tclNativeExecutableName;
+MODULE_SCOPE int tclFindExecutableSearchDone;
+MODULE_SCOPE char *tclMemDumpFileName;
MODULE_SCOPE TclPlatformType tclPlatform;
MODULE_SCOPE Tcl_NotifierProcs tclNotifierHooks;
@@ -2492,9 +2487,9 @@ MODULE_SCOPE Tcl_NotifierProcs tclNotifierHooks;
* Data for the time hooks, if any.
*/
-MODULE_SCOPE Tcl_GetTimeProc* tclGetTimeProcPtr;
-MODULE_SCOPE Tcl_ScaleTimeProc* tclScaleTimeProcPtr;
-MODULE_SCOPE ClientData tclTimeClientData;
+MODULE_SCOPE Tcl_GetTimeProc *tclGetTimeProcPtr;
+MODULE_SCOPE Tcl_ScaleTimeProc *tclScaleTimeProcPtr;
+MODULE_SCOPE ClientData tclTimeClientData;
/*
* Variables denoting the Tcl object types defined in the core.
@@ -2550,7 +2545,6 @@ MODULE_SCOPE long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS];
MODULE_SCOPE char * tclEmptyStringRep;
MODULE_SCOPE char tclEmptyString;
-
/*
*----------------------------------------------------------------
* Procedures shared among Tcl modules but not used by the outside world,
@@ -2577,21 +2571,20 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
*----------------------------------------------------------------
*/
-MODULE_SCOPE int TclNREvalCmd(Tcl_Interp * interp, Tcl_Obj * objPtr,
- int flags);
-
-MODULE_SCOPE void TclAdvanceLines(int *line, const char *start,
+MODULE_SCOPE int TclNREvalCmd(Tcl_Interp * interp, Tcl_Obj * objPtr,
+ int flags);
+MODULE_SCOPE void TclAdvanceLines(int *line, const char *start,
const char *end);
-MODULE_SCOPE void TclArgumentEnter(Tcl_Interp* interp,
- Tcl_Obj* objv[], int objc, CmdFrame* cf);
-MODULE_SCOPE void TclArgumentRelease(Tcl_Interp* interp,
- Tcl_Obj* objv[], int objc);
-MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp* interp,
- void* codePtr, CmdFrame* cfPtr);
-MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp* interp,
- void* codePtr);
-MODULE_SCOPE void TclArgumentGet(Tcl_Interp* interp, Tcl_Obj* obj,
- CmdFrame** cfPtrPtr, int* wordPtr);
+MODULE_SCOPE void TclArgumentEnter(Tcl_Interp *interp,
+ Tcl_Obj *objv[], int objc, CmdFrame *cf);
+MODULE_SCOPE void TclArgumentRelease(Tcl_Interp *interp,
+ Tcl_Obj *objv[], int objc);
+MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp,
+ void *codePtr, CmdFrame *cfPtr);
+MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp,
+ void *codePtr);
+MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
+ CmdFrame **cfPtrPtr, int *wordPtr);
MODULE_SCOPE int TclArraySet(Tcl_Interp *interp,
Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj);
MODULE_SCOPE double TclBignumToDouble(mp_int *bignum);
@@ -2602,14 +2595,14 @@ MODULE_SCOPE double TclCeil(mp_int *a);
MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp,const char *value);
MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp,
Tcl_Channel chan);
-MODULE_SCOPE int TclClearRootEnsemble(ClientData data[],
- Tcl_Interp *interp, int result);
+MODULE_SCOPE int TclClearRootEnsemble(ClientData data[],
+ Tcl_Interp *interp, int result);
MODULE_SCOPE void TclCleanupLiteralTable(Tcl_Interp *interp,
LiteralTable *tablePtr);
MODULE_SCOPE int TclDoubleDigits(char *buf, double value, int *signum);
-MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr);
+MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr);
/* TIP #280 - Modified token based evulation, with line information */
-MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script,
+MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script,
int numBytes, int flags, int line);
MODULE_SCOPE int TclFileAttrsCmd(Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
@@ -2644,7 +2637,7 @@ MODULE_SCOPE double TclFloor(mp_int *a);
MODULE_SCOPE void TclFormatNaN(double value, char *buffer);
MODULE_SCOPE int TclFSFileAttrIndex(Tcl_Obj *pathPtr,
const char *attributeName, int *indexPtr);
-MODULE_SCOPE int * TclGetAsyncReadyPtr(void);
+MODULE_SCOPE int * TclGetAsyncReadyPtr(void);
MODULE_SCOPE Tcl_Obj * TclGetBgErrorHandler(Tcl_Interp *interp);
MODULE_SCOPE int TclGetChannelFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, Tcl_Channel *chanPtr,
@@ -2694,7 +2687,7 @@ MODULE_SCOPE Tcl_Obj * TclLindexList(Tcl_Interp *interp,
MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
int indexCount, Tcl_Obj *const indexArray[]);
/* TIP #280 */
-MODULE_SCOPE void TclListLines(const char *listStr, int line, int n,
+MODULE_SCOPE void TclListLines(const char *listStr, int line, int n,
int *lines);
MODULE_SCOPE Tcl_Obj * TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
MODULE_SCOPE int TclLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
@@ -2710,16 +2703,16 @@ MODULE_SCOPE Tcl_Obj * TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
Tcl_Obj *valuePtr);
MODULE_SCOPE Tcl_Command TclMakeEnsemble(Tcl_Interp *interp, const char *name,
const EnsembleImplMap map[]);
-MODULE_SCOPE int TclMarkList(Tcl_Interp *interp, const char *list,
+MODULE_SCOPE int TclMarkList(Tcl_Interp *interp, const char *list,
const char *end, int *argcPtr,
const int **argszPtr, const char ***argvPtr);
MODULE_SCOPE int TclMergeReturnOptions(Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr,
int *codePtr, int *levelPtr);
MODULE_SCOPE int TclNokia770Doubles();
-MODULE_SCOPE void TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
- Tcl_Obj *part2Ptr, const char *operation,
- const char *reason, int index);
+MODULE_SCOPE void TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
+ Tcl_Obj *part2Ptr, const char *operation,
+ const char *reason, int index);
MODULE_SCOPE int TclObjInvokeNamespace(Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[],
Tcl_Namespace *nsPtr, int flags);
@@ -2772,14 +2765,14 @@ MODULE_SCOPE void TclpNativeJoinPath(Tcl_Obj *prefix, char *joining);
MODULE_SCOPE Tcl_Obj * TclpNativeSplitPath(Tcl_Obj *pathPtr, int *lenPtr);
MODULE_SCOPE Tcl_PathType TclpGetNativePathType(Tcl_Obj *pathPtr,
int *driveNameLengthPtr, Tcl_Obj **driveNameRef);
-MODULE_SCOPE int TclCrossFilesystemCopy(Tcl_Interp *interp,
+MODULE_SCOPE int TclCrossFilesystemCopy(Tcl_Interp *interp,
Tcl_Obj *source, Tcl_Obj *target);
MODULE_SCOPE int TclpMatchInDirectory(Tcl_Interp *interp,
Tcl_Obj *resultPtr, Tcl_Obj *pathPtr,
const char *pattern, Tcl_GlobTypeData *types);
MODULE_SCOPE ClientData TclpGetNativeCwd(ClientData clientData);
MODULE_SCOPE Tcl_FSDupInternalRepProc TclNativeDupInternalRep;
-MODULE_SCOPE Tcl_Obj* TclpObjLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr,
+MODULE_SCOPE Tcl_Obj * TclpObjLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr,
int linkType);
MODULE_SCOPE int TclpObjChdir(Tcl_Obj *pathPtr);
MODULE_SCOPE Tcl_Obj * TclPathPart(Tcl_Interp *interp, Tcl_Obj *pathPtr,
@@ -2830,7 +2823,7 @@ MODULE_SCOPE int TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr,
Tcl_FSUnloadFileProc **unloadProcPtr);
MODULE_SCOPE int TclpUtime(Tcl_Obj *pathPtr, struct utimbuf *tval);
#ifdef TCL_LOAD_FROM_MEMORY
-MODULE_SCOPE void* TclpLoadMemoryGetBuffer(Tcl_Interp *interp, int size);
+MODULE_SCOPE void * TclpLoadMemoryGetBuffer(Tcl_Interp *interp, int size);
MODULE_SCOPE int TclpLoadMemory(Tcl_Interp *interp, void *buffer,
int size, int codeSize, Tcl_LoadHandle *loadHandle,
Tcl_FSUnloadFileProc **unloadProcPtr);
@@ -2844,11 +2837,11 @@ MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks);
#endif
MODULE_SCOPE Tcl_Obj * TclDisassembleByteCodeObj(Tcl_Obj *objPtr);
-MODULE_SCOPE void * TclpThreadCreateKey(void);
-MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr);
-MODULE_SCOPE void TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr);
-MODULE_SCOPE void * TclpThreadGetMasterTSD(void *tsdKeyPtr);
-
+MODULE_SCOPE void * TclpThreadCreateKey(void);
+MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr);
+MODULE_SCOPE void TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr);
+MODULE_SCOPE void * TclpThreadGetMasterTSD(void *tsdKeyPtr);
+
/*
*----------------------------------------------------------------
* Command procedures in the generic core:
@@ -3200,10 +3193,10 @@ MODULE_SCOPE int TclCompileLsetCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileNamespaceCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, Command *cmdPtr,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileNoOp(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, Command *cmdPtr,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileRegexpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
@@ -3233,10 +3226,10 @@ MODULE_SCOPE int TclCompileSwitchCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileUpvarCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, Command *cmdPtr,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileVariableCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, Command *cmdPtr,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileWhileCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
@@ -3389,7 +3382,7 @@ MODULE_SCOPE int TclCompileStreqOpCmd(Tcl_Interp *interp,
MODULE_SCOPE Var * TclObjLookupVarEx(Tcl_Interp * interp,
Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags,
- const char * msg, const int createPart1,
+ const char *msg, const int createPart1,
const int createPart2, Var **arrayPtrPtr);
MODULE_SCOPE Var * TclLookupArrayElement(Tcl_Interp *interp,
Tcl_Obj *arrayNamePtr, Tcl_Obj *elNamePtr,
@@ -3407,8 +3400,8 @@ MODULE_SCOPE Tcl_Obj * TclPtrIncrObjVar(Tcl_Interp *interp,
Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr,
const int flags, int index);
-MODULE_SCOPE int TclPtrObjMakeUpvar(Tcl_Interp *interp, Var *otherPtr,
- Tcl_Obj *myNamePtr, int myFlags, int index);
+MODULE_SCOPE int TclPtrObjMakeUpvar(Tcl_Interp *interp, Var *otherPtr,
+ Tcl_Obj *myNamePtr, int myFlags, int index);
MODULE_SCOPE void TclInvalidateNsPath(Namespace *nsPtr);
/*
@@ -3472,10 +3465,10 @@ MODULE_SCOPE unsigned TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
#endif /* TCL_COMPILE_STATS */
# define TclAllocObjStorage(objPtr) \
- TclAllocObjStorageEx(NULL, (objPtr))
+ TclAllocObjStorageEx(NULL, (objPtr))
# define TclFreeObjStorage(objPtr) \
- TclFreeObjStorageEx(NULL, (objPtr))
+ TclFreeObjStorageEx(NULL, (objPtr))
#ifndef TCL_MEM_DEBUG
# define TclNewObj(objPtr) \
@@ -3495,19 +3488,19 @@ MODULE_SCOPE unsigned TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
*/
# define TclDecrRefCount(objPtr) \
- if (--(objPtr)->refCount > 0) ; else { \
- if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \
- TCL_DTRACE_OBJ_FREE(objPtr); \
- if ((objPtr)->bytes \
- && ((objPtr)->bytes != tclEmptyStringRep)) { \
- ckfree((char *) (objPtr)->bytes); \
- } \
- (objPtr)->length = -1; \
- TclFreeObjStorage(objPtr); \
- TclIncrObjsFreed(); \
- } else { \
- TclFreeObj(objPtr); \
- } \
+ if (--(objPtr)->refCount > 0) ; else { \
+ if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \
+ TCL_DTRACE_OBJ_FREE(objPtr); \
+ if ((objPtr)->bytes \
+ && ((objPtr)->bytes != tclEmptyStringRep)) { \
+ ckfree((char *) (objPtr)->bytes); \
+ } \
+ (objPtr)->length = -1; \
+ TclFreeObjStorage(objPtr); \
+ TclIncrObjsFreed(); \
+ } else { \
+ TclFreeObj(objPtr); \
+ } \
}
#if defined(PURIFY)
@@ -3519,10 +3512,10 @@ MODULE_SCOPE unsigned TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
* track memory leaks
*/
-# define TclAllocObjStorageEx(interp, objPtr) \
+# define TclAllocObjStorageEx(interp, objPtr) \
(objPtr) = (Tcl_Obj *) Tcl_Alloc(sizeof(Tcl_Obj))
-# define TclFreeObjStorageEx(interp, objPtr) \
+# define TclFreeObjStorageEx(interp, objPtr) \
ckfree((char *) (objPtr))
#undef USE_THREAD_ALLOC
@@ -3641,15 +3634,14 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr);
*/
#define TclInitStringRep(objPtr, bytePtr, len) \
- if ((len) == 0) { \
- (objPtr)->bytes = tclEmptyStringRep; \
- (objPtr)->length = 0; \
- } else { \
- (objPtr)->bytes = (char *) ckalloc((unsigned) ((len) + 1)); \
- memcpy((void *) (objPtr)->bytes, (void *) (bytePtr), \
- (unsigned) (len)); \
- (objPtr)->bytes[len] = '\0'; \
- (objPtr)->length = (len); \
+ if ((len) == 0) { \
+ (objPtr)->bytes = tclEmptyStringRep; \
+ (objPtr)->length = 0; \
+ } else { \
+ (objPtr)->bytes = (char *) ckalloc((unsigned) ((len) + 1)); \
+ memcpy((objPtr)->bytes, (bytePtr), (unsigned) (len)); \
+ (objPtr)->bytes[len] = '\0'; \
+ (objPtr)->length = (len); \
}
/*
@@ -3667,7 +3659,6 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr);
#define TclGetString(objPtr) \
((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString((objPtr)))
-
#define TclGetStringFromObj(objPtr, lenPtr) \
((objPtr)->bytes \
? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes) \
@@ -3699,18 +3690,18 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr);
*/
#define TclInvalidateStringRep(objPtr) \
- if (objPtr->bytes != NULL) { \
- if (objPtr->bytes != tclEmptyStringRep) {\
- ckfree((char *) objPtr->bytes);\
- }\
- objPtr->bytes = NULL;\
- }\
+ if (objPtr->bytes != NULL) { \
+ if (objPtr->bytes != tclEmptyStringRep) { \
+ ckfree((char *) objPtr->bytes); \
+ } \
+ objPtr->bytes = NULL; \
+ }
/*
*----------------------------------------------------------------
- * Macros used by the Tcl core to grow Tcl_Token arrays. They use
- * the same growth algorithm as used in tclStringObj.c for growing
- * strings. The ANSI C "prototype" for this macro is:
+ * Macros used by the Tcl core to grow Tcl_Token arrays. They use the same
+ * growth algorithm as used in tclStringObj.c for growing strings. The ANSI C
+ * "prototype" for this macro is:
*
* MODULE_SCOPE void TclGrowTokenArray(Tcl_Token *tokenPtr, int used,
* int available, int append,
@@ -3731,16 +3722,16 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr);
if (oldPtr == (staticPtr)) { \
oldPtr = NULL; \
} \
- newPtr = (Tcl_Token *) attemptckrealloc( (char *) oldPtr, \
- (unsigned int) (allocated * sizeof(Tcl_Token))); \
+ newPtr = (Tcl_Token *) attemptckrealloc((char *) oldPtr, \
+ (unsigned) (allocated * sizeof(Tcl_Token))); \
if (newPtr == NULL) { \
allocated = needed + (append) + TCL_MIN_TOKEN_GROWTH; \
- newPtr = (Tcl_Token *) ckrealloc( (char *) oldPtr, \
- (unsigned int) (allocated * sizeof(Tcl_Token))); \
+ newPtr = (Tcl_Token *) ckrealloc((char *) oldPtr, \
+ (unsigned) (allocated * sizeof(Tcl_Token))); \
} \
(available) = allocated; \
if (oldPtr == NULL) { \
- memcpy((VOID *) newPtr, (VOID *) staticPtr, \
+ memcpy(newPtr, staticPtr, \
(size_t) ((used) * sizeof(Tcl_Token))); \
} \
(tokenPtr) = newPtr; \
@@ -3756,7 +3747,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr);
*----------------------------------------------------------------
* Macro used by the Tcl core get a unicode char from a utf string. It checks
* to see if we have a one-byte utf char before calling the real
- * Tcl_UtfToUniChar, as this will save a lot of time for primarily ascii
+ * Tcl_UtfToUniChar, as this will save a lot of time for primarily ASCII
* string handling. The macro's expression result is 1 for the 1-byte case or
* the result of Tcl_UtfToUniChar. The ANSI C "prototype" for this macro is:
*
@@ -3941,7 +3932,7 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum,
TCL_DTRACE_OBJ_CREATE(objPtr)
#else /* TCL_MEM_DEBUG */
-#define TclNewIntObj(objPtr, i) \
+#define TclNewIntObj(objPtr, i) \
(objPtr) = Tcl_NewIntObj(i)
#define TclNewLongObj(objPtr, l) \
@@ -3974,21 +3965,21 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum,
*/
#ifdef _MSC_VER
-# define TclIsInfinite(d) ( ! (_finite((d))) )
+# define TclIsInfinite(d) (!(_finite((d))))
# define TclIsNaN(d) (_isnan((d)))
#else
-# define TclIsInfinite(d) ( (d) > DBL_MAX || (d) < -DBL_MAX )
+# define TclIsInfinite(d) ((d) > DBL_MAX || (d) < -DBL_MAX)
# ifdef NO_ISNAN
-# define TclIsNaN(d) ((d) != (d))
+# define TclIsNaN(d) ((d) != (d))
# else
-# define TclIsNaN(d) (isnan(d))
+# define TclIsNaN(d) (isnan(d))
# endif
#endif
/*
* ----------------------------------------------------------------------
- * Macro to use to find the offset of a field in a structure.
- * Computes number of bytes from beginning of structure to a given field.
+ * Macro to use to find the offset of a field in a structure. Computes number
+ * of bytes from beginning of structure to a given field.
*/
#ifdef offsetof
@@ -4042,11 +4033,10 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum,
((limit).granularityTicker % (limit).timeGranularity == 0)))\
? 1 : 0)))
-
/*
*----------------------------------------------------------------
- * Allocator for small structs (<=sizeof(Tcl_Obj)) using the Tcl_Obj
- * pool. Only checked at compile time.
+ * Allocator for small structs (<=sizeof(Tcl_Obj)) using the Tcl_Obj pool.
+ * Only checked at compile time.
*
* ONLY USE FOR CONSTANT nBytes: if you do and nBytes is too large, the
* compiler will error out with "duplicate case value" (thanks dkf!). If the
@@ -4113,8 +4103,8 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum,
*----------------------------------------------------------------
*/
-#define NRE_USE_SMALL_ALLOC 1 /* Only turn off for debugging purposes. */
-#define NRE_ENABLE_ASSERTS 1
+#define NRE_USE_SMALL_ALLOC 1 /* Only turn off for debugging purposes. */
+#define NRE_ENABLE_ASSERTS 1
/*
* This is the main data struct for representing NR commands. It is designed
@@ -4154,10 +4144,12 @@ typedef struct TEOV_callback {
}
#if NRE_USE_SMALL_ALLOC
-#define TCLNR_ALLOC(interp, ptr) TclSmallAllocEx(interp, sizeof(TEOV_callback), (ptr))
+#define TCLNR_ALLOC(interp, ptr) \
+ TclSmallAllocEx(interp, sizeof(TEOV_callback), (ptr))
#define TCLNR_FREE(interp, ptr) TclSmallFreeEx((interp), (ptr))
#else
-#define TCLNR_ALLOC(interp, ptr) (ptr = ((ClientData) ckalloc(sizeof(TEOV_callback))))
+#define TCLNR_ALLOC(interp, ptr) \
+ (ptr = ((ClientData) ckalloc(sizeof(TEOV_callback))))
#define TCLNR_FREE(interp, ptr) ckfree((char *) (ptr))
#endif
@@ -4167,8 +4159,6 @@ typedef struct TEOV_callback {
#define NRE_ASSERT(expr)
#endif
-
-
#include "tclPort.h"
#include "tclIntDecls.h"
#include "tclIntPlatDecls.h"
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 535f8cc..55f9200 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -23,7 +23,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclNamesp.c,v 1.175 2008/08/20 15:41:25 dkf Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.176 2008/08/23 11:35:54 dkf Exp $
*/
#include "tclInt.h"
@@ -6009,7 +6009,7 @@ TclMakeEnsemble(
TclNewObj(mapDict);
for (i=0 ; map[i].name != NULL ; i++) {
Tcl_Obj *fromObj, *toObj;
- Command *cmdPtr;
+ register Command *cmdPtr;
fromObj = Tcl_NewStringObj(map[i].name, -1);
TclNewStringObj(toObj, Tcl_DStringValue(&buf),
@@ -6019,6 +6019,7 @@ TclMakeEnsemble(
cmdPtr = (Command *) Tcl_CreateObjCommand(interp,
TclGetString(toObj), map[i].proc, NULL, NULL);
cmdPtr->compileProc = map[i].compileProc;
+ cmdPtr->nreProc = map[i].nreProc;
compile |= (map[i].compileProc != NULL);
}
Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict);
generated by cgit v0.12 at 2024-08-21 18:49:31 (GMT)