Changes On Branch dkf-bcc-optimize
Not logged in

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

Changes In Branch dkf-bcc-optimize Excluding Merge-Ins

This is equivalent to a diff from 652c4f2107 to c76fb949b9

2013-05-15
10:41
A better technique for [list {*}blah]. Remove the INST_LIST_EXPANDED opcode (and the complex machine... check-in: 40f8bba871 user: dkf tags: trunk
10:41
merge-mark check-in: 6f516aeb48 user: jan.nijtmans tags: trunk
10:41
merge trunk Closed-Leaf check-in: c76fb949b9 user: dkf tags: dkf-bcc-optimize
10:38
A better technique for [list {*}blah]. Remove the INST_LIST_EXPANDED opcode (and the complex machine... check-in: a42aa0a38c user: dkf tags: dkf-bcc-optimize
2013-05-14
18:44
make dist check-in: 652c4f2107 user: dgp tags: trunk
2013-05-13
16:59
Merged fix to bytecode engine problem. Details in merged revision. check-in: 01e27a732a user: andreask tags: trunk

Changes to generic/tclBasic.c.
181
182
183
184
185
186
187
188

189
190
191







192
193
194
195
196
197
198
199
200
201
202
203
204



205
206

207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257


















































258
259
260
261
262
263

264
265
266


267
268
269
270

271
272
273
274
275




276
277
278
279
280


281
282
283


284
285
286
287


288
289
290


291
292
293
294
295
296
297
181
182
183
184
185
186
187

188


189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206



207
208
209
210

211
212


















































213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267

268
269


270
271
272
273
274

275
276




277
278
279
280
281
282
283


284
285
286


287
288
289
290


291
292
293


294
295
296
297
298
299
300
301
302







-
+
-
-

+
+
+
+
+
+
+










-
-
-
+
+
+

-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
+

-
-
+
+



-
+

-
-
-
-
+
+
+
+



-
-
+
+

-
-
+
+


-
-
+
+

-
-
+
+







 */

typedef struct {
    const char *name;		/* Name of object-based command. */
    Tcl_ObjCmdProc *objProc;	/* Object-based function for command. */
    CompileProc *compileProc;	/* Function called to compile command. */
    Tcl_ObjCmdProc *nreProc;	/* NR-based function for command */
    int isSafe;			/* If non-zero, command will be present in
    int flags;			/* Various flag bits, as defined below. */
				 * safe interpreter. Otherwise it will be
				 * hidden. */
} CmdInfo;

#define CMD_IS_SAFE         1   /* Whether this command is part of the set of
                                 * commands present by default in a safe
                                 * interpreter. */
/* CMD_COMPILES_EXPANDED - Whether the compiler for this command can handle
 * expansion for itself rather than needing the generic layer to take care of
 * it for it. Defined in tclInt.h. */

/*
 * The built-in commands, and the functions that implement them:
 */

static const CmdInfo builtInCmds[] = {
    /*
     * Commands in the generic core.
     */

    {"append",		Tcl_AppendObjCmd,	TclCompileAppendCmd,	NULL,	1},
    {"apply",		Tcl_ApplyObjCmd,	NULL,			TclNRApplyObjCmd,	1},
    {"break",		Tcl_BreakObjCmd,	TclCompileBreakCmd,	NULL,	1},
    {"append",		Tcl_AppendObjCmd,	TclCompileAppendCmd,	NULL,	CMD_IS_SAFE},
    {"apply",		Tcl_ApplyObjCmd,	NULL,			TclNRApplyObjCmd,	CMD_IS_SAFE},
    {"break",		Tcl_BreakObjCmd,	TclCompileBreakCmd,	NULL,	CMD_IS_SAFE},
#ifndef EXCLUDE_OBSOLETE_COMMANDS
    {"case",		Tcl_CaseObjCmd,		NULL,			NULL,	1},
    {"case",		Tcl_CaseObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
#endif
    {"catch",		Tcl_CatchObjCmd,	TclCompileCatchCmd,	TclNRCatchObjCmd,	1},
    {"concat",		Tcl_ConcatObjCmd,	NULL,			NULL,	1},
    {"continue",	Tcl_ContinueObjCmd,	TclCompileContinueCmd,	NULL,	1},
    {"coroutine",	NULL,			NULL,			TclNRCoroutineObjCmd,	1},
    {"error",		Tcl_ErrorObjCmd,	TclCompileErrorCmd,	NULL,	1},
    {"eval",		Tcl_EvalObjCmd,		NULL,			TclNREvalObjCmd,	1},
    {"expr",		Tcl_ExprObjCmd,		TclCompileExprCmd,	TclNRExprObjCmd,	1},
    {"for",		Tcl_ForObjCmd,		TclCompileForCmd,	TclNRForObjCmd,	1},
    {"foreach",		Tcl_ForeachObjCmd,	TclCompileForeachCmd,	TclNRForeachCmd,	1},
    {"format",		Tcl_FormatObjCmd,	TclCompileFormatCmd,	NULL,	1},
    {"global",		Tcl_GlobalObjCmd,	TclCompileGlobalCmd,	NULL,	1},
    {"if",		Tcl_IfObjCmd,		TclCompileIfCmd,	TclNRIfObjCmd,	1},
    {"incr",		Tcl_IncrObjCmd,		TclCompileIncrCmd,	NULL,	1},
    {"join",		Tcl_JoinObjCmd,		NULL,			NULL,	1},
    {"lappend",		Tcl_LappendObjCmd,	TclCompileLappendCmd,	NULL,	1},
    {"lassign",		Tcl_LassignObjCmd,	TclCompileLassignCmd,	NULL,	1},
    {"lindex",		Tcl_LindexObjCmd,	TclCompileLindexCmd,	NULL,	1},
    {"linsert",		Tcl_LinsertObjCmd,	NULL,			NULL,	1},
    {"list",		Tcl_ListObjCmd,		TclCompileListCmd,	NULL,	1},
    {"llength",		Tcl_LlengthObjCmd,	TclCompileLlengthCmd,	NULL,	1},
    {"lmap",		Tcl_LmapObjCmd,		TclCompileLmapCmd,	TclNRLmapCmd,	1},
    {"lrange",		Tcl_LrangeObjCmd,	TclCompileLrangeCmd,	NULL,	1},
    {"lrepeat",		Tcl_LrepeatObjCmd,	NULL,			NULL,	1},
    {"lreplace",	Tcl_LreplaceObjCmd,	TclCompileLreplaceCmd,	NULL,	1},
    {"lreverse",	Tcl_LreverseObjCmd,	NULL,			NULL,	1},
    {"lsearch",		Tcl_LsearchObjCmd,	NULL,			NULL,	1},
    {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	NULL,	1},
    {"lsort",		Tcl_LsortObjCmd,	NULL,			NULL,	1},
    {"package",		Tcl_PackageObjCmd,	NULL,			NULL,	1},
    {"proc",		Tcl_ProcObjCmd,		NULL,			NULL,	1},
    {"regexp",		Tcl_RegexpObjCmd,	TclCompileRegexpCmd,	NULL,	1},
    {"regsub",		Tcl_RegsubObjCmd,	TclCompileRegsubCmd,	NULL,	1},
    {"rename",		Tcl_RenameObjCmd,	NULL,			NULL,	1},
    {"return",		Tcl_ReturnObjCmd,	TclCompileReturnCmd,	NULL,	1},
    {"scan",		Tcl_ScanObjCmd,		NULL,			NULL,	1},
    {"set",		Tcl_SetObjCmd,		TclCompileSetCmd,	NULL,	1},
    {"split",		Tcl_SplitObjCmd,	NULL,			NULL,	1},
    {"subst",		Tcl_SubstObjCmd,	TclCompileSubstCmd,	TclNRSubstObjCmd,	1},
    {"switch",		Tcl_SwitchObjCmd,	TclCompileSwitchCmd,	TclNRSwitchObjCmd, 1},
    {"tailcall",	NULL,			TclCompileTailcallCmd,	TclNRTailcallObjCmd,	1},
    {"throw",		Tcl_ThrowObjCmd,	TclCompileThrowCmd,	NULL,	1},
    {"trace",		Tcl_TraceObjCmd,	NULL,			NULL,	1},
    {"try",		Tcl_TryObjCmd,		TclCompileTryCmd,	TclNRTryObjCmd,	1},
    {"unset",		Tcl_UnsetObjCmd,	TclCompileUnsetCmd,	NULL,	1},
    {"uplevel",		Tcl_UplevelObjCmd,	NULL,			TclNRUplevelObjCmd,	1},
    {"upvar",		Tcl_UpvarObjCmd,	TclCompileUpvarCmd,	NULL,	1},
    {"variable",	Tcl_VariableObjCmd,	TclCompileVariableCmd,	NULL,	1},
    {"while",		Tcl_WhileObjCmd,	TclCompileWhileCmd,	TclNRWhileObjCmd,	1},
    {"yield",		NULL,			TclCompileYieldCmd,	TclNRYieldObjCmd,	1},
    {"yieldto",		NULL,			NULL,			TclNRYieldToObjCmd,	1},
    {"catch",		Tcl_CatchObjCmd,	TclCompileCatchCmd,	TclNRCatchObjCmd,	CMD_IS_SAFE},
    {"concat",		Tcl_ConcatObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"continue",	Tcl_ContinueObjCmd,	TclCompileContinueCmd,	NULL,	CMD_IS_SAFE},
    {"coroutine",	NULL,			NULL,			TclNRCoroutineObjCmd,	CMD_IS_SAFE},
    {"error",		Tcl_ErrorObjCmd,	TclCompileErrorCmd,	NULL,	CMD_IS_SAFE},
    {"eval",		Tcl_EvalObjCmd,		NULL,			TclNREvalObjCmd,	CMD_IS_SAFE},
    {"expr",		Tcl_ExprObjCmd,		TclCompileExprCmd,	TclNRExprObjCmd,	CMD_IS_SAFE},
    {"for",		Tcl_ForObjCmd,		TclCompileForCmd,	TclNRForObjCmd,	CMD_IS_SAFE},
    {"foreach",		Tcl_ForeachObjCmd,	TclCompileForeachCmd,	TclNRForeachCmd,	CMD_IS_SAFE},
    {"format",		Tcl_FormatObjCmd,	TclCompileFormatCmd,	NULL,	CMD_IS_SAFE},
    {"global",		Tcl_GlobalObjCmd,	TclCompileGlobalCmd,	NULL,	CMD_IS_SAFE},
    {"if",		Tcl_IfObjCmd,		TclCompileIfCmd,	TclNRIfObjCmd,	CMD_IS_SAFE},
    {"incr",		Tcl_IncrObjCmd,		TclCompileIncrCmd,	NULL,	CMD_IS_SAFE},
    {"join",		Tcl_JoinObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"lappend",		Tcl_LappendObjCmd,	TclCompileLappendCmd,	NULL,	CMD_IS_SAFE},
    {"lassign",		Tcl_LassignObjCmd,	TclCompileLassignCmd,	NULL,	CMD_IS_SAFE},
    {"lindex",		Tcl_LindexObjCmd,	TclCompileLindexCmd,	NULL,	CMD_IS_SAFE},
    {"linsert",		Tcl_LinsertObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"list",		Tcl_ListObjCmd,		TclCompileListCmd,	NULL,	CMD_IS_SAFE|CMD_COMPILES_EXPANDED},
    {"llength",		Tcl_LlengthObjCmd,	TclCompileLlengthCmd,	NULL,	CMD_IS_SAFE},
    {"lmap",		Tcl_LmapObjCmd,		TclCompileLmapCmd,	TclNRLmapCmd,	CMD_IS_SAFE},
    {"lrange",		Tcl_LrangeObjCmd,	TclCompileLrangeCmd,	NULL,	CMD_IS_SAFE},
    {"lrepeat",		Tcl_LrepeatObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lreplace",	Tcl_LreplaceObjCmd,	TclCompileLreplaceCmd,	NULL,	CMD_IS_SAFE},
    {"lreverse",	Tcl_LreverseObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lsearch",		Tcl_LsearchObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	NULL,	CMD_IS_SAFE},
    {"lsort",		Tcl_LsortObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"package",		Tcl_PackageObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"proc",		Tcl_ProcObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"regexp",		Tcl_RegexpObjCmd,	TclCompileRegexpCmd,	NULL,	CMD_IS_SAFE},
    {"regsub",		Tcl_RegsubObjCmd,	TclCompileRegsubCmd,	NULL,	CMD_IS_SAFE},
    {"rename",		Tcl_RenameObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"return",		Tcl_ReturnObjCmd,	TclCompileReturnCmd,	NULL,	CMD_IS_SAFE},
    {"scan",		Tcl_ScanObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"set",		Tcl_SetObjCmd,		TclCompileSetCmd,	NULL,	CMD_IS_SAFE},
    {"split",		Tcl_SplitObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"subst",		Tcl_SubstObjCmd,	TclCompileSubstCmd,	TclNRSubstObjCmd,	CMD_IS_SAFE},
    {"switch",		Tcl_SwitchObjCmd,	TclCompileSwitchCmd,	TclNRSwitchObjCmd, CMD_IS_SAFE},
    {"tailcall",	NULL,			TclCompileTailcallCmd,	TclNRTailcallObjCmd,	CMD_IS_SAFE},
    {"throw",		Tcl_ThrowObjCmd,	TclCompileThrowCmd,	NULL,	CMD_IS_SAFE},
    {"trace",		Tcl_TraceObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"try",		Tcl_TryObjCmd,		TclCompileTryCmd,	TclNRTryObjCmd,	CMD_IS_SAFE},
    {"unset",		Tcl_UnsetObjCmd,	TclCompileUnsetCmd,	NULL,	CMD_IS_SAFE},
    {"uplevel",		Tcl_UplevelObjCmd,	NULL,			TclNRUplevelObjCmd,	CMD_IS_SAFE},
    {"upvar",		Tcl_UpvarObjCmd,	TclCompileUpvarCmd,	NULL,	CMD_IS_SAFE},
    {"variable",	Tcl_VariableObjCmd,	TclCompileVariableCmd,	NULL,	CMD_IS_SAFE},
    {"while",		Tcl_WhileObjCmd,	TclCompileWhileCmd,	TclNRWhileObjCmd,	CMD_IS_SAFE},
    {"yield",		NULL,			TclCompileYieldCmd,	TclNRYieldObjCmd,	CMD_IS_SAFE},
    {"yieldto",		NULL,			NULL,			TclNRYieldToObjCmd,	CMD_IS_SAFE},

    /*
     * Commands in the OS-interface. Note that many of these are unsafe.
     */

    {"after",		Tcl_AfterObjCmd,	NULL,			NULL,	1},
    {"after",		Tcl_AfterObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"cd",		Tcl_CdObjCmd,		NULL,			NULL,	0},
    {"close",		Tcl_CloseObjCmd,	NULL,			NULL,	1},
    {"eof",		Tcl_EofObjCmd,		NULL,			NULL,	1},
    {"close",		Tcl_CloseObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"eof",		Tcl_EofObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"encoding",	Tcl_EncodingObjCmd,	NULL,			NULL,	0},
    {"exec",		Tcl_ExecObjCmd,		NULL,			NULL,	0},
    {"exit",		Tcl_ExitObjCmd,		NULL,			NULL,	0},
    {"fblocked",	Tcl_FblockedObjCmd,	NULL,			NULL,	1},
    {"fblocked",	Tcl_FblockedObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"fconfigure",	Tcl_FconfigureObjCmd,	NULL,			NULL,	0},
    {"fcopy",		Tcl_FcopyObjCmd,	NULL,			NULL,	1},
    {"fileevent",	Tcl_FileEventObjCmd,	NULL,			NULL,	1},
    {"flush",		Tcl_FlushObjCmd,	NULL,			NULL,	1},
    {"gets",		Tcl_GetsObjCmd,		NULL,			NULL,	1},
    {"fcopy",		Tcl_FcopyObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"fileevent",	Tcl_FileEventObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"flush",		Tcl_FlushObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"gets",		Tcl_GetsObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"glob",		Tcl_GlobObjCmd,		NULL,			NULL,	0},
    {"load",		Tcl_LoadObjCmd,		NULL,			NULL,	0},
    {"open",		Tcl_OpenObjCmd,		NULL,			NULL,	0},
    {"pid",		Tcl_PidObjCmd,		NULL,			NULL,	1},
    {"puts",		Tcl_PutsObjCmd,		NULL,			NULL,	1},
    {"pid",		Tcl_PidObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"puts",		Tcl_PutsObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"pwd",		Tcl_PwdObjCmd,		NULL,			NULL,	0},
    {"read",		Tcl_ReadObjCmd,		NULL,			NULL,	1},
    {"seek",		Tcl_SeekObjCmd,		NULL,			NULL,	1},
    {"read",		Tcl_ReadObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"seek",		Tcl_SeekObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"socket",		Tcl_SocketObjCmd,	NULL,			NULL,	0},
    {"source",		Tcl_SourceObjCmd,	NULL,			TclNRSourceObjCmd,	0},
    {"tell",		Tcl_TellObjCmd,		NULL,			NULL,	1},
    {"time",		Tcl_TimeObjCmd,		NULL,			NULL,	1},
    {"tell",		Tcl_TellObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"time",		Tcl_TimeObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"unload",		Tcl_UnloadObjCmd,	NULL,			NULL,	0},
    {"update",		Tcl_UpdateObjCmd,	NULL,			NULL,	1},
    {"vwait",		Tcl_VwaitObjCmd,	NULL,			NULL,	1},
    {"update",		Tcl_UpdateObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"vwait",		Tcl_VwaitObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {NULL,		NULL,			NULL,			NULL,	0}
};

/*
 * Math functions. All are safe.
 */

764
765
766
767
768
769
770



771
772
773
774
775
776
777
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785







+
+
+







	    cmdPtr->proc = TclInvokeObjectCommand;
	    cmdPtr->clientData = cmdPtr;
	    cmdPtr->objProc = cmdInfoPtr->objProc;
	    cmdPtr->objClientData = NULL;
	    cmdPtr->deleteProc = NULL;
	    cmdPtr->deleteData = NULL;
	    cmdPtr->flags = 0;
            if (cmdInfoPtr->flags & CMD_COMPILES_EXPANDED) {
                cmdPtr->flags |= CMD_COMPILES_EXPANDED;
            }
	    cmdPtr->importRefPtr = NULL;
	    cmdPtr->tracePtr = NULL;
	    cmdPtr->nreProc = cmdInfoPtr->nreProc;
	    Tcl_SetHashValue(hPtr, cmdPtr);
	}
    }

996
997
998
999
1000
1001
1002
1003

1004
1005
1006
1007
1008
1009
1010
1004
1005
1006
1007
1008
1009
1010

1011
1012
1013
1014
1015
1016
1017
1018







-
+







{
    register const CmdInfo *cmdInfoPtr;

    if (interp == NULL) {
	return TCL_ERROR;
    }
    for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
	if (!cmdInfoPtr->isSafe) {
	if (!(cmdInfoPtr->flags & CMD_IS_SAFE)) {
	    Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name);
	}
    }
    TclMakeFileCommandSafe(interp);     /* Ugh! */
    return TCL_OK;
}

Changes to generic/tclCompCmds.c.
4462
4463
4464
4465
4466
4467
4468
4469

4470
4471
4472
4473
4474
4475
4476
4462
4463
4464
4465
4466
4467
4468

4469
4470
4471
4472
4473
4474
4475
4476







-
+







				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *valueTokenPtr;
    int i, numWords;
    int i, numWords, concat, build;
    Tcl_Obj *listObj, *objPtr;

    if (parsePtr->numWords == 1) {
	/*
	 * [list] without arguments just pushes an empty object.
	 */

4517
4518
4519
4520
4521
4522
4523

4524








4525









4526
4527

4528

















4529
4530
4531
4532
4533
4534
4535
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546

4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570







+

+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+


+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








    /*
     * Push the all values onto the stack.
     */

    numWords = parsePtr->numWords;
    valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
    concat = build = 0;
    for (i = 1; i < numWords; i++) {
	if (valueTokenPtr->type == TCL_TOKEN_EXPAND_WORD && build > 0) {
	    TclEmitInstInt4(	INST_LIST, build,	envPtr);
	    if (concat) {
		TclEmitOpcode(	INST_LIST_CONCAT,	envPtr);
	    }
	    build = 0;
	    concat = 1;
	}
	CompileWord(envPtr, valueTokenPtr, interp, i);
	if (valueTokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
	    if (concat) {
		TclEmitOpcode(	INST_LIST_CONCAT,	envPtr);
	    } else {
		concat = 1;
	    }
	} else {
	    build++;
	}
	valueTokenPtr = TokenAfter(valueTokenPtr);
    }
    if (build > 0) {
    TclEmitInstInt4(	INST_LIST, numWords - 1,	envPtr);
	TclEmitInstInt4(	INST_LIST, build,	envPtr);
	if (concat) {
	    TclEmitOpcode(	INST_LIST_CONCAT,	envPtr);
	}
    }

    /*
     * If there was just one expanded word, we must ensure that it is a list
     * at this point. We use an [lrange ... 0 end] for this (instead of
     * [llength], as with literals) as we must drop any string representation
     * that might be hanging around.
     */

    if (concat && numWords == 2) {
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,	envPtr);
	TclEmitInt4(			-2,		envPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLlengthCmd --
Changes to generic/tclCompile.c.
276
277
278
279
280
281
282
283
284
285



286
287
288


289
290
291
292
293
294
295
276
277
278
279
280
281
282



283
284
285



286
287
288
289
290
291
292
293
294







-
-
-
+
+
+
-
-
-
+
+







    {"returnImm",	  9,   -1,         2,	{OPERAND_INT4, OPERAND_UINT4}},
	/* Compiled [return], code, level are operands; options and result
	 * are on the stack. */
    {"expon",		  1,   -1,	   0,	{OPERAND_NONE}},
	/* Binary exponentiation operator: push (stknext ** stktop) */

    /*
     * NOTE: the stack effects of expandStkTop, invokeExpanded and
     * listExpanded are wrong - but it cannot be done right at compile time,
     * the stack effect is only known at run time. The value for both
     * NOTE: the stack effects of expandStkTop and invokeExpanded are wrong -
     * but it cannot be done right at compile time, the stack effect is only
     * known at run time. The value for invokeExpanded is estimated better at
     * invokeExpanded and listExpanded are estimated better at compile time.
     * See the comments further down in this file, where INST_INVOKE_EXPANDED
     * and INST_LIST_EXPANDED are emitted.
     * compile time.  See the comments further down in this file, where
     * INST_INVOKE_EXPANDED is emitted.
     */
    {"expandStart",       1,    0,          0,	{OPERAND_NONE}},
	/* Start of command with {*} (expanded) arguments */
    {"expandStkTop",      5,    0,          1,	{OPERAND_UINT4}},
	/* Expand the list at stacktop: push its elements on the stack */
    {"invokeExpanded",    1,    0,          0,	{OPERAND_NONE}},
	/* Invoke the command marked by the last 'expandStart' */
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561


562
563
564
565
566
567
568
534
535
536
537
538
539
540


541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567







-
-


















+
+







	 * the word at the top of the stack;
	 * <objc,objv> = <op4,top op4 after popping 1> */

    {"listConcat",	 1,	-1,	  0,	{OPERAND_NONE}},
	/* Concatenates the two lists at the top of the stack into a single
	 * list and pushes that resulting list onto the stack.
	 * Stack: ... list1 list2 => ... [lconcat list1 list2] */
    {"listExpanded",	 1,	0,	  0,	{OPERAND_NONE}},
	/* Construct a list from the words marked by the last 'expandStart' */

    {NULL, 0, 0, 0, {OPERAND_NONE}}
};

/*
 * Prototypes for procedures defined later in this file:
 */

static ByteCode *	CompileSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int flags);
static void		DupByteCodeInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
static unsigned char *	EncodeCmdLocMap(CompileEnv *envPtr,
			    ByteCode *codePtr, unsigned char *startPtr);
static void		EnterCmdExtentData(CompileEnv *envPtr,
			    int cmdNumber, int numSrcBytes, int numCodeBytes);
static void		EnterCmdStartData(CompileEnv *envPtr,
			    int cmdNumber, int srcOffset, int codeOffset);
static Command *	FindCommandFromToken(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, Tcl_Namespace *namespacePtr);
static void		FreeByteCodeInternalRep(Tcl_Obj *objPtr);
static void		FreeSubstCodeInternalRep(Tcl_Obj *objPtr);
static int		GetCmdLocEncodingSize(CompileEnv *envPtr);
static int		IsCompactibleCompileEnv(Tcl_Interp *interp,
			    CompileEnv *envPtr);
static void		PeepholeOptimize(CompileEnv *envPtr);
#ifdef TCL_COMPILE_STATS
1769
1770
1771
1772
1773
1774
1775











































1776
1777
1778
1779
1780
1781
1782
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    }
    if (valuePtr != NULL) {
	Tcl_AppendObjToObj(valuePtr, tempPtr);
	Tcl_DecrRefCount(tempPtr);
    }
    return 1;
}

/*
 * ---------------------------------------------------------------------
 *
 * FindCommandFromToken --
 *
 *	A simple helper that looks up a command's compiler from its token.
 *
 * ---------------------------------------------------------------------
 */

static Command *
FindCommandFromToken(
    Tcl_Interp *interp,
    Tcl_Token *tokenPtr,
    Tcl_Namespace *namespacePtr)
{
    Tcl_DString ds;
    Command *cmdPtr;

    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	return NULL;
    }

    /*
     * We copy the string before trying to find the command by name. We used
     * to modify the string in place, but this is not safe because the name
     * resolution handlers could have side effects that rely on the unmodified
     * string.
     */

    Tcl_DStringInit(&ds);
    TclDStringAppendToken(&ds, &tokenPtr[1]);
    cmdPtr = (Command *) Tcl_FindCommand(interp, Tcl_DStringValue(&ds),
	    namespacePtr, /*flags*/ 0);
    if (cmdPtr != NULL && (cmdPtr->compileProc == NULL
	    || (cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION)
	    || (cmdPtr->flags & CMD_HAS_EXEC_TRACES))) {
	cmdPtr = NULL;
    }
    Tcl_DStringFree(&ds);
    return cmdPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileScript --
 *
 *	Compile a Tcl script in a string.
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1854
1855
1856
1857
1858
1859
1860

1861
1862
1863
1864
1865
1866
1867
1868
1869


1870
1871
1872
1873
1874
1875
1876







-









-
-







				 * code. Init. to avoid compiler warning. */
    unsigned char *entryCodeNext = envPtr->codeNext;
    const char *p, *next;
    Namespace *cmdNsPtr;
    Command *cmdPtr;
    Tcl_Token *tokenPtr;
    int bytesLeft, isFirstCmd, wordIdx, currCmdIndex, commandLength, objIndex;
    Tcl_DString ds;
    /* TIP #280 */
    ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
    int *wlines, wlineat, cmdLine, *clNext;
    Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));

    if (envPtr->iPtr == NULL) {
	Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
    }

    Tcl_DStringInit(&ds);

    if (numBytes < 0) {
	numBytes = strlen(script);
    }
    Tcl_ResetResult(interp);
    isFirstCmd = 1;

    if (envPtr->procPtr != NULL) {
1873
1874
1875
1876
1877
1878
1879

1880

1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1912
1913
1914
1915
1916
1917
1918
1919

1920
1921







1922
1923
1924
1925
1926
1927
1928







+
-
+

-
-
-
-
-
-
-







	 */

	TclAdvanceLines(&cmdLine, p, parsePtr->commandStart);
	TclAdvanceContinuations(&cmdLine, &clNext,
		parsePtr->commandStart - envPtr->source);

	if (parsePtr->numWords > 0) {
	    int expand = 0;	/* Set to the relevant expansion instruction
	    int expand = 0;	/* Set if there are dynamic expansions to
				 * if there are dynamic expansions to
				 * handle */
	    int expandIgnoredWords = 0;
				/* The number of *apparent* words that we are
				 * generating code from directly during
				 * expansion processing. For [list {*}blah]
				 * expansion, we set this to one because we
				 * ignore the first word and generate code
				 * directly. */

	    /*
	     * If not the first command, pop the previous command's result
	     * and, if we're compiling a top level command, update the last
	     * command's code size to account for the pop instruction.
	     */

1938
1939
1940
1941
1942
1943
1944
















1945
1946
1947
1948
1949
1950
1951
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







		    wordIdx < parsePtr->numWords;
		    wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
		if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
		    expand = INST_INVOKE_EXPANDED;
		    break;
		}
	    }

	    /*
	     * If expansion was requested, check if the command declares that
	     * it knows how to compile it. Note that if expansion is requested
	     * for the first word, this check will fail as the token type will
	     * inhibit it. (That check is done inside FindCommandFromToken.)
	     * This is as it should be.
	     */

	    if (expand) {
		cmdPtr = FindCommandFromToken(interp, parsePtr->tokenPtr,
			(Tcl_Namespace *) cmdNsPtr);
		if (cmdPtr && (cmdPtr->flags & CMD_COMPILES_EXPANDED)) {
		    expand = 0;
		}
	    }

	    envPtr->numCommands++;
	    currCmdIndex = envPtr->numCommands - 1;
	    lastTopLevelCmdIndex = currCmdIndex;
	    startCodeOffset = envPtr->codeNext - envPtr->codeStart;
	    EnterCmdStartData(envPtr, currCmdIndex,
		    parsePtr->commandStart - envPtr->source, startCodeOffset);
1987
1988
1989
1990
1991
1992
1993
1994

1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015

2016
2017
2018
2019
2020
2021

2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2036
2037
2038
2039
2040
2041
2042

2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057







2058






2059
2060
2061



2062
2063
2064
2065
2066
2067
2068







-
+














-
-
-
-
-
-
-
+
-
-
-
-
-
-
+


-
-
-







		if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
		    /*
		     * The word is not a simple string of characters.
		     */

		    TclCompileTokens(interp, tokenPtr+1,
			    tokenPtr->numComponents, envPtr);
		    if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
		    if (expand && tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
			TclEmitInstInt4(INST_EXPAND_STKTOP,
				envPtr->currStackDepth, envPtr);
		    }
		    continue;
		}

		/*
		 * This is a simple string of literal characters (i.e. we know
		 * it absolutely and can use it directly). If this is the
		 * first word and the command has a compile procedure, let it
		 * compile the command.
		 */

		if ((wordIdx == 0) && !expand) {
		    /*
		     * We copy the string before trying to find the command by
		     * name. We used to modify the string in place, but this
		     * is not safe because the name resolution handlers could
		     * have side effects that rely on the unmodified string.
		     */

		    cmdPtr = FindCommandFromToken(interp, tokenPtr,
		    TclDStringClear(&ds);
		    TclDStringAppendToken(&ds, &tokenPtr[1]);

		    cmdPtr = (Command *) Tcl_FindCommand(interp,
			    Tcl_DStringValue(&ds),
			    (Tcl_Namespace *) cmdNsPtr, /*flags*/ 0);
			    (Tcl_Namespace *) cmdNsPtr);

		    if ((cmdPtr != NULL)
			    && (cmdPtr->compileProc != NULL)
			    && !(cmdPtr->nsPtr->flags&NS_SUPPRESS_COMPILATION)
			    && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)
			    && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) {
			int code, savedNumCmds = envPtr->numCommands;
			unsigned savedCodeNext =
				envPtr->codeNext - envPtr->codeStart;
			int update = 0;
#ifdef TCL_COMPILE_DEBUG
			int startStackDepth = envPtr->currStackDepth;
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2179
2180
2181
2182
2183
2184
2185




















2186
2187
2188
2189
2190
2191
2192







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







		    objIndex = TclRegisterNewCmdLiteral(envPtr,
			    tokenPtr[1].start, tokenPtr[1].size);
		    if (cmdPtr != NULL) {
			TclSetCmdNameObj(interp,
				TclFetchLiteral(envPtr, objIndex), cmdPtr);
		    }
		} else {
		    if (wordIdx == 0 && expand) {
			TclDStringClear(&ds);
			TclDStringAppendToken(&ds, &tokenPtr[1]);
			cmdPtr = (Command *) Tcl_FindCommand(interp,
				Tcl_DStringValue(&ds),
				(Tcl_Namespace *) cmdNsPtr, /*flags*/ 0);
			if ((cmdPtr != NULL) &&
				(cmdPtr->compileProc == TclCompileListCmd)) {
			    /*
			     * Special case! [list] command can be expanded
			     * directly provided the first word is not the
			     * expanded one.
			     */

			    expand = INST_LIST_EXPANDED;
			    expandIgnoredWords = 1;
			    continue;
			}
		    }

		    /*
		     * Simple argument word of a command. We reach this if and
		     * only if the command word was not compiled for whatever
		     * reason. Register the literal's location for use by
		     * uplevel, etc. commands, should they encounter it
		     * unmodified. We care only if the we are in a context
		     * which already allows absolute counting.
2207
2208
2209
2210
2211
2212
2213
2214
2215


2216
2217
2218
2219

2220
2221
2222
2223
2224
2225
2226
2222
2223
2224
2225
2226
2227
2228


2229
2230
2231
2232
2233

2234
2235
2236
2237
2238
2239
2240
2241







-
-
+
+



-
+







		 * words of the command are popped from the stack, and the
		 * result is pushed: the stack top changes by (1-wordIdx).
		 *
		 * Note that the estimates are not correct while the command
		 * is being prepared and run, INST_EXPAND_STKTOP is not
		 * stack-neutral in general.
		 *
		 * The opcodes that may be issued here (both assumed to be
		 * non-zero) are INST_INVOKE_EXPANDED and INST_LIST_EXPANDED.
		 * The opcode that may be issued here (assumed to be non-zero)
		 * is INST_INVOKE_EXPANDED.
		 */

		TclEmitOpcode(expand, envPtr);
		TclAdjustStackDepth(1 + expandIgnoredWords - wordIdx, envPtr);
		TclAdjustStackDepth(1 - wordIdx, envPtr);
	    } else if (wordIdx > 0) {
		/*
		 * Save PC -> command map for the TclArgumentBC* functions.
		 */

		int isnew;
		Tcl_HashEntry *hePtr = Tcl_CreateHashEntry(&eclPtr->litInfo,
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309

2310
2311
2312
2313
2314
2315
2316







-








    if (envPtr->codeNext == entryCodeNext) {
	TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
    }

    envPtr->numSrcBytes = p - script;
    TclStackFree(interp, parsePtr);
    Tcl_DStringFree(&ds);
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileTokens --
 *
Changes to generic/tclCompile.h.
712
713
714
715
716
717
718
719
720
721
722

723
724
725
726
727
728
729
712
713
714
715
716
717
718

719
720

721
722
723
724
725
726
727
728







-


-
+







#define INST_ARRAY_EXISTS_IMM		160
#define INST_ARRAY_MAKE_STK		161
#define INST_ARRAY_MAKE_IMM		162

#define INST_INVOKE_REPLACE		163

#define INST_LIST_CONCAT		164
#define INST_LIST_EXPANDED		165

/* The last opcode */
#define LAST_INST_OPCODE		165
#define LAST_INST_OPCODE		164

/*
 * Table describing the Tcl bytecode instructions: their name (for displaying
 * code), total number of code bytes required (including operand bytes), and a
 * description of the type of each operand. These operand types include signed
 * and unsigned integers of length one and four bytes. The unsigned integers
 * are used for indexes or for, e.g., the count of objects to push in a "push"
Changes to generic/tclExecute.c.
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4434
4435
4436
4437
4438
4439
4440












4441
4442
4443
4444
4445
4446
4447







-
-
-
-
-
-
-
-
-
-
-
-







	 */

	opnd = TclGetUInt4AtPtr(pc+1);
	objResultPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1));
	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
	NEXT_INST_V(5, opnd, 1);

    case INST_LIST_EXPANDED:
	CLANG_ASSERT(auxObjList);
	objc = CURR_DEPTH - auxObjList->internalRep.ptrAndLongRep.value;
	POP_TAUX_OBJ();
	objResultPtr = Tcl_NewListObj(objc, &OBJ_AT_DEPTH(objc-1));
	TRACE_WITH_OBJ(("(%u) => ", objc), objResultPtr);
	while (objc--) {
	    valuePtr = POP_OBJECT();
	    TclDecrRefCount(valuePtr);
	}
	NEXT_INST_F(1, 0, 1);

    case INST_LIST_LENGTH:
	valuePtr = OBJ_AT_TOS;
	if (TclListObjLength(interp, valuePtr, &length) != TCL_OK) {
	    TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
		    Tcl_GetObjResult(interp));
	    goto gotError;
	}
Changes to generic/tclInt.h.
1677
1678
1679
1680
1681
1682
1683



1684
1685
1686
1687
1688
1689
1690
1691
1692
1693

1694
1695
1696
1697
1698
1699
1700
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704







+
+
+










+







 * CMD_TRACE_ACTIVE -		1 means that trace processing is currently
 *				underway for a rename/delete change. See the
 *				two flags below for which is currently being
 *				processed.
 * CMD_HAS_EXEC_TRACES -	1 means that this command has at least one
 *				execution trace (as opposed to simple
 *				delete/rename traces) in its tracePtr list.
 * CMD_COMPILES_EXPANDED -	1 means that this command has a compiler that
 *				can handle expansion (provided it is not the
 *				first word).
 * TCL_TRACE_RENAME -		A rename trace is in progress. Further
 *				recursive renames will not be traced.
 * TCL_TRACE_DELETE -		A delete trace is in progress. Further
 *				recursive deletes will not be traced.
 * (these last two flags are defined in tcl.h)
 */

#define CMD_IS_DELETED		    0x1
#define CMD_TRACE_ACTIVE	    0x2
#define CMD_HAS_EXEC_TRACES	    0x4
#define CMD_COMPILES_EXPANDED	    0x8

/*
 *----------------------------------------------------------------
 * Data structures related to name resolution procedures.
 *----------------------------------------------------------------
 */