Tcl Source Code

Check-in [af7ffdb548]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2018 Conference, Houston/TX, US, Oct 15-19
Send your abstracts to tclconference@googlegroups.com
or submit via the online form by Aug 20.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Make sure all Tcl_NR*Eval*() routines do a schedule only. No errors raised.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:af7ffdb548b4a5e6cf7049119c08571bf3c851fb
User & Date: dgp 2013-08-23 16:23:47
Context
2013-10-22
12:10
Merge af7ffd check-in: b9f0a93b97 user: dgp tags: dgp-stack-depth-tester
2013-08-24
09:42
Unbreak doc; the apropos index entry *must* be one line. (This is an external constraint forced by ... check-in: 608930382f user: dkf tags: trunk
2013-08-23
18:30
stop looking at the C-stack depth Leaf check-in: 23832ea106 user: mig tags: mig-stacklevels
16:33
merge trunk check-in: 83dc51357b user: dgp tags: bug-2502002
16:29
merge trunk check-in: 8d1656cc0c user: dgp tags: dgp-refactor
16:23
Make sure all Tcl_NR*Eval*() routines do a schedule only. No errors raised. check-in: af7ffdb548 user: dgp tags: trunk
13:08
fix NRE docs check-in: 2f58df3b39 user: mig tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclBasic.c.

153
154
155
156
157
158
159

160
161
162
163
164
165
166
....
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
4115
4116
4117


















4118

4119

4120
4121
4122
4123






4124
4125
4126
4127
4128
4129
4130
....
4160
4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
....
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212

4213
4214
4215
4216
4217
4218
4219
....
4234
4235
4236
4237
4238
4239
4240

4241
4242
4243
4244
4245
4246
4247
static Tcl_NRPostProc	TEOEx_ByteCodeCallback;
static Tcl_NRPostProc	TEOEx_ListCallback;
static Tcl_NRPostProc	TEOV_Error;
static Tcl_NRPostProc	TEOV_Exception;
static Tcl_NRPostProc	TEOV_NotFoundCallback;
static Tcl_NRPostProc	TEOV_RestoreVarFrame;
static Tcl_NRPostProc	TEOV_RunLeaveTraces;

static Tcl_NRPostProc	Dispatch;

static Tcl_ObjCmdProc NRCoroInjectObjCmd;

MODULE_SCOPE const TclStubs tclStubs;

/*
................................................................................
				 * 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 = iPtr->lookupNsPtr;
    
    iPtr->lookupNsPtr = NULL;

    /*
     * Push a callback with cleanup tasks for commands; the cmdPtr at data[0]
     * will be filled later when the command is found: save its address at
     * objProcPtr.
     *
     * data[1] stores a marker for use by tailcalls; it will be set to 1 by
     * command redirectors (imports, alias, ensembles) so that tailcalls
     * finishes the source command and not just the target.
     */

    if (iPtr->deferredCallbacks) {
        iPtr->deferredCallbacks = NULL;
    } else {
	TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
    }

    iPtr->numLevels++;


















    result = TclInterpReady(interp);



    if ((result != TCL_OK) || (objc == 0)) {
	return result;
    }







    if (cmdPtr) {
	goto commandFound;
    }

    /*
     * Push records for task to be done on return, in INVERSE order. First, if
     * needed, the exception handlers (as they should happen last).
................................................................................
     */

    cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
    if (!cmdPtr) {
	return TEOV_NotFound(interp, objc, objv, lookupNsPtr);
    }

    iPtr->cmdCount++;
    if (TclLimitExceeded(iPtr->limit)) {
	return TCL_ERROR;
    }

    /*
     * Found a command! The real work begins now ...
     */

  commandFound:
    if (iPtr->tracePtr || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
	/*
................................................................................
    Tcl_Interp *interp,
    int result)
{
    Tcl_ObjCmdProc *objProc = data[0];
    ClientData clientData = data[1];
    int objc = PTR2INT(data[2]);
    Tcl_Obj **objv = data[3];
#ifdef USE_DTRACE
    Interp *iPtr = (Interp *) interp;


    if (TCL_DTRACE_CMD_ARGS_ENABLED()) {
	const char *a[10];
	int i = 0;

	while (i < 10) {
	    a[i] = i < objc ? TclGetString(objv[i]) : NULL; i++;
	}
................................................................................
    }
    if (TCL_DTRACE_CMD_ENTRY_ENABLED() && objc) {
	TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1,
		(Tcl_Obj **)(objv + 1));
    }
#endif /* USE_DTRACE */


    return objProc(clientData, interp, objc, objv);
}

int
TclNRRunCallbacks(
    Tcl_Interp *interp,
    int result,







>







 







<
<
|
<
<

<
<
<
<












>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
|
>
|
|


>
>
>
>
>
>







 







<
<
<
<
<







 







<


>







 







>







153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
....
4090
4091
4092
4093
4094
4095
4096


4097


4098




4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
4144
4145
4146
4147
4148
4149
....
4179
4180
4181
4182
4183
4184
4185





4186
4187
4188
4189
4190
4191
4192
....
4217
4218
4219
4220
4221
4222
4223

4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
....
4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
static Tcl_NRPostProc	TEOEx_ByteCodeCallback;
static Tcl_NRPostProc	TEOEx_ListCallback;
static Tcl_NRPostProc	TEOV_Error;
static Tcl_NRPostProc	TEOV_Exception;
static Tcl_NRPostProc	TEOV_NotFoundCallback;
static Tcl_NRPostProc	TEOV_RestoreVarFrame;
static Tcl_NRPostProc	TEOV_RunLeaveTraces;
static Tcl_NRPostProc	EvalObjvCore;
static Tcl_NRPostProc	Dispatch;

static Tcl_ObjCmdProc NRCoroInjectObjCmd;

MODULE_SCOPE const TclStubs tclStubs;

/*
................................................................................
				 * 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;





    /*




     * data[1] stores a marker for use by tailcalls; it will be set to 1 by
     * command redirectors (imports, alias, ensembles) so that tailcalls
     * finishes the source command and not just the target.
     */

    if (iPtr->deferredCallbacks) {
        iPtr->deferredCallbacks = NULL;
    } else {
	TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
    }

    iPtr->numLevels++;
    TclNRAddCallback(interp, EvalObjvCore, cmdPtr, INT2PTR(flags),
	    INT2PTR(objc), objv);
    return TCL_OK;
}

static int
EvalObjvCore(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Command *cmdPtr = data[0];
    int flags = PTR2INT(data[1]);
    int objc = PTR2INT(data[2]);
    Tcl_Obj **objv = data[3];
    Interp *iPtr = (Interp *) interp;
    Namespace *lookupNsPtr = iPtr->lookupNsPtr;
    
    if (TCL_OK != TclInterpReady(interp)) {
	return TCL_ERROR;
    }

    if (objc == 0) {
	return TCL_OK;
    }

    if (TclLimitExceeded(iPtr->limit)) {
	return TCL_ERROR;
    }

    iPtr->lookupNsPtr = NULL;

    if (cmdPtr) {
	goto commandFound;
    }

    /*
     * Push records for task to be done on return, in INVERSE order. First, if
     * needed, the exception handlers (as they should happen last).
................................................................................
     */

    cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
    if (!cmdPtr) {
	return TEOV_NotFound(interp, objc, objv, lookupNsPtr);
    }






    /*
     * Found a command! The real work begins now ...
     */

  commandFound:
    if (iPtr->tracePtr || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
	/*
................................................................................
    Tcl_Interp *interp,
    int result)
{
    Tcl_ObjCmdProc *objProc = data[0];
    ClientData clientData = data[1];
    int objc = PTR2INT(data[2]);
    Tcl_Obj **objv = data[3];

    Interp *iPtr = (Interp *) interp;

#ifdef USE_DTRACE
    if (TCL_DTRACE_CMD_ARGS_ENABLED()) {
	const char *a[10];
	int i = 0;

	while (i < 10) {
	    a[i] = i < objc ? TclGetString(objv[i]) : NULL; i++;
	}
................................................................................
    }
    if (TCL_DTRACE_CMD_ENTRY_ENABLED() && objc) {
	TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1,
		(Tcl_Obj **)(objv + 1));
    }
#endif /* USE_DTRACE */

    iPtr->cmdCount++;
    return objProc(clientData, interp, objc, objv);
}

int
TclNRRunCallbacks(
    Tcl_Interp *interp,
    int result,