summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2008-07-21 16:25:58 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2008-07-21 16:25:58 (GMT)
commit1d5e719008a7c51b66cc13a0a30991af762353c1 (patch)
tree8fd30c46b1bdb91d7e870818b760478eb06a9f16
parent884b6dff3c37ee13afd4737b75fd7c23ed011c5d (diff)
downloadtcl-1d5e719008a7c51b66cc13a0a30991af762353c1.zip
tcl-1d5e719008a7c51b66cc13a0a30991af762353c1.tar.gz
tcl-1d5e719008a7c51b66cc13a0a30991af762353c1.tar.bz2
* generic/tcl.decls: Changed the implementation of
* generic/tclBasic.c: [namespace import]; removed * generic/tclDecls.h: Tcl_NRObjProc, replaced with * generic/tclExecute.c: Tcl_NRCmdSwap (proposed public * generic/tclInt.h: NRE API). This should fix * generic/tclNRE.h: [Bug 582506]. * generic/tclNamesp.c: * generic/tclStubInit.c:
-rw-r--r--ChangeLog9
-rw-r--r--generic/tcl.decls6
-rw-r--r--generic/tclBasic.c98
-rw-r--r--generic/tclDecls.h19
-rw-r--r--generic/tclExecute.c7
-rw-r--r--generic/tclInt.h5
-rw-r--r--generic/tclNRE.h15
-rw-r--r--generic/tclNamesp.c18
-rw-r--r--generic/tclStubInit.c4
9 files changed, 106 insertions, 75 deletions
diff --git a/ChangeLog b/ChangeLog
index 7559188..d70a848 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -4,6 +4,15 @@
2008-07-21 Miguel Sofer <msofer@users.sf.net>
+ * generic/tcl.decls: Changed the implementation of
+ * generic/tclBasic.c: [namespace import]; removed
+ * generic/tclDecls.h: Tcl_NRObjProc, replaced with
+ * generic/tclExecute.c: Tcl_NRCmdSwap (proposed public
+ * generic/tclInt.h: NRE API). This should fix
+ * generic/tclNRE.h: [Bug 582506].
+ * generic/tclNamesp.c:
+ * generic/tclStubInit.c:
+
* generic/tclBasic.c: NRE: enabled calling NR commands
* generic/tclExecute.c: from the callbacks. Completely
* generic/tclInt.h: redone tailcall implementation
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 5ca73c7..c7f5d34 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.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: tcl.decls,v 1.135 2008/07/18 13:46:39 msofer Exp $
+# RCS: @(#) $Id: tcl.decls,v 1.136 2008/07/21 16:25:59 msofer Exp $
library tcl
@@ -2123,8 +2123,8 @@ declare 584 generic {
int flags)
}
declare 585 generic {
- int Tcl_NRObjProc(Tcl_Interp *interp, Tcl_ObjCmdProc *objProc,
- ClientData clientData)
+ int Tcl_NRCmdSwap(Tcl_Interp *interp, Tcl_Command cmd, int objc,
+ Tcl_Obj *CONST objv[])
}
declare 586 generic {
void Tcl_NRAddCallback(Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr,
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 554e5d2..7b08f66 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.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: tclBasic.c,v 1.318 2008/07/21 03:49:52 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.319 2008/07/21 16:26:01 msofer Exp $
*/
#include "tclInt.h"
@@ -3918,10 +3918,27 @@ Tcl_EvalObjv(
* TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE and
* TCL_EVAL_NOERR are currently supported. */
{
- Command *cmdPtr;
+ return TclEvalObjv(interp, objc, objv, flags, NULL);
+}
+
+int
+TclEvalObjv(
+ Tcl_Interp *interp, /* Interpreter in which to evaluate the
+ * command. Also used for error reporting. */
+ int objc, /* Number of words in command. */
+ Tcl_Obj *const objv[], /* An array of pointers to objects that are
+ * the words that make up the command. */
+ int flags, /* Collection of OR-ed bits that control the
+ * evaluation of the script. Only
+ * TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE and
+ * TCL_EVAL_NOERR are currently supported. */
+ Command *cmdPtr) /* NULL if the Command is to be looked up
+ * here, otherwise the pointer to the
+ * requested Command struct to be invoked. */
+{
Interp *iPtr = (Interp *) interp;
int result;
- Namespace *lookupNsPtr;
+ Namespace *lookupNsPtr = NULL;
TEOV_record *rootPtr = TOP_RECORD(iPtr);
TEOV_record *recordPtr;
Tcl_ObjCmdProc *objProc;
@@ -3930,6 +3947,14 @@ Tcl_EvalObjv(
TEBC_CALL(iPtr) = 0;
+ if (cmdPtr) {
+ if (iPtr->lookupNsPtr) {
+ iPtr->lookupNsPtr = NULL;
+ }
+ PUSH_RECORD(interp, recordPtr);
+ goto commandFound;
+ }
+
restartAtTop:
TclResetCancellation(interp, 0);
iPtr->numLevels++;
@@ -3993,6 +4018,18 @@ Tcl_EvalObjv(
goto done;
}
+ iPtr->cmdCount++;
+ if (TclLimitExceeded(iPtr->limit)) {
+ result = TCL_ERROR;
+ iPtr->numLevels--;
+ goto done;
+ }
+
+ /*
+ * Found a command! The real work begins now ...
+ */
+
+ commandFound:
if (iPtr->tracePtr || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
/*
* Call enter traces. They will schedule a call to the leave traces if
@@ -4009,10 +4046,6 @@ Tcl_EvalObjv(
}
}
- /*
- * Found a command! The real work begins now ...
- */
-
if (TCL_DTRACE_CMD_ARGS_ENABLED()) {
char *a[10];
int i = 0;
@@ -4050,13 +4083,6 @@ Tcl_EvalObjv(
* where it really belongs, and do not really know what it does either.
*/
- iPtr->cmdCount++;
- if (TclLimitExceeded(iPtr->limit)) {
- result = TCL_ERROR;
- iPtr->numLevels--;
- goto done;
- }
-
objProc = cmdPtr->nreProc;
if (!objProc) {
objProc = cmdPtr->objProc;
@@ -4066,13 +4092,12 @@ Tcl_EvalObjv(
COMPLETE_RECORD(recordPtr);
cmdPtr->refCount++;
- objProcReentryPoint:
/*
* If this is an NR-enabled command, find the real objProc.
*/
result = (*objProc)(objClientData, interp, objc, objv);
- if ((result != TCL_OK) || !VALID_NEW_REQUEST(recordPtr)) {
+ if (result != TCL_OK) {
#if 0
TclStackPurge(interp, recordPtr->tosPtr);
#endif
@@ -4150,16 +4175,16 @@ Tcl_EvalObjv(
}
goto done;
}
- case TCL_NR_OBJPROC_TYPE:
+ case TCL_NR_CMDSWAP_TYPE:
/*
- * This is a rewrite like ns-import does, without a new cmdPtr or new
- * reentrant call. FIXME NRE: add edition of objc/objv?
+ * This is a cmdPtr swap like ns-import does.
*/
- objProc = recordPtr->data.objProc.objProc;
- objClientData = recordPtr->data.objProc.clientData;
+ cmdPtr = recordPtr->cmdPtr;
+ objc = recordPtr->data.objcv.objc;
+ objv = recordPtr->data.objcv.objv;
recordPtr->type = TCL_NR_NO_TYPE;
- goto objProcReentryPoint;
+ goto commandFound;
default:
Tcl_Panic("TEOV: unknown NR-request type %i!", recordPtr->type);
}
@@ -4229,6 +4254,7 @@ TclEvalObjv_NR2(
case TCL_NR_BC_TYPE:
case TCL_NR_CMD_TYPE:
case TCL_NR_SCRIPT_TYPE:
+ case TCL_NR_CMDSWAP_TYPE:
goto done;
case TCL_NR_TAILCALL_TYPE:
Tcl_Panic("Tailcall called from a callback!");
@@ -7419,7 +7445,7 @@ NRPostProcess(
"impossible to tailcall from a non-NRE enabled command",
TCL_STATIC);
result = TCL_ERROR;
- break;
+ break;
case TCL_NR_CMD_TYPE: {
Tcl_Obj *objPtr = recordPtr->data.obj.objPtr;
int flags = recordPtr->data.obj.flags;
@@ -7437,14 +7463,9 @@ NRPostProcess(
result = TclNREvalObjEx(interp, objPtr, flags, NULL, 0);
break;
}
- case TCL_NR_OBJPROC_TYPE: {
- Tcl_ObjCmdProc *objProc = recordPtr->data.objProc.objProc;
- ClientData clientData = recordPtr->data.objProc.clientData;
-
- if (!objc) {
- Tcl_Panic("NRPostProcess: something is very wrong!");
- }
- result = (*objProc)(clientData, interp, objc, objv);
+ case TCL_NR_CMDSWAP_TYPE: {
+ result = TclEvalObjv(interp, recordPtr->data.objcv.objc,
+ recordPtr->data.objcv.objv, 0, recordPtr->cmdPtr);
break;
}
default:
@@ -7593,16 +7614,19 @@ Tcl_NREvalObj(
}
int
-Tcl_NRObjProc(
+Tcl_NRCmdSwap(
Tcl_Interp *interp,
- Tcl_ObjCmdProc *objProc,
- ClientData clientData)
+ Tcl_Command cmd,
+ int objc,
+ Tcl_Obj *const objv[])
{
TEOV_record *recordPtr = TOP_RECORD(interp);
- recordPtr->type = TCL_NR_OBJPROC_TYPE;
- recordPtr->data.objProc.objProc = objProc;
- recordPtr->data.objProc.clientData = clientData;
+ recordPtr->type = TCL_NR_CMDSWAP_TYPE;
+ recordPtr->cmdPtr = (Command *) cmd;
+ recordPtr->data.objcv.objc = objc;
+ recordPtr->data.objcv.objv = (Tcl_Obj **) objv;
+
return TCL_OK;
}
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 31e3751..b644952 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -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: tclDecls.h,v 1.136 2008/07/18 13:46:43 msofer Exp $
+ * RCS: @(#) $Id: tclDecls.h,v 1.137 2008/07/21 16:26:01 msofer Exp $
*/
#ifndef _TCLDECLS
@@ -3534,12 +3534,11 @@ EXTERN int Tcl_NREvalObj (Tcl_Interp * interp, Tcl_Obj * objPtr,
EXTERN int Tcl_NREvalObjv (Tcl_Interp * interp, int objc,
Tcl_Obj *CONST objv[], int flags);
#endif
-#ifndef Tcl_NRObjProc_TCL_DECLARED
-#define Tcl_NRObjProc_TCL_DECLARED
+#ifndef Tcl_NRCmdSwap_TCL_DECLARED
+#define Tcl_NRCmdSwap_TCL_DECLARED
/* 585 */
-EXTERN int Tcl_NRObjProc (Tcl_Interp * interp,
- Tcl_ObjCmdProc * objProc,
- ClientData clientData);
+EXTERN int Tcl_NRCmdSwap (Tcl_Interp * interp, Tcl_Command cmd,
+ int objc, Tcl_Obj *CONST objv[]);
#endif
#ifndef Tcl_NRAddCallback_TCL_DECLARED
#define Tcl_NRAddCallback_TCL_DECLARED
@@ -4201,7 +4200,7 @@ typedef struct TclStubs {
Tcl_Command (*tcl_NRCreateCommand) (Tcl_Interp * interp, CONST char * cmdName, Tcl_ObjCmdProc * proc, Tcl_ObjCmdProc * nreProc, ClientData clientData, Tcl_CmdDeleteProc * deleteProc); /* 582 */
int (*tcl_NREvalObj) (Tcl_Interp * interp, Tcl_Obj * objPtr, int flags); /* 583 */
int (*tcl_NREvalObjv) (Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], int flags); /* 584 */
- int (*tcl_NRObjProc) (Tcl_Interp * interp, Tcl_ObjCmdProc * objProc, ClientData clientData); /* 585 */
+ int (*tcl_NRCmdSwap) (Tcl_Interp * interp, Tcl_Command cmd, int objc, Tcl_Obj *CONST objv[]); /* 585 */
void (*tcl_NRAddCallback) (Tcl_Interp * interp, Tcl_NRPostProc * postProcPtr, ClientData data0, ClientData data1, ClientData data2, ClientData data3); /* 586 */
int (*tcl_NRCallObjProc) (Tcl_Interp * interp, Tcl_ObjCmdProc * objProc, ClientData clientData, int objc, Tcl_Obj *const objv[]); /* 587 */
} TclStubs;
@@ -6616,9 +6615,9 @@ extern CONST TclStubs *tclStubsPtr;
#define Tcl_NREvalObjv \
(tclStubsPtr->tcl_NREvalObjv) /* 584 */
#endif
-#ifndef Tcl_NRObjProc
-#define Tcl_NRObjProc \
- (tclStubsPtr->tcl_NRObjProc) /* 585 */
+#ifndef Tcl_NRCmdSwap
+#define Tcl_NRCmdSwap \
+ (tclStubsPtr->tcl_NRCmdSwap) /* 585 */
#endif
#ifndef Tcl_NRAddCallback
#define Tcl_NRAddCallback \
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 6243266..0be6655 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclExecute.c,v 1.383 2008/07/21 03:43:30 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.384 2008/07/21 16:26:02 msofer Exp $
*/
#include "tclInt.h"
@@ -7775,6 +7775,7 @@ TclExecuteByteCode(
bottomPtr = oldBottomPtr; /* back to old bc */
/* Please free anything that might still be on my new stack */
+ resumeCleanup:
if (TOP_RECORD(iPtr) != bottomPtr->recordPtr) {
CACHE_STACK_INFO();
result = TclEvalObjv_NR2(interp, result, bottomPtr->recordPtr);
@@ -7809,6 +7810,10 @@ TclExecuteByteCode(
#endif
tailcall = 1;
goto restoreStateVariables;
+ case TCL_NR_CMDSWAP_TYPE:
+ result = TclEvalObjv(interp, recordPtr->data.objcv.objc,
+ recordPtr->data.objcv.objv, 0, recordPtr->cmdPtr);
+ goto resumeCleanup;
default:
Tcl_Panic("TEBC: TEOV_NR2 sent us a record we cannot handle!");
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 93fa71b..1857153 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -14,7 +14,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.374 2008/07/21 03:43:31 msofer Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.375 2008/07/21 16:26:06 msofer Exp $
*/
#ifndef _TCLINT
@@ -2477,9 +2477,12 @@ MODULE_SCOPE char tclEmptyString;
*----------------------------------------------------------------
*/
+/* Introduced by/for NRE */
MODULE_SCOPE Tcl_ObjCmdProc TclNRNamespaceObjCmd;
MODULE_SCOPE int TclNREvalCmd(Tcl_Interp * interp, Tcl_Obj * objPtr,
int flags);
+MODULE_SCOPE int TclEvalObjv(Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[], int flags, Command *cmdPtr);
MODULE_SCOPE void TclAdvanceLines(int *line, const char *start,
const char *end);
diff --git a/generic/tclNRE.h b/generic/tclNRE.h
index 4d44ab2..e0d692d 100644
--- a/generic/tclNRE.h
+++ b/generic/tclNRE.h
@@ -11,7 +11,7 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* // FIXME: RCS numbering?
- * RCS: @(#) $Id: tclNRE.h,v 1.5 2008/07/21 03:43:32 msofer Exp $
+ * RCS: @(#) $Id: tclNRE.h,v 1.6 2008/07/21 16:26:08 msofer Exp $
*/
@@ -108,9 +108,9 @@ typedef struct TEOV_record {
int flags;
} obj;
struct {
- Tcl_ObjCmdProc *objProc;
- ClientData clientData;
- } objProc;
+ int objc;
+ Tcl_Obj **objv;
+ } objcv;
} data;
#if !USE_SMALL_ALLOC
/* Extra checks: can disappear later */
@@ -126,11 +126,11 @@ typedef struct TEOV_record {
#define TCL_NR_NO_TYPE 0 /* for internal (cleanup) use only */
#define TCL_NR_BC_TYPE 2 /* procs, lambdas, TclOO+Itcl sometime ... */
-#define TCL_NR_OBJPROC_TYPE 4 /* ns-imports (cmdd redirect) */
+#define TCL_NR_CMDSWAP_TYPE 4 /* ns-imports (cmdd redirect) */
#define TCL_NR_TAILCALL_TYPE 6
#define TCL_NR_TEBC_SWAPENV_TYPE 8 /* continuations, micro-threads !? */
-#define TCL_NR_CMD_TYPE 1 /* i-alias, ns-ens use this */
+#define TCL_NR_CMD_TYPE 1 /* i-alias, ns-ens use this */
#define TCL_NR_SCRIPT_TYPE 3 /* ns-eval, uplevel use this */
#define TCL_NR_HAS_OBJ(TYPE) ((TYPE) & 1)
@@ -223,9 +223,6 @@ typedef struct TEOV_record {
TCLNR_FREE(((Tcl_Interp *)iPtr), recordPtr); \
}
-#define VALID_NEW_REQUEST(recordPtr) \
- ( (recordPtr)->callbackPtr || ((recordPtr)->type != TCL_NR_NO_TYPE))
-
#define CHECK_VALID_RETURN(iPtr, recordPtr) \
((TOP_RECORD(iPtr) == recordPtr) && \
CHECK_EXTRA(iPtr, recordPtr))
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index f657e75..cf7e250 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.169 2008/07/19 22:50:41 nijtmans Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.170 2008/07/21 16:26:08 msofer Exp $
*/
#include "tclInt.h"
@@ -1894,14 +1894,10 @@ InvokeImportedNRCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
- register ImportedCmdData *dataPtr = clientData;
- register Command *realCmdPtr = dataPtr->realCmdPtr;
+ ImportedCmdData *dataPtr = clientData;
+ Command *realCmdPtr = dataPtr->realCmdPtr;
- if (!realCmdPtr->nreProc) {
- return realCmdPtr->objProc(realCmdPtr->objClientData, interp,
- objc, objv);
- }
- return realCmdPtr->nreProc(realCmdPtr->objClientData, interp, objc, objv);
+ return Tcl_NRCmdSwap(interp, (Tcl_Command) realCmdPtr, objc, objv);
}
static int
@@ -1912,10 +1908,8 @@ InvokeImportedCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
- register ImportedCmdData *dataPtr = clientData;
- register Command *realCmdPtr = dataPtr->realCmdPtr;
-
- return realCmdPtr->objProc(realCmdPtr->objClientData, interp, objc, objv);
+ return Tcl_NRCallObjProc(interp, InvokeImportedNRCmd, clientData,
+ objc, objv);
}
/*
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 84aca49..7d310d7 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.157 2008/07/18 13:46:47 msofer Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.158 2008/07/21 16:26:09 msofer Exp $
*/
#include "tclInt.h"
@@ -1111,7 +1111,7 @@ static const TclStubs tclStubs = {
Tcl_NRCreateCommand, /* 582 */
Tcl_NREvalObj, /* 583 */
Tcl_NREvalObjv, /* 584 */
- Tcl_NRObjProc, /* 585 */
+ Tcl_NRCmdSwap, /* 585 */
Tcl_NRAddCallback, /* 586 */
Tcl_NRCallObjProc, /* 587 */
};