Tcl Source Code

Check-in [2c2c6d6225]
Login

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

Overview
Comment:merge trunk
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | novem
Files: files | file ages | folders
SHA1: 2c2c6d62259194a258fc60f110e326b40fbef785
User & Date: jan.nijtmans 2014-01-02 17:05:45
Context
2014-01-23
23:12
merge trunk check-in: ddec41f466 user: jan.nijtmans tags: novem
2014-01-02
17:05
merge trunk check-in: 2c2c6d6225 user: jan.nijtmans tags: novem
10:01
more fixes to instruction tracing; ensure all places that need DECACHE_STACK_INFO have it check-in: cecc44d165 user: dkf tags: trunk
2014-01-01
12:36
merge trunk check-in: 3cb08706ae user: jan.nijtmans tags: novem
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclExecute.c.

258
259
260
261
262
263
264
































































265
266
267
268
269
270
271
	    }							\
	    goto cleanupV_pushObjResultPtr;			\
	} else {						\
	    goto cleanupV;					\
	}							\
    } while (0)

































































/*
 * Macros used to cache often-referenced Tcl evaluation stack information
 * in local variables. Note that a DECACHE_STACK_INFO()-CACHE_STACK_INFO()
 * pair must surround any call inside TclNRExecuteByteCode (and a few other
 * procedures that use this scheme) that could result in a recursive call
 * to TclNRExecuteByteCode.
 */







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
	    }							\
	    goto cleanupV_pushObjResultPtr;			\
	} else {						\
	    goto cleanupV;					\
	}							\
    } while (0)

#ifndef TCL_COMPILE_DEBUG
#define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \
    do {								\
	pc += (pcAdjustment);						\
	switch (*pc) {							\
	case INST_JUMP_FALSE1:						\
	    NEXT_INST_F(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \
	case INST_JUMP_TRUE1:						\
	    NEXT_INST_F(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \
	case INST_JUMP_FALSE4:						\
	    NEXT_INST_F(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \
	case INST_JUMP_TRUE4:						\
	    NEXT_INST_F(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \
	default:							\
	    if ((condition) < 0) {					\
		TclNewLongObj(objResultPtr, -1);				\
	    } else {							\
		objResultPtr = TCONST((condition) > 0);			\
	    }								\
	    NEXT_INST_F(0, (cleanup), 1);				\
	}								\
    } while (0)
#define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \
    do {								\
	pc += (pcAdjustment);						\
	switch (*pc) {							\
	case INST_JUMP_FALSE1:						\
	    NEXT_INST_V(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \
	case INST_JUMP_TRUE1:						\
	    NEXT_INST_V(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \
	case INST_JUMP_FALSE4:						\
	    NEXT_INST_V(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \
	case INST_JUMP_TRUE4:						\
	    NEXT_INST_V(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \
	default:							\
	    if ((condition) < 0) {					\
		TclNewLongObj(objResultPtr, -1);				\
	    } else {							\
		objResultPtr = TCONST((condition) > 0);			\
	    }								\
	    NEXT_INST_V(0, (cleanup), 1);				\
	}								\
    } while (0)
#else /* TCL_COMPILE_DEBUG */
#define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \
    do{									\
	if ((condition) < 0) {						\
	    TclNewLongObj(objResultPtr, -1);				\
	} else {							\
	    objResultPtr = TCONST((condition) > 0);			\
	}								\
	NEXT_INST_F((pcAdjustment), (cleanup), 1);			\
    } while (0)
#define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \
    do{									\
	if ((condition) < 0) {						\
	    TclNewLongObj(objResultPtr, -1);				\
	} else {							\
	    objResultPtr = TCONST((condition) > 0);			\
	}								\
	NEXT_INST_V((pcAdjustment), (cleanup), 1);			\
    } while (0)
#endif

/*
 * Macros used to cache often-referenced Tcl evaluation stack information
 * in local variables. Note that a DECACHE_STACK_INFO()-CACHE_STACK_INFO()
 * pair must surround any call inside TclNRExecuteByteCode (and a few other
 * procedures that use this scheme) that could result in a recursive call
 * to TclNRExecuteByteCode.
 */
2095
2096
2097
2098
2099
2100
2101
2102




2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
	    TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr);
	}
	if (codePtr->flags & TCL_BYTECODE_RECOMPILE) {
	    iPtr->flags |= ERR_ALREADY_LOGGED;
	    codePtr->flags &= ~TCL_BYTECODE_RECOMPILE;
	}

	if (result == TCL_OK) {




	    /*
	     * Push the call's object result and continue execution with the
	     * next instruction.
	     */

	    TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
		    objc, cmdNameBuf), Tcl_GetObjResult(interp));

	    /*
	     * Reset the interp's result to avoid possible duplications of
	     * large objects [Bug 781585]. We do not call Tcl_ResetResult to
	     * avoid any side effects caused by the resetting of errorInfo and
	     * errorCode [Bug 804681], which are not needed here. We chose
	     * instead to manipulate the interp's object result directly.
	     *
	     * Note that the result object is now in objResultPtr, it keeps
	     * the refCount it had in its role of iPtr->objResultPtr.
	     */

	    objResultPtr = Tcl_GetObjResult(interp);
	    TclNewObj(objPtr);
	    Tcl_IncrRefCount(objPtr);
	    iPtr->objResultPtr = objPtr;
#ifndef TCL_COMPILE_DEBUG
	    if (*pc == INST_POP) {
		TclDecrRefCount(objResultPtr);
		NEXT_INST_V(1, cleanup, 0);
	    }
#endif
	    NEXT_INST_V(0, cleanup, -1);
	} else {
	    pc--;
	    goto processExceptionReturn;
	}
    }

    /*
     * Targets for standard instruction endings; unrolled for speed in the
     * most frequent cases (instructions that consume up to two stack
     * elements).
     *







|
>
>
>
>
|
|
|
|

|
|

|
|
|
|
|
|
|
|
|
|

|
|
|
|

|
|
|
|

|
<
<
<
<







2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200




2201
2202
2203
2204
2205
2206
2207
	    TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr);
	}
	if (codePtr->flags & TCL_BYTECODE_RECOMPILE) {
	    iPtr->flags |= ERR_ALREADY_LOGGED;
	    codePtr->flags &= ~TCL_BYTECODE_RECOMPILE;
	}

	if (result != TCL_OK) {
	    pc--;
	    goto processExceptionReturn;
	}

	/*
	 * Push the call's object result and continue execution with the next
	 * instruction.
	 */

	TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
		objc, cmdNameBuf), Tcl_GetObjResult(interp));

	/*
	 * Reset the interp's result to avoid possible duplications of large
	 * objects [Bug 781585]. We do not call Tcl_ResetResult to avoid any
	 * side effects caused by the resetting of errorInfo and errorCode
	 * [Bug 804681], which are not needed here. We chose instead to
	 * manipulate the interp's object result directly.
	 *
	 * Note that the result object is now in objResultPtr, it keeps the
	 * refCount it had in its role of iPtr->objResultPtr.
	 */

	objResultPtr = Tcl_GetObjResult(interp);
	TclNewObj(objPtr);
	Tcl_IncrRefCount(objPtr);
	iPtr->objResultPtr = objPtr;
#ifndef TCL_COMPILE_DEBUG
	if (*pc == INST_POP) {
	    TclDecrRefCount(objResultPtr);
	    NEXT_INST_V(1, cleanup, 0);
	}
#endif
	NEXT_INST_V(0, cleanup, -1);




    }

    /*
     * Targets for standard instruction endings; unrolled for speed in the
     * most frequent cases (instructions that consume up to two stack
     * elements).
     *
2349
2350
2351
2352
2353
2354
2355

2356
2357

2358
2359
2360
2361
2362
2363
2364
	CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;

	TRACE(("%.30s => ", O2S(OBJ_AT_TOS)));
	if (!corPtr) {
	    TRACE_APPEND(("ERROR: yield outside coroutine\n"));
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "yield can only be called in a coroutine", -1));

	    Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD",
		    NULL);

	    goto gotError;
	}

#ifdef TCL_COMPILE_DEBUG
	TRACE_WITH_OBJ(("yield, result="), iPtr->objResultPtr);
	if (traceInstructions) {
	    fprintf(stdout, "\n");







>


>







2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
	CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;

	TRACE(("%.30s => ", O2S(OBJ_AT_TOS)));
	if (!corPtr) {
	    TRACE_APPEND(("ERROR: yield outside coroutine\n"));
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "yield can only be called in a coroutine", -1));
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD",
		    NULL);
	    CACHE_STACK_INFO();
	    goto gotError;
	}

#ifdef TCL_COMPILE_DEBUG
	TRACE_WITH_OBJ(("yield, result="), iPtr->objResultPtr);
	if (traceInstructions) {
	    fprintf(stdout, "\n");
2395
2396
2397
2398
2399
2400
2401

2402

2403
2404
2405
2406
2407
2408
2409

	opnd = TclGetUInt1AtPtr(pc+1);

	if (!(iPtr->varFramePtr->isProcCallFrame & 1)) {
	    TRACE(("%d => ERROR: tailcall in non-proc context\n", opnd));
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "tailcall can only be called from a proc or lambda", -1));

	    Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);

	    goto gotError;
	}

#ifdef TCL_COMPILE_DEBUG
	{
	    register int i;








>

>







2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477

	opnd = TclGetUInt1AtPtr(pc+1);

	if (!(iPtr->varFramePtr->isProcCallFrame & 1)) {
	    TRACE(("%d => ERROR: tailcall in non-proc context\n", opnd));
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "tailcall can only be called from a proc or lambda", -1));
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);
	    CACHE_STACK_INFO();
	    goto gotError;
	}

#ifdef TCL_COMPILE_DEBUG
	{
	    register int i;

2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494

2495
2496
2497
2498
2499
2500
2501
	objResultPtr = OBJ_AT_TOS;
	TRACE_WITH_OBJ(("=> "), objResultPtr);
	NEXT_INST_F(1, 0, 1);

    case INST_OVER:
	opnd = TclGetUInt4AtPtr(pc+1);
	objResultPtr = OBJ_AT_DEPTH(opnd);
	TRACE_WITH_OBJ(("=> "), objResultPtr);
	NEXT_INST_F(5, 0, 1);

    case INST_REVERSE: {
	Tcl_Obj **a, **b;

	opnd = TclGetUInt4AtPtr(pc+1);
	a = tosPtr-(opnd-1);
	b = tosPtr;
	while (a<b) {
	    tmpPtr = *a;
	    *a = *b;
	    *b = tmpPtr;
	    a++; b--;
	}

	NEXT_INST_F(5, 0, 0);
    }

    case INST_CONCAT1: {
	int appendLen = 0;
	char *bytes, *p;
	Tcl_Obj **currPtr;







|














>







2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
	objResultPtr = OBJ_AT_TOS;
	TRACE_WITH_OBJ(("=> "), objResultPtr);
	NEXT_INST_F(1, 0, 1);

    case INST_OVER:
	opnd = TclGetUInt4AtPtr(pc+1);
	objResultPtr = OBJ_AT_DEPTH(opnd);
	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
	NEXT_INST_F(5, 0, 1);

    case INST_REVERSE: {
	Tcl_Obj **a, **b;

	opnd = TclGetUInt4AtPtr(pc+1);
	a = tosPtr-(opnd-1);
	b = tosPtr;
	while (a<b) {
	    tmpPtr = *a;
	    *a = *b;
	    *b = tmpPtr;
	    a++; b--;
	}
	TRACE(("%u => OK\n", opnd));
	NEXT_INST_F(5, 0, 0);
    }

    case INST_CONCAT1: {
	int appendLen = 0;
	char *bytes, *p;
	Tcl_Obj **currPtr;
2658
2659
2660
2661
2662
2663
2664

2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680

2681
2682
2683
2684
2685
2686
2687
	 * error, also in INST_EXPAND_STKTOP).
	 */

	TclNewObj(objPtr);
	objPtr->internalRep.ptrAndLongRep.value = CURR_DEPTH;
	objPtr->length = 0;
	PUSH_TAUX_OBJ(objPtr);

	NEXT_INST_F(1, 0, 0);

    case INST_EXPAND_DROP:
	/*
	 * Drops an element of the auxObjList, popping stack elements to
	 * restore the stack to the state before the point where the aux
	 * element was created.
	 */

	CLANG_ASSERT(auxObjList);
	objc = CURR_DEPTH - auxObjList->internalRep.ptrAndLongRep.value;
	POP_TAUX_OBJ();
#ifdef TCL_COMPILE_DEBUG
	/* Ugly abuse! */
	starting = 1;
#endif

	NEXT_INST_V(1, objc, 0);

    case INST_EXPAND_STKTOP: {
	int i;
	ptrdiff_t moved;

	/*







>
















>







2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
	 * error, also in INST_EXPAND_STKTOP).
	 */

	TclNewObj(objPtr);
	objPtr->internalRep.ptrAndLongRep.value = CURR_DEPTH;
	objPtr->length = 0;
	PUSH_TAUX_OBJ(objPtr);
	TRACE(("=> mark depth as %d\n", (int) CURR_DEPTH));
	NEXT_INST_F(1, 0, 0);

    case INST_EXPAND_DROP:
	/*
	 * Drops an element of the auxObjList, popping stack elements to
	 * restore the stack to the state before the point where the aux
	 * element was created.
	 */

	CLANG_ASSERT(auxObjList);
	objc = CURR_DEPTH - auxObjList->internalRep.ptrAndLongRep.value;
	POP_TAUX_OBJ();
#ifdef TCL_COMPILE_DEBUG
	/* Ugly abuse! */
	starting = 1;
#endif
	TRACE(("=> drop %d items\n", objc));
	NEXT_INST_V(1, objc, 0);

    case INST_EXPAND_STKTOP: {
	int i;
	ptrdiff_t moved;

	/*
3378
3379
3380
3381
3382
3383
3384

3385
3386

3387
3388
3389
3390
3391
3392
3393
	    TRACE(("\"%.30s\" (by %ld) => ", O2S(objPtr), increment));
	}
	part1Ptr = objPtr;
	opnd = -1;
	varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr,
		TCL_LEAVE_ERR_MSG, "read", 1, 1, &arrayPtr);
	if (!varPtr) {

	    Tcl_AddErrorInfo(interp,
		    "\n    (reading value of variable to increment)");

	    TRACE_ERROR(interp);
	    Tcl_DecrRefCount(incrPtr);
	    goto gotError;
	}
	cleanup = ((part2Ptr == NULL)? 1 : 2);
	goto doIncrVar;








>


>







3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
	    TRACE(("\"%.30s\" (by %ld) => ", O2S(objPtr), increment));
	}
	part1Ptr = objPtr;
	opnd = -1;
	varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr,
		TCL_LEAVE_ERR_MSG, "read", 1, 1, &arrayPtr);
	if (!varPtr) {
	    DECACHE_STACK_INFO();
	    Tcl_AddErrorInfo(interp,
		    "\n    (reading value of variable to increment)");
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    Tcl_DecrRefCount(incrPtr);
	    goto gotError;
	}
	cleanup = ((part2Ptr == NULL)? 1 : 2);
	goto doIncrVar;

3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
	/*
	 * Peep-hole optimisation: if you're about to jump, do jump from here.
	 */

    afterExistsPeephole: {
	int found = (varPtr && !TclIsVarUndefined(varPtr));

	pc += pcAdjustment;
#ifndef TCL_COMPILE_DEBUG
	switch (*pc) {
	case INST_JUMP_FALSE1:
	    NEXT_INST_V((found? 2 : TclGetInt1AtPtr(pc+1)), cleanup, 0);
	case INST_JUMP_TRUE1:
	    NEXT_INST_V((found? TclGetInt1AtPtr(pc+1) : 2), cleanup, 0);
	case INST_JUMP_FALSE4:
	    NEXT_INST_V((found? 5 : TclGetInt4AtPtr(pc+1)), cleanup, 0);
	case INST_JUMP_TRUE4:
	    NEXT_INST_V((found? TclGetInt4AtPtr(pc+1) : 5), cleanup, 0);
	}
#endif
	objResultPtr = TCONST(found ? 1 : 0);
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_V(0, cleanup, 1);
    }

    /*
     *	   End of INST_EXIST instructions.
     * -----------------------------------------------------------------
     *	   Start of INST_UNSET instructions.
     */

    {
	int flags;

    case INST_UNSET_SCALAR:
	flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
	opnd = TclGetUInt4AtPtr(pc+2);
	varPtr = LOCAL(opnd);
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	TRACE(("%s %u => ", (flags?"normal":"noerr"), opnd));
	if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) {
	    /*
	     * No errors, no traces, no searches: just make the variable cease
	     * to exist.
	     */

	    if (!TclIsVarUndefined(varPtr)) {







<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|


















|







3750
3751
3752
3753
3754
3755
3756














3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
	/*
	 * Peep-hole optimisation: if you're about to jump, do jump from here.
	 */

    afterExistsPeephole: {
	int found = (varPtr && !TclIsVarUndefined(varPtr));















	TRACE_APPEND(("%d\n", found ? 1 : 0));
	JUMP_PEEPHOLE_V(found, pcAdjustment, cleanup);
    }

    /*
     *	   End of INST_EXIST instructions.
     * -----------------------------------------------------------------
     *	   Start of INST_UNSET instructions.
     */

    {
	int flags;

    case INST_UNSET_SCALAR:
	flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
	opnd = TclGetUInt4AtPtr(pc+2);
	varPtr = LOCAL(opnd);
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	TRACE(("%s %u => ", (flags ? "normal" : "noerr"), opnd));
	if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) {
	    /*
	     * No errors, no traces, no searches: just make the variable cease
	     * to exist.
	     */

	    if (!TclIsVarUndefined(varPtr)) {
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808

3809
3810
3811
3812
3813
3814
3815
	NEXT_INST_F(6, 1, 0);

    case INST_UNSET_ARRAY_STK:
	flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
	cleanup = 2;
	part2Ptr = OBJ_AT_TOS;		/* element name */
	part1Ptr = OBJ_UNDER_TOS;	/* array name */
	TRACE(("%s \"%.30s(%.30s)\" => ", (flags?"normal":"noerr"),
		O2S(part1Ptr), O2S(part2Ptr)));
	goto doUnsetStk;

    case INST_UNSET_STK:
	flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
	cleanup = 1;
	part2Ptr = NULL;
	part1Ptr = OBJ_AT_TOS;		/* variable name */
	TRACE(("%s \"%.30s\" => ", (flags?"normal":"noerr"), O2S(part1Ptr)));


    doUnsetStk:
	DECACHE_STACK_INFO();
	if (TclObjUnsetVar2(interp, part1Ptr, part2Ptr, flags) != TCL_OK
		&& (flags & TCL_LEAVE_ERR_MSG)) {
	    goto errorInUnset;
	}







|








|
>







3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
	NEXT_INST_F(6, 1, 0);

    case INST_UNSET_ARRAY_STK:
	flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
	cleanup = 2;
	part2Ptr = OBJ_AT_TOS;		/* element name */
	part1Ptr = OBJ_UNDER_TOS;	/* array name */
	TRACE(("%s \"%.30s(%.30s)\" => ", (flags ? "normal" : "noerr"),
		O2S(part1Ptr), O2S(part2Ptr)));
	goto doUnsetStk;

    case INST_UNSET_STK:
	flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
	cleanup = 1;
	part2Ptr = NULL;
	part1Ptr = OBJ_AT_TOS;		/* variable name */
	TRACE(("%s \"%.30s\" => ", (flags ? "normal" : "noerr"),
		O2S(part1Ptr)));

    doUnsetStk:
	DECACHE_STACK_INFO();
	if (TclObjUnsetVar2(interp, part1Ptr, part2Ptr, flags) != TCL_OK
		&& (flags & TCL_LEAVE_ERR_MSG)) {
	    goto errorInUnset;
	}
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838

	/*
	 * This is really an unset operation these days. Do not issue.
	 */

    case INST_DICT_DONE:
	opnd = TclGetUInt4AtPtr(pc+1);
	TRACE(("%u\n", opnd));
	varPtr = LOCAL(opnd);
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) {
	    if (!TclIsVarUndefined(varPtr)) {
		TclDecrRefCount(varPtr->value.objPtr);







|







3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898

	/*
	 * This is really an unset operation these days. Do not issue.
	 */

    case INST_DICT_DONE:
	opnd = TclGetUInt4AtPtr(pc+1);
	TRACE(("%u => OK\n", opnd));
	varPtr = LOCAL(opnd);
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) {
	    if (!TclIsVarUndefined(varPtr)) {
		TclDecrRefCount(varPtr->value.objPtr);
3922
3923
3924
3925
3926
3927
3928

3929

3930
3931
3932
3933
3934
3935
3936
	    if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) {
		/*
		 * Either an array element, or a scalar: lose!
		 */

		TclObjVarErrMsg(interp, part1Ptr, NULL, "array set",
			"variable isn't array", opnd);

		Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);

		TRACE_ERROR(interp);
		goto gotError;
	    }
	    TclSetVarArray(varPtr);
	    varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable));
	    TclInitVarHashTable(varPtr->value.tablePtr,
		    TclGetVarNsPtr(varPtr));







>

>







3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
	    if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) {
		/*
		 * Either an array element, or a scalar: lose!
		 */

		TclObjVarErrMsg(interp, part1Ptr, NULL, "array set",
			"variable isn't array", opnd);
		DECACHE_STACK_INFO();
		Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }
	    TclSetVarArray(varPtr);
	    varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable));
	    TclInitVarHashTable(varPtr->value.tablePtr,
		    TclGetVarNsPtr(varPtr));
4261
4262
4263
4264
4265
4266
4267

4268
4269

4270
4271
4272
4273
4274
4275
4276
		framePtr = framePtr->callerVarPtr) {
	    /* Empty loop body */
	}
	if (framePtr == rootFramePtr) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad level \"%s\"", TclGetString(OBJ_AT_TOS)));
	    TRACE_ERROR(interp);

	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL",
		    TclGetString(OBJ_AT_TOS), NULL);

	    goto gotError;
	}
	objResultPtr = Tcl_NewListObj(framePtr->objc, framePtr->objv);
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_F(1, 1, 1);
    }
    case INST_RESOLVE_COMMAND: {







>


>







4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
		framePtr = framePtr->callerVarPtr) {
	    /* Empty loop body */
	}
	if (framePtr == rootFramePtr) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad level \"%s\"", TclGetString(OBJ_AT_TOS)));
	    TRACE_ERROR(interp);
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL",
		    TclGetString(OBJ_AT_TOS), NULL);
	    CACHE_STACK_INFO();
	    goto gotError;
	}
	objResultPtr = Tcl_NewListObj(framePtr->objc, framePtr->objv);
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_F(1, 1, 1);
    }
    case INST_RESOLVE_COMMAND: {
4289
4290
4291
4292
4293
4294
4295

4296

4297
4298
4299
4300
4301
4302
4303

	if (framePtr == NULL ||
		!(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
	    TRACE(("=> ERROR: no TclOO call context\n"));
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "self may only be called from inside a method",
		    -1));

	    Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);

	    goto gotError;
	}
	contextPtr = framePtr->clientData;

	/*
	 * Call out to get the name; it's expensive to compute but cached.
	 */







>

>







4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369

	if (framePtr == NULL ||
		!(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
	    TRACE(("=> ERROR: no TclOO call context\n"));
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "self may only be called from inside a method",
		    -1));
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
	    CACHE_STACK_INFO();
	    goto gotError;
	}
	contextPtr = framePtr->clientData;

	/*
	 * Call out to get the name; it's expensive to compute but cached.
	 */
4684
4685
4686
4687
4688
4689
4690
4691
4692
4693
4694
4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709
4710
4711
4712

	/*
	 * Peep-hole optimisation: if you're about to jump, do jump from here.
	 * We're saving the effort of pushing a boolean value only to pop it
	 * for branching.
	 */

	pc++;
#ifndef TCL_COMPILE_DEBUG
	switch (*pc) {
	case INST_JUMP_FALSE1:
	    NEXT_INST_F((match ? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
	case INST_JUMP_TRUE1:
	    NEXT_INST_F((match ? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
	case INST_JUMP_FALSE4:
	    NEXT_INST_F((match ? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
	case INST_JUMP_TRUE4:
	    NEXT_INST_F((match ? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
	}
#endif
	objResultPtr = TCONST(match);
	NEXT_INST_F(0, 2, 1);

    case INST_LIST_CONCAT:
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;
	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
	if (Tcl_IsShared(valuePtr)) {
	    objResultPtr = Tcl_DuplicateObj(valuePtr);







<
<
<
<
<
<
<
<
<
<
<
<
<
|
<







4750
4751
4752
4753
4754
4755
4756













4757

4758
4759
4760
4761
4762
4763
4764

	/*
	 * Peep-hole optimisation: if you're about to jump, do jump from here.
	 * We're saving the effort of pushing a boolean value only to pop it
	 * for branching.
	 */














	JUMP_PEEPHOLE_F(match, 1, 2);


    case INST_LIST_CONCAT:
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;
	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
	if (Tcl_IsShared(valuePtr)) {
	    objResultPtr = Tcl_DuplicateObj(valuePtr);
4852
4853
4854
4855
4856
4857
4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
4873
4874
4875
4876
4877
4878
4879
4880
4881
4882
4883
4884
4885
4886
4887
4888
4889
4890
4891
4892
		break;
	    case INST_GE:
		match = (match >= 0);
		break;
	    }
	}

#ifndef TCL_COMPILE_DEBUG
	switch (*(pc+1)) {
	case INST_JUMP_FALSE1:
	    NEXT_INST_F((match? 3 : TclGetInt1AtPtr(pc+2)+1), 2, 0);
	case INST_JUMP_TRUE1:
	    NEXT_INST_F((match? TclGetInt1AtPtr(pc+2)+1 : 3), 2, 0);
	case INST_JUMP_FALSE4:
	    NEXT_INST_F((match? 6 : TclGetInt4AtPtr(pc+2)+1), 2, 0);
	case INST_JUMP_TRUE4:
	    NEXT_INST_F((match? TclGetInt4AtPtr(pc+2)+1 : 6), 2, 0);
	}
#endif

	if (match < 0) {
	    TclNewLongObj(objResultPtr, -1);
	} else {
	    objResultPtr = TCONST(match > 0);
	}
	TRACE(("%.20s %.20s => %s\n", O2S(valuePtr), O2S(value2Ptr),
		O2S(objResultPtr)));
	NEXT_INST_F(1, 2, 1);

    case INST_STR_LEN:
	valuePtr = OBJ_AT_TOS;
	length = Tcl_GetCharLength(valuePtr);
	TclNewLongObj(objResultPtr, length);
	TRACE(("%.20s => %d\n", O2S(valuePtr), length));
	NEXT_INST_F(1, 1, 1);

    case INST_STR_INDEX:
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;
	TRACE(("\"%.20s\" %.20s => ", O2S(valuePtr), O2S(value2Ptr)));








<
<
<
<
<
<
<
<
<
<
<
<
|
|
<
<
|
<
<
<
<





|







4904
4905
4906
4907
4908
4909
4910












4911
4912


4913




4914
4915
4916
4917
4918
4919
4920
4921
4922
4923
4924
4925
4926
		break;
	    case INST_GE:
		match = (match >= 0);
		break;
	    }
	}













	TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr),
		(match < 0 ? -1 : match > 0 ? 1 : 0)));


	JUMP_PEEPHOLE_F(match, 1, 2);





    case INST_STR_LEN:
	valuePtr = OBJ_AT_TOS;
	length = Tcl_GetCharLength(valuePtr);
	TclNewLongObj(objResultPtr, length);
	TRACE(("\"%.20s\" => %d\n", O2S(valuePtr), length));
	NEXT_INST_F(1, 1, 1);

    case INST_STR_INDEX:
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;
	TRACE(("\"%.20s\" %.20s => ", O2S(valuePtr), O2S(value2Ptr)));

4995
4996
4997
4998
4999
5000
5001
5002
5003
5004
5005
5006
5007
5008
5009
5010
5011
5012
5013
5014
5015
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
5027
5028
5029

    case INST_STR_MAP:
	valuePtr = OBJ_AT_TOS;		/* "Main" string. */
	value3Ptr = OBJ_UNDER_TOS;	/* "Target" string. */
	value2Ptr = OBJ_AT_DEPTH(2);	/* "Source" string. */
	if (value3Ptr == value2Ptr) {
	    objResultPtr = valuePtr;
	    NEXT_INST_V(1, 3, 1);
	} else if (valuePtr == value2Ptr) {
	    objResultPtr = value3Ptr;
	    NEXT_INST_V(1, 3, 1);
	}
	ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
	if (length == 0) {
	    objResultPtr = valuePtr;
	    NEXT_INST_V(1, 3, 1);
	}
	ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
	if (length2 > length || length2 == 0) {
	    objResultPtr = valuePtr;
	    NEXT_INST_V(1, 3, 1);
	} else if (length2 == length) {
	    if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length)) {
		objResultPtr = valuePtr;
	    } else {
		objResultPtr = value3Ptr;
	    }
	    NEXT_INST_V(1, 3, 1);
	}
	ustring3 = Tcl_GetUnicodeFromObj(value3Ptr, &length3);

	objResultPtr = Tcl_NewUnicodeObj(ustring1, 0);
	p = ustring1;
	end = ustring1 + length;
	for (; ustring1 < end; ustring1++) {







|


|




|




|






|







5029
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
5045
5046
5047
5048
5049
5050
5051
5052
5053
5054
5055
5056
5057
5058
5059
5060
5061
5062
5063

    case INST_STR_MAP:
	valuePtr = OBJ_AT_TOS;		/* "Main" string. */
	value3Ptr = OBJ_UNDER_TOS;	/* "Target" string. */
	value2Ptr = OBJ_AT_DEPTH(2);	/* "Source" string. */
	if (value3Ptr == value2Ptr) {
	    objResultPtr = valuePtr;
	    goto doneStringMap;
	} else if (valuePtr == value2Ptr) {
	    objResultPtr = value3Ptr;
	    goto doneStringMap;
	}
	ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
	if (length == 0) {
	    objResultPtr = valuePtr;
	    goto doneStringMap;
	}
	ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
	if (length2 > length || length2 == 0) {
	    objResultPtr = valuePtr;
	    goto doneStringMap;
	} else if (length2 == length) {
	    if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length)) {
		objResultPtr = valuePtr;
	    } else {
		objResultPtr = value3Ptr;
	    }
	    goto doneStringMap;
	}
	ustring3 = Tcl_GetUnicodeFromObj(value3Ptr, &length3);

	objResultPtr = Tcl_NewUnicodeObj(ustring1, 0);
	p = ustring1;
	end = ustring1 + length;
	for (; ustring1 < end; ustring1++) {
5044
5045
5046
5047
5048
5049
5050

5051
5052
5053
5054
5055
5056
5057
	if (p != ustring1) {
	    /*
	     * Put the rest of the unmapped chars onto result.
	     */

	    Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1 - p);
	}

	TRACE_WITH_OBJ(("%.20s %.20s %.20s => ",
		O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr);
	NEXT_INST_V(1, 3, 1);

    case INST_STR_FIND:
	ustring1 = Tcl_GetUnicodeFromObj(OBJ_AT_TOS, &length);	/* Haystack */
	ustring2 = Tcl_GetUnicodeFromObj(OBJ_UNDER_TOS, &length2);/* Needle */







>







5078
5079
5080
5081
5082
5083
5084
5085
5086
5087
5088
5089
5090
5091
5092
	if (p != ustring1) {
	    /*
	     * Put the rest of the unmapped chars onto result.
	     */

	    Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1 - p);
	}
    doneStringMap:
	TRACE_WITH_OBJ(("%.20s %.20s %.20s => ",
		O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr);
	NEXT_INST_V(1, 3, 1);

    case INST_STR_FIND:
	ustring1 = Tcl_GetUnicodeFromObj(OBJ_AT_TOS, &length);	/* Haystack */
	ustring2 = Tcl_GetUnicodeFromObj(OBJ_UNDER_TOS, &length2);/* Needle */
5066
5067
5068
5069
5070
5071
5072
5073
5074
5075
5076
5077
5078
5079
5080
		    break;
		}
	    }
	}

	TRACE(("%.20s %.20s => %d\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));

	TclNewLongObj(objResultPtr, match);
	NEXT_INST_F(1, 2, 1);

    case INST_STR_FIND_LAST:
	ustring1 = Tcl_GetUnicodeFromObj(OBJ_AT_TOS, &length);	/* Haystack */
	ustring2 = Tcl_GetUnicodeFromObj(OBJ_UNDER_TOS, &length2);/* Needle */








<







5101
5102
5103
5104
5105
5106
5107

5108
5109
5110
5111
5112
5113
5114
		    break;
		}
	    }
	}

	TRACE(("%.20s %.20s => %d\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));

	TclNewLongObj(objResultPtr, match);
	NEXT_INST_F(1, 2, 1);

    case INST_STR_FIND_LAST:
	ustring1 = Tcl_GetUnicodeFromObj(OBJ_AT_TOS, &length);	/* Haystack */
	ustring2 = Tcl_GetUnicodeFromObj(OBJ_UNDER_TOS, &length2);/* Needle */

5132
5133
5134
5135
5136
5137
5138
5139
5140
5141
5142
5143
5144
5145
5146
5147
5148
5149
5150
5151
5152
5153
5154
5155
5156
5157
5158

5159
5160
5161
5162
5163
5164
5165
5166
5167
5168

5169
5170
5171
5172
5173
5174
5175
5176
5177
5178
5179
5180
5181
5182
5183
5184
5185
5186
5187
5188
5189
5190
5191
5192
5193
5194
5195
5196
5197
5198
5199
5200
5201
5202
5203
5204
5205
5206
5207
5208
5209
5210
5211
5212
5213

	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));

	/*
	 * Peep-hole optimisation: if you're about to jump, do jump from here.
	 */

	pc += 2;
#ifndef TCL_COMPILE_DEBUG
	switch (*pc) {
	case INST_JUMP_FALSE1:
	    NEXT_INST_F((match? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
	case INST_JUMP_TRUE1:
	    NEXT_INST_F((match? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
	case INST_JUMP_FALSE4:
	    NEXT_INST_F((match? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
	case INST_JUMP_TRUE4:
	    NEXT_INST_F((match? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
	}
#endif
	objResultPtr = TCONST(match);
	NEXT_INST_F(0, 2, 1);

    case INST_REGEXP:
	cflags = TclGetInt1AtPtr(pc+1); /* RE compile flages like NOCASE */
	valuePtr = OBJ_AT_TOS;		/* String */
	value2Ptr = OBJ_UNDER_TOS;	/* Pattern */


	/*
	 * Compile and match the regular expression.
	 */

	{
	    Tcl_RegExp regExpr =
		    Tcl_GetRegExpFromObj(interp, value2Ptr, cflags);

	    if (regExpr == NULL) {

		goto regexpFailure;
	    }

	    match = Tcl_RegExpExecObj(interp, regExpr, valuePtr, 0, 0, 0);

	    if (match < 0) {
	    regexpFailure:
#ifdef TCL_COMPILE_DEBUG
		objResultPtr = Tcl_GetObjResult(interp);
		TRACE_WITH_OBJ(("%.20s %.20s => ERROR: ",
			O2S(valuePtr), O2S(value2Ptr)), objResultPtr);
#endif
		goto gotError;
	    }
	}

	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));

	/*
	 * Peep-hole optimisation: if you're about to jump, do jump from here.
	 * Adjustment is 2 due to the nocase byte.
	 */

	pc += 2;
#ifndef TCL_COMPILE_DEBUG
	switch (*pc) {
	case INST_JUMP_FALSE1:
	    NEXT_INST_F((match? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
	case INST_JUMP_TRUE1:
	    NEXT_INST_F((match? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
	case INST_JUMP_FALSE4:
	    NEXT_INST_F((match? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
	case INST_JUMP_TRUE4:
	    NEXT_INST_F((match? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
	}
#endif
	objResultPtr = TCONST(match);
	NEXT_INST_F(0, 2, 1);
    }

    /*
     *	   End of string-related instructions.
     * -----------------------------------------------------------------
     *	   Start of numeric operator instructions.
     */







<
<
<
<
<
<
<
<
<
<
<
<
<
|
<





>










>
|

<

<

<
<
|
<
<
<




|






<
<
<
<
<
<
<
<
<
<
<
<
<
|
<







5166
5167
5168
5169
5170
5171
5172













5173

5174
5175
5176
5177
5178
5179
5180
5181
5182
5183
5184
5185
5186
5187
5188
5189
5190
5191
5192

5193

5194


5195



5196
5197
5198
5199
5200
5201
5202
5203
5204
5205
5206













5207

5208
5209
5210
5211
5212
5213
5214

	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));

	/*
	 * Peep-hole optimisation: if you're about to jump, do jump from here.
	 */














	JUMP_PEEPHOLE_F(match, 2, 2);


    case INST_REGEXP:
	cflags = TclGetInt1AtPtr(pc+1); /* RE compile flages like NOCASE */
	valuePtr = OBJ_AT_TOS;		/* String */
	value2Ptr = OBJ_UNDER_TOS;	/* Pattern */
	TRACE(("%.20s %.20s => ", O2S(valuePtr), O2S(value2Ptr)));

	/*
	 * Compile and match the regular expression.
	 */

	{
	    Tcl_RegExp regExpr =
		    Tcl_GetRegExpFromObj(interp, value2Ptr, cflags);

	    if (regExpr == NULL) {
		TRACE_ERROR(interp);
		goto gotError;
	    }

	    match = Tcl_RegExpExecObj(interp, regExpr, valuePtr, 0, 0, 0);

	    if (match < 0) {


		TRACE_ERROR(interp);



		goto gotError;
	    }
	}

	TRACE_APPEND(("%d\n", match));

	/*
	 * Peep-hole optimisation: if you're about to jump, do jump from here.
	 * Adjustment is 2 due to the nocase byte.
	 */














	JUMP_PEEPHOLE_F(match, 2, 2);

    }

    /*
     *	   End of string-related instructions.
     * -----------------------------------------------------------------
     *	   Start of numeric operator instructions.
     */
5297
5298
5299
5300
5301
5302
5303
5304
5305
5306
5307
5308
5309
5310
5311
5312
5313
5314
5315
5316

5317
5318
5319
5320
5321
5322
5323
5324
5325
	}

	/*
	 * Peep-hole optimisation: if you're about to jump, do jump from here.
	 */

    foundResult:
	pc++;
#ifndef TCL_COMPILE_DEBUG
	switch (*pc) {
	case INST_JUMP_FALSE1:
	    NEXT_INST_F((iResult? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
	case INST_JUMP_TRUE1:
	    NEXT_INST_F((iResult? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
	case INST_JUMP_FALSE4:
	    NEXT_INST_F((iResult? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
	case INST_JUMP_TRUE4:
	    NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
	}
#endif

	objResultPtr = TCONST(iResult);
	NEXT_INST_F(0, 2, 1);
    }

    case INST_MOD:
    case INST_LSHIFT:
    case INST_RSHIFT:
    case INST_BITOR:
    case INST_BITXOR:







<
<
<
<
<
<
<
<
<
<
<
<
<
>
|
|







5298
5299
5300
5301
5302
5303
5304













5305
5306
5307
5308
5309
5310
5311
5312
5313
5314
	}

	/*
	 * Peep-hole optimisation: if you're about to jump, do jump from here.
	 */

    foundResult:













	TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr),
		iResult));
	JUMP_PEEPHOLE_F(iResult, 1, 2);
    }

    case INST_MOD:
    case INST_LSHIFT:
    case INST_RSHIFT:
    case INST_BITOR:
    case INST_BITXOR:
5398
5399
5400
5401
5402
5403
5404
5405
5406
5407
5408
5409
5410
5411
5412
5413
5414
5415
5416
5417
5418
		    goto longResultOfArithmetic;
		}

	    case INST_RSHIFT:
		if (l2 < 0) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "negative shift argument", -1));
#if 0
		    DECACHE_STACK_INFO();
		    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
			    "domain error: argument not in valid range",
			    NULL);
		    CACHE_STACK_INFO();
#endif
		    goto gotError;
		} else if (l1 == 0) {
		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
		    objResultPtr = TCONST(0);
		    TRACE(("%s\n", O2S(objResultPtr)));
		    NEXT_INST_F(1, 2, 1);
		} else {







|





|







5387
5388
5389
5390
5391
5392
5393
5394
5395
5396
5397
5398
5399
5400
5401
5402
5403
5404
5405
5406
5407
		    goto longResultOfArithmetic;
		}

	    case INST_RSHIFT:
		if (l2 < 0) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "negative shift argument", -1));
#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
		    DECACHE_STACK_INFO();
		    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
			    "domain error: argument not in valid range",
			    NULL);
		    CACHE_STACK_INFO();
#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
		    goto gotError;
		} else if (l1 == 0) {
		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
		    objResultPtr = TCONST(0);
		    TRACE(("%s\n", O2S(objResultPtr)));
		    NEXT_INST_F(1, 2, 1);
		} else {
5446
5447
5448
5449
5450
5451
5452
5453
5454
5455
5456
5457
5458
5459
5460
5461
5462
5463
5464
5465
5466
5467
5468
5469
5470
5471
5472
5473
5474
5475
5476
5477
5478
5479
5480
5481
5482
5483
5484
5485
5486
5487
5488
		    goto longResultOfArithmetic;
		}

	    case INST_LSHIFT:
		if (l2 < 0) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "negative shift argument", -1));
#if 0
		    DECACHE_STACK_INFO();
		    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
			    "domain error: argument not in valid range",
			    NULL);
		    CACHE_STACK_INFO();
#endif
		    goto gotError;
		} else if (l1 == 0) {
		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
		    objResultPtr = TCONST(0);
		    TRACE(("%s\n", O2S(objResultPtr)));
		    NEXT_INST_F(1, 2, 1);
		} else if (l2 > (long) INT_MAX) {
		    /*
		     * Technically, we could hold the value (1 << (INT_MAX+1))
		     * in an mp_int, but since we're using mp_mul_2d() to do
		     * the work, and it takes only an int argument, that's a
		     * good place to draw the line.
		     */

		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "integer value too large to represent", -1));
#if 0
		    DECACHE_STACK_INFO();
		    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
			    "integer value too large to represent", NULL);
		    CACHE_STACK_INFO();
#endif
		    goto gotError;
		} else {
		    int shift = (int) l2;

		    /*
		     * Handle shifts within the native long range.
		     */







|





|
















|




|







5435
5436
5437
5438
5439
5440
5441
5442
5443
5444
5445
5446
5447
5448
5449
5450
5451
5452
5453
5454
5455
5456
5457
5458
5459
5460
5461
5462
5463
5464
5465
5466
5467
5468
5469
5470
5471
5472
5473
5474
5475
5476
5477
		    goto longResultOfArithmetic;
		}

	    case INST_LSHIFT:
		if (l2 < 0) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "negative shift argument", -1));
#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
		    DECACHE_STACK_INFO();
		    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
			    "domain error: argument not in valid range",
			    NULL);
		    CACHE_STACK_INFO();
#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
		    goto gotError;
		} else if (l1 == 0) {
		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
		    objResultPtr = TCONST(0);
		    TRACE(("%s\n", O2S(objResultPtr)));
		    NEXT_INST_F(1, 2, 1);
		} else if (l2 > (long) INT_MAX) {
		    /*
		     * Technically, we could hold the value (1 << (INT_MAX+1))
		     * in an mp_int, but since we're using mp_mul_2d() to do
		     * the work, and it takes only an int argument, that's a
		     * good place to draw the line.
		     */

		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "integer value too large to represent", -1));
#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
		    DECACHE_STACK_INFO();
		    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
			    "integer value too large to represent", NULL);
		    CACHE_STACK_INFO();
#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
		    goto gotError;
		} else {
		    int shift = (int) l2;

		    /*
		     * Handle shifts within the native long range.
		     */
5712
5713
5714
5715
5716
5717
5718
5719
5720
5721
5722
5723
5724
5725
5726
5727

5728
5729
5730
5731
5732

5733
5734
5735
5736
5737
5738
5739
5740
5741
5742
5743
5744
5745
5746
5747
5748
5749

5750
5751
5752

5753
5754
5755
5756

5757
5758

5759
5760
5761
5762
5763

5764
5765
5766
5767
5768
5769
5770
5771
5772
5773
5774
5775

5776
5777
5778
5779
5780
5781

5782
5783
5784

5785
5786
5787
5788
5789
5790

5791
5792

5793
5794
5795
5796
5797
5798
5799
5800
5801
5802
5803
5804

5805
5806
5807
5808
5809
5810
5811
5812
5813
5814
5815
5816
5817
5818
5819
5820
5821
5822
5823
5824
5825
5826
5827
5828
5829
5830
5831
5832
5833
5834
5835
5836
5837
5838
5839
5840
5841
5842
5843
5844
5845
5846
5847
5848
5849
5850
5851
5852
5853
5854
5855
5856
5857
5858
5859
5860
5861
5862
5863
5864
5865
5866
5867
5868
5869
5870
5871
5872
5873
5874
5875
5876
5877
5878
5879
5880
5881
5882
5883
5884
5885
5886
5887
5888
5889
5890
5891
5892
5893
5894

5895
5896
5897
5898
5899
5900
5901
5902
5903
5904

5905
5906
5907
5908
5909
5910
5911
	int b;

	valuePtr = OBJ_AT_TOS;

	/* TODO - check claim that taking address of b harms performance */
	/* TODO - consider optimization search for constants */
	if (TclGetBooleanFromObj(NULL, valuePtr, &b) != TCL_OK) {
	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n", O2S(valuePtr),
		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
	    DECACHE_STACK_INFO();
	    IllegalExprOperandType(interp, pc, valuePtr);
	    CACHE_STACK_INFO();
	    goto gotError;
	}
	/* TODO: Consider peephole opt. */
	objResultPtr = TCONST(!b);

	NEXT_INST_F(1, 1, 1);
    }

    case INST_BITNOT:
	valuePtr = OBJ_AT_TOS;

	if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
		|| (type1==TCL_NUMBER_NAN) || (type1==TCL_NUMBER_DOUBLE)) {
	    /*
	     * ... ~$NonInteger => raise an error.
	     */

	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
	    DECACHE_STACK_INFO();
	    IllegalExprOperandType(interp, pc, valuePtr);
	    CACHE_STACK_INFO();
	    goto gotError;
	}
	if (type1 == TCL_NUMBER_LONG) {
	    l1 = *((const long *) ptr1);
	    if (Tcl_IsShared(valuePtr)) {
		TclNewLongObj(objResultPtr, ~l1);

		NEXT_INST_F(1, 1, 1);
	    }
	    TclSetLongObj(valuePtr, ~l1);

	    NEXT_INST_F(1, 0, 0);
	}
	objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr);
	if (objResultPtr != NULL) {

	    NEXT_INST_F(1, 1, 1);
	} else {

	    NEXT_INST_F(1, 0, 0);
	}

    case INST_UMINUS:
	valuePtr = OBJ_AT_TOS;

	if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
		|| IsErroringNaNType(type1)) {
	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
	    DECACHE_STACK_INFO();
	    IllegalExprOperandType(interp, pc, valuePtr);
	    CACHE_STACK_INFO();
	    goto gotError;
	}
	switch (type1) {
	case TCL_NUMBER_NAN:
	    /* -NaN => NaN */

	    NEXT_INST_F(1, 0, 0);
	case TCL_NUMBER_LONG:
	    l1 = *((const long *) ptr1);
	    if (l1 != LONG_MIN) {
		if (Tcl_IsShared(valuePtr)) {
		    TclNewLongObj(objResultPtr, -l1);

		    NEXT_INST_F(1, 1, 1);
		}
		TclSetLongObj(valuePtr, -l1);

		NEXT_INST_F(1, 0, 0);
	    }
	    /* FALLTHROUGH */
	}
	objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr);
	if (objResultPtr != NULL) {

	    NEXT_INST_F(1, 1, 1);
	} else {

	    NEXT_INST_F(1, 0, 0);
	}

    case INST_UPLUS:
    case INST_TRY_CVT_TO_NUMERIC:
	/*
	 * Try to convert the topmost stack object to numeric object. This is
	 * done in order to support [expr]'s policy of interpreting operands
	 * if at all possible as numbers first, then strings.
	 */

	valuePtr = OBJ_AT_TOS;


	if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) {
	    if (*pc == INST_UPLUS) {
		/*
		 * ... +$NonNumeric => raise an error.
		 */

		TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
			(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
		DECACHE_STACK_INFO();
		IllegalExprOperandType(interp, pc, valuePtr);
		CACHE_STACK_INFO();
		goto gotError;
	    }

	    /* ... TryConvertToNumeric($NonNumeric) is acceptable */
	    TRACE(("\"%.20s\" => not numeric\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 0, 0);
	}
	if (IsErroringNaNType(type1)) {
	    if (*pc == INST_UPLUS) {
		/*
		 * ... +$NonNumeric => raise an error.
		 */

		TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
			(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
		DECACHE_STACK_INFO();
		IllegalExprOperandType(interp, pc, valuePtr);
		CACHE_STACK_INFO();
	    } else {
		/*
		 * Numeric conversion of NaN -> error.
		 */

		TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n",
			O2S(objResultPtr)));
		DECACHE_STACK_INFO();
		TclExprFloatError(interp, *((const double *) ptr1));
		CACHE_STACK_INFO();
	    }
	    goto gotError;
	}

	/*
	 * Ensure that the numeric value has a string rep the same as the
	 * formatted version of its internal rep. This is used, e.g., to make
	 * sure that "expr {0001}" yields "1", not "0001". We implement this
	 * by _discarding_ the string rep since we know it will be
	 * regenerated, if needed later, by formatting the internal rep's
	 * value.
	 */

	if (valuePtr->bytes == NULL) {
	    TRACE(("\"%.20s\" => numeric, same Tcl_Obj\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 0, 0);
	}
	if (Tcl_IsShared(valuePtr)) {
	    /*
	     * Here we do some surgery within the Tcl_Obj internals. We want
	     * to copy the intrep, but not the string, so we temporarily hide
	     * the string so we do not copy it.
	     */

	    char *savedString = valuePtr->bytes;

	    valuePtr->bytes = NULL;
	    objResultPtr = Tcl_DuplicateObj(valuePtr);
	    valuePtr->bytes = savedString;
	    TRACE(("\"%.20s\" => numeric, new Tcl_Obj\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 1, 1);
	}
	TclInvalidateStringRep(valuePtr);
	TRACE(("\"%.20s\" => numeric, same Tcl_Obj\n", O2S(valuePtr)));
	NEXT_INST_F(1, 0, 0);
    }

    /*
     *	   End of numeric operator instructions.
     * -----------------------------------------------------------------
     */

    case INST_BREAK:
	/*
	DECACHE_STACK_INFO();
	Tcl_ResetResult(interp);
	CACHE_STACK_INFO();
	*/
	result = TCL_BREAK;
	cleanup = 0;

	goto processExceptionReturn;

    case INST_CONTINUE:
	/*
	DECACHE_STACK_INFO();
	Tcl_ResetResult(interp);
	CACHE_STACK_INFO();
	*/
	result = TCL_CONTINUE;
	cleanup = 0;

	goto processExceptionReturn;

    {
	ForeachInfo *infoPtr;
	Var *iterVarPtr, *listVarPtr;
	Tcl_Obj *oldValuePtr, *listPtr, **elements;
	ForeachVarList *varListPtr;







|








>





>






|










>



>




>


>





>


|









>






>



>






>


>












>







|








|








|









|
<

















|














|



|
















>










>







5701
5702
5703
5704
5705
5706
5707
5708
5709
5710
5711
5712
5713
5714
5715
5716
5717
5718
5719
5720
5721
5722
5723
5724
5725
5726
5727
5728
5729
5730
5731
5732
5733
5734
5735
5736
5737
5738
5739
5740
5741
5742
5743
5744
5745
5746
5747
5748
5749
5750
5751
5752
5753
5754
5755
5756
5757
5758
5759
5760
5761
5762
5763
5764
5765
5766
5767
5768
5769
5770
5771
5772
5773
5774
5775
5776
5777
5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
5788
5789
5790
5791
5792
5793
5794
5795
5796
5797
5798
5799
5800
5801
5802
5803
5804
5805
5806
5807
5808
5809
5810
5811
5812
5813
5814
5815
5816
5817
5818
5819
5820
5821
5822
5823
5824
5825
5826
5827
5828
5829
5830
5831
5832
5833
5834
5835
5836
5837
5838
5839
5840
5841
5842

5843
5844
5845
5846
5847
5848
5849
5850
5851
5852
5853
5854
5855
5856
5857
5858
5859
5860
5861
5862
5863
5864
5865
5866
5867
5868
5869
5870
5871
5872
5873
5874
5875
5876
5877
5878
5879
5880
5881
5882
5883
5884
5885
5886
5887
5888
5889
5890
5891
5892
5893
5894
5895
5896
5897
5898
5899
5900
5901
5902
5903
5904
5905
5906
5907
5908
5909
5910
5911
5912
5913
5914
	int b;

	valuePtr = OBJ_AT_TOS;

	/* TODO - check claim that taking address of b harms performance */
	/* TODO - consider optimization search for constants */
	if (TclGetBooleanFromObj(NULL, valuePtr, &b) != TCL_OK) {
	    TRACE(("\"%.20s\" => ERROR: illegal type %s\n", O2S(valuePtr),
		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
	    DECACHE_STACK_INFO();
	    IllegalExprOperandType(interp, pc, valuePtr);
	    CACHE_STACK_INFO();
	    goto gotError;
	}
	/* TODO: Consider peephole opt. */
	objResultPtr = TCONST(!b);
	TRACE_WITH_OBJ(("%s => ", O2S(valuePtr)), objResultPtr);
	NEXT_INST_F(1, 1, 1);
    }

    case INST_BITNOT:
	valuePtr = OBJ_AT_TOS;
	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
	if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
		|| (type1==TCL_NUMBER_NAN) || (type1==TCL_NUMBER_DOUBLE)) {
	    /*
	     * ... ~$NonInteger => raise an error.
	     */

	    TRACE_APPEND(("ERROR: illegal type %s\n",
		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
	    DECACHE_STACK_INFO();
	    IllegalExprOperandType(interp, pc, valuePtr);
	    CACHE_STACK_INFO();
	    goto gotError;
	}
	if (type1 == TCL_NUMBER_LONG) {
	    l1 = *((const long *) ptr1);
	    if (Tcl_IsShared(valuePtr)) {
		TclNewLongObj(objResultPtr, ~l1);
		TRACE_APPEND(("%s\n", O2S(objResultPtr)));
		NEXT_INST_F(1, 1, 1);
	    }
	    TclSetLongObj(valuePtr, ~l1);
	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 0, 0);
	}
	objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr);
	if (objResultPtr != NULL) {
	    TRACE_APPEND(("%s\n", O2S(objResultPtr)));
	    NEXT_INST_F(1, 1, 1);
	} else {
	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 0, 0);
	}

    case INST_UMINUS:
	valuePtr = OBJ_AT_TOS;
	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
	if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
		|| IsErroringNaNType(type1)) {
	    TRACE_APPEND(("ERROR: illegal type %s \n",
		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
	    DECACHE_STACK_INFO();
	    IllegalExprOperandType(interp, pc, valuePtr);
	    CACHE_STACK_INFO();
	    goto gotError;
	}
	switch (type1) {
	case TCL_NUMBER_NAN:
	    /* -NaN => NaN */
	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 0, 0);
	case TCL_NUMBER_LONG:
	    l1 = *((const long *) ptr1);
	    if (l1 != LONG_MIN) {
		if (Tcl_IsShared(valuePtr)) {
		    TclNewLongObj(objResultPtr, -l1);
		    TRACE_APPEND(("%s\n", O2S(objResultPtr)));
		    NEXT_INST_F(1, 1, 1);
		}
		TclSetLongObj(valuePtr, -l1);
		TRACE_APPEND(("%s\n", O2S(valuePtr)));
		NEXT_INST_F(1, 0, 0);
	    }
	    /* FALLTHROUGH */
	}
	objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr);
	if (objResultPtr != NULL) {
	    TRACE_APPEND(("%s\n", O2S(objResultPtr)));
	    NEXT_INST_F(1, 1, 1);
	} else {
	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 0, 0);
	}

    case INST_UPLUS:
    case INST_TRY_CVT_TO_NUMERIC:
	/*
	 * Try to convert the topmost stack object to numeric object. This is
	 * done in order to support [expr]'s policy of interpreting operands
	 * if at all possible as numbers first, then strings.
	 */

	valuePtr = OBJ_AT_TOS;
	TRACE(("\"%.20s\" => ", O2S(valuePtr)));

	if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) {
	    if (*pc == INST_UPLUS) {
		/*
		 * ... +$NonNumeric => raise an error.
		 */

		TRACE_APPEND(("ERROR: illegal type %s\n",
			(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
		DECACHE_STACK_INFO();
		IllegalExprOperandType(interp, pc, valuePtr);
		CACHE_STACK_INFO();
		goto gotError;
	    }

	    /* ... TryConvertToNumeric($NonNumeric) is acceptable */
	    TRACE_APPEND(("not numeric\n"));
	    NEXT_INST_F(1, 0, 0);
	}
	if (IsErroringNaNType(type1)) {
	    if (*pc == INST_UPLUS) {
		/*
		 * ... +$NonNumeric => raise an error.
		 */

		TRACE_APPEND(("ERROR: illegal type %s\n",
			(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
		DECACHE_STACK_INFO();
		IllegalExprOperandType(interp, pc, valuePtr);
		CACHE_STACK_INFO();
	    } else {
		/*
		 * Numeric conversion of NaN -> error.
		 */

		TRACE_APPEND(("ERROR: IEEE floating pt error\n"));

		DECACHE_STACK_INFO();
		TclExprFloatError(interp, *((const double *) ptr1));
		CACHE_STACK_INFO();
	    }
	    goto gotError;
	}

	/*
	 * Ensure that the numeric value has a string rep the same as the
	 * formatted version of its internal rep. This is used, e.g., to make
	 * sure that "expr {0001}" yields "1", not "0001". We implement this
	 * by _discarding_ the string rep since we know it will be
	 * regenerated, if needed later, by formatting the internal rep's
	 * value.
	 */

	if (valuePtr->bytes == NULL) {
	    TRACE_APPEND(("numeric, same Tcl_Obj\n"));
	    NEXT_INST_F(1, 0, 0);
	}
	if (Tcl_IsShared(valuePtr)) {
	    /*
	     * Here we do some surgery within the Tcl_Obj internals. We want
	     * to copy the intrep, but not the string, so we temporarily hide
	     * the string so we do not copy it.
	     */

	    char *savedString = valuePtr->bytes;

	    valuePtr->bytes = NULL;
	    objResultPtr = Tcl_DuplicateObj(valuePtr);
	    valuePtr->bytes = savedString;
	    TRACE_APPEND(("numeric, new Tcl_Obj\n"));
	    NEXT_INST_F(1, 1, 1);
	}
	TclInvalidateStringRep(valuePtr);
	TRACE_APPEND(("numeric, same Tcl_Obj\n"));
	NEXT_INST_F(1, 0, 0);
    }

    /*
     *	   End of numeric operator instructions.
     * -----------------------------------------------------------------
     */

    case INST_BREAK:
	/*
	DECACHE_STACK_INFO();
	Tcl_ResetResult(interp);
	CACHE_STACK_INFO();
	*/
	result = TCL_BREAK;
	cleanup = 0;
	TRACE(("=> BREAK!\n"));
	goto processExceptionReturn;

    case INST_CONTINUE:
	/*
	DECACHE_STACK_INFO();
	Tcl_ResetResult(interp);
	CACHE_STACK_INFO();
	*/
	result = TCL_CONTINUE;
	cleanup = 0;
	TRACE(("=> CONTINUE!\n"));
	goto processExceptionReturn;

    {
	ForeachInfo *infoPtr;
	Var *iterVarPtr, *listVarPtr;
	Tcl_Obj *oldValuePtr, *listPtr, **elements;
	ForeachVarList *varListPtr;
6046
6047
6048
6049
6050
6051
6052
6053
6054
6055
6056
6057
6058
6059
6060
6061
		    }
		    valIndex++;
		}
		TclDecrRefCount(listPtr);
		listTmpIndex++;
	    }
	}
	TRACE_APPEND(("%d lists, iter %d, %s loop\n", opnd, numLists,
		iterNum, (continueLoop? "continue" : "exit")));

	/*
	 * Run-time peep-hole optimisation: the compiler ALWAYS follows
	 * INST_FOREACH_STEP4 with an INST_JUMP_FALSE. We just skip that
	 * instruction and jump direct from here.
	 */








|
|







6049
6050
6051
6052
6053
6054
6055
6056
6057
6058
6059
6060
6061
6062
6063
6064
		    }
		    valIndex++;
		}
		TclDecrRefCount(listPtr);
		listTmpIndex++;
	    }
	}
	TRACE_APPEND(("%d lists, iter %d, %s loop\n",
		numLists, iterNum, (continueLoop? "continue" : "exit")));

	/*
	 * Run-time peep-hole optimisation: the compiler ALWAYS follows
	 * INST_FOREACH_STEP4 with an INST_JUMP_FALSE. We just skip that
	 * instruction and jump direct from here.
	 */

6081
6082
6083
6084
6085
6086
6087

6088
6089
6090
6091
6092
6093
6094
6095
6096
6097
6098
6099
6100
6101
6102
6103
6104
6105
6106
6107
6108
	 * Initialize the data for the looping construct, pushing the
	 * corresponding Tcl_Objs to the stack.
	 */

	opnd = TclGetUInt4AtPtr(pc+1);
	infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
	numLists = infoPtr->numLists;


	/*
	 * Compute the number of iterations that will be run: iterMax
	 */

	iterMax = 0;
	listTmpDepth = numLists-1;
	for (i = 0;  i < numLists;  i++) {
	    varListPtr = infoPtr->varLists[i];
	    numVars = varListPtr->numVars;
	    listPtr = OBJ_AT_DEPTH(listTmpDepth);
	    if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
		TRACE_WITH_OBJ(("%u => ERROR converting list %ld, \"%s\": ",
			opnd, i, O2S(listPtr)), Tcl_GetObjResult(interp));
		goto gotError;
	    }
	    if (Tcl_IsShared(listPtr)) {
		objPtr = TclListObjCopy(NULL, listPtr);
		Tcl_IncrRefCount(objPtr);
		Tcl_DecrRefCount(listPtr);
		OBJ_AT_DEPTH(listTmpDepth) = objPtr;







>












|
|







6084
6085
6086
6087
6088
6089
6090
6091
6092
6093
6094
6095
6096
6097
6098
6099
6100
6101
6102
6103
6104
6105
6106
6107
6108
6109
6110
6111
6112
	 * Initialize the data for the looping construct, pushing the
	 * corresponding Tcl_Objs to the stack.
	 */

	opnd = TclGetUInt4AtPtr(pc+1);
	infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
	numLists = infoPtr->numLists;
	TRACE(("%u => ", opnd));

	/*
	 * Compute the number of iterations that will be run: iterMax
	 */

	iterMax = 0;
	listTmpDepth = numLists-1;
	for (i = 0;  i < numLists;  i++) {
	    varListPtr = infoPtr->varLists[i];
	    numVars = varListPtr->numVars;
	    listPtr = OBJ_AT_DEPTH(listTmpDepth);
	    if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
		TRACE_APPEND(("ERROR converting list %ld, \"%s\": %s",
			i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
		goto gotError;
	    }
	    if (Tcl_IsShared(listPtr)) {
		objPtr = TclListObjCopy(NULL, listPtr);
		Tcl_IncrRefCount(objPtr);
		Tcl_DecrRefCount(listPtr);
		OBJ_AT_DEPTH(listTmpDepth) = objPtr;
6130
6131
6132
6133
6134
6135
6136

6137
6138
6139
6140
6141
6142
6143
6144
6145
6146
6147
6148
6149
6150
6151
6152
6153

6154
6155
6156
6157
6158
6159
6160
	 * Store a pointer to the ForeachInfo struct; same dirty trick
	 * as above
	 */

	TclNewObj(tmpPtr);
	tmpPtr->internalRep.otherValuePtr = infoPtr;
	PUSH_OBJECT(tmpPtr); /* infoPtr object */


	/*
	 * Jump directly to the INST_FOREACH_STEP instruction; the C code just
	 * falls through.
	 */

	pc += 5 - infoPtr->loopCtTemp;

    case INST_FOREACH_STEP:
	/*
	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
	 * the next value list element to each loop var.
	 */

	tmpPtr = OBJ_AT_TOS;
	infoPtr = tmpPtr->internalRep.otherValuePtr;
	numLists = infoPtr->numLists;


	tmpPtr = OBJ_AT_DEPTH(1);
	iterNum = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr1);
	iterMax = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr2);

	/*
	 * If some list still has a remaining list element iterate one more







>

















>







6134
6135
6136
6137
6138
6139
6140
6141
6142
6143
6144
6145
6146
6147
6148
6149
6150
6151
6152
6153
6154
6155
6156
6157
6158
6159
6160
6161
6162
6163
6164
6165
6166
	 * Store a pointer to the ForeachInfo struct; same dirty trick
	 * as above
	 */

	TclNewObj(tmpPtr);
	tmpPtr->internalRep.otherValuePtr = infoPtr;
	PUSH_OBJECT(tmpPtr); /* infoPtr object */
	TRACE_APPEND(("jump to loop step\n"));

	/*
	 * Jump directly to the INST_FOREACH_STEP instruction; the C code just
	 * falls through.
	 */

	pc += 5 - infoPtr->loopCtTemp;

    case INST_FOREACH_STEP:
	/*
	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
	 * the next value list element to each loop var.
	 */

	tmpPtr = OBJ_AT_TOS;
	infoPtr = tmpPtr->internalRep.otherValuePtr;
	numLists = infoPtr->numLists;
	TRACE(("=> "));

	tmpPtr = OBJ_AT_DEPTH(1);
	iterNum = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr1);
	iterMax = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr2);

	/*
	 * If some list still has a remaining list element iterate one more
6200
6201
6202
6203
6204
6205
6206
6207
6208
6209
6210
6211
6212
6213
6214
6215
6216
6217

6218
6219
6220
6221

6222
6223
6224
6225
6226
6227
6228
6229
6230
6231
6232
6233
6234
6235

6236
6237
6238
6239
6240
6241
6242
6243
6244
6245
6246
6247
6248
6249
6250
6251

6252
6253
6254
6255
6256
6257
6258
			    Tcl_IncrRefCount(valuePtr);
			}
		    } else {
			DECACHE_STACK_INFO();
			if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
				valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
			    CACHE_STACK_INFO();
			    TRACE_WITH_OBJ((
				    "%u => ERROR init. index temp %d: ",
				    opnd,varIndex), Tcl_GetObjResult(interp));
			    goto gotError;
			}
			CACHE_STACK_INFO();
		    }
		    valIndex++;
		}
		listTmpDepth--;
	    }

	    /* loopCtTemp being 'misused' for storing the jump size */
	    NEXT_INST_F(infoPtr->loopCtTemp, 0, 0);
	}


#ifdef TCL_COMPILE_DEBUG
	NEXT_INST_F(1, 0, 0);
#else
	/*
	 * FALL THROUGH
	 */
	pc++;
#endif

    case INST_FOREACH_END:
	/* THIS INSTRUCTION IS ONLY CALLED AS A BREAK TARGET */
	tmpPtr = OBJ_AT_TOS;
	infoPtr = tmpPtr->internalRep.otherValuePtr;
	numLists = infoPtr->numLists;

	NEXT_INST_V(1, numLists+2, 0);

    case INST_LMAP_COLLECT:
	/*
	 * This instruction is only issued by lmap. The stack is:
	 *   - result
	 *   - infoPtr
	 *   - loop counters
	 *   - valLists
	 *   - collecting obj (unshared)
	 * The instruction lappends the result to the collecting obj.
	 */

	tmpPtr = OBJ_AT_DEPTH(1);
	infoPtr = tmpPtr->internalRep.otherValuePtr;
	numLists = infoPtr->numLists;

	
	objPtr = OBJ_AT_DEPTH(3 + numLists);
	Tcl_ListObjAppendElement(NULL, objPtr, OBJ_AT_TOS);
	NEXT_INST_F(1, 1, 0);
    }

    case INST_BEGIN_CATCH4:







<
|
|








>




>














>
















>







6206
6207
6208
6209
6210
6211
6212

6213
6214
6215
6216
6217
6218
6219
6220
6221
6222
6223
6224
6225
6226
6227
6228
6229
6230
6231
6232
6233
6234
6235
6236
6237
6238
6239
6240
6241
6242
6243
6244
6245
6246
6247
6248
6249
6250
6251
6252
6253
6254
6255
6256
6257
6258
6259
6260
6261
6262
6263
6264
6265
6266
6267
			    Tcl_IncrRefCount(valuePtr);
			}
		    } else {
			DECACHE_STACK_INFO();
			if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
				valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
			    CACHE_STACK_INFO();

			    TRACE_APPEND(("ERROR init. index temp %d: %.30s",
				    varIndex, O2S(Tcl_GetObjResult(interp))));
			    goto gotError;
			}
			CACHE_STACK_INFO();
		    }
		    valIndex++;
		}
		listTmpDepth--;
	    }
	    TRACE_APPEND(("jump to loop start\n"));
	    /* loopCtTemp being 'misused' for storing the jump size */
	    NEXT_INST_F(infoPtr->loopCtTemp, 0, 0);
	}

	TRACE_APPEND(("loop has no more iterations\n"));
#ifdef TCL_COMPILE_DEBUG
	NEXT_INST_F(1, 0, 0);
#else
	/*
	 * FALL THROUGH
	 */
	pc++;
#endif

    case INST_FOREACH_END:
	/* THIS INSTRUCTION IS ONLY CALLED AS A BREAK TARGET */
	tmpPtr = OBJ_AT_TOS;
	infoPtr = tmpPtr->internalRep.otherValuePtr;
	numLists = infoPtr->numLists;
	TRACE(("=> loop terminated\n"));
	NEXT_INST_V(1, numLists+2, 0);

    case INST_LMAP_COLLECT:
	/*
	 * This instruction is only issued by lmap. The stack is:
	 *   - result
	 *   - infoPtr
	 *   - loop counters
	 *   - valLists
	 *   - collecting obj (unshared)
	 * The instruction lappends the result to the collecting obj.
	 */

	tmpPtr = OBJ_AT_DEPTH(1);
	infoPtr = tmpPtr->internalRep.otherValuePtr;
	numLists = infoPtr->numLists;
	TRACE_APPEND(("=> appending to list at depth %d\n", 3 + numLists));
	
	objPtr = OBJ_AT_DEPTH(3 + numLists);
	Tcl_ListObjAppendElement(NULL, objPtr, OBJ_AT_TOS);
	NEXT_INST_F(1, 1, 0);
    }

    case INST_BEGIN_CATCH4:
6310
6311
6312
6313
6314
6315
6316

6317
6318
6319
6320
6321
6322
6323
6324
6325
6326
6327
6328
6329
6330
6331
6332
6333
6334
6335
6336
6337
6338
6339
6340
6341
6342
6343
6344
	}
	if (code == TCL_OK) {
	    Tcl_Panic("INST_RETURN_CODE_BRANCH: TOS is TCL_OK!");
	}
	if (code < TCL_ERROR || code > TCL_CONTINUE) {
	    code = TCL_CONTINUE + 1;
	}

	NEXT_INST_F(2*code -1, 1, 0);
    }

    /*
     * -----------------------------------------------------------------
     *	   Start of dictionary-related instructions.
     */

    {
	int opnd2, allocateDict, done, i, allocdict;
	Tcl_Obj *dictPtr, *statePtr, *keyPtr, *listPtr, *varNamePtr, *keysPtr;
	Tcl_Obj *emptyPtr, **keyPtrPtr;
	Tcl_DictSearch *searchPtr;
	DictUpdateInfo *duiPtr;

    case INST_DICT_VERIFY:
	dictPtr = OBJ_AT_TOS;
	TRACE(("=> "));
	if (Tcl_DictObjSize(interp, dictPtr, &done) != TCL_OK) {
	    TRACE_APPEND(("ERROR verifying dictionary nature of \"%s\": %s\n",
		    O2S(OBJ_AT_DEPTH(opnd)), O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
	}
	TRACE_APPEND(("OK\n"));
	NEXT_INST_F(1, 1, 0);

    case INST_DICT_GET:
    case INST_DICT_EXISTS: {







>
|
















|

|
|







6319
6320
6321
6322
6323
6324
6325
6326
6327
6328
6329
6330
6331
6332
6333
6334
6335
6336
6337
6338
6339
6340
6341
6342
6343
6344
6345
6346
6347
6348
6349
6350
6351
6352
6353
6354
	}
	if (code == TCL_OK) {
	    Tcl_Panic("INST_RETURN_CODE_BRANCH: TOS is TCL_OK!");
	}
	if (code < TCL_ERROR || code > TCL_CONTINUE) {
	    code = TCL_CONTINUE + 1;
	}
	TRACE(("\"%s\" => jump offset %d\n", O2S(OBJ_AT_TOS), 2*code-1));
	NEXT_INST_F(2*code-1, 1, 0);
    }

    /*
     * -----------------------------------------------------------------
     *	   Start of dictionary-related instructions.
     */

    {
	int opnd2, allocateDict, done, i, allocdict;
	Tcl_Obj *dictPtr, *statePtr, *keyPtr, *listPtr, *varNamePtr, *keysPtr;
	Tcl_Obj *emptyPtr, **keyPtrPtr;
	Tcl_DictSearch *searchPtr;
	DictUpdateInfo *duiPtr;

    case INST_DICT_VERIFY:
	dictPtr = OBJ_AT_TOS;
	TRACE(("\"%.30s\" => ", O2S(dictPtr)));
	if (Tcl_DictObjSize(interp, dictPtr, &done) != TCL_OK) {
	    TRACE_APPEND(("ERROR verifying dictionary nature of \"%.30s\": %s\n",
		    O2S(dictPtr), O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
	}
	TRACE_APPEND(("OK\n"));
	NEXT_INST_F(1, 1, 0);

    case INST_DICT_GET:
    case INST_DICT_EXISTS: {
6356
6357
6358
6359
6360
6361
6362
6363
6364
6365
6366
6367
6368
6369
6370
6371
6372
6373
6374
6375
6376
6377
6378
6379

6380
6381
6382
6383
6384
6385
6386
6387
6388
6389
6390
6391
6392
6393
6394
6395

6396
6397
6398
6399
6400
6401
6402
6403
6404
6405
6406
6407
6408
6409
6410
6411
6412
6413
6414
6415
6416
6417
6418
6419
6420
6421
6422
6423
6424
6425
6426
6427
6428
		    &OBJ_AT_DEPTH(opnd-1), DICT_PATH_READ);
	    if (dictPtr == NULL) {
		if (*pc == INST_DICT_EXISTS) {
		    found = 0;
		    goto afterDictExists;
		}
		TRACE_WITH_OBJ((
			"ERROR tracing dictionary path into \"%s\": ",
			O2S(OBJ_AT_DEPTH(opnd))),
			Tcl_GetObjResult(interp));
		goto gotError;
	    }
	}
	if (Tcl_DictObjGet(interp2, dictPtr, OBJ_AT_TOS,
		&objResultPtr) == TCL_OK) {
	    if (*pc == INST_DICT_EXISTS) {
		found = (objResultPtr ? 1 : 0);
		goto afterDictExists;
	    }
	    if (!objResultPtr) {
		DECACHE_STACK_INFO();
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"key \"%s\" not known in dictionary",
			TclGetString(OBJ_AT_TOS)));

		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
			TclGetString(OBJ_AT_TOS), NULL);
		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }
	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	    NEXT_INST_V(5, opnd+1, 1);
	} else if (*pc != INST_DICT_EXISTS) {
	    TRACE_APPEND(("ERROR reading leaf dictionary key \"%.30s\": %s",
		    O2S(dictPtr), O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
	} else {
	    found = 0;
	}
    afterDictExists:

#ifndef TCL_COMPILE_DEBUG
	/*
	 * The INST_DICT_EXISTS instruction is usually followed by a
	 * conditional jump, so we can take advantage of this to do some
	 * peephole optimization (note that we're careful to not close out
	 * someone doing something else).
	 */

	pc += 5;
	switch (*pc) {
	case INST_JUMP_FALSE1:
	    NEXT_INST_V((found ? 2 : TclGetInt1AtPtr(pc+1)), opnd+1, 0);
	case INST_JUMP_FALSE4:
	    NEXT_INST_V((found ? 5 : TclGetInt4AtPtr(pc+1)), opnd+1, 0);
	case INST_JUMP_TRUE1:
	    NEXT_INST_V((found ? TclGetInt1AtPtr(pc+1) : 2), opnd+1, 0);
	case INST_JUMP_TRUE4:
	    NEXT_INST_V((found ? TclGetInt4AtPtr(pc+1) : 5), opnd+1, 0);
	default:
	    pc -= 5;
	    /* fall through to non-debug handling */
	}
#endif
	TRACE_APPEND(("%d\n", found));
	objResultPtr = TCONST(found);
	NEXT_INST_V(5, opnd+1, 1);
    }

    case INST_DICT_SET:
    case INST_DICT_UNSET:
    case INST_DICT_INCR_IMM:
	opnd = TclGetUInt4AtPtr(pc+1);
	opnd2 = TclGetUInt4AtPtr(pc+5);







|












<



>
















>
|







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|







6366
6367
6368
6369
6370
6371
6372
6373
6374
6375
6376
6377
6378
6379
6380
6381
6382
6383
6384
6385

6386
6387
6388
6389
6390
6391
6392
6393
6394
6395
6396
6397
6398
6399
6400
6401
6402
6403
6404
6405
6406
6407
6408
6409
6410
6411
6412
6413
6414

















6415
6416
6417
6418
6419
6420
6421
6422
		    &OBJ_AT_DEPTH(opnd-1), DICT_PATH_READ);
	    if (dictPtr == NULL) {
		if (*pc == INST_DICT_EXISTS) {
		    found = 0;
		    goto afterDictExists;
		}
		TRACE_WITH_OBJ((
			"ERROR tracing dictionary path into \"%.30s\": ",
			O2S(OBJ_AT_DEPTH(opnd))),
			Tcl_GetObjResult(interp));
		goto gotError;
	    }
	}
	if (Tcl_DictObjGet(interp2, dictPtr, OBJ_AT_TOS,
		&objResultPtr) == TCL_OK) {
	    if (*pc == INST_DICT_EXISTS) {
		found = (objResultPtr ? 1 : 0);
		goto afterDictExists;
	    }
	    if (!objResultPtr) {

		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"key \"%s\" not known in dictionary",
			TclGetString(OBJ_AT_TOS)));
		DECACHE_STACK_INFO();
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
			TclGetString(OBJ_AT_TOS), NULL);
		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }
	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	    NEXT_INST_V(5, opnd+1, 1);
	} else if (*pc != INST_DICT_EXISTS) {
	    TRACE_APPEND(("ERROR reading leaf dictionary key \"%.30s\": %s",
		    O2S(dictPtr), O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
	} else {
	    found = 0;
	}
    afterDictExists:
	TRACE_APPEND(("%d\n", found));

	/*
	 * The INST_DICT_EXISTS instruction is usually followed by a
	 * conditional jump, so we can take advantage of this to do some
	 * peephole optimization (note that we're careful to not close out
	 * someone doing something else).
	 */


















	JUMP_PEEPHOLE_V(found, 5, opnd+1);
    }

    case INST_DICT_SET:
    case INST_DICT_UNSET:
    case INST_DICT_INCR_IMM:
	opnd = TclGetUInt4AtPtr(pc+1);
	opnd2 = TclGetUInt4AtPtr(pc+5);
6488
6489
6490
6491
6492
6493
6494
6495
6496
6497
6498
6499
6500
6501
6502
6503
	    Tcl_Panic("Should not happen!");
	}

	if (result != TCL_OK) {
	    if (allocateDict) {
		TclDecrRefCount(dictPtr);
	    }
	    TRACE_WITH_OBJ(("%u %u => ERROR updating dictionary: ",
		    opnd, opnd2), Tcl_GetObjResult(interp));
	    goto checkForCatch;
	}

	if (TclIsVarDirectWritable(varPtr)) {
	    if (allocateDict) {
		value2Ptr = varPtr->value.objPtr;
		Tcl_IncrRefCount(dictPtr);







|
|







6482
6483
6484
6485
6486
6487
6488
6489
6490
6491
6492
6493
6494
6495
6496
6497
	    Tcl_Panic("Should not happen!");
	}

	if (result != TCL_OK) {
	    if (allocateDict) {
		TclDecrRefCount(dictPtr);
	    }
	    TRACE_APPEND(("ERROR updating dictionary: %s\n",
		    O2S(Tcl_GetObjResult(interp))));
	    goto checkForCatch;
	}

	if (TclIsVarDirectWritable(varPtr)) {
	    if (allocateDict) {
		value2Ptr = varPtr->value.objPtr;
		Tcl_IncrRefCount(dictPtr);
6705
6706
6707
6708
6709
6710
6711


6712
6713
6714
6715
6716
6717
6718
6719
6720
6721
6722
6723
6724
6725
6726
6727
6728
6729
6730
6731
6732
6733
6734
6735
6736
6737
6738
6739
6740
6741
6742
6743
6744
6745
6746
6747
6748
	    TclNewObj(emptyPtr);
	    PUSH_OBJECT(emptyPtr);
	    PUSH_OBJECT(emptyPtr);
	} else {
	    PUSH_OBJECT(valuePtr);
	    PUSH_OBJECT(keyPtr);
	}



#ifndef TCL_COMPILE_DEBUG
	/*
	 * The INST_DICT_FIRST and INST_DICT_NEXT instructsions are always
	 * followed by a conditional jump, so we can take advantage of this to
	 * do some peephole optimization (note that we're careful to not close
	 * out someone doing something else).
	 */

	pc += 5;
	switch (*pc) {
	case INST_JUMP_FALSE1:
	    NEXT_INST_F((done ? 2 : TclGetInt1AtPtr(pc+1)), 0, 0);
	case INST_JUMP_FALSE4:
	    NEXT_INST_F((done ? 5 : TclGetInt4AtPtr(pc+1)), 0, 0);
	case INST_JUMP_TRUE1:
	    NEXT_INST_F((done ? TclGetInt1AtPtr(pc+1) : 2), 0, 0);
	case INST_JUMP_TRUE4:
	    NEXT_INST_F((done ? TclGetInt4AtPtr(pc+1) : 5), 0, 0);
	default:
	    pc -= 5;
	    /* fall through to non-debug handling */
	}
#endif

	TRACE_APPEND(("\"%.30s\" \"%.30s\" %d\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done));
	objResultPtr = TCONST(done);
	/* TODO: consider opt like INST_FOREACH_STEP4 */
	NEXT_INST_F(5, 0, 1);

    case INST_DICT_UPDATE_START:
	opnd = TclGetUInt4AtPtr(pc+1);
	opnd2 = TclGetUInt4AtPtr(pc+5);
	TRACE(("%u => ", opnd));
	varPtr = LOCAL(opnd);
	duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData;







>
>

<







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<







6699
6700
6701
6702
6703
6704
6705
6706
6707
6708

6709
6710
6711
6712
6713
6714
6715















6716





6717
6718
6719
6720
6721
6722
6723
	    TclNewObj(emptyPtr);
	    PUSH_OBJECT(emptyPtr);
	    PUSH_OBJECT(emptyPtr);
	} else {
	    PUSH_OBJECT(valuePtr);
	    PUSH_OBJECT(keyPtr);
	}
	TRACE_APPEND(("\"%.30s\" \"%.30s\" %d\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done));


	/*
	 * The INST_DICT_FIRST and INST_DICT_NEXT instructsions are always
	 * followed by a conditional jump, so we can take advantage of this to
	 * do some peephole optimization (note that we're careful to not close
	 * out someone doing something else).
	 */
















	JUMP_PEEPHOLE_F(done, 5, 0);






    case INST_DICT_UPDATE_START:
	opnd = TclGetUInt4AtPtr(pc+1);
	opnd2 = TclGetUInt4AtPtr(pc+5);
	TRACE(("%u => ", opnd));
	varPtr = LOCAL(opnd);
	duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData;
6871
6872
6873
6874
6875
6876
6877
6878
6879
6880
6881
6882
6883
6884
6885
6886
6887
6888
6889
6890
6891
6892
6893
6894
6895
	}
	TRACE_APPEND(("written back\n"));
	NEXT_INST_F(9, 1, 0);

    case INST_DICT_EXPAND:
	dictPtr = OBJ_UNDER_TOS;
	listPtr = OBJ_AT_TOS;
	TRACE(("%.30s %.30s =>", O2S(dictPtr), O2S(listPtr)));
	if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	objResultPtr = TclDictWithInit(interp, dictPtr, objc, objv);
	if (objResultPtr == NULL) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_F(1, 2, 1);

    case INST_DICT_RECOMBINE_STK:
	keysPtr = POP_OBJECT();
	varNamePtr = OBJ_UNDER_TOS;
	listPtr = OBJ_AT_TOS;
	TRACE(("\"%.30s\" \"%.30s\" \"%.30s\" => ",







|









|







6846
6847
6848
6849
6850
6851
6852
6853
6854
6855
6856
6857
6858
6859
6860
6861
6862
6863
6864
6865
6866
6867
6868
6869
6870
	}
	TRACE_APPEND(("written back\n"));
	NEXT_INST_F(9, 1, 0);

    case INST_DICT_EXPAND:
	dictPtr = OBJ_UNDER_TOS;
	listPtr = OBJ_AT_TOS;
	TRACE(("\"%.30s\" \"%.30s\" =>", O2S(dictPtr), O2S(listPtr)));
	if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	objResultPtr = TclDictWithInit(interp, dictPtr, objc, objv);
	if (objResultPtr == NULL) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
	NEXT_INST_F(1, 2, 1);

    case INST_DICT_RECOMBINE_STK:
	keysPtr = POP_OBJECT();
	varNamePtr = OBJ_UNDER_TOS;
	listPtr = OBJ_AT_TOS;
	TRACE(("\"%.30s\" \"%.30s\" \"%.30s\" => ",
7029
7030
7031
7032
7033
7034
7035
7036
7037
7038
7039
7040
7041
7042
7043
7044
7045
7046
7047
7048
7049
7050
7051
7052
7053

7054
7055
7056
7057
7058
7059
7060
7061
7062
7063
7064
7065
7066

7067
7068
7069
7070
7071
7072
7073
		    rangePtr->codeOffset, rangePtr->continueOffset));
	    NEXT_INST_F(0, 0, 0);
	}
#ifdef TCL_COMPILE_DEBUG
	if (traceInstructions) {
	    objPtr = Tcl_GetObjResult(interp);
	    if ((result != TCL_ERROR) && (result != TCL_RETURN)) {
		TRACE_APPEND(("OTHER RETURN CODE %d, result= \"%s\"\n ",
			result, O2S(objPtr)));
	    } else {
		TRACE_APPEND(("%s, result= \"%s\"\n",
			StringForResultCode(result), O2S(objPtr)));
	    }
	}
#endif
	goto checkForCatch;

	/*
	 * Division by zero in an expression. Control only reaches this point
	 * by "goto divideByZero".
	 */

    divideByZero:
	DECACHE_STACK_INFO();
	Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1));

	Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL);
	CACHE_STACK_INFO();
	goto gotError;

	/*
	 * Exponentiation of zero by negative number in an expression. Control
	 * only reaches this point by "goto exponOfZero".
	 */

    exponOfZero:
	DECACHE_STACK_INFO();
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"exponentiation of zero by negative power", -1));

	Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
		"exponentiation of zero by negative power", NULL);
	CACHE_STACK_INFO();

	/*
	 * Almost all error paths feed through here rather than assigning to
	 * result themselves (for a small but consistent saving).







|


|












<

>










<


>







7004
7005
7006
7007
7008
7009
7010
7011
7012
7013
7014
7015
7016
7017
7018
7019
7020
7021
7022
7023
7024
7025
7026

7027
7028
7029
7030
7031
7032
7033
7034
7035
7036
7037
7038

7039
7040
7041
7042
7043
7044
7045
7046
7047
7048
		    rangePtr->codeOffset, rangePtr->continueOffset));
	    NEXT_INST_F(0, 0, 0);
	}
#ifdef TCL_COMPILE_DEBUG
	if (traceInstructions) {
	    objPtr = Tcl_GetObjResult(interp);
	    if ((result != TCL_ERROR) && (result != TCL_RETURN)) {
		TRACE_APPEND(("OTHER RETURN CODE %d, result=\"%.30s\"\n ",
			result, O2S(objPtr)));
	    } else {
		TRACE_APPEND(("%s, result=\"%.30s\"\n",
			StringForResultCode(result), O2S(objPtr)));
	    }
	}
#endif
	goto checkForCatch;

	/*
	 * Division by zero in an expression. Control only reaches this point
	 * by "goto divideByZero".
	 */

    divideByZero:

	Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1));
	DECACHE_STACK_INFO();
	Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL);
	CACHE_STACK_INFO();
	goto gotError;

	/*
	 * Exponentiation of zero by negative number in an expression. Control
	 * only reaches this point by "goto exponOfZero".
	 */

    exponOfZero:

	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"exponentiation of zero by negative power", -1));
	DECACHE_STACK_INFO();
	Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
		"exponentiation of zero by negative power", NULL);
	CACHE_STACK_INFO();

	/*
	 * Almost all error paths feed through here rather than assigning to
	 * result themselves (for a small but consistent saving).

Changes to unix/Makefile.in.

1189
1190
1191
1192
1193
1194
1195

1196
1197
1198
1199
1200
1201
1202
tclLoadDl2.o: $(UNIX_DIR)/tclLoadDl2.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadDl2.c

tclLoadDld.o: $(UNIX_DIR)/tclLoadDld.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadDld.c

tclLoadDyld.o: $(UNIX_DIR)/tclLoadDyld.c

	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadDyld.c

tclLoadNone.o: $(GENERIC_DIR)/tclLoadNone.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclLoadNone.c

tclLoadOSF.o: $(UNIX_DIR)/tclLoadOSF.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadOSF.c







>







1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
tclLoadDl2.o: $(UNIX_DIR)/tclLoadDl2.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadDl2.c

tclLoadDld.o: $(UNIX_DIR)/tclLoadDld.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadDld.c

tclLoadDyld.o: $(UNIX_DIR)/tclLoadDyld.c
	@echo Warnings are expected from compiling tclLoadDyld.c: deprecated API use
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadDyld.c

tclLoadNone.o: $(GENERIC_DIR)/tclLoadNone.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclLoadNone.c

tclLoadOSF.o: $(UNIX_DIR)/tclLoadOSF.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadOSF.c