summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2016-07-07 07:48:53 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2016-07-07 07:48:53 (GMT)
commit72476cdd50825cebaea367188325e69ea5a8ff40 (patch)
tree52448af5d0bd3975ccd1af4b672ca33a90507530 /generic
parent7519883347a28417d8c6d8a3de4460386f66ad29 (diff)
parent0aa3b5113db3c6c750aa4bbcfdb657dec48c0de1 (diff)
downloadtcl-72476cdd50825cebaea367188325e69ea5a8ff40.zip
tcl-72476cdd50825cebaea367188325e69ea5a8ff40.tar.gz
tcl-72476cdd50825cebaea367188325e69ea5a8ff40.tar.bz2
Merge core-8-6-branch:
New tests to demo the remaining flaw in ensemble dispatch revisions. Itcl 4 also demonstrated these [bd7f17bce8] Revise ensemble dispatch to call TclNREvalObjv() which supports the TCL_EVAL_INVOKE Simplify all the Tcl_NRPostProc declarations Create and use a utility Tcl_NRPostProc when decr ref count of values is all that is needed Bugfix [5d7ea04580]. Treat .cmd and .ps1 files are executable on Windows
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c21
-rw-r--r--generic/tclCmdIL.c3
-rw-r--r--generic/tclCmdMZ.c12
-rw-r--r--generic/tclDictObj.c18
-rw-r--r--generic/tclEnsemble.c33
-rw-r--r--generic/tclIOUtil.c3
-rw-r--r--generic/tclInt.h4
-rw-r--r--generic/tclOO.c9
-rw-r--r--generic/tclOOCall.c9
-rw-r--r--generic/tclOOMethod.c6
-rw-r--r--generic/tclTest.c3
11 files changed, 47 insertions, 74 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index e3ac714..a0b5505 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -128,7 +128,7 @@ static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
int actual, Tcl_Obj *const *objv);
static Tcl_NRPostProc NRCoroutineCallerCallback;
static Tcl_NRPostProc NRCoroutineExitCallback;
-static int NRCommand(ClientData data[], Tcl_Interp *interp, int result);
+static Tcl_NRPostProc NRCommand;
static Tcl_ObjCmdProc OldMathFuncProc;
static void OldMathFuncDeleteProc(ClientData clientData);
@@ -146,7 +146,6 @@ static int TEOV_RunEnterTraces(Tcl_Interp *interp,
Command **cmdPtrPtr, Tcl_Obj *commandPtr, int objc,
Tcl_Obj *const objv[]);
static Tcl_NRPostProc RewindCoroutineCallback;
-static Tcl_NRPostProc TailcallCleanup;
static Tcl_NRPostProc TEOEx_ByteCodeCallback;
static Tcl_NRPostProc TEOEx_ListCallback;
static Tcl_NRPostProc TEOV_Error;
@@ -8372,7 +8371,7 @@ TclNRTailcallEval(
* a now-gone namespace: cleanup and return.
*/
- TailcallCleanup(data, interp, result);
+ Tcl_DecrRefCount(listPtr);
return result;
}
@@ -8381,18 +8380,26 @@ TclNRTailcallEval(
*/
TclMarkTailcall(interp);
- TclNRAddCallback(interp, TailcallCleanup, listPtr, NULL, NULL,NULL);
+ TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL);
iPtr->lookupNsPtr = (Namespace *) nsPtr;
return TclNREvalObjv(interp, objc-1, objv+1, 0, NULL);
}
-static int
-TailcallCleanup(
+int
+TclNRReleaseValues(
ClientData data[],
Tcl_Interp *interp,
int result)
{
- Tcl_DecrRefCount((Tcl_Obj *) data[0]);
+ int i = 0;
+ while (i < 4) {
+ if (data[i]) {
+ Tcl_DecrRefCount((Tcl_Obj *) data[i]);
+ } else {
+ break;
+ }
+ i++;
+ }
return result;
}
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 4cb81ea..7420538 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -105,8 +105,7 @@ typedef struct SortInfo {
*/
static int DictionaryCompare(const char *left, const char *right);
-static int IfConditionCallback(ClientData data[],
- Tcl_Interp *interp, int result);
+static Tcl_NRPostProc IfConditionCallback;
static int InfoArgsCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int InfoBodyCmd(ClientData dummy, Tcl_Interp *interp,
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 13f9e7d..885a0bc 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -22,14 +22,10 @@
static inline Tcl_Obj * During(Tcl_Interp *interp, int resultCode,
Tcl_Obj *oldOptions, Tcl_Obj *errorInfo);
-static int SwitchPostProc(ClientData data[], Tcl_Interp *interp,
- int result);
-static int TryPostBody(ClientData data[], Tcl_Interp *interp,
- int result);
-static int TryPostFinal(ClientData data[], Tcl_Interp *interp,
- int result);
-static int TryPostHandler(ClientData data[], Tcl_Interp *interp,
- int result);
+static Tcl_NRPostProc SwitchPostProc;
+static Tcl_NRPostProc TryPostBody;
+static Tcl_NRPostProc TryPostFinal;
+static Tcl_NRPostProc TryPostHandler;
static int UniCharIsAscii(int character);
static int UniCharIsHexDigit(int character);
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index c8474e6..428173d 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -70,18 +70,12 @@ static inline void DeleteChainTable(struct Dict *dict);
static inline Tcl_HashEntry *CreateChainEntry(struct Dict *dict,
Tcl_Obj *keyPtr, int *newPtr);
static inline int DeleteChainEntry(struct Dict *dict, Tcl_Obj *keyPtr);
-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 DictMapNRCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *const *objv);
-static int DictForLoopCallback(ClientData data[],
- Tcl_Interp *interp, int result);
-static int DictMapLoopCallback(ClientData data[],
- Tcl_Interp *interp, int result);
+static Tcl_NRPostProc FinalizeDictUpdate;
+static Tcl_NRPostProc FinalizeDictWith;
+static Tcl_ObjCmdProc DictForNRCmd;
+static Tcl_ObjCmdProc DictMapNRCmd;
+static Tcl_NRPostProc DictForLoopCallback;
+static Tcl_NRPostProc DictMapLoopCallback;
/*
* Table of dict subcommand names and implementations.
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index a9698be..ee81aee 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -41,7 +41,6 @@ static int CompileBasicNArgCommand(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
CompileEnv *envPtr);
-static Tcl_NRPostProc FreeObj;
static Tcl_NRPostProc FreeER;
/*
@@ -1848,25 +1847,24 @@ NsEnsembleImplementationCmdNR(
{
Tcl_Obj *copyPtr; /* The actual list of words to dispatch to.
* Will be freed by the dispatch engine. */
- int prefixObjc;
+ Tcl_Obj **copyObjv;
+ int copyObjc, prefixObjc;
Tcl_ListObjLength(NULL, prefixObj, &prefixObjc);
if (objc == 2) {
- copyPtr = prefixObj;
- Tcl_IncrRefCount(copyPtr);
- TclNRAddCallback(interp, FreeObj, copyPtr, NULL, NULL, NULL);
+ copyPtr = TclListObjCopy(NULL, prefixObj);
} else {
- int copyObjc = objc - 2 + prefixObjc;
-
- copyPtr = Tcl_NewListObj(copyObjc, NULL);
+ copyPtr = Tcl_NewListObj(objc - 2 + prefixObjc, NULL);
Tcl_ListObjAppendList(NULL, copyPtr, prefixObj);
Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
- ensemblePtr->numParameters, objv+1);
+ ensemblePtr->numParameters, objv + 1);
Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
objc - 2 - ensemblePtr->numParameters,
objv + 2 + ensemblePtr->numParameters);
}
+ Tcl_IncrRefCount(copyPtr);
+ TclNRAddCallback(interp, TclNRReleaseValues, copyPtr, NULL, NULL, NULL);
TclDecrRefCount(prefixObj);
/*
@@ -1886,7 +1884,8 @@ NsEnsembleImplementationCmdNR(
*/
TclSkipTailcall(interp);
- return TclNREvalObjEx(interp, copyPtr, TCL_EVAL_INVOKE, NULL,INT_MIN);
+ Tcl_ListObjGetElements(NULL, copyPtr, &copyObjc, &copyObjv);
+ return TclNREvalObjv(interp, copyObjc, copyObjv, TCL_EVAL_INVOKE, NULL);
}
unknownOrAmbiguousSubcommand:
@@ -2064,18 +2063,6 @@ FreeER(
return result;
}
-static int
-FreeObj(
- ClientData data[],
- Tcl_Interp *interp,
- int result)
-{
- Tcl_Obj *objPtr = (Tcl_Obj *)data[0];
-
- Tcl_DecrRefCount(objPtr);
- return result;
-}
-
void
TclSpellFix(
Tcl_Interp *interp,
@@ -2151,7 +2138,7 @@ TclSpellFix(
store[idx] = fix;
Tcl_IncrRefCount(fix);
- TclNRAddCallback(interp, FreeObj, fix, NULL, NULL, NULL);
+ TclNRAddCallback(interp, TclNRReleaseValues, fix, NULL, NULL, NULL);
}
/*
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 1330c02..3aa0ce5 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -71,8 +71,7 @@ typedef struct ThreadSpecificData {
* Prototypes for functions defined later in this file.
*/
-static int EvalFileCallback(ClientData data[],
- Tcl_Interp *interp, int result);
+static Tcl_NRPostProc EvalFileCallback;
static FilesystemRecord*FsGetFirstFilesystem(void);
static void FsThrExitProc(ClientData cd);
static Tcl_Obj * FsListMounts(Tcl_Obj *pathPtr, const char *pattern);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 100197d..5ccd637 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2754,6 +2754,7 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRInvoke;
+MODULE_SCOPE Tcl_NRPostProc TclNRReleaseValues;
MODULE_SCOPE void TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr);
MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp);
@@ -2864,8 +2865,7 @@ MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp,
MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp,
Tcl_Channel chan);
MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
-MODULE_SCOPE int TclClearRootEnsemble(ClientData data[],
- Tcl_Interp *interp, int result);
+MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble;
MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, int num,
int *loc);
MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr,
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 9dae778..ef0c987 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -68,12 +68,9 @@ static int CloneObjectMethod(Tcl_Interp *interp, Object *oPtr,
static void DeletedDefineNamespace(ClientData clientData);
static void DeletedObjdefNamespace(ClientData clientData);
static void DeletedHelpersNamespace(ClientData clientData);
-static int FinalizeAlloc(ClientData data[],
- Tcl_Interp *interp, int result);
-static int FinalizeNext(ClientData data[],
- Tcl_Interp *interp, int result);
-static int FinalizeObjectCall(ClientData data[],
- Tcl_Interp *interp, int result);
+static Tcl_NRPostProc FinalizeAlloc;
+static Tcl_NRPostProc FinalizeNext;
+static Tcl_NRPostProc FinalizeObjectCall;
static int InitFoundation(Tcl_Interp *interp);
static void KillFoundation(ClientData clientData,
Tcl_Interp *interp);
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index facf90d..1797760 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -70,15 +70,12 @@ static void AddSimpleClassChainToCallContext(Class *classPtr,
Class *const filterDecl);
static int CmpStr(const void *ptr1, const void *ptr2);
static void DupMethodNameRep(Tcl_Obj *srcPtr, Tcl_Obj *dstPtr);
-static int FinalizeMethodRefs(ClientData data[],
- Tcl_Interp *interp, int result);
+static Tcl_NRPostProc FinalizeMethodRefs;
static void FreeMethodNameRep(Tcl_Obj *objPtr);
static inline int IsStillValid(CallChain *callPtr, Object *oPtr,
int flags, int reuseMask);
-static int ResetFilterFlags(ClientData data[],
- Tcl_Interp *interp, int result);
-static int SetFilterFlags(ClientData data[],
- Tcl_Interp *interp, int result);
+static Tcl_NRPostProc ResetFilterFlags;
+static Tcl_NRPostProc SetFilterFlags;
static inline void StashCallChain(Tcl_Obj *objPtr, CallChain *callPtr);
/*
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index a311ddb..99a8bfc 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -70,10 +70,8 @@ static Tcl_Obj ** InitEnsembleRewrite(Tcl_Interp *interp, int objc,
static int InvokeProcedureMethod(ClientData clientData,
Tcl_Interp *interp, Tcl_ObjectContext context,
int objc, Tcl_Obj *const *objv);
-static int FinalizeForwardCall(ClientData data[], Tcl_Interp *interp,
- int result);
-static int FinalizePMCall(ClientData data[], Tcl_Interp *interp,
- int result);
+static Tcl_NRPostProc FinalizeForwardCall;
+static Tcl_NRPostProc FinalizePMCall;
static int PushMethodCallFrame(Tcl_Interp *interp,
CallContext *contextPtr, ProcedureMethod *pmPtr,
int objc, Tcl_Obj *const *objv,
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 33eaadd..d3da641 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -408,8 +408,7 @@ static int TestHashSystemHashCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int NREUnwind_callback(ClientData data[], Tcl_Interp *interp,
- int result);
+static Tcl_NRPostProc NREUnwind_callback;
static int TestNREUnwind(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);