diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | generic/tcl.decls | 6 | ||||
| -rw-r--r-- | generic/tclBasic.c | 98 | ||||
| -rw-r--r-- | generic/tclDecls.h | 19 | ||||
| -rw-r--r-- | generic/tclExecute.c | 7 | ||||
| -rw-r--r-- | generic/tclInt.h | 5 | ||||
| -rw-r--r-- | generic/tclNRE.h | 15 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 18 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 4 |
9 files changed, 106 insertions, 75 deletions
@@ -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 */ }; |