1 /*
2  * tclExecute.c --
3  *
4  *	This file contains procedures that execute byte-compiled Tcl commands.
5  *
6  * Copyright © 1996-1997 Sun Microsystems, Inc.
7  * Copyright © 1998-2000 Scriptics Corporation.
8  * Copyright © 2001 Kevin B. Kenny. All rights reserved.
9  * Copyright © 2002-2010 Miguel Sofer.
10  * Copyright © 2005-2007 Donal K. Fellows.
11  * Copyright © 2007 Daniel A. Steffen <das@users.sourceforge.net>
12  * Copyright © 2006-2008 Joe Mistachkin.  All rights reserved.
13  *
14  * See the file "license.terms" for information on usage and redistribution of
15  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
16  */
17 
18 #include "tclInt.h"
19 #include "tclCompile.h"
20 #include "tclOOInt.h"
21 #include "tclTomMath.h"
22 #include <math.h>
23 #include <assert.h>
24 
25 /*
26  * Hack to determine whether we may expect IEEE floating point. The hack is
27  * formally incorrect in that non-IEEE platforms might have the same precision
28  * and range, but VAX, IBM, and Cray do not; are there any other floating
29  * point units that we might care about?
30  */
31 
32 #if (FLT_RADIX == 2) && (DBL_MANT_DIG == 53) && (DBL_MAX_EXP == 1024)
33 #define IEEE_FLOATING_POINT
34 #endif
35 
36 /*
37  * A counter that is used to work out when the bytecode engine should call
38  * Tcl_AsyncReady() to see whether there is a signal that needs handling, and
39  * other expensive periodic operations.
40  */
41 
42 #ifndef ASYNC_CHECK_COUNT
43 #   define ASYNC_CHECK_COUNT	64
44 #endif /* !ASYNC_CHECK_COUNT */
45 
46 /*
47  * Boolean flag indicating whether the Tcl bytecode interpreter has been
48  * initialized.
49  */
50 
51 static int execInitialized = 0;
52 TCL_DECLARE_MUTEX(execMutex)
53 
54 static int cachedInExit = 0;
55 
56 #ifdef TCL_COMPILE_DEBUG
57 /*
58  * Variable that controls whether execution tracing is enabled and, if so,
59  * what level of tracing is desired:
60  *    0: no execution tracing
61  *    1: trace invocations of Tcl procs only
62  *    2: trace invocations of all (not compiled away) commands
63  *    3: display each instruction executed
64  * This variable is linked to the Tcl variable "tcl_traceExec".
65  */
66 
67 int tclTraceExec = 0;
68 #endif
69 
70 /*
71  * Mapping from expression instruction opcodes to strings; used for error
72  * messages. Note that these entries must match the order and number of the
73  * expression opcodes (e.g., INST_LOR) in tclCompile.h.
74  *
75  * Does not include the string for INST_EXPON (and beyond), as that is
76  * disjoint for backward-compatability reasons.
77  */
78 
79 static const char *const operatorStrings[] = {
80     "||", "&&", "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>",
81     "+", "-", "*", "/", "%", "+", "-", "~", "!"
82 };
83 
84 /*
85  * Mapping from Tcl result codes to strings; used for error and debugging
86  * messages.
87  */
88 
89 #ifdef TCL_COMPILE_DEBUG
90 static const char *const resultStrings[] = {
91     "TCL_OK", "TCL_ERROR", "TCL_RETURN", "TCL_BREAK", "TCL_CONTINUE"
92 };
93 #endif
94 
95 /*
96  * These are used by evalstats to monitor object usage in Tcl.
97  */
98 
99 #ifdef TCL_COMPILE_STATS
100 size_t		tclObjsAlloced = 0;
101 size_t		tclObjsFreed = 0;
102 size_t		tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
103 #endif /* TCL_COMPILE_STATS */
104 
105 /*
106  * Support pre-8.5 bytecodes unless specifically requested otherwise.
107  */
108 
109 #ifndef TCL_SUPPORT_84_BYTECODE
110 #define TCL_SUPPORT_84_BYTECODE 1
111 #endif
112 
113 #if TCL_SUPPORT_84_BYTECODE
114 /*
115  * We need to know the tclBuiltinFuncTable to support translation of pre-8.5
116  * math functions to the namespace-based ::tcl::mathfunc::op in 8.5+.
117  */
118 
119 typedef struct {
120     const char *name;		/* Name of function. */
121     int numArgs;		/* Number of arguments for function. */
122 } BuiltinFunc;
123 
124 /*
125  * Table describing the built-in math functions. Entries in this table are
126  * indexed by the values of the INST_CALL_BUILTIN_FUNC instruction's
127  * operand byte.
128  */
129 
130 static BuiltinFunc const tclBuiltinFuncTable[] = {
131     {"acos", 1},
132     {"asin", 1},
133     {"atan", 1},
134     {"atan2", 2},
135     {"ceil", 1},
136     {"cos", 1},
137     {"cosh", 1},
138     {"exp", 1},
139     {"floor", 1},
140     {"fmod", 2},
141     {"hypot", 2},
142     {"log", 1},
143     {"log10", 1},
144     {"pow", 2},
145     {"sin", 1},
146     {"sinh", 1},
147     {"sqrt", 1},
148     {"tan", 1},
149     {"tanh", 1},
150     {"abs", 1},
151     {"double", 1},
152     {"int", 1},
153     {"rand", 0},
154     {"round", 1},
155     {"srand", 1},
156     {"wide", 1},
157     {NULL, 0},
158 };
159 
160 #define LAST_BUILTIN_FUNC	25
161 #endif
162 
163 /*
164  * NR_TEBC
165  * Helpers for NR - non-recursive calls to TEBC
166  * Minimal data required to fully reconstruct the execution state.
167  */
168 
169 typedef struct TEBCdata {
170     ByteCode *codePtr;		/* Constant until the BC returns */
171 				/* -----------------------------------------*/
172     ptrdiff_t *catchTop;	/* These fields are used on return TO this */
173     Tcl_Obj *auxObjList;	/* this level: they record the state when a */
174     CmdFrame cmdFrame;		/* new codePtr was received for NR */
175                                 /* execution. */
176     void *stack[1];		/* Start of the actual combined catch and obj
177 				 * stacks; the struct will be expanded as
178 				 * necessary */
179 } TEBCdata;
180 
181 #define TEBC_YIELD() \
182     do {						\
183 	esPtr->tosPtr = tosPtr;				\
184 	TclNRAddCallback(interp, TEBCresume,		\
185 		TD, pc, INT2PTR(cleanup), NULL);	\
186     } while (0)
187 
188 #define TEBC_DATA_DIG() \
189     do {					\
190 	tosPtr = esPtr->tosPtr;			\
191     } while (0)
192 
193 #define PUSH_TAUX_OBJ(objPtr) \
194     do {							\
195 	if (auxObjList) {					\
196 	    objPtr->length += auxObjList->length;		\
197 	}							\
198 	objPtr->internalRep.twoPtrValue.ptr1 = auxObjList;	\
199 	auxObjList = objPtr;					\
200     } while (0)
201 
202 #define POP_TAUX_OBJ() \
203     do {							\
204 	tmpPtr = auxObjList;					\
205 	auxObjList = (Tcl_Obj *)tmpPtr->internalRep.twoPtrValue.ptr1;	\
206 	Tcl_DecrRefCount(tmpPtr);				\
207     } while (0)
208 
209 /*
210  * These variable-access macros have to coincide with those in tclVar.c
211  */
212 
213 #define VarHashGetValue(hPtr) \
214     ((Var *) ((char *)hPtr - offsetof(VarInHash, entry)))
215 
216 static inline Var *
VarHashCreateVar(TclVarHashTable * tablePtr,Tcl_Obj * key,int * newPtr)217 VarHashCreateVar(
218     TclVarHashTable *tablePtr,
219     Tcl_Obj *key,
220     int *newPtr)
221 {
222     Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(&tablePtr->table,
223 	    key, newPtr);
224 
225     if (!hPtr) {
226 	return NULL;
227     }
228     return VarHashGetValue(hPtr);
229 }
230 
231 #define VarHashFindVar(tablePtr, key) \
232     VarHashCreateVar((tablePtr), (key), NULL)
233 
234 /*
235  * The new macro for ending an instruction; note that a reasonable C-optimiser
236  * will resolve all branches at compile time. (result) is always a constant;
237  * the macro NEXT_INST_F handles constant (nCleanup), NEXT_INST_V is resolved
238  * at runtime for variable (nCleanup).
239  *
240  * ARGUMENTS:
241  *    pcAdjustment: how much to increment pc
242  *    nCleanup: how many objects to remove from the stack
243  *    resultHandling: 0 indicates no object should be pushed on the stack;
244  *	otherwise, push objResultPtr. If (result < 0), objResultPtr already
245  *	has the correct reference count.
246  *
247  * We use the new compile-time assertions to check that nCleanup is constant
248  * and within range.
249  */
250 
251 /* Verify the stack depth, only when no expansion is in progress */
252 
253 #ifdef TCL_COMPILE_DEBUG
254 #define CHECK_STACK()							\
255     do {								\
256 	ValidatePcAndStackTop(codePtr, pc, CURR_DEPTH,			\
257 		/*checkStack*/ !(starting || auxObjList));		\
258 	starting = 0;							\
259     } while (0)
260 #else
261 #define CHECK_STACK()
262 #endif
263 
264 #define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling)	\
265     do {							\
266 	TCL_CT_ASSERT((nCleanup >= 0) && (nCleanup <= 2));	\
267 	CHECK_STACK();						\
268 	if (nCleanup == 0) {					\
269 	    if (resultHandling != 0) {				\
270 		if ((resultHandling) > 0) {			\
271 		    PUSH_OBJECT(objResultPtr);			\
272 		} else {					\
273 		    *(++tosPtr) = objResultPtr;			\
274 		}						\
275 	    }							\
276 	    pc += (pcAdjustment);				\
277 	    goto cleanup0;					\
278 	} else if (resultHandling != 0) {			\
279 	    if ((resultHandling) > 0) {				\
280 		Tcl_IncrRefCount(objResultPtr);			\
281 	    }							\
282 	    pc += (pcAdjustment);				\
283 	    switch (nCleanup) {					\
284 	    case 1: goto cleanup1_pushObjResultPtr;		\
285 	    case 2: goto cleanup2_pushObjResultPtr;		\
286 	    case 0: break;					\
287 	    }							\
288 	} else {						\
289 	    pc += (pcAdjustment);				\
290 	    switch (nCleanup) {					\
291 	    case 1: goto cleanup1;				\
292 	    case 2: goto cleanup2;				\
293 	    case 0: break;					\
294 	    }							\
295 	}							\
296     } while (0)
297 
298 #define NEXT_INST_V(pcAdjustment, nCleanup, resultHandling)	\
299     CHECK_STACK();						\
300     do {							\
301 	pc += (pcAdjustment);					\
302 	cleanup = (nCleanup);					\
303 	if (resultHandling) {					\
304 	    if ((resultHandling) > 0) {				\
305 		Tcl_IncrRefCount(objResultPtr);			\
306 	    }							\
307 	    goto cleanupV_pushObjResultPtr;			\
308 	} else {						\
309 	    goto cleanupV;					\
310 	}							\
311     } while (0)
312 
313 #ifndef TCL_COMPILE_DEBUG
314 #define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \
315     do {								\
316 	pc += (pcAdjustment);						\
317 	switch (*pc) {							\
318 	case INST_JUMP_FALSE1:						\
319 	    NEXT_INST_F(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \
320 	break; \
321 	case INST_JUMP_TRUE1:						\
322 	    NEXT_INST_F(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \
323 	break; \
324 	case INST_JUMP_FALSE4:						\
325 	    NEXT_INST_F(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \
326 	break; \
327 	case INST_JUMP_TRUE4:						\
328 	    NEXT_INST_F(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \
329 	break; \
330 	default:							\
331 	    if ((condition) < 0) {					\
332 		TclNewIntObj(objResultPtr, -1);				\
333 	    } else {							\
334 		objResultPtr = TCONST((condition) > 0);			\
335 	    }								\
336 	    NEXT_INST_F(0, (cleanup), 1);				\
337 	break; \
338 	}								\
339     } while (0)
340 #define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \
341     do {								\
342 	pc += (pcAdjustment);						\
343 	switch (*pc) {							\
344 	case INST_JUMP_FALSE1:						\
345 	    NEXT_INST_V(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \
346 	break; \
347 	case INST_JUMP_TRUE1:						\
348 	    NEXT_INST_V(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \
349 	break; \
350 	case INST_JUMP_FALSE4:						\
351 	    NEXT_INST_V(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \
352 	break; \
353 	case INST_JUMP_TRUE4:						\
354 	    NEXT_INST_V(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \
355 	break; \
356 	default:							\
357 	    if ((condition) < 0) {					\
358 		TclNewIntObj(objResultPtr, -1);				\
359 	    } else {							\
360 		objResultPtr = TCONST((condition) > 0);			\
361 	    }								\
362 	    NEXT_INST_V(0, (cleanup), 1);				\
363 	break; \
364 	}								\
365     } while (0)
366 #else /* TCL_COMPILE_DEBUG */
367 #define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \
368     do{									\
369 	if ((condition) < 0) {						\
370 	    TclNewIntObj(objResultPtr, -1);				\
371 	} else {							\
372 	    objResultPtr = TCONST((condition) > 0);			\
373 	}								\
374 	NEXT_INST_F((pcAdjustment), (cleanup), 1);			\
375     } while (0)
376 #define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \
377     do{									\
378 	if ((condition) < 0) {						\
379 	    TclNewIntObj(objResultPtr, -1);				\
380 	} else {							\
381 	    objResultPtr = TCONST((condition) > 0);			\
382 	}								\
383 	NEXT_INST_V((pcAdjustment), (cleanup), 1);			\
384     } while (0)
385 #endif
386 
387 /*
388  * Macros used to cache often-referenced Tcl evaluation stack information
389  * in local variables. Note that a DECACHE_STACK_INFO()-CACHE_STACK_INFO()
390  * pair must surround any call inside TclNRExecuteByteCode (and a few other
391  * procedures that use this scheme) that could result in a recursive call
392  * to TclNRExecuteByteCode.
393  */
394 
395 #define CACHE_STACK_INFO() \
396     checkInterp = 1
397 
398 #define DECACHE_STACK_INFO() \
399     esPtr->tosPtr = tosPtr
400 
401 /*
402  * Macros used to access items on the Tcl evaluation stack. PUSH_OBJECT
403  * increments the object's ref count since it makes the stack have another
404  * reference pointing to the object. However, POP_OBJECT does not decrement
405  * the ref count. This is because the stack may hold the only reference to the
406  * object, so the object would be destroyed if its ref count were decremented
407  * before the caller had a chance to, e.g., store it in a variable. It is the
408  * caller's responsibility to decrement the ref count when it is finished with
409  * an object.
410  *
411  * WARNING! It is essential that objPtr only appear once in the PUSH_OBJECT
412  * macro. The actual parameter might be an expression with side effects, and
413  * this ensures that it will be executed only once.
414  */
415 
416 #define PUSH_OBJECT(objPtr) \
417     Tcl_IncrRefCount(*(++tosPtr) = (objPtr))
418 
419 #define POP_OBJECT()	*(tosPtr--)
420 
421 #define OBJ_AT_TOS	*tosPtr
422 
423 #define OBJ_UNDER_TOS	*(tosPtr-1)
424 
425 #define OBJ_AT_DEPTH(n)	*(tosPtr-(n))
426 
427 #define CURR_DEPTH	((ptrdiff_t) (tosPtr - initTosPtr))
428 
429 #define STACK_BASE(esPtr) ((esPtr)->stackWords - 1)
430 
431 /*
432  * Macros used to trace instruction execution. The macros TRACE,
433  * TRACE_WITH_OBJ, and O2S are only used inside TclNRExecuteByteCode. O2S is
434  * only used in TRACE* calls to get a string from an object.
435  */
436 
437 #ifdef TCL_COMPILE_DEBUG
438 #   define TRACE(a) \
439     while (traceInstructions) {					\
440 	fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels,	\
441 		(int) CURR_DEPTH,				\
442 		(unsigned) (pc - codePtr->codeStart),		\
443 		GetOpcodeName(pc));				\
444 	printf a;						\
445 	break;							\
446     }
447 #   define TRACE_APPEND(a) \
448     while (traceInstructions) {		\
449 	printf a;			\
450 	break;				\
451     }
452 #   define TRACE_ERROR(interp) \
453     TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
454 #   define TRACE_WITH_OBJ(a, objPtr) \
455     while (traceInstructions) {					\
456 	fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels,	\
457 		(int) CURR_DEPTH,				\
458 		(unsigned) (pc - codePtr->codeStart),		\
459 		GetOpcodeName(pc));				\
460 	printf a;						\
461 	TclPrintObject(stdout, objPtr, 30);			\
462 	fprintf(stdout, "\n");					\
463 	break;							\
464     }
465 #   define O2S(objPtr) \
466     (objPtr ? TclGetString(objPtr) : "")
467 #else /* !TCL_COMPILE_DEBUG */
468 #   define TRACE(a)
469 #   define TRACE_APPEND(a)
470 #   define TRACE_ERROR(interp)
471 #   define TRACE_WITH_OBJ(a, objPtr)
472 #   define O2S(objPtr)
473 #endif /* TCL_COMPILE_DEBUG */
474 
475 /*
476  * DTrace instruction probe macros.
477  */
478 
479 #define TCL_DTRACE_INST_NEXT() \
480     do {								\
481 	if (TCL_DTRACE_INST_DONE_ENABLED()) {				\
482 	    if (curInstName) {						\
483 		TCL_DTRACE_INST_DONE(curInstName, (int) CURR_DEPTH,	\
484 			tosPtr);					\
485 	    }								\
486 	    curInstName = tclInstructionTable[*pc].name;		\
487 	    if (TCL_DTRACE_INST_START_ENABLED()) {			\
488 		TCL_DTRACE_INST_START(curInstName, (int) CURR_DEPTH,	\
489 			tosPtr);					\
490 	    }								\
491 	} else if (TCL_DTRACE_INST_START_ENABLED()) {			\
492 	    TCL_DTRACE_INST_START(tclInstructionTable[*pc].name,	\
493 			(int) CURR_DEPTH, tosPtr);			\
494 	}								\
495     } while (0)
496 #define TCL_DTRACE_INST_LAST() \
497     do {								\
498 	if (TCL_DTRACE_INST_DONE_ENABLED() && curInstName) {		\
499 	    TCL_DTRACE_INST_DONE(curInstName, (int) CURR_DEPTH, tosPtr);\
500 	}								\
501     } while (0)
502 
503 /*
504  * Macro used in this file to save a function call for common uses of
505  * TclGetNumberFromObj(). The ANSI C "prototype" is:
506  *
507  * MODULE_SCOPE int GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
508  *			ClientData *ptrPtr, int *tPtr);
509  */
510 
511 #define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
512     ((TclHasIntRep((objPtr), &tclIntType))					\
513 	?	(*(tPtr) = TCL_NUMBER_INT,				\
514 		*(ptrPtr) = (ClientData)				\
515 		    (&((objPtr)->internalRep.wideValue)), TCL_OK) :	\
516     TclHasIntRep((objPtr), &tclDoubleType)				\
517 	?	(((TclIsNaN((objPtr)->internalRep.doubleValue))		\
518 		    ?	(*(tPtr) = TCL_NUMBER_NAN)			\
519 		    :	(*(tPtr) = TCL_NUMBER_DOUBLE)),			\
520 		*(ptrPtr) = (ClientData)				\
521 		    (&((objPtr)->internalRep.doubleValue)), TCL_OK) :	\
522     (((objPtr)->bytes != NULL) && ((objPtr)->length == 0))		\
523 	? TCL_ERROR :			\
524     TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
525 
526 /*
527  * Macro used to make the check for type overflow more mnemonic. This works by
528  * comparing sign bits; the rest of the word is irrelevant. The ANSI C
529  * "prototype" (where inttype_t is any integer type) is:
530  *
531  * MODULE_SCOPE int Overflowing(inttype_t a, inttype_t b, inttype_t sum);
532  *
533  * Check first the condition most likely to fail in usual code (at least for
534  * usage in [incr]: do the first summand and the sum have != signs?
535  */
536 
537 #define Overflowing(a,b,sum) ((((a)^(sum)) < 0) && (((a)^(b)) >= 0))
538 
539 /*
540  * Macro for checking whether the type is NaN, used when we're thinking about
541  * throwing an error for supplying a non-number number.
542  */
543 
544 #ifndef ACCEPT_NAN
545 #define IsErroringNaNType(type)		((type) == TCL_NUMBER_NAN)
546 #else
547 #define IsErroringNaNType(type)		0
548 #endif
549 
550 /*
551  * Auxiliary tables used to compute powers of small integers.
552  */
553 
554 /*
555  * Maximum base that, when raised to powers 2, 3, ..., 16, fits in a
556  * Tcl_WideInt.
557  */
558 
559 static const Tcl_WideInt MaxBase64[] = {
560     (Tcl_WideInt)46340*65536+62259,	/* 3037000499 == isqrt(2**63-1) */
561     (Tcl_WideInt)2097151, (Tcl_WideInt)55108, (Tcl_WideInt)6208,
562     (Tcl_WideInt)1448, (Tcl_WideInt)511, (Tcl_WideInt)234, (Tcl_WideInt)127,
563     (Tcl_WideInt)78, (Tcl_WideInt)52, (Tcl_WideInt)38, (Tcl_WideInt)28,
564     (Tcl_WideInt)22, (Tcl_WideInt)18, (Tcl_WideInt)15
565 };
566 static const size_t MaxBase64Size = sizeof(MaxBase64)/sizeof(Tcl_WideInt);
567 
568 /*
569  * Table giving 3, 4, ..., 13 raised to powers greater than 16 when the
570  * results fit in a 64-bit signed integer.
571  */
572 
573 static const unsigned short Exp64Index[] = {
574     0, 23, 38, 49, 57, 63, 67, 70, 72, 74, 75, 76
575 };
576 static const size_t Exp64IndexSize =
577     sizeof(Exp64Index) / sizeof(unsigned short);
578 static const Tcl_WideInt Exp64Value[] = {
579     (Tcl_WideInt)243*243*243*3*3,
580     (Tcl_WideInt)243*243*243*3*3*3,
581     (Tcl_WideInt)243*243*243*3*3*3*3,
582     (Tcl_WideInt)243*243*243*243,
583     (Tcl_WideInt)243*243*243*243*3,
584     (Tcl_WideInt)243*243*243*243*3*3,
585     (Tcl_WideInt)243*243*243*243*3*3*3,
586     (Tcl_WideInt)243*243*243*243*3*3*3*3,
587     (Tcl_WideInt)243*243*243*243*243,
588     (Tcl_WideInt)243*243*243*243*243*3,
589     (Tcl_WideInt)243*243*243*243*243*3*3,
590     (Tcl_WideInt)243*243*243*243*243*3*3*3,
591     (Tcl_WideInt)243*243*243*243*243*3*3*3*3,
592     (Tcl_WideInt)243*243*243*243*243*243,
593     (Tcl_WideInt)243*243*243*243*243*243*3,
594     (Tcl_WideInt)243*243*243*243*243*243*3*3,
595     (Tcl_WideInt)243*243*243*243*243*243*3*3*3,
596     (Tcl_WideInt)243*243*243*243*243*243*3*3*3*3,
597     (Tcl_WideInt)243*243*243*243*243*243*243,
598     (Tcl_WideInt)243*243*243*243*243*243*243*3,
599     (Tcl_WideInt)243*243*243*243*243*243*243*3*3,
600     (Tcl_WideInt)243*243*243*243*243*243*243*3*3*3,
601     (Tcl_WideInt)243*243*243*243*243*243*243*3*3*3*3,
602     (Tcl_WideInt)1024*1024*1024*4*4,
603     (Tcl_WideInt)1024*1024*1024*4*4*4,
604     (Tcl_WideInt)1024*1024*1024*4*4*4*4,
605     (Tcl_WideInt)1024*1024*1024*1024,
606     (Tcl_WideInt)1024*1024*1024*1024*4,
607     (Tcl_WideInt)1024*1024*1024*1024*4*4,
608     (Tcl_WideInt)1024*1024*1024*1024*4*4*4,
609     (Tcl_WideInt)1024*1024*1024*1024*4*4*4*4,
610     (Tcl_WideInt)1024*1024*1024*1024*1024,
611     (Tcl_WideInt)1024*1024*1024*1024*1024*4,
612     (Tcl_WideInt)1024*1024*1024*1024*1024*4*4,
613     (Tcl_WideInt)1024*1024*1024*1024*1024*4*4*4,
614     (Tcl_WideInt)1024*1024*1024*1024*1024*4*4*4*4,
615     (Tcl_WideInt)1024*1024*1024*1024*1024*1024,
616     (Tcl_WideInt)1024*1024*1024*1024*1024*1024*4,
617     (Tcl_WideInt)3125*3125*3125*5*5,
618     (Tcl_WideInt)3125*3125*3125*5*5*5,
619     (Tcl_WideInt)3125*3125*3125*5*5*5*5,
620     (Tcl_WideInt)3125*3125*3125*3125,
621     (Tcl_WideInt)3125*3125*3125*3125*5,
622     (Tcl_WideInt)3125*3125*3125*3125*5*5,
623     (Tcl_WideInt)3125*3125*3125*3125*5*5*5,
624     (Tcl_WideInt)3125*3125*3125*3125*5*5*5*5,
625     (Tcl_WideInt)3125*3125*3125*3125*3125,
626     (Tcl_WideInt)3125*3125*3125*3125*3125*5,
627     (Tcl_WideInt)3125*3125*3125*3125*3125*5*5,
628     (Tcl_WideInt)7776*7776*7776*6*6,
629     (Tcl_WideInt)7776*7776*7776*6*6*6,
630     (Tcl_WideInt)7776*7776*7776*6*6*6*6,
631     (Tcl_WideInt)7776*7776*7776*7776,
632     (Tcl_WideInt)7776*7776*7776*7776*6,
633     (Tcl_WideInt)7776*7776*7776*7776*6*6,
634     (Tcl_WideInt)7776*7776*7776*7776*6*6*6,
635     (Tcl_WideInt)7776*7776*7776*7776*6*6*6*6,
636     (Tcl_WideInt)16807*16807*16807*7*7,
637     (Tcl_WideInt)16807*16807*16807*7*7*7,
638     (Tcl_WideInt)16807*16807*16807*7*7*7*7,
639     (Tcl_WideInt)16807*16807*16807*16807,
640     (Tcl_WideInt)16807*16807*16807*16807*7,
641     (Tcl_WideInt)16807*16807*16807*16807*7*7,
642     (Tcl_WideInt)32768*32768*32768*8*8,
643     (Tcl_WideInt)32768*32768*32768*8*8*8,
644     (Tcl_WideInt)32768*32768*32768*8*8*8*8,
645     (Tcl_WideInt)32768*32768*32768*32768,
646     (Tcl_WideInt)59049*59049*59049*9*9,
647     (Tcl_WideInt)59049*59049*59049*9*9*9,
648     (Tcl_WideInt)59049*59049*59049*9*9*9*9,
649     (Tcl_WideInt)100000*100000*100000*10*10,
650     (Tcl_WideInt)100000*100000*100000*10*10*10,
651     (Tcl_WideInt)161051*161051*161051*11*11,
652     (Tcl_WideInt)161051*161051*161051*11*11*11,
653     (Tcl_WideInt)248832*248832*248832*12*12,
654     (Tcl_WideInt)371293*371293*371293*13*13
655 };
656 static const size_t Exp64ValueSize = sizeof(Exp64Value) / sizeof(Tcl_WideInt);
657 
658 /*
659  * Markers for ExecuteExtendedBinaryMathOp.
660  */
661 
662 #define DIVIDED_BY_ZERO		((Tcl_Obj *) -1)
663 #define EXPONENT_OF_ZERO	((Tcl_Obj *) -2)
664 #define GENERAL_ARITHMETIC_ERROR ((Tcl_Obj *) -3)
665 #define OUT_OF_MEMORY ((Tcl_Obj *) -4)
666 
667 /*
668  * Declarations for local procedures to this file:
669  */
670 
671 #ifdef TCL_COMPILE_STATS
672 static int		EvalStatsCmd(ClientData clientData,
673 			    Tcl_Interp *interp, int objc,
674 			    Tcl_Obj *const objv[]);
675 #endif /* TCL_COMPILE_STATS */
676 #ifdef TCL_COMPILE_DEBUG
677 static const char *	GetOpcodeName(const unsigned char *pc);
678 static void		PrintByteCodeInfo(ByteCode *codePtr);
679 static const char *	StringForResultCode(int result);
680 static void		ValidatePcAndStackTop(ByteCode *codePtr,
681 			    const unsigned char *pc, int stackTop,
682 			    int checkStack);
683 #endif /* TCL_COMPILE_DEBUG */
684 static ByteCode *	CompileExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
685 static void		DeleteExecStack(ExecStack *esPtr);
686 static void		DupExprCodeInternalRep(Tcl_Obj *srcPtr,
687 			    Tcl_Obj *copyPtr);
688 static Tcl_Obj *	ExecuteExtendedBinaryMathOp(Tcl_Interp *interp,
689 			    int opcode, Tcl_Obj **constants,
690 			    Tcl_Obj *valuePtr, Tcl_Obj *value2Ptr);
691 static Tcl_Obj *	ExecuteExtendedUnaryMathOp(int opcode,
692 			    Tcl_Obj *valuePtr);
693 static void		FreeExprCodeInternalRep(Tcl_Obj *objPtr);
694 static ExceptionRange *	GetExceptRangeForPc(const unsigned char *pc,
695 			    int searchMode, ByteCode *codePtr);
696 static const char *	GetSrcInfoForPc(const unsigned char *pc,
697 			    ByteCode *codePtr, int *lengthPtr,
698 			    const unsigned char **pcBeg, int *cmdIdxPtr);
699 static Tcl_Obj **	GrowEvaluationStack(ExecEnv *eePtr, int growth,
700 			    int move);
701 static void		IllegalExprOperandType(Tcl_Interp *interp,
702 			    const unsigned char *pc, Tcl_Obj *opndPtr);
703 static void		InitByteCodeExecution(Tcl_Interp *interp);
704 static inline int	wordSkip(void *ptr);
705 static void		ReleaseDictIterator(Tcl_Obj *objPtr);
706 /* Useful elsewhere, make available in tclInt.h or stubs? */
707 static Tcl_Obj **	StackAllocWords(Tcl_Interp *interp, int numWords);
708 static Tcl_Obj **	StackReallocWords(Tcl_Interp *interp, int numWords);
709 static Tcl_NRPostProc	CopyCallback;
710 static Tcl_NRPostProc	ExprObjCallback;
711 static Tcl_NRPostProc	FinalizeOONext;
712 static Tcl_NRPostProc	FinalizeOONextFilter;
713 static Tcl_NRPostProc   TEBCresume;
714 
715 /*
716  * The structure below defines a bytecode Tcl object type to hold the
717  * compiled bytecode for Tcl expressions.
718  */
719 
720 static const Tcl_ObjType exprCodeType = {
721     "exprcode",
722     FreeExprCodeInternalRep,	/* freeIntRepProc */
723     DupExprCodeInternalRep,	/* dupIntRepProc */
724     NULL,			/* updateStringProc */
725     NULL			/* setFromAnyProc */
726 };
727 
728 /*
729  * Custom object type only used in this file; values of its type should never
730  * be seen by user scripts.
731  */
732 
733 static const Tcl_ObjType dictIteratorType = {
734     "dictIterator",
735     ReleaseDictIterator,
736     NULL, NULL, NULL
737 };
738 
739 /*
740  *----------------------------------------------------------------------
741  *
742  * ReleaseDictIterator --
743  *
744  *	This takes apart a dictionary iterator that is stored in the given Tcl
745  *	object.
746  *
747  * Results:
748  *	None.
749  *
750  * Side effects:
751  *	Deallocates memory, marks the object as being untyped.
752  *
753  *----------------------------------------------------------------------
754  */
755 
756 static void
ReleaseDictIterator(Tcl_Obj * objPtr)757 ReleaseDictIterator(
758     Tcl_Obj *objPtr)
759 {
760     Tcl_DictSearch *searchPtr;
761     Tcl_Obj *dictPtr;
762     const Tcl_ObjIntRep *irPtr;
763 
764     irPtr = TclFetchIntRep(objPtr, &dictIteratorType);
765     assert(irPtr != NULL);
766 
767     /*
768      * First kill the search, and then release the reference to the dictionary
769      * that we were holding.
770      */
771 
772     searchPtr = (Tcl_DictSearch *)irPtr->twoPtrValue.ptr1;
773     Tcl_DictObjDone(searchPtr);
774     ckfree(searchPtr);
775 
776     dictPtr = (Tcl_Obj *)irPtr->twoPtrValue.ptr2;
777     TclDecrRefCount(dictPtr);
778 }
779 
780 /*
781  *----------------------------------------------------------------------
782  *
783  * InitByteCodeExecution --
784  *
785  *	This procedure is called once to initialize the Tcl bytecode
786  *	interpreter.
787  *
788  * Results:
789  *	None.
790  *
791  * Side effects:
792  *	This procedure initializes the array of instruction names. If
793  *	compiling with the TCL_COMPILE_STATS flag, it initializes the array
794  *	that counts the executions of each instruction and it creates the
795  *	"evalstats" command. It also establishes the link between the Tcl
796  *	"tcl_traceExec" and C "tclTraceExec" variables.
797  *
798  *----------------------------------------------------------------------
799  */
800 
801 #if defined(TCL_COMPILE_STATS) || defined(TCL_COMPILE_DEBUG)
802 static void
InitByteCodeExecution(Tcl_Interp * interp)803 InitByteCodeExecution(
804     Tcl_Interp *interp)		/* Interpreter for which the Tcl variable
805 				 * "tcl_traceExec" is linked to control
806 				 * instruction tracing. */
807 {
808 #ifdef TCL_COMPILE_DEBUG
809     if (Tcl_LinkVar(interp, "tcl_traceExec", &tclTraceExec,
810 	    TCL_LINK_INT) != TCL_OK) {
811 	Tcl_Panic("InitByteCodeExecution: can't create link for tcl_traceExec variable");
812     }
813 #endif
814 #ifdef TCL_COMPILE_STATS
815     Tcl_CreateObjCommand(interp, "evalstats", EvalStatsCmd, NULL, NULL);
816 #endif /* TCL_COMPILE_STATS */
817 }
818 
819 #else
820 
821 static void
InitByteCodeExecution(TCL_UNUSED (Tcl_Interp *))822 InitByteCodeExecution(
823     TCL_UNUSED(Tcl_Interp *))
824 {
825 }
826 #endif
827 
828 /*
829  *----------------------------------------------------------------------
830  *
831  * TclCreateExecEnv --
832  *
833  *	This procedure creates a new execution environment for Tcl bytecode
834  *	execution. An ExecEnv points to a Tcl evaluation stack. An ExecEnv is
835  *	typically created once for each Tcl interpreter (Interp structure) and
836  *	recursively passed to TclNRExecuteByteCode to execute ByteCode sequences
837  *	for nested commands.
838  *
839  * Results:
840  *	A newly allocated ExecEnv is returned. This points to an empty
841  *	evaluation stack of the standard initial size.
842  *
843  * Side effects:
844  *	The bytecode interpreter is also initialized here, as this procedure
845  *	will be called before any call to TclNRExecuteByteCode.
846  *
847  *----------------------------------------------------------------------
848  */
849 
850 ExecEnv *
TclCreateExecEnv(Tcl_Interp * interp,int size)851 TclCreateExecEnv(
852     Tcl_Interp *interp,		/* Interpreter for which the execution
853 				 * environment is being created. */
854     int size)			/* The initial stack size, in number of words
855 				 * [sizeof(Tcl_Obj*)] */
856 {
857     ExecEnv *eePtr = (ExecEnv *)ckalloc(sizeof(ExecEnv));
858     ExecStack *esPtr = (ExecStack *)ckalloc(offsetof(ExecStack, stackWords)
859 	    + size * sizeof(Tcl_Obj *));
860 
861     eePtr->execStackPtr = esPtr;
862     TclNewIntObj(eePtr->constants[0], 0);
863     Tcl_IncrRefCount(eePtr->constants[0]);
864     TclNewIntObj(eePtr->constants[1], 1);
865     Tcl_IncrRefCount(eePtr->constants[1]);
866     eePtr->interp = interp;
867     eePtr->callbackPtr = NULL;
868     eePtr->corPtr = NULL;
869     eePtr->rewind = 0;
870 
871     esPtr->prevPtr = NULL;
872     esPtr->nextPtr = NULL;
873     esPtr->markerPtr = NULL;
874     esPtr->endPtr = &esPtr->stackWords[size-1];
875     esPtr->tosPtr = STACK_BASE(esPtr);
876 
877     Tcl_MutexLock(&execMutex);
878     if (!execInitialized) {
879 	InitByteCodeExecution(interp);
880 	execInitialized = 1;
881     }
882     Tcl_MutexUnlock(&execMutex);
883 
884     return eePtr;
885 }
886 
887 /*
888  *----------------------------------------------------------------------
889  *
890  * TclDeleteExecEnv --
891  *
892  *	Frees the storage for an ExecEnv.
893  *
894  * Results:
895  *	None.
896  *
897  * Side effects:
898  *	Storage for an ExecEnv and its contained storage (e.g. the evaluation
899  *	stack) is freed.
900  *
901  *----------------------------------------------------------------------
902  */
903 
904 static void
DeleteExecStack(ExecStack * esPtr)905 DeleteExecStack(
906     ExecStack *esPtr)
907 {
908     if (esPtr->markerPtr && !cachedInExit) {
909 	Tcl_Panic("freeing an execStack which is still in use");
910     }
911 
912     if (esPtr->prevPtr) {
913 	esPtr->prevPtr->nextPtr = esPtr->nextPtr;
914     }
915     if (esPtr->nextPtr) {
916 	esPtr->nextPtr->prevPtr = esPtr->prevPtr;
917     }
918     ckfree(esPtr);
919 }
920 
921 void
TclDeleteExecEnv(ExecEnv * eePtr)922 TclDeleteExecEnv(
923     ExecEnv *eePtr)		/* Execution environment to free. */
924 {
925     ExecStack *esPtr = eePtr->execStackPtr, *tmpPtr;
926 
927 	cachedInExit = TclInExit();
928 
929     /*
930      * Delete all stacks in this exec env.
931      */
932 
933     while (esPtr->nextPtr) {
934 	esPtr = esPtr->nextPtr;
935     }
936     while (esPtr) {
937 	tmpPtr = esPtr;
938 	esPtr = tmpPtr->prevPtr;
939 	DeleteExecStack(tmpPtr);
940     }
941 
942     TclDecrRefCount(eePtr->constants[0]);
943     TclDecrRefCount(eePtr->constants[1]);
944     if (eePtr->callbackPtr && !cachedInExit) {
945 	Tcl_Panic("Deleting execEnv with pending TEOV callbacks!");
946     }
947     if (eePtr->corPtr && !cachedInExit) {
948 	Tcl_Panic("Deleting execEnv with existing coroutine");
949     }
950     ckfree(eePtr);
951 }
952 
953 /*
954  *----------------------------------------------------------------------
955  *
956  * TclFinalizeExecution --
957  *
958  *	Finalizes the execution environment setup so that it can be later
959  *	reinitialized.
960  *
961  * Results:
962  *	None.
963  *
964  * Side effects:
965  *	After this call, the next time TclCreateExecEnv will be called it will
966  *	call InitByteCodeExecution.
967  *
968  *----------------------------------------------------------------------
969  */
970 
971 void
TclFinalizeExecution(void)972 TclFinalizeExecution(void)
973 {
974     Tcl_MutexLock(&execMutex);
975     execInitialized = 0;
976     Tcl_MutexUnlock(&execMutex);
977 }
978 
979 /*
980  * Auxiliary code to insure that GrowEvaluationStack always returns correctly
981  * aligned memory.
982  *
983  * WALLOCALIGN represents the alignment reqs in words, just as TCL_ALLOCALIGN
984  * represents the reqs in bytes. This assumes that TCL_ALLOCALIGN is a
985  * multiple of the wordsize 'sizeof(Tcl_Obj *)'.
986  */
987 
988 #define WALLOCALIGN \
989     (TCL_ALLOCALIGN/sizeof(Tcl_Obj *))
990 
991 /*
992  * wordSkip computes how many words have to be skipped until the next aligned
993  * word. Note that we are only interested in the low order bits of ptr, so
994  * that any possible information loss in PTR2INT is of no consequence.
995  */
996 
997 static inline int
wordSkip(void * ptr)998 wordSkip(
999     void *ptr)
1000 {
1001     int mask = TCL_ALLOCALIGN-1;
1002     int base = PTR2INT(ptr) & mask;
1003     return (TCL_ALLOCALIGN - base)/sizeof(Tcl_Obj *);
1004 }
1005 
1006 /*
1007  * Given a marker, compute where the following aligned memory starts.
1008  */
1009 
1010 #define MEMSTART(markerPtr) \
1011     ((markerPtr) + wordSkip(markerPtr))
1012 
1013 /*
1014  *----------------------------------------------------------------------
1015  *
1016  * GrowEvaluationStack --
1017  *
1018  *	This procedure grows a Tcl evaluation stack stored in an ExecEnv,
1019  *	copying over the words since the last mark if so requested. A mark is
1020  *	set at the beginning of the new area when no copying is requested.
1021  *
1022  * Results:
1023  *	Returns a pointer to the first usable word in the (possibly) grown
1024  *	stack.
1025  *
1026  * Side effects:
1027  *	The size of the evaluation stack may be grown, a marker is set
1028  *
1029  *----------------------------------------------------------------------
1030  */
1031 
1032 static Tcl_Obj **
GrowEvaluationStack(ExecEnv * eePtr,int growth,int move)1033 GrowEvaluationStack(
1034     ExecEnv *eePtr,		/* Points to the ExecEnv with an evaluation
1035 				 * stack to enlarge. */
1036     int growth,			/* How much larger than the current used
1037 				 * size. */
1038     int move)			/* 1 if move words since last marker. */
1039 {
1040     ExecStack *esPtr = eePtr->execStackPtr, *oldPtr = NULL;
1041     int newBytes, newElems, currElems;
1042     int needed = growth - (esPtr->endPtr - esPtr->tosPtr);
1043     Tcl_Obj **markerPtr = esPtr->markerPtr, **memStart;
1044     int moveWords = 0;
1045 
1046     if (move) {
1047 	if (!markerPtr) {
1048 	    Tcl_Panic("STACK: Reallocating with no previous alloc");
1049 	}
1050 	if (needed <= 0) {
1051 	    return MEMSTART(markerPtr);
1052 	}
1053     } else {
1054 #ifndef PURIFY
1055 	Tcl_Obj **tmpMarkerPtr = esPtr->tosPtr + 1;
1056 	int offset = wordSkip(tmpMarkerPtr);
1057 
1058 	if (needed + offset < 0) {
1059 	    /*
1060 	     * Put a marker pointing to the previous marker in this stack, and
1061 	     * store it in esPtr as the current marker. Return a pointer to
1062 	     * the start of aligned memory.
1063 	     */
1064 
1065 	    esPtr->markerPtr = tmpMarkerPtr;
1066 	    memStart = tmpMarkerPtr + offset;
1067 	    esPtr->tosPtr = memStart - 1;
1068 	    *esPtr->markerPtr = (Tcl_Obj *) markerPtr;
1069 	    return memStart;
1070 	}
1071 #endif
1072     }
1073 
1074     /*
1075      * Reset move to hold the number of words to be moved to new stack (if
1076      * any) and growth to hold the complete stack requirements: add one for
1077      * the marker, (WALLOCALIGN-1) for the maximal possible offset.
1078      */
1079 
1080     if (move) {
1081 	moveWords = esPtr->tosPtr - MEMSTART(markerPtr) + 1;
1082     }
1083     needed = growth + moveWords + WALLOCALIGN;
1084 
1085 
1086     /*
1087      * Check if there is enough room in the next stack (if there is one, it
1088      * should be both empty and the last one!)
1089      */
1090 
1091     if (esPtr->nextPtr) {
1092 	oldPtr = esPtr;
1093 	esPtr = oldPtr->nextPtr;
1094 	currElems = esPtr->endPtr - STACK_BASE(esPtr);
1095 	if (esPtr->markerPtr || (esPtr->tosPtr != STACK_BASE(esPtr))) {
1096 	    Tcl_Panic("STACK: Stack after current is in use");
1097 	}
1098 	if (esPtr->nextPtr) {
1099 	    Tcl_Panic("STACK: Stack after current is not last");
1100 	}
1101 	if (needed <= currElems) {
1102 	    goto newStackReady;
1103 	}
1104 	DeleteExecStack(esPtr);
1105 	esPtr = oldPtr;
1106     } else {
1107 	currElems = esPtr->endPtr - STACK_BASE(esPtr);
1108     }
1109 
1110     /*
1111      * We need to allocate a new stack! It needs to store 'growth' words,
1112      * including the elements to be copied over and the new marker.
1113      */
1114 
1115 #ifndef PURIFY
1116     newElems = 2*currElems;
1117     while (needed > newElems) {
1118 	newElems *= 2;
1119     }
1120 #else
1121     newElems = needed;
1122 #endif
1123 
1124     newBytes = offsetof(ExecStack, stackWords) + newElems * sizeof(Tcl_Obj *);
1125 
1126     oldPtr = esPtr;
1127     esPtr = (ExecStack *)ckalloc(newBytes);
1128 
1129     oldPtr->nextPtr = esPtr;
1130     esPtr->prevPtr = oldPtr;
1131     esPtr->nextPtr = NULL;
1132     esPtr->endPtr = &esPtr->stackWords[newElems-1];
1133 
1134   newStackReady:
1135     eePtr->execStackPtr = esPtr;
1136 
1137     /*
1138      * Store a NULL marker at the beginning of the stack, to indicate that
1139      * this is the first marker in this stack and that rewinding to here
1140      * should actually be a return to the previous stack.
1141      */
1142 
1143     esPtr->stackWords[0] = NULL;
1144     esPtr->markerPtr = &esPtr->stackWords[0];
1145     memStart = MEMSTART(esPtr->markerPtr);
1146     esPtr->tosPtr = memStart - 1;
1147 
1148     if (move) {
1149 	memcpy(memStart, MEMSTART(markerPtr), moveWords*sizeof(Tcl_Obj *));
1150 	esPtr->tosPtr += moveWords;
1151 	oldPtr->markerPtr = (Tcl_Obj **) *markerPtr;
1152 	oldPtr->tosPtr = markerPtr-1;
1153     }
1154 
1155     /*
1156      * Free the old stack if it is now unused.
1157      */
1158 
1159     if (!oldPtr->markerPtr) {
1160 	DeleteExecStack(oldPtr);
1161     }
1162 
1163     return memStart;
1164 }
1165 
1166 /*
1167  *--------------------------------------------------------------
1168  *
1169  * TclStackAlloc, TclStackRealloc, TclStackFree --
1170  *
1171  *	Allocate memory from the execution stack; it has to be returned later
1172  *	with a call to TclStackFree.
1173  *
1174  * Results:
1175  *	A pointer to the first byte allocated, or panics if the allocation did
1176  *	not succeed.
1177  *
1178  * Side effects:
1179  *	The execution stack may be grown.
1180  *
1181  *--------------------------------------------------------------
1182  */
1183 
1184 static Tcl_Obj **
StackAllocWords(Tcl_Interp * interp,int numWords)1185 StackAllocWords(
1186     Tcl_Interp *interp,
1187     int numWords)
1188 {
1189     /*
1190      * Note that GrowEvaluationStack sets a marker in the stack. This marker
1191      * is read when rewinding, e.g., by TclStackFree.
1192      */
1193 
1194     Interp *iPtr = (Interp *) interp;
1195     ExecEnv *eePtr = iPtr->execEnvPtr;
1196     Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 0);
1197 
1198     eePtr->execStackPtr->tosPtr += numWords;
1199     return resPtr;
1200 }
1201 
1202 static Tcl_Obj **
StackReallocWords(Tcl_Interp * interp,int numWords)1203 StackReallocWords(
1204     Tcl_Interp *interp,
1205     int numWords)
1206 {
1207     Interp *iPtr = (Interp *) interp;
1208     ExecEnv *eePtr = iPtr->execEnvPtr;
1209     Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 1);
1210 
1211     eePtr->execStackPtr->tosPtr += numWords;
1212     return resPtr;
1213 }
1214 
1215 void
TclStackFree(Tcl_Interp * interp,void * freePtr)1216 TclStackFree(
1217     Tcl_Interp *interp,
1218     void *freePtr)
1219 {
1220     Interp *iPtr = (Interp *) interp;
1221     ExecEnv *eePtr;
1222     ExecStack *esPtr;
1223     Tcl_Obj **markerPtr, *marker;
1224 
1225     if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
1226 	ckfree(freePtr);
1227 	return;
1228     }
1229 
1230     /*
1231      * Rewind the stack to the previous marker position. The current marker,
1232      * as set in the last call to GrowEvaluationStack, contains a pointer to
1233      * the previous marker.
1234      */
1235 
1236     eePtr = iPtr->execEnvPtr;
1237     esPtr = eePtr->execStackPtr;
1238     markerPtr = esPtr->markerPtr;
1239     marker = *markerPtr;
1240 
1241     if ((freePtr != NULL) && (MEMSTART(markerPtr) != (Tcl_Obj **)freePtr)) {
1242 	Tcl_Panic("TclStackFree: incorrect freePtr (%p != %p). Call out of sequence?",
1243 		freePtr, MEMSTART(markerPtr));
1244     }
1245 
1246     esPtr->tosPtr = markerPtr - 1;
1247     esPtr->markerPtr = (Tcl_Obj **) marker;
1248     if (marker) {
1249 	return;
1250     }
1251 
1252     /*
1253      * Return to previous active stack. Note that repeated expansions or
1254      * reallocs could have generated several unused intervening stacks: free
1255      * them too.
1256      */
1257 
1258     while (esPtr->nextPtr) {
1259 	esPtr = esPtr->nextPtr;
1260     }
1261     esPtr->tosPtr = STACK_BASE(esPtr);
1262     while (esPtr->prevPtr) {
1263 	ExecStack *tmpPtr = esPtr->prevPtr;
1264 	if (tmpPtr->tosPtr == STACK_BASE(tmpPtr)) {
1265 	    DeleteExecStack(tmpPtr);
1266 	} else {
1267 	    break;
1268 	}
1269     }
1270     if (esPtr->prevPtr) {
1271 	eePtr->execStackPtr = esPtr->prevPtr;
1272 #ifdef PURIFY
1273 	eePtr->execStackPtr->nextPtr = NULL;
1274 	DeleteExecStack(esPtr);
1275 #endif
1276     } else {
1277 	eePtr->execStackPtr = esPtr;
1278     }
1279 }
1280 
1281 void *
TclStackAlloc(Tcl_Interp * interp,int numBytes)1282 TclStackAlloc(
1283     Tcl_Interp *interp,
1284     int numBytes)
1285 {
1286     Interp *iPtr = (Interp *) interp;
1287     int numWords;
1288 
1289     if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
1290 	return (void *) ckalloc(numBytes);
1291     }
1292     numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
1293     return (void *) StackAllocWords(interp, numWords);
1294 }
1295 
1296 void *
TclStackRealloc(Tcl_Interp * interp,void * ptr,int numBytes)1297 TclStackRealloc(
1298     Tcl_Interp *interp,
1299     void *ptr,
1300     int numBytes)
1301 {
1302     Interp *iPtr = (Interp *) interp;
1303     ExecEnv *eePtr;
1304     ExecStack *esPtr;
1305     Tcl_Obj **markerPtr;
1306     int numWords;
1307 
1308     if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
1309 	return (void *) ckrealloc((char *) ptr, numBytes);
1310     }
1311 
1312     eePtr = iPtr->execEnvPtr;
1313     esPtr = eePtr->execStackPtr;
1314     markerPtr = esPtr->markerPtr;
1315 
1316     if (MEMSTART(markerPtr) != (Tcl_Obj **)ptr) {
1317 	Tcl_Panic("TclStackRealloc: incorrect ptr. Call out of sequence?");
1318     }
1319 
1320     numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
1321     return (void *) StackReallocWords(interp, numWords);
1322 }
1323 
1324 /*
1325  *--------------------------------------------------------------
1326  *
1327  * Tcl_ExprObj --
1328  *
1329  *	Evaluate an expression in a Tcl_Obj.
1330  *
1331  * Results:
1332  *	A standard Tcl object result. If the result is other than TCL_OK, then
1333  *	the interpreter's result contains an error message. If the result is
1334  *	TCL_OK, then a pointer to the expression's result value object is
1335  *	stored in resultPtrPtr. In that case, the object's ref count is
1336  *	incremented to reflect the reference returned to the caller; the
1337  *	caller is then responsible for the resulting object and must, for
1338  *	example, decrement the ref count when it is finished with the object.
1339  *
1340  * Side effects:
1341  *	Any side effects caused by subcommands in the expression, if any. The
1342  *	interpreter result is not modified unless there is an error.
1343  *
1344  *--------------------------------------------------------------
1345  */
1346 
1347 int
Tcl_ExprObj(Tcl_Interp * interp,Tcl_Obj * objPtr,Tcl_Obj ** resultPtrPtr)1348 Tcl_ExprObj(
1349     Tcl_Interp *interp,		/* Context in which to evaluate the
1350 				 * expression. */
1351     Tcl_Obj *objPtr,	/* Points to Tcl object containing expression
1352 				 * to evaluate. */
1353     Tcl_Obj **resultPtrPtr)	/* Where the Tcl_Obj* that is the expression
1354 				 * result is stored if no errors occur. */
1355 {
1356     NRE_callback *rootPtr = TOP_CB(interp);
1357     Tcl_Obj *resultPtr;
1358 
1359     TclNewObj(resultPtr);
1360     TclNRAddCallback(interp, CopyCallback, resultPtrPtr, resultPtr,
1361 	    NULL, NULL);
1362     Tcl_NRExprObj(interp, objPtr, resultPtr);
1363     return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
1364 }
1365 
1366 static int
CopyCallback(ClientData data[],TCL_UNUSED (Tcl_Interp *),int result)1367 CopyCallback(
1368     ClientData data[],
1369     TCL_UNUSED(Tcl_Interp *),
1370     int result)
1371 {
1372     Tcl_Obj **resultPtrPtr = (Tcl_Obj **)data[0];
1373     Tcl_Obj *resultPtr = (Tcl_Obj *)data[1];
1374 
1375     if (result == TCL_OK) {
1376 	*resultPtrPtr = resultPtr;
1377 	Tcl_IncrRefCount(resultPtr);
1378     } else {
1379 	Tcl_DecrRefCount(resultPtr);
1380     }
1381     return result;
1382 }
1383 
1384 /*
1385  *--------------------------------------------------------------
1386  *
1387  * Tcl_NRExprObj --
1388  *
1389  *	Request evaluation of the expression in a Tcl_Obj by the NR stack.
1390  *
1391  * Results:
1392  *	Returns TCL_OK.
1393  *
1394  * Side effects:
1395  *	Compiles objPtr as a Tcl expression and places callbacks on the
1396  *	NR stack to execute the bytecode and store the result in resultPtr.
1397  *	If bytecode execution raises an exception, nothing is written
1398  *	to resultPtr, and the exceptional return code flows up the NR
1399  *	stack.  If the exception is TCL_ERROR, an error message is left
1400  *	in the interp result and the interp's return options dictionary
1401  *	holds additional error information too.  Execution of the bytecode
1402  *	may have other side effects, depending on the expression.
1403  *
1404  *--------------------------------------------------------------
1405  */
1406 
1407 int
Tcl_NRExprObj(Tcl_Interp * interp,Tcl_Obj * objPtr,Tcl_Obj * resultPtr)1408 Tcl_NRExprObj(
1409     Tcl_Interp *interp,
1410     Tcl_Obj *objPtr,
1411     Tcl_Obj *resultPtr)
1412 {
1413     ByteCode *codePtr;
1414     Tcl_InterpState state = Tcl_SaveInterpState(interp, TCL_OK);
1415 
1416     Tcl_ResetResult(interp);
1417     codePtr = CompileExprObj(interp, objPtr);
1418 
1419     Tcl_NRAddCallback(interp, ExprObjCallback, state, resultPtr,
1420 	    NULL, NULL);
1421     return TclNRExecuteByteCode(interp, codePtr);
1422 }
1423 
1424 static int
ExprObjCallback(ClientData data[],Tcl_Interp * interp,int result)1425 ExprObjCallback(
1426     ClientData data[],
1427     Tcl_Interp *interp,
1428     int result)
1429 {
1430     Tcl_InterpState state = (Tcl_InterpState)data[0];
1431     Tcl_Obj *resultPtr = (Tcl_Obj *)data[1];
1432 
1433     if (result == TCL_OK) {
1434 	TclSetDuplicateObj(resultPtr, Tcl_GetObjResult(interp));
1435 	(void) Tcl_RestoreInterpState(interp, state);
1436     } else {
1437 	Tcl_DiscardInterpState(state);
1438     }
1439     return result;
1440 }
1441 
1442 /*
1443  *----------------------------------------------------------------------
1444  *
1445  * CompileExprObj --
1446  *	Compile a Tcl expression value into ByteCode.
1447  *
1448  * Results:
1449  *	A (ByteCode *) is returned pointing to the resulting ByteCode.
1450  *
1451  * Side effects:
1452  *	The Tcl_ObjType of objPtr is changed to the "exprcode" type,
1453  *	and the ByteCode is kept in the internal rep (along with context
1454  *	data for checking validity) for faster operations the next time
1455  *	CompileExprObj is called on the same value.
1456  *
1457  *----------------------------------------------------------------------
1458  */
1459 
1460 static ByteCode *
CompileExprObj(Tcl_Interp * interp,Tcl_Obj * objPtr)1461 CompileExprObj(
1462     Tcl_Interp *interp,
1463     Tcl_Obj *objPtr)
1464 {
1465     Interp *iPtr = (Interp *) interp;
1466     CompileEnv compEnv;		/* Compilation environment structure allocated
1467 				 * in frame. */
1468     ByteCode *codePtr = NULL;
1469 				/* Tcl Internal type of bytecode. Initialized
1470 				 * to avoid compiler warning. */
1471 
1472     /*
1473      * Get the expression ByteCode from the object. If it exists, make sure it
1474      * is valid in the current context.
1475      */
1476 
1477     ByteCodeGetIntRep(objPtr, &exprCodeType, codePtr);
1478 
1479     if (codePtr != NULL) {
1480 	Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;
1481 
1482 	if (((Interp *) *codePtr->interpHandle != iPtr)
1483 		|| (codePtr->compileEpoch != iPtr->compileEpoch)
1484 		|| (codePtr->nsPtr != namespacePtr)
1485 		|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)
1486 		|| (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) {
1487 	    Tcl_StoreIntRep(objPtr, &exprCodeType, NULL);
1488 	    codePtr = NULL;
1489 	}
1490     }
1491 
1492     if (codePtr == NULL) {
1493 	/*
1494 	 * TIP #280: No invoker (yet) - Expression compilation.
1495 	 */
1496 
1497 	const char *string = TclGetString(objPtr);
1498 
1499 	TclInitCompileEnv(interp, &compEnv, string, objPtr->length, NULL, 0);
1500 	TclCompileExpr(interp, string, objPtr->length, &compEnv, 0);
1501 
1502 	/*
1503 	 * Successful compilation. If the expression yielded no instructions,
1504 	 * push an zero object as the expression's result.
1505 	 */
1506 
1507 	if (compEnv.codeNext == compEnv.codeStart) {
1508 	    TclEmitPush(TclRegisterLiteral(&compEnv, "0", 1, 0),
1509 		    &compEnv);
1510 	}
1511 
1512 	/*
1513 	 * Add a "done" instruction as the last instruction and change the
1514 	 * object into a ByteCode object. Ownership of the literal objects and
1515 	 * aux data items is given to the ByteCode object.
1516 	 */
1517 
1518 	TclEmitOpcode(INST_DONE, &compEnv);
1519 	codePtr = TclInitByteCodeObj(objPtr, &exprCodeType, &compEnv);
1520 	TclFreeCompileEnv(&compEnv);
1521 	if (iPtr->varFramePtr->localCachePtr) {
1522 	    codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
1523 	    codePtr->localCachePtr->refCount++;
1524 	}
1525 #ifdef TCL_COMPILE_DEBUG
1526 	if (tclTraceCompile == 2) {
1527 	    TclPrintByteCodeObj(interp, objPtr);
1528 	    fflush(stdout);
1529 	}
1530 #endif /* TCL_COMPILE_DEBUG */
1531     }
1532     return codePtr;
1533 }
1534 
1535 /*
1536  *----------------------------------------------------------------------
1537  *
1538  * DupExprCodeInternalRep --
1539  *
1540  *	Part of the Tcl object type implementation for Tcl expression
1541  *	bytecode. We do not copy the bytecode intrep. Instead, we return
1542  *	without setting copyPtr->typePtr, so the copy is a plain string copy
1543  *	of the expression value, and if it is to be used as a compiled
1544  *	expression, it will just need a recompile.
1545  *
1546  *	This makes sense, because with Tcl's copy-on-write practices, the
1547  *	usual (only?) time Tcl_DuplicateObj() will be called is when the copy
1548  *	is about to be modified, which would invalidate any copied bytecode
1549  *	anyway. The only reason it might make sense to copy the bytecode is if
1550  *	we had some modifying routines that operated directly on the intrep,
1551  *	like we do for lists and dicts.
1552  *
1553  * Results:
1554  *	None.
1555  *
1556  * Side effects:
1557  *	None.
1558  *
1559  *----------------------------------------------------------------------
1560  */
1561 
1562 static void
DupExprCodeInternalRep(TCL_UNUSED (Tcl_Obj *),TCL_UNUSED (Tcl_Obj *))1563 DupExprCodeInternalRep(
1564     TCL_UNUSED(Tcl_Obj *),
1565     TCL_UNUSED(Tcl_Obj *))
1566 {
1567     return;
1568 }
1569 
1570 /*
1571  *----------------------------------------------------------------------
1572  *
1573  * FreeExprCodeInternalRep --
1574  *
1575  *	Part of the Tcl object type implementation for Tcl expression
1576  *	bytecode. Frees the storage allocated to hold the internal rep, unless
1577  *	ref counts indicate bytecode execution is still in progress.
1578  *
1579  * Results:
1580  *	None.
1581  *
1582  * Side effects:
1583  *	May free allocated memory. Leaves objPtr untyped.
1584  *
1585  *----------------------------------------------------------------------
1586  */
1587 
1588 static void
FreeExprCodeInternalRep(Tcl_Obj * objPtr)1589 FreeExprCodeInternalRep(
1590     Tcl_Obj *objPtr)
1591 {
1592     ByteCode *codePtr;
1593     ByteCodeGetIntRep(objPtr, &exprCodeType, codePtr);
1594     assert(codePtr != NULL);
1595 
1596     TclReleaseByteCode(codePtr);
1597 }
1598 
1599 /*
1600  *----------------------------------------------------------------------
1601  *
1602  * TclCompileObj --
1603  *
1604  *	This procedure compiles the script contained in a Tcl_Obj.
1605  *
1606  * Results:
1607  *	A pointer to the corresponding ByteCode, never NULL.
1608  *
1609  * Side effects:
1610  *	The object is shimmered to bytecode type.
1611  *
1612  *----------------------------------------------------------------------
1613  */
1614 
1615 ByteCode *
TclCompileObj(Tcl_Interp * interp,Tcl_Obj * objPtr,const CmdFrame * invoker,int word)1616 TclCompileObj(
1617     Tcl_Interp *interp,
1618     Tcl_Obj *objPtr,
1619     const CmdFrame *invoker,
1620     int word)
1621 {
1622     Interp *iPtr = (Interp *) interp;
1623     ByteCode *codePtr;	/* Tcl Internal type of bytecode. */
1624     Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;
1625 
1626     /*
1627      * If the object is not already of tclByteCodeType, compile it (and reset
1628      * the compilation flags in the interpreter; this should be done after any
1629      * compilation). Otherwise, check that it is "fresh" enough.
1630      */
1631 
1632     ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr);
1633     if (codePtr != NULL) {
1634 	/*
1635 	 * Make sure the Bytecode hasn't been invalidated by, e.g., someone
1636 	 * redefining a command with a compile procedure (this might make the
1637 	 * compiled code wrong). The object needs to be recompiled if it was
1638 	 * compiled in/for a different interpreter, or for a different
1639 	 * namespace, or for the same namespace but with different name
1640 	 * resolution rules. Precompiled objects, however, are immutable and
1641 	 * therefore they are not recompiled, even if the epoch has changed.
1642 	 *
1643 	 * To be pedantically correct, we should also check that the
1644 	 * originating procPtr is the same as the current context procPtr
1645 	 * (assuming one exists at all - none for global level). This code is
1646 	 * #def'ed out because [info body] was changed to never return a
1647 	 * bytecode type object, which should obviate us from the extra checks
1648 	 * here.
1649 	 */
1650 
1651 	if (((Interp *) *codePtr->interpHandle != iPtr)
1652 		|| (codePtr->compileEpoch != iPtr->compileEpoch)
1653 		|| (codePtr->nsPtr != namespacePtr)
1654 		|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)) {
1655 	    if (!(codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
1656 		goto recompileObj;
1657 	    }
1658 	    if ((Interp *) *codePtr->interpHandle != iPtr) {
1659 		Tcl_Panic("Tcl_EvalObj: compiled script jumped interps");
1660 	    }
1661 	    codePtr->compileEpoch = iPtr->compileEpoch;
1662 	}
1663 
1664 	/*
1665 	 * Check that any compiled locals do refer to the current proc
1666 	 * environment! If not, recompile.
1667 	 */
1668 
1669 	if (!(codePtr->flags & TCL_BYTECODE_PRECOMPILED) &&
1670 		(codePtr->procPtr == NULL) &&
1671 		(codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)){
1672 	    goto recompileObj;
1673 	}
1674 
1675 	/*
1676 	 * #280.
1677 	 * Literal sharing fix. This part of the fix is not required by 8.4
1678 	 * nor 8.5, because they eval-direct any literals, so just saving the
1679 	 * argument locations per command in bytecode is enough, embedded
1680 	 * 'eval' commands, etc. get the correct information.
1681 	 *
1682 	 * But in 8.6 all the embedded script are compiled, and the resulting
1683 	 * bytecode stored in the literal. Now the shared literal has bytecode
1684 	 * with location data for _one_ particular location this literal is
1685 	 * found at. If we get executed from a different location the bytecode
1686 	 * has to be recompiled to get the correct locations. Not doing this
1687 	 * will execute the saved bytecode with data for a different location,
1688 	 * causing 'info frame' to point to the wrong place in the sources.
1689 	 *
1690 	 * Future optimizations ...
1691 	 * (1) Save the location data (ExtCmdLoc) keyed by start line. In that
1692 	 *     case we recompile once per location of the literal, but not
1693 	 *     continously, because the moment we have all locations we do not
1694 	 *     need to recompile any longer.
1695 	 *
1696 	 * (2) Alternative: Do not recompile, tell the execution engine the
1697 	 *     offset between saved starting line and actual one. Then modify
1698 	 *     the users to adjust the locations they have by this offset.
1699 	 *
1700 	 * (3) Alternative 2: Do not fully recompile, adjust just the location
1701 	 *     information.
1702 	 */
1703 
1704 	if (invoker == NULL) {
1705 	    return codePtr;
1706 	} else {
1707 	    Tcl_HashEntry *hePtr =
1708 		    Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);
1709 	    ExtCmdLoc *eclPtr;
1710 	    CmdFrame *ctxCopyPtr;
1711 	    int redo;
1712 
1713 	    if (!hePtr) {
1714 		return codePtr;
1715 	    }
1716 
1717 	    eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hePtr);
1718 	    redo = 0;
1719 	    ctxCopyPtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame));
1720 	    *ctxCopyPtr = *invoker;
1721 
1722 	    if (invoker->type == TCL_LOCATION_BC) {
1723 		/*
1724 		 * Note: Type BC => ctx.data.eval.path    is not used.
1725 		 *		    ctx.data.tebc.codePtr used instead
1726 		 */
1727 
1728 		TclGetSrcInfoForPc(ctxCopyPtr);
1729 		if (ctxCopyPtr->type == TCL_LOCATION_SOURCE) {
1730 		    /*
1731 		     * The reference made by 'TclGetSrcInfoForPc' is dead.
1732 		     */
1733 
1734 		    Tcl_DecrRefCount(ctxCopyPtr->data.eval.path);
1735 		    ctxCopyPtr->data.eval.path = NULL;
1736 		}
1737 	    }
1738 
1739 	    if (word < ctxCopyPtr->nline) {
1740 		/*
1741 		 * Note: We do not care if the line[word] is -1. This is a
1742 		 * difference and requires a recompile (location changed from
1743 		 * absolute to relative, literal is used fixed and through
1744 		 * variable)
1745 		 *
1746 		 * Example:
1747 		 * test info-32.0 using literal of info-24.8
1748 		 *     (dict with ... vs           set body ...).
1749 		 */
1750 
1751 		redo = ((eclPtr->type == TCL_LOCATION_SOURCE)
1752 			    && (eclPtr->start != ctxCopyPtr->line[word]))
1753 			|| ((eclPtr->type == TCL_LOCATION_BC)
1754 			    && (ctxCopyPtr->type == TCL_LOCATION_SOURCE));
1755 	    }
1756 
1757 	    TclStackFree(interp, ctxCopyPtr);
1758 	    if (!redo) {
1759 		return codePtr;
1760 	    }
1761 	}
1762     }
1763 
1764   recompileObj:
1765     iPtr->errorLine = 1;
1766 
1767     /*
1768      * TIP #280. Remember the invoker for a moment in the interpreter
1769      * structures so that the byte code compiler can pick it up when
1770      * initializing the compilation environment, i.e. the extended location
1771      * information.
1772      */
1773 
1774     iPtr->invokeCmdFramePtr = invoker;
1775     iPtr->invokeWord = word;
1776     TclSetByteCodeFromAny(interp, objPtr, NULL, NULL);
1777     iPtr->invokeCmdFramePtr = NULL;
1778     ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr);
1779     if (iPtr->varFramePtr->localCachePtr) {
1780 	codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
1781 	codePtr->localCachePtr->refCount++;
1782     }
1783     return codePtr;
1784 }
1785 
1786 /*
1787  *----------------------------------------------------------------------
1788  *
1789  * TclIncrObj --
1790  *
1791  *	Increment an integeral value in a Tcl_Obj by an integeral value held
1792  *	in another Tcl_Obj. Caller is responsible for making sure we can
1793  *	update the first object.
1794  *
1795  * Results:
1796  *	TCL_ERROR if either object is non-integer, and TCL_OK otherwise. On
1797  *	error, an error message is left in the interpreter (if it is not NULL,
1798  *	of course).
1799  *
1800  * Side effects:
1801  *	valuePtr gets the new incrmented value.
1802  *
1803  *----------------------------------------------------------------------
1804  */
1805 
1806 int
TclIncrObj(Tcl_Interp * interp,Tcl_Obj * valuePtr,Tcl_Obj * incrPtr)1807 TclIncrObj(
1808     Tcl_Interp *interp,
1809     Tcl_Obj *valuePtr,
1810     Tcl_Obj *incrPtr)
1811 {
1812     ClientData ptr1, ptr2;
1813     int type1, type2;
1814     mp_int value, incr;
1815     mp_err err;
1816 
1817     if (Tcl_IsShared(valuePtr)) {
1818 	Tcl_Panic("%s called with shared object", "TclIncrObj");
1819     }
1820 
1821     if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) {
1822 	/*
1823 	 * Produce error message (reparse?!)
1824 	 */
1825 
1826 	return TclGetIntFromObj(interp, valuePtr, &type1);
1827     }
1828     if (GetNumberFromObj(NULL, incrPtr, &ptr2, &type2) != TCL_OK) {
1829 	/*
1830 	 * Produce error message (reparse?!)
1831 	 */
1832 
1833 	TclGetIntFromObj(interp, incrPtr, &type1);
1834 	Tcl_AddErrorInfo(interp, "\n    (reading increment)");
1835 	return TCL_ERROR;
1836     }
1837 
1838     if ((type1 == TCL_NUMBER_DOUBLE) || (type1 == TCL_NUMBER_NAN)) {
1839 	/*
1840 	 * Produce error message (reparse?!)
1841 	 */
1842 
1843 	return TclGetIntFromObj(interp, valuePtr, &type1);
1844     }
1845     if ((type2 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_NAN)) {
1846 	/*
1847 	 * Produce error message (reparse?!)
1848 	 */
1849 
1850 	TclGetIntFromObj(interp, incrPtr, &type1);
1851 	Tcl_AddErrorInfo(interp, "\n    (reading increment)");
1852 	return TCL_ERROR;
1853     }
1854 
1855     if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
1856 	Tcl_WideInt w1, w2, sum;
1857 
1858 	w1 = *((const Tcl_WideInt *)ptr1);
1859 	w2 = *((const Tcl_WideInt *)ptr2);
1860 	sum = w1 + w2;
1861 
1862 	/*
1863 	 * Check for overflow.
1864 	 */
1865 
1866 	if (!Overflowing(w1, w2, sum)) {
1867 	    TclSetIntObj(valuePtr, sum);
1868 	    return TCL_OK;
1869 	}
1870     }
1871 
1872     Tcl_TakeBignumFromObj(interp, valuePtr, &value);
1873     Tcl_GetBignumFromObj(interp, incrPtr, &incr);
1874     err = mp_add(&value, &incr, &value);
1875     mp_clear(&incr);
1876     if (err != MP_OKAY) {
1877 	return TCL_ERROR;
1878     }
1879     Tcl_SetBignumObj(valuePtr, &value);
1880     return TCL_OK;
1881 }
1882 
1883 /*
1884  *----------------------------------------------------------------------
1885  *
1886  * ArgumentBCEnter --
1887  *
1888  *	This is a helper for TclNRExecuteByteCode/TEBCresume that encapsulates
1889  *	a code sequence that is fairly common in the code but *not* commonly
1890  *	called.
1891  *
1892  * Results:
1893  *	None
1894  *
1895  * Side effects:
1896  *	May register information about the bytecode in the command frame.
1897  *
1898  *----------------------------------------------------------------------
1899  */
1900 
1901 static void
ArgumentBCEnter(Tcl_Interp * interp,ByteCode * codePtr,TEBCdata * tdPtr,const unsigned char * pc,int objc,Tcl_Obj ** objv)1902 ArgumentBCEnter(
1903     Tcl_Interp *interp,
1904     ByteCode *codePtr,
1905     TEBCdata *tdPtr,
1906     const unsigned char *pc,
1907     int objc,
1908     Tcl_Obj **objv)
1909 {
1910     int cmd;
1911 
1912     if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) {
1913 	TclArgumentBCEnter(interp, objv, objc, codePtr, &tdPtr->cmdFrame, cmd,
1914 		pc - codePtr->codeStart);
1915     }
1916 }
1917 
1918 /*
1919  *----------------------------------------------------------------------
1920  *
1921  * TclNRExecuteByteCode --
1922  *
1923  *	This procedure executes the instructions of a ByteCode structure. It
1924  *	returns when a "done" instruction is executed or an error occurs.
1925  *
1926  * Results:
1927  *	The return value is one of the return codes defined in tcl.h (such as
1928  *	TCL_OK), and interp->objResultPtr refers to a Tcl object that either
1929  *	contains the result of executing the code or an error message.
1930  *
1931  * Side effects:
1932  *	Almost certainly, depending on the ByteCode's instructions.
1933  *
1934  *----------------------------------------------------------------------
1935  */
1936 #define	bcFramePtr	(&TD->cmdFrame)
1937 #define	initCatchTop	((ptrdiff_t *) (TD->stack-1))
1938 #define	initTosPtr	((Tcl_Obj **) (initCatchTop+codePtr->maxExceptDepth))
1939 #define esPtr		(iPtr->execEnvPtr->execStackPtr)
1940 
1941 int
TclNRExecuteByteCode(Tcl_Interp * interp,ByteCode * codePtr)1942 TclNRExecuteByteCode(
1943     Tcl_Interp *interp,		/* Token for command interpreter. */
1944     ByteCode *codePtr)		/* The bytecode sequence to interpret. */
1945 {
1946     Interp *iPtr = (Interp *) interp;
1947     TEBCdata *TD;
1948     int size = sizeof(TEBCdata) - 1
1949 	    + (codePtr->maxStackDepth + codePtr->maxExceptDepth)
1950 		* sizeof(void *);
1951     int numWords = (size + sizeof(Tcl_Obj *) - 1) / sizeof(Tcl_Obj *);
1952 
1953     TclPreserveByteCode(codePtr);
1954 
1955     /*
1956      * Reserve the stack, setup the TEBCdataPtr (TD) and CallFrame
1957      *
1958      * The execution uses a unified stack: first a TEBCdata, immediately
1959      * above it a CmdFrame, then the catch stack, then the execution stack.
1960      *
1961      * Make sure the catch stack is large enough to hold the maximum number of
1962      * catch commands that could ever be executing at the same time (this will
1963      * be no more than the exception range array's depth). Make sure the
1964      * execution stack is large enough to execute this ByteCode.
1965      */
1966 
1967     TD = (TEBCdata *) GrowEvaluationStack(iPtr->execEnvPtr, numWords, 0);
1968     esPtr->tosPtr = initTosPtr;
1969 
1970     TD->codePtr     = codePtr;
1971     TD->catchTop    = initCatchTop;
1972     TD->auxObjList  = NULL;
1973 
1974     /*
1975      * TIP #280: Initialize the frame. Do not push it yet: it will be pushed
1976      * every time that we call out from this TD, popped when we return to it.
1977      */
1978 
1979     bcFramePtr->type = ((codePtr->flags & TCL_BYTECODE_PRECOMPILED)
1980 	    ? TCL_LOCATION_PREBC : TCL_LOCATION_BC);
1981     bcFramePtr->level = (iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level+1 : 1);
1982     bcFramePtr->framePtr = iPtr->framePtr;
1983     bcFramePtr->nextPtr = iPtr->cmdFramePtr;
1984     bcFramePtr->nline = 0;
1985     bcFramePtr->line = NULL;
1986     bcFramePtr->litarg = NULL;
1987     bcFramePtr->data.tebc.codePtr = codePtr;
1988     bcFramePtr->data.tebc.pc = NULL;
1989     bcFramePtr->cmdObj = NULL;
1990     bcFramePtr->cmd = NULL;
1991     bcFramePtr->len = 0;
1992 
1993 #ifdef TCL_COMPILE_STATS
1994     iPtr->stats.numExecutions++;
1995 #endif
1996 
1997     /*
1998      * Test namespace-50.9 demonstrates the need for this call.
1999      * Use a --enable-symbols=mem bug to see.
2000      */
2001 
2002     TclResetRewriteEnsemble(interp, 1);
2003 
2004     /*
2005      * Push the callback for bytecode execution
2006      */
2007 
2008     TclNRAddCallback(interp, TEBCresume, TD, /* pc */ NULL,
2009 	    /* cleanup */ INT2PTR(0), INT2PTR(iPtr->evalFlags));
2010 
2011     /*
2012      * Reset discard result flag - because it is applicable for this call only,
2013      * and should not affect all the nested invocations may return result.
2014      */
2015     iPtr->evalFlags &= ~TCL_EVAL_DISCARD_RESULT;
2016 
2017     return TCL_OK;
2018 }
2019 
2020 static int
TEBCresume(ClientData data[],Tcl_Interp * interp,int result)2021 TEBCresume(
2022     ClientData data[],
2023     Tcl_Interp *interp,
2024     int result)
2025 {
2026     /*
2027      * Compiler cast directive - not a real variable.
2028      *	   Interp *iPtr = (Interp *) interp;
2029      */
2030 #define iPtr ((Interp *) interp)
2031 
2032     /*
2033      * Check just the read-traced/write-traced bit of a variable.
2034      */
2035 
2036 #define ReadTraced(varPtr) ((varPtr)->flags & VAR_TRACED_READ)
2037 #define WriteTraced(varPtr) ((varPtr)->flags & VAR_TRACED_WRITE)
2038 #define UnsetTraced(varPtr) ((varPtr)->flags & VAR_TRACED_UNSET)
2039 
2040     /*
2041      * Bottom of allocated stack holds the NR data
2042      */
2043 
2044     /*
2045      * Constants: variables that do not change during the execution, used
2046      * sporadically: no special need for speed.
2047      */
2048 
2049     unsigned interruptCounter = 1;
2050 				/* Counter that is used to work out when to
2051 				 * call Tcl_AsyncReady(). This must be 1
2052 				 * initially so that we call the async-check
2053 				 * stanza early, otherwise there are command
2054 				 * sequences that can make the interpreter
2055 				 * busy-loop without an opportunity to
2056 				 * recognise an interrupt. */
2057     const char *curInstName;
2058 #ifdef TCL_COMPILE_DEBUG
2059     int traceInstructions;	/* Whether we are doing instruction-level
2060 				 * tracing or not. */
2061 #endif
2062 
2063     Var *compiledLocals = iPtr->varFramePtr->compiledLocals;
2064     Tcl_Obj **constants = &iPtr->execEnvPtr->constants[0];
2065 
2066 #define LOCAL(i)	(&compiledLocals[(i)])
2067 #define TCONST(i)	(constants[(i)])
2068 
2069     /*
2070      * These macros are just meant to save some global variables that are not
2071      * used too frequently
2072      */
2073 
2074     TEBCdata *TD = (TEBCdata *)data[0];
2075 #define auxObjList	(TD->auxObjList)
2076 #define catchTop	(TD->catchTop)
2077 #define codePtr		(TD->codePtr)
2078 #define curEvalFlags	PTR2INT(data[3])  /* calling iPtr->evalFlags */
2079 
2080     /*
2081      * Globals: variables that store state, must remain valid at all times.
2082      */
2083 
2084     Tcl_Obj **tosPtr;		/* Cached pointer to top of evaluation
2085 				 * stack. */
2086     const unsigned char *pc = (const unsigned char *)data[1];
2087                                 /* The current program counter. */
2088     unsigned char inst;         /* The currently running instruction */
2089 
2090     /*
2091      * Transfer variables - needed only between opcodes, but not while
2092      * executing an instruction.
2093      */
2094 
2095     int cleanup = PTR2INT(data[2]);
2096     Tcl_Obj *objResultPtr;
2097     int checkInterp = 0;        /* Indicates when a check of interp readyness
2098 				 * is necessary. Set by CACHE_STACK_INFO() */
2099 
2100     /*
2101      * Locals - variables that are used within opcodes or bounded sections of
2102      * the file (jumps between opcodes within a family).
2103      * NOTE: These are now mostly defined locally where needed.
2104      */
2105 
2106     Tcl_Obj *objPtr, *valuePtr, *value2Ptr, *part1Ptr, *part2Ptr, *tmpPtr;
2107     Tcl_Obj **objv = NULL;
2108     int objc = 0;
2109     int opnd, length, pcAdjustment;
2110     Var *varPtr, *arrayPtr;
2111 #ifdef TCL_COMPILE_DEBUG
2112     char cmdNameBuf[21];
2113 #endif
2114 
2115 #ifdef TCL_COMPILE_DEBUG
2116     int starting = 1;
2117     traceInstructions = (tclTraceExec == 3);
2118 #endif
2119 
2120     TEBC_DATA_DIG();
2121 
2122 #ifdef TCL_COMPILE_DEBUG
2123     if (!pc && (tclTraceExec >= 2)) {
2124 	PrintByteCodeInfo(codePtr);
2125 	fprintf(stdout, "  Starting stack top=%d\n", (int) CURR_DEPTH);
2126 	fflush(stdout);
2127     }
2128 #endif
2129 
2130     if (!pc) {
2131 	/* bytecode is starting from scratch */
2132 	pc = codePtr->codeStart;
2133 
2134 	/*
2135 	 * Reset the interp's result to avoid possible duplications of large
2136 	 * objects [3c6e47363e], [781585], [804681], This can happen by start
2137 	 * also in nested compiled blocks (enclosed in parent cycle).
2138 	 * See else branch below for opposite handling by continuation/resume.
2139 	 */
2140 
2141 	objPtr = iPtr->objResultPtr;
2142 	if (objPtr->refCount > 1) {
2143 	    TclDecrRefCount(objPtr);
2144 	    TclNewObj(objPtr);
2145 	    Tcl_IncrRefCount(objPtr);
2146 	    iPtr->objResultPtr = objPtr;
2147 	}
2148 
2149 	goto cleanup0;
2150     } else {
2151         /* resume from invocation */
2152 	CACHE_STACK_INFO();
2153 
2154 	NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr);
2155 	if (bcFramePtr->cmdObj) {
2156 	    Tcl_DecrRefCount(bcFramePtr->cmdObj);
2157 	    bcFramePtr->cmdObj = NULL;
2158 	    bcFramePtr->cmd = NULL;
2159 	}
2160 	iPtr->cmdFramePtr = bcFramePtr->nextPtr;
2161 	if (iPtr->flags & INTERP_DEBUG_FRAME) {
2162 	    TclArgumentBCRelease(interp, bcFramePtr);
2163 	}
2164 	if (iPtr->execEnvPtr->rewind) {
2165 	    result = TCL_ERROR;
2166 	    goto abnormalReturn;
2167 	}
2168 	if (codePtr->flags & TCL_BYTECODE_RECOMPILE) {
2169 	    codePtr->flags &= ~TCL_BYTECODE_RECOMPILE;
2170 	    checkInterp = 1;
2171 	    iPtr->flags |= ERR_ALREADY_LOGGED;
2172 	}
2173 
2174 	if (result != TCL_OK) {
2175 	    pc--;
2176 	    goto processExceptionReturn;
2177 	}
2178 
2179 	/*
2180 	 * Push the call's object result and continue execution with the next
2181 	 * instruction.
2182 	 */
2183 
2184 	TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
2185 		objc, cmdNameBuf), Tcl_GetObjResult(interp));
2186 
2187 	/*
2188 	 * Obtain and reset interp's result to avoid possible duplications of
2189 	 * objects [Bug 781585]. We do not call Tcl_ResetResult to avoid any
2190 	 * side effects caused by the resetting of errorInfo and errorCode
2191 	 * [Bug 804681], which are not needed here. We chose instead to
2192 	 * manipulate the interp's object result directly.
2193 	 *
2194 	 * Note that the result object is now in objResultPtr, it keeps the
2195 	 * refCount it had in its role of iPtr->objResultPtr.
2196 	 */
2197 
2198 	objResultPtr = Tcl_GetObjResult(interp);
2199 	TclNewObj(objPtr);
2200 	Tcl_IncrRefCount(objPtr);
2201 	iPtr->objResultPtr = objPtr;
2202 #ifndef TCL_COMPILE_DEBUG
2203 	if (*pc == INST_POP) {
2204 	    TclDecrRefCount(objResultPtr);
2205 	    NEXT_INST_V(1, cleanup, 0);
2206 	}
2207 #endif
2208 	NEXT_INST_V(0, cleanup, -1);
2209     }
2210 
2211     /*
2212      * Targets for standard instruction endings; unrolled for speed in the
2213      * most frequent cases (instructions that consume up to two stack
2214      * elements).
2215      *
2216      * This used to be a "for(;;)" loop, with each instruction doing its own
2217      * cleanup.
2218      */
2219 
2220   cleanupV_pushObjResultPtr:
2221     switch (cleanup) {
2222     case 0:
2223 	*(++tosPtr) = (objResultPtr);
2224 	goto cleanup0;
2225     default:
2226 	cleanup -= 2;
2227 	while (cleanup--) {
2228 	    objPtr = POP_OBJECT();
2229 	    TclDecrRefCount(objPtr);
2230 	}
2231 	/* FALLTHRU */
2232     case 2:
2233     cleanup2_pushObjResultPtr:
2234 	objPtr = POP_OBJECT();
2235 	TclDecrRefCount(objPtr);
2236 	/* FALLTHRU */
2237     case 1:
2238     cleanup1_pushObjResultPtr:
2239 	objPtr = OBJ_AT_TOS;
2240 	TclDecrRefCount(objPtr);
2241     }
2242     OBJ_AT_TOS = objResultPtr;
2243     goto cleanup0;
2244 
2245   cleanupV:
2246     switch (cleanup) {
2247     default:
2248 	cleanup -= 2;
2249 	while (cleanup--) {
2250 	    objPtr = POP_OBJECT();
2251 	    TclDecrRefCount(objPtr);
2252 	}
2253 	/* FALLTHRU */
2254     case 2:
2255     cleanup2:
2256 	objPtr = POP_OBJECT();
2257 	TclDecrRefCount(objPtr);
2258 	/* FALLTHRU */
2259     case 1:
2260     cleanup1:
2261 	objPtr = POP_OBJECT();
2262 	TclDecrRefCount(objPtr);
2263 	/* FALLTHRU */
2264     case 0:
2265 	/*
2266 	 * We really want to do nothing now, but this is needed for some
2267 	 * compilers (SunPro CC).
2268 	 */
2269 
2270 	break;
2271     }
2272   cleanup0:
2273 
2274     /*
2275      * Check for asynchronous handlers [Bug 746722]; we do the check every
2276      * ASYNC_CHECK_COUNT instructions.
2277      */
2278 
2279     if ((--interruptCounter) == 0) {
2280 	interruptCounter = ASYNC_CHECK_COUNT;
2281 	DECACHE_STACK_INFO();
2282 	if (TclAsyncReady(iPtr)) {
2283 	    result = Tcl_AsyncInvoke(interp, result);
2284 	    if (result == TCL_ERROR) {
2285 		CACHE_STACK_INFO();
2286 		goto gotError;
2287 	    }
2288 	}
2289 
2290 	if (TclCanceled(iPtr)) {
2291 	    if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
2292 		CACHE_STACK_INFO();
2293 		goto gotError;
2294 	    }
2295 	}
2296 
2297 	if (TclLimitReady(iPtr->limit)) {
2298 	    if (Tcl_LimitCheck(interp) == TCL_ERROR) {
2299 		CACHE_STACK_INFO();
2300 		goto gotError;
2301 	    }
2302 	}
2303 	CACHE_STACK_INFO();
2304     }
2305 
2306     /*
2307      * These two instructions account for 26% of all instructions (according
2308      * to measurements on tclbench by Ben Vitale
2309      * [http://www.cs.toronto.edu/syslab/pubs/tcl2005-vitale-zaleski.pdf]
2310      * Resolving them before the switch reduces the cost of branch
2311      * mispredictions, seems to improve runtime by 5% to 15%, and (amazingly!)
2312      * reduces total obj size.
2313      */
2314 
2315     inst = *pc;
2316 
2317     peepholeStart:
2318 #ifdef TCL_COMPILE_STATS
2319     iPtr->stats.instructionCount[*pc]++;
2320 #endif
2321 
2322 #ifdef TCL_COMPILE_DEBUG
2323     /*
2324      * Skip the stack depth check if an expansion is in progress.
2325      */
2326 
2327     CHECK_STACK();
2328     if (traceInstructions) {
2329 	fprintf(stdout, "%2d: %2d ", iPtr->numLevels, (int) CURR_DEPTH);
2330 	TclPrintInstruction(codePtr, pc);
2331 	fflush(stdout);
2332     }
2333 #endif /* TCL_COMPILE_DEBUG */
2334 
2335     TCL_DTRACE_INST_NEXT();
2336 
2337     if (inst == INST_LOAD_SCALAR1) {
2338 	goto instLoadScalar1;
2339     } else if (inst == INST_PUSH1) {
2340 	PUSH_OBJECT(codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)]);
2341 	TRACE_WITH_OBJ(("%u => ", TclGetUInt1AtPtr(pc+1)), OBJ_AT_TOS);
2342 	inst = *(pc += 2);
2343 	goto peepholeStart;
2344     } else if (inst == INST_START_CMD) {
2345 	/*
2346 	 * Peephole: do not run INST_START_CMD, just skip it
2347 	 */
2348 
2349 	iPtr->cmdCount += TclGetUInt4AtPtr(pc+5);
2350 	if (checkInterp) {
2351 	    if (((codePtr->compileEpoch != iPtr->compileEpoch) ||
2352 		 (codePtr->nsEpoch != iPtr->varFramePtr->nsPtr->resolverEpoch)) &&
2353 		!(codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
2354 		goto instStartCmdFailed;
2355 	    }
2356 	    checkInterp = 0;
2357 	}
2358 	inst = *(pc += 9);
2359 	goto peepholeStart;
2360     } else if (inst == INST_NOP) {
2361 #ifndef TCL_COMPILE_DEBUG
2362 	while (inst == INST_NOP)
2363 #endif
2364 	{
2365 	    inst = *++pc;
2366 	}
2367 	goto peepholeStart;
2368     }
2369 
2370     switch (inst) {
2371     case INST_SYNTAX:
2372     case INST_RETURN_IMM: {
2373 	int code = TclGetInt4AtPtr(pc+1);
2374 	int level = TclGetUInt4AtPtr(pc+5);
2375 
2376 	/*
2377 	 * OBJ_AT_TOS is returnOpts, OBJ_UNDER_TOS is resultObjPtr.
2378 	 */
2379 
2380 	TRACE(("%u %u => ", code, level));
2381 	result = TclProcessReturn(interp, code, level, OBJ_AT_TOS);
2382 	if (result == TCL_OK) {
2383 	    TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")\n",
2384 		    O2S(objResultPtr)));
2385 	    NEXT_INST_F(9, 1, 0);
2386 	}
2387 	Tcl_SetObjResult(interp, OBJ_UNDER_TOS);
2388 	if (*pc == INST_SYNTAX) {
2389 	    iPtr->flags &= ~ERR_ALREADY_LOGGED;
2390 	}
2391 	cleanup = 2;
2392 	TRACE_APPEND(("\n"));
2393 	goto processExceptionReturn;
2394     }
2395 
2396     case INST_RETURN_STK:
2397 	TRACE(("=> "));
2398 	objResultPtr = POP_OBJECT();
2399 	result = Tcl_SetReturnOptions(interp, OBJ_AT_TOS);
2400 	if (result == TCL_OK) {
2401 	    Tcl_DecrRefCount(OBJ_AT_TOS);
2402 	    OBJ_AT_TOS = objResultPtr;
2403 	    TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")\n",
2404 		    O2S(objResultPtr)));
2405 	    NEXT_INST_F(1, 0, 0);
2406 	} else if (result == TCL_ERROR) {
2407 	    /*
2408 	     * BEWARE! Must do this in this order, because an error in the
2409 	     * option dictionary overrides the result (and can be verified by
2410 	     * test).
2411 	     */
2412 
2413 	    Tcl_SetObjResult(interp, objResultPtr);
2414 	    Tcl_SetReturnOptions(interp, OBJ_AT_TOS);
2415 	    Tcl_DecrRefCount(OBJ_AT_TOS);
2416 	    OBJ_AT_TOS = objResultPtr;
2417 	} else {
2418 	    Tcl_DecrRefCount(OBJ_AT_TOS);
2419 	    OBJ_AT_TOS = objResultPtr;
2420 	    Tcl_SetObjResult(interp, objResultPtr);
2421 	}
2422 	cleanup = 1;
2423 	TRACE_APPEND(("\n"));
2424 	goto processExceptionReturn;
2425 
2426     {
2427 	CoroutineData *corPtr;
2428 	int yieldParameter;
2429 
2430     case INST_YIELD:
2431 	corPtr = iPtr->execEnvPtr->corPtr;
2432 	TRACE(("%.30s => ", O2S(OBJ_AT_TOS)));
2433 	if (!corPtr) {
2434 	    TRACE_APPEND(("ERROR: yield outside coroutine\n"));
2435 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
2436 		    "yield can only be called in a coroutine", -1));
2437 	    DECACHE_STACK_INFO();
2438 	    Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD",
2439 		    NULL);
2440 	    CACHE_STACK_INFO();
2441 	    goto gotError;
2442 	}
2443 
2444 #ifdef TCL_COMPILE_DEBUG
2445 	if (tclTraceExec >= 2) {
2446 	    if (traceInstructions) {
2447 		TRACE_APPEND(("YIELD...\n"));
2448 	    } else {
2449 		fprintf(stdout, "%d: (%u) yielding value \"%.30s\"\n",
2450 			iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
2451 			Tcl_GetString(OBJ_AT_TOS));
2452 	    }
2453 	    fflush(stdout);
2454 	}
2455 #endif
2456 	yieldParameter = 0;
2457 	Tcl_SetObjResult(interp, OBJ_AT_TOS);
2458 	goto doYield;
2459 
2460     case INST_YIELD_TO_INVOKE:
2461 	corPtr = iPtr->execEnvPtr->corPtr;
2462 	valuePtr = OBJ_AT_TOS;
2463 	if (!corPtr) {
2464 	    TRACE(("[%.30s] => ERROR: yield outside coroutine\n",
2465 		    O2S(valuePtr)));
2466 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
2467 		    "yieldto can only be called in a coroutine", -1));
2468 	    DECACHE_STACK_INFO();
2469 	    Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD",
2470 		    NULL);
2471 	    CACHE_STACK_INFO();
2472 	    goto gotError;
2473 	}
2474 	if (((Namespace *)TclGetCurrentNamespace(interp))->flags & NS_DYING) {
2475 	    TRACE(("[%.30s] => ERROR: yield in deleted\n",
2476 		    O2S(valuePtr)));
2477 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
2478 		    "yieldto called in deleted namespace", -1));
2479 	    DECACHE_STACK_INFO();
2480 	    Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
2481 		    NULL);
2482 	    CACHE_STACK_INFO();
2483 	    goto gotError;
2484 	}
2485 
2486 #ifdef TCL_COMPILE_DEBUG
2487 	if (tclTraceExec >= 2) {
2488 	    if (traceInstructions) {
2489 		TRACE(("[%.30s] => YIELD...\n", O2S(valuePtr)));
2490 	    } else {
2491 		/* FIXME: What is the right thing to trace? */
2492 		fprintf(stdout, "%d: (%u) yielding to [%.30s]\n",
2493 			iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
2494 			TclGetString(valuePtr));
2495 	    }
2496 	    fflush(stdout);
2497 	}
2498 #endif
2499 
2500 	/*
2501 	 * Install a tailcall record in the caller and continue with the
2502 	 * yield. The yield is switched into multi-return mode (via the
2503 	 * 'yieldParameter').
2504 	 */
2505 
2506 	Tcl_IncrRefCount(valuePtr);
2507 	iPtr->execEnvPtr = corPtr->callerEEPtr;
2508 	TclSetTailcall(interp, valuePtr);
2509 	iPtr->execEnvPtr = corPtr->eePtr;
2510 	yieldParameter = (PTR2INT(NULL)+1);	/*==CORO_ACTIVATE_YIELDM*/
2511 
2512     doYield:
2513 	/* TIP #280: Record the last piece of info needed by
2514 	 * 'TclGetSrcInfoForPc', and push the frame.
2515 	 */
2516 
2517 	bcFramePtr->data.tebc.pc = (char *) pc;
2518 	iPtr->cmdFramePtr = bcFramePtr;
2519 
2520 	if (iPtr->flags & INTERP_DEBUG_FRAME) {
2521 	    ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
2522 	}
2523 
2524 	pc++;
2525 	cleanup = 1;
2526 	TEBC_YIELD();
2527 	TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
2528 		INT2PTR(yieldParameter), NULL, NULL);
2529 	return TCL_OK;
2530     }
2531 
2532     case INST_TAILCALL: {
2533 	Tcl_Obj *listPtr, *nsObjPtr;
2534 
2535 	opnd = TclGetUInt1AtPtr(pc+1);
2536 
2537 	if (!(iPtr->varFramePtr->isProcCallFrame & 1)) {
2538 	    TRACE(("%d => ERROR: tailcall in non-proc context\n", opnd));
2539 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
2540 		    "tailcall can only be called from a proc or lambda", -1));
2541 	    DECACHE_STACK_INFO();
2542 	    Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);
2543 	    CACHE_STACK_INFO();
2544 	    goto gotError;
2545 	}
2546 
2547 #ifdef TCL_COMPILE_DEBUG
2548 	/* FIXME: What is the right thing to trace? */
2549 	{
2550 	    int i;
2551 
2552 	    TRACE(("%d [", opnd));
2553 	    for (i=opnd-1 ; i>=0 ; i--) {
2554 		TRACE_APPEND(("\"%.30s\"", O2S(OBJ_AT_DEPTH(i))));
2555 		if (i > 0) {
2556 		    TRACE_APPEND((" "));
2557 		}
2558 	    }
2559 	    TRACE_APPEND(("] => RETURN..."));
2560 	}
2561 #endif
2562 
2563 	/*
2564 	 * Push the evaluation of the called command into the NR callback
2565 	 * stack.
2566 	 */
2567 
2568 	listPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1));
2569 	nsObjPtr = Tcl_NewStringObj(iPtr->varFramePtr->nsPtr->fullName, -1);
2570 	TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
2571 	if (iPtr->varFramePtr->tailcallPtr) {
2572 	    Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr);
2573 	}
2574 	iPtr->varFramePtr->tailcallPtr = listPtr;
2575 
2576 	result = TCL_RETURN;
2577 	cleanup = opnd;
2578 	goto processExceptionReturn;
2579     }
2580 
2581     case INST_DONE:
2582 	if (tosPtr > initTosPtr) {
2583 
2584 	    if ((curEvalFlags & TCL_EVAL_DISCARD_RESULT) && (result == TCL_OK)) {
2585 		/* simulate pop & fast done (like it does continue in loop) */
2586 		TRACE_WITH_OBJ(("=> discarding "), OBJ_AT_TOS);
2587 		objPtr = POP_OBJECT();
2588 		TclDecrRefCount(objPtr);
2589 		goto abnormalReturn;
2590 	    }
2591 	    /*
2592 	     * Set the interpreter's object result to point to the topmost
2593 	     * object from the stack, and check for a possible [catch]. The
2594 	     * stackTop's level and refCount will be handled by "processCatch"
2595 	     * or "abnormalReturn".
2596 	     */
2597 
2598 	    Tcl_SetObjResult(interp, OBJ_AT_TOS);
2599 #ifdef TCL_COMPILE_DEBUG
2600 	    TRACE_WITH_OBJ(("=> return code=%d, result=", result),
2601 		    iPtr->objResultPtr);
2602 	    if (traceInstructions) {
2603 		fprintf(stdout, "\n");
2604 	    }
2605 #endif
2606 	    goto checkForCatch;
2607 	}
2608 	(void) POP_OBJECT();
2609 	goto abnormalReturn;
2610 
2611     case INST_PUSH4:
2612 	objResultPtr = codePtr->objArrayPtr[TclGetUInt4AtPtr(pc+1)];
2613 	TRACE_WITH_OBJ(("%u => ", TclGetUInt4AtPtr(pc+1)), objResultPtr);
2614 	NEXT_INST_F(5, 0, 1);
2615     break;
2616 
2617     case INST_POP:
2618 	TRACE_WITH_OBJ(("=> discarding "), OBJ_AT_TOS);
2619 	objPtr = POP_OBJECT();
2620 	TclDecrRefCount(objPtr);
2621 	NEXT_INST_F(1, 0, 0);
2622     break;
2623 
2624     case INST_DUP:
2625 	objResultPtr = OBJ_AT_TOS;
2626 	TRACE_WITH_OBJ(("=> "), objResultPtr);
2627 	NEXT_INST_F(1, 0, 1);
2628     break;
2629 
2630     case INST_OVER:
2631 	opnd = TclGetUInt4AtPtr(pc+1);
2632 	objResultPtr = OBJ_AT_DEPTH(opnd);
2633 	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
2634 	NEXT_INST_F(5, 0, 1);
2635     break;
2636 
2637     case INST_REVERSE: {
2638 	Tcl_Obj **a, **b;
2639 
2640 	opnd = TclGetUInt4AtPtr(pc+1);
2641 	a = tosPtr-(opnd-1);
2642 	b = tosPtr;
2643 	while (a<b) {
2644 	    tmpPtr = *a;
2645 	    *a = *b;
2646 	    *b = tmpPtr;
2647 	    a++; b--;
2648 	}
2649 	TRACE(("%u => OK\n", opnd));
2650 	NEXT_INST_F(5, 0, 0);
2651     }
2652     break;
2653 
2654     case INST_STR_CONCAT1:
2655 
2656 	opnd = TclGetUInt1AtPtr(pc+1);
2657 	objResultPtr = TclStringCat(interp, opnd, &OBJ_AT_DEPTH(opnd-1),
2658 		TCL_STRING_IN_PLACE);
2659 	if (objResultPtr == NULL) {
2660 	    TRACE_ERROR(interp);
2661 	    goto gotError;
2662 	}
2663 
2664 	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
2665 	NEXT_INST_V(2, opnd, 1);
2666     break;
2667 
2668     case INST_CONCAT_STK:
2669 	/*
2670 	 * Pop the opnd (objc) top stack elements, run through Tcl_ConcatObj,
2671 	 * and then decrement their ref counts.
2672 	 */
2673 
2674 	opnd = TclGetUInt4AtPtr(pc+1);
2675 	objResultPtr = Tcl_ConcatObj(opnd, &OBJ_AT_DEPTH(opnd-1));
2676 	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
2677 	NEXT_INST_V(5, opnd, 1);
2678     break;
2679 
2680     case INST_EXPAND_START:
2681 	/*
2682 	 * Push an element to the auxObjList. This records the current
2683 	 * stack depth - i.e., the point in the stack where the expanded
2684 	 * command starts.
2685 	 *
2686 	 * Use a Tcl_Obj as linked list element; slight mem waste, but faster
2687 	 * allocation than ckalloc. This also abuses the Tcl_Obj structure, as
2688 	 * we do not define a special tclObjType for it. It is not dangerous
2689 	 * as the obj is never passed anywhere, so that all manipulations are
2690 	 * performed here and in INST_INVOKE_EXPANDED (in case of an expansion
2691 	 * error, also in INST_EXPAND_STKTOP).
2692 	 */
2693 
2694 	TclNewObj(objPtr);
2695 	objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(CURR_DEPTH);
2696 	objPtr->length = 0;
2697 	PUSH_TAUX_OBJ(objPtr);
2698 	TRACE(("=> mark depth as %d\n", (int) CURR_DEPTH));
2699 	NEXT_INST_F(1, 0, 0);
2700     break;
2701 
2702     case INST_EXPAND_DROP:
2703 	/*
2704 	 * Drops an element of the auxObjList, popping stack elements to
2705 	 * restore the stack to the state before the point where the aux
2706 	 * element was created.
2707 	 */
2708 
2709 	CLANG_ASSERT(auxObjList);
2710 	objc = CURR_DEPTH - PTR2INT(auxObjList->internalRep.twoPtrValue.ptr2);
2711 	POP_TAUX_OBJ();
2712 #ifdef TCL_COMPILE_DEBUG
2713 	/* Ugly abuse! */
2714 	starting = 1;
2715 #endif
2716 	TRACE(("=> drop %d items\n", objc));
2717 	NEXT_INST_V(1, objc, 0);
2718 
2719     case INST_EXPAND_STKTOP: {
2720 	int i;
2721 	ptrdiff_t moved;
2722 
2723 	/*
2724 	 * Make sure that the element at stackTop is a list; if not, just
2725 	 * leave with an error. Note that the element from the expand list
2726 	 * will be removed at checkForCatch.
2727 	 */
2728 
2729 	objPtr = OBJ_AT_TOS;
2730 	TRACE(("\"%.30s\" => ", O2S(objPtr)));
2731 	if (TclListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
2732 	    TRACE_ERROR(interp);
2733 	    goto gotError;
2734 	}
2735 	(void) POP_OBJECT();
2736 
2737 	/*
2738 	 * Make sure there is enough room in the stack to expand this list
2739 	 * *and* process the rest of the command (at least up to the next
2740 	 * argument expansion or command end). The operand is the current
2741 	 * stack depth, as seen by the compiler.
2742 	 */
2743 
2744 	auxObjList->length += objc - 1;
2745 	if ((objc > 1) && (auxObjList->length > 0)) {
2746 	    length = auxObjList->length /* Total expansion room we need */
2747 		    + codePtr->maxStackDepth /* Beyond the original max */
2748 		    - CURR_DEPTH;	/* Relative to where we are */
2749 	    DECACHE_STACK_INFO();
2750 	    moved = GrowEvaluationStack(iPtr->execEnvPtr, length, 1)
2751 		    - (Tcl_Obj **) TD;
2752 	    if (moved) {
2753 		/*
2754 		 * Change the global data to point to the new stack: move the
2755 		 * TEBCdataPtr TD, recompute the position of every other
2756 		 * stack-allocated parameter, update the stack pointers.
2757 		 */
2758 
2759 		TD = (TEBCdata *) (((Tcl_Obj **)TD) + moved);
2760 
2761 		catchTop += moved;
2762 		tosPtr += moved;
2763 	    }
2764 	}
2765 
2766 	/*
2767 	 * Expand the list at stacktop onto the stack; free the list. Knowing
2768 	 * that it has a freeIntRepProc we use Tcl_DecrRefCount().
2769 	 */
2770 
2771 	for (i = 0; i < objc; i++) {
2772 	    PUSH_OBJECT(objv[i]);
2773 	}
2774 
2775 	TRACE_APPEND(("OK\n"));
2776 	Tcl_DecrRefCount(objPtr);
2777 	NEXT_INST_F(5, 0, 0);
2778     }
2779     break;
2780 
2781     case INST_EXPR_STK: {
2782 	ByteCode *newCodePtr;
2783 
2784 	bcFramePtr->data.tebc.pc = (char *) pc;
2785 	iPtr->cmdFramePtr = bcFramePtr;
2786 	DECACHE_STACK_INFO();
2787 	newCodePtr = CompileExprObj(interp, OBJ_AT_TOS);
2788 	CACHE_STACK_INFO();
2789 	cleanup = 1;
2790 	pc++;
2791 	TEBC_YIELD();
2792 	return TclNRExecuteByteCode(interp, newCodePtr);
2793     }
2794 
2795 	/*
2796 	 * INVOCATION BLOCK
2797 	 */
2798 
2799     case INST_EVAL_STK:
2800     instEvalStk:
2801 	bcFramePtr->data.tebc.pc = (char *) pc;
2802 	iPtr->cmdFramePtr = bcFramePtr;
2803 
2804 	cleanup = 1;
2805 	pc += 1;
2806 	/* yield next instruction */
2807 	TEBC_YIELD();
2808 	/* add TEBCResume for object at top of stack */
2809 	return TclNRExecuteByteCode(interp,
2810 		    TclCompileObj(interp, OBJ_AT_TOS, NULL, 0));
2811 
2812     case INST_INVOKE_EXPANDED:
2813 	CLANG_ASSERT(auxObjList);
2814 	objc = CURR_DEPTH - PTR2INT(auxObjList->internalRep.twoPtrValue.ptr2);
2815 	POP_TAUX_OBJ();
2816 	if (objc) {
2817 	    pcAdjustment = 1;
2818 	    goto doInvocation;
2819 	}
2820 
2821 	/*
2822 	 * Nothing was expanded, return {}.
2823 	 */
2824 
2825 	TclNewObj(objResultPtr);
2826 	NEXT_INST_F(1, 0, 1);
2827     break;
2828 
2829     case INST_INVOKE_STK4:
2830 	objc = TclGetUInt4AtPtr(pc+1);
2831 	pcAdjustment = 5;
2832 	goto doInvocation;
2833 
2834     case INST_INVOKE_STK1:
2835 	objc = TclGetUInt1AtPtr(pc+1);
2836 	pcAdjustment = 2;
2837 
2838     doInvocation:
2839 	objv = &OBJ_AT_DEPTH(objc-1);
2840 	cleanup = objc;
2841 
2842 #ifdef TCL_COMPILE_DEBUG
2843 	if (tclTraceExec >= 2) {
2844 	    int i;
2845 
2846 	    if (traceInstructions) {
2847 		strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
2848 		TRACE(("%u => call ", objc));
2849 	    } else {
2850 		fprintf(stdout, "%d: (%u) invoking ", iPtr->numLevels,
2851 			(unsigned)(pc - codePtr->codeStart));
2852 	    }
2853 	    for (i = 0;  i < objc;  i++) {
2854 		TclPrintObject(stdout, objv[i], 15);
2855 		fprintf(stdout, " ");
2856 	    }
2857 	    fprintf(stdout, "\n");
2858 	    fflush(stdout);
2859 	}
2860 #endif /*TCL_COMPILE_DEBUG*/
2861 
2862 	/*
2863 	 * Finally, let TclEvalObjv handle the command.
2864 	 *
2865 	 * TIP #280: Record the last piece of info needed by
2866 	 * 'TclGetSrcInfoForPc', and push the frame.
2867 	 */
2868 
2869 	bcFramePtr->data.tebc.pc = (char *) pc;
2870 	iPtr->cmdFramePtr = bcFramePtr;
2871 
2872 	if (iPtr->flags & INTERP_DEBUG_FRAME) {
2873 	    ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
2874 	}
2875 
2876 	DECACHE_STACK_INFO();
2877 
2878 	pc += pcAdjustment;
2879 	TEBC_YIELD();
2880 	return TclNREvalObjv(interp, objc, objv,
2881 		TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL);
2882 
2883 #if TCL_SUPPORT_84_BYTECODE
2884     case INST_CALL_BUILTIN_FUNC1:
2885 	/*
2886 	 * Call one of the built-in pre-8.5 Tcl math functions. This
2887 	 * translates to INST_INVOKE_STK1 with the first argument of
2888 	 * ::tcl::mathfunc::$objv[0]. We need to insert the named math
2889 	 * function into the stack.
2890 	 */
2891 
2892 	opnd = TclGetUInt1AtPtr(pc+1);
2893 	if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) {
2894 	    TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd));
2895 	    Tcl_Panic("TclNRExecuteByteCode: unrecognized builtin function code %d", opnd);
2896 	}
2897 
2898 	TclNewLiteralStringObj(objPtr, "::tcl::mathfunc::");
2899 	Tcl_AppendToObj(objPtr, tclBuiltinFuncTable[opnd].name, -1);
2900 
2901 	/*
2902 	 * Only 0, 1 or 2 args.
2903 	 */
2904 
2905 	{
2906 	    int numArgs = tclBuiltinFuncTable[opnd].numArgs;
2907 	    Tcl_Obj *tmpPtr1, *tmpPtr2;
2908 
2909 	    if (numArgs == 0) {
2910 		PUSH_OBJECT(objPtr);
2911 	    } else if (numArgs == 1) {
2912 		tmpPtr1 = POP_OBJECT();
2913 		PUSH_OBJECT(objPtr);
2914 		PUSH_OBJECT(tmpPtr1);
2915 		Tcl_DecrRefCount(tmpPtr1);
2916 	    } else {
2917 		tmpPtr2 = POP_OBJECT();
2918 		tmpPtr1 = POP_OBJECT();
2919 		PUSH_OBJECT(objPtr);
2920 		PUSH_OBJECT(tmpPtr1);
2921 		PUSH_OBJECT(tmpPtr2);
2922 		Tcl_DecrRefCount(tmpPtr1);
2923 		Tcl_DecrRefCount(tmpPtr2);
2924 	    }
2925 	    objc = numArgs + 1;
2926 	}
2927 	pcAdjustment = 2;
2928 	goto doInvocation;
2929 
2930     case INST_CALL_FUNC1:
2931 	/*
2932 	 * Call a non-builtin Tcl math function previously registered by a
2933 	 * call to Tcl_CreateMathFunc pre-8.5. This is essentially
2934 	 * INST_INVOKE_STK1 converting the first arg to
2935 	 * ::tcl::mathfunc::$objv[0].
2936 	 */
2937 
2938 	objc = TclGetUInt1AtPtr(pc+1);	/* Number of arguments. The function
2939 					 * name is the 0-th argument. */
2940 
2941 	objPtr = OBJ_AT_DEPTH(objc-1);
2942 	TclNewLiteralStringObj(tmpPtr, "::tcl::mathfunc::");
2943 	Tcl_AppendObjToObj(tmpPtr, objPtr);
2944 	Tcl_DecrRefCount(objPtr);
2945 
2946 	/*
2947 	 * Variation of PUSH_OBJECT.
2948 	 */
2949 
2950 	OBJ_AT_DEPTH(objc-1) = tmpPtr;
2951 	Tcl_IncrRefCount(tmpPtr);
2952 
2953 	pcAdjustment = 2;
2954 	goto doInvocation;
2955 #else
2956     /*
2957      * INST_CALL_BUILTIN_FUNC1 and INST_CALL_FUNC1 were made obsolete by the
2958      * changes to add a ::tcl::mathfunc namespace in 8.5. Optional support
2959      * remains for existing bytecode precompiled files.
2960      */
2961 
2962     case INST_CALL_BUILTIN_FUNC1:
2963 	Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found");
2964     case INST_CALL_FUNC1:
2965 	Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_FUNC1 found");
2966 #endif
2967 
2968     case INST_INVOKE_REPLACE:
2969 	objc = TclGetUInt4AtPtr(pc+1);
2970 	opnd = TclGetUInt1AtPtr(pc+5);
2971 	objPtr = POP_OBJECT();
2972 	objv = &OBJ_AT_DEPTH(objc-1);
2973 	cleanup = objc;
2974 #ifdef TCL_COMPILE_DEBUG
2975 	if (tclTraceExec >= 2) {
2976 	    int i;
2977 
2978 	    if (traceInstructions) {
2979 		strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
2980 		TRACE(("%u => call (implementation %s) ", objc, O2S(objPtr)));
2981 	    } else {
2982 		fprintf(stdout,
2983 			"%d: (%u) invoking (using implementation %s) ",
2984 			iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
2985 			O2S(objPtr));
2986 	    }
2987 	    for (i = 0;  i < objc;  i++) {
2988 		if (i < opnd) {
2989 		    fprintf(stdout, "<");
2990 		    TclPrintObject(stdout, objv[i], 15);
2991 		    fprintf(stdout, ">");
2992 		} else {
2993 		    TclPrintObject(stdout, objv[i], 15);
2994 		}
2995 		fprintf(stdout, " ");
2996 	    }
2997 	    fprintf(stdout, "\n");
2998 	    fflush(stdout);
2999 	}
3000 #endif /*TCL_COMPILE_DEBUG*/
3001 
3002 	bcFramePtr->data.tebc.pc = (char *) pc;
3003 	iPtr->cmdFramePtr = bcFramePtr;
3004 	if (iPtr->flags & INTERP_DEBUG_FRAME) {
3005 	    ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
3006 	}
3007 
3008 	TclInitRewriteEnsemble(interp, opnd, 1, objv);
3009 
3010 	{
3011 	    Tcl_Obj *copyPtr = Tcl_NewListObj(objc - opnd + 1, NULL);
3012 
3013 	    Tcl_ListObjAppendElement(NULL, copyPtr, objPtr);
3014 	    Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
3015 		    objc - opnd, objv + opnd);
3016 	    Tcl_DecrRefCount(objPtr);
3017 	    objPtr = copyPtr;
3018 	}
3019 
3020 	DECACHE_STACK_INFO();
3021 	pc += 6;
3022 	TEBC_YIELD();
3023 
3024 	TclMarkTailcall(interp);
3025 	TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
3026 	Tcl_ListObjGetElements(NULL, objPtr, &objc, &objv);
3027 	TclNRAddCallback(interp, TclNRReleaseValues, objPtr, NULL, NULL, NULL);
3028 	return TclNREvalObjv(interp, objc, objv, TCL_EVAL_INVOKE, NULL);
3029 
3030     /*
3031      * -----------------------------------------------------------------
3032      *	   Start of INST_LOAD instructions.
3033      *
3034      * WARNING: more 'goto' here than your doctor recommended! The different
3035      * instructions set the value of some variables and then jump to some
3036      * common execution code.
3037      */
3038 
3039     case INST_LOAD_SCALAR1:
3040     instLoadScalar1:
3041 	opnd = TclGetUInt1AtPtr(pc+1);
3042 	varPtr = LOCAL(opnd);
3043 	while (TclIsVarLink(varPtr)) {
3044 	    varPtr = varPtr->value.linkPtr;
3045 	}
3046 	TRACE(("%u => ", opnd));
3047 	if (TclIsVarDirectReadable(varPtr)) {
3048 	    /*
3049 	     * No errors, no traces: just get the value.
3050 	     */
3051 
3052 	    objResultPtr = varPtr->value.objPtr;
3053 	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
3054 	    NEXT_INST_F(2, 0, 1);
3055 	}
3056 	pcAdjustment = 2;
3057 	cleanup = 0;
3058 	arrayPtr = NULL;
3059 	part1Ptr = part2Ptr = NULL;
3060 	goto doCallPtrGetVar;
3061 
3062     case INST_LOAD_SCALAR4:
3063 	opnd = TclGetUInt4AtPtr(pc+1);
3064 	varPtr = LOCAL(opnd);
3065 	while (TclIsVarLink(varPtr)) {
3066 	    varPtr = varPtr->value.linkPtr;
3067 	}
3068 	TRACE(("%u => ", opnd));
3069 	if (TclIsVarDirectReadable(varPtr)) {
3070 	    /*
3071 	     * No errors, no traces: just get the value.
3072 	     */
3073 
3074 	    objResultPtr = varPtr->value.objPtr;
3075 	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
3076 	    NEXT_INST_F(5, 0, 1);
3077 	}
3078 	pcAdjustment = 5;
3079 	cleanup = 0;
3080 	arrayPtr = NULL;
3081 	part1Ptr = part2Ptr = NULL;
3082 	goto doCallPtrGetVar;
3083 
3084     case INST_LOAD_ARRAY4:
3085 	opnd = TclGetUInt4AtPtr(pc+1);
3086 	pcAdjustment = 5;
3087 	goto doLoadArray;
3088 
3089     case INST_LOAD_ARRAY1:
3090 	opnd = TclGetUInt1AtPtr(pc+1);
3091 	pcAdjustment = 2;
3092 
3093     doLoadArray:
3094 	part1Ptr = NULL;
3095 	part2Ptr = OBJ_AT_TOS;
3096 	arrayPtr = LOCAL(opnd);
3097 	while (TclIsVarLink(arrayPtr)) {
3098 	    arrayPtr = arrayPtr->value.linkPtr;
3099 	}
3100 	TRACE(("%u \"%.30s\" => ", opnd, O2S(part2Ptr)));
3101 	if (TclIsVarArray(arrayPtr) && !ReadTraced(arrayPtr)) {
3102 	    varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
3103 	    if (varPtr && TclIsVarDirectReadable(varPtr)) {
3104 		/*
3105 		 * No errors, no traces: just get the value.
3106 		 */
3107 
3108 		objResultPtr = varPtr->value.objPtr;
3109 		TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
3110 		NEXT_INST_F(pcAdjustment, 1, 1);
3111 	    }
3112 	}
3113 	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
3114 		TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr, opnd);
3115 	if (varPtr == NULL) {
3116 	    TRACE_ERROR(interp);
3117 	    goto gotError;
3118 	}
3119 	cleanup = 1;
3120 	goto doCallPtrGetVar;
3121 
3122     case INST_LOAD_ARRAY_STK:
3123 	cleanup = 2;
3124 	part2Ptr = OBJ_AT_TOS;		/* element name */
3125 	objPtr = OBJ_UNDER_TOS;		/* array name */
3126 	TRACE(("\"%.30s(%.30s)\" => ", O2S(objPtr), O2S(part2Ptr)));
3127 	goto doLoadStk;
3128 
3129     case INST_LOAD_STK:
3130     case INST_LOAD_SCALAR_STK:
3131 	cleanup = 1;
3132 	part2Ptr = NULL;
3133 	objPtr = OBJ_AT_TOS;		/* variable name */
3134 	TRACE(("\"%.30s\" => ", O2S(objPtr)));
3135 
3136     doLoadStk:
3137 	part1Ptr = objPtr;
3138 	varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr,
3139 		TCL_LEAVE_ERR_MSG, "read", /*createPart1*/0, /*createPart2*/1,
3140 		&arrayPtr);
3141 	if (!varPtr) {
3142 	    TRACE_ERROR(interp);
3143 	    goto gotError;
3144 	}
3145 
3146 	if (TclIsVarDirectReadable2(varPtr, arrayPtr)) {
3147 	    /*
3148 	     * No errors, no traces: just get the value.
3149 	     */
3150 
3151 	    objResultPtr = varPtr->value.objPtr;
3152 	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
3153 	    NEXT_INST_V(1, cleanup, 1);
3154 	}
3155 	pcAdjustment = 1;
3156 	opnd = -1;
3157 
3158     doCallPtrGetVar:
3159 	/*
3160 	 * There are either errors or the variable is traced: call
3161 	 * TclPtrGetVar to process fully.
3162 	 */
3163 
3164 	DECACHE_STACK_INFO();
3165 	objResultPtr = TclPtrGetVarIdx(interp, varPtr, arrayPtr,
3166 		part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, opnd);
3167 	CACHE_STACK_INFO();
3168 	if (!objResultPtr) {
3169 	    TRACE_ERROR(interp);
3170 	    goto gotError;
3171 	}
3172 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
3173 	NEXT_INST_V(pcAdjustment, cleanup, 1);
3174 
3175     /*
3176      *	   End of INST_LOAD instructions.
3177      * -----------------------------------------------------------------
3178      *	   Start of INST_STORE and related instructions.
3179      *
3180      * WARNING: more 'goto' here than your doctor recommended! The different
3181      * instructions set the value of some variables and then jump to somme
3182      * common execution code.
3183      */
3184 
3185     {
3186 	int storeFlags, len;
3187 
3188     case INST_STORE_ARRAY4:
3189 	opnd = TclGetUInt4AtPtr(pc+1);
3190 	pcAdjustment = 5;
3191 	goto doStoreArrayDirect;
3192 
3193     case INST_STORE_ARRAY1:
3194 	opnd = TclGetUInt1AtPtr(pc+1);
3195 	pcAdjustment = 2;
3196 
3197     doStoreArrayDirect:
3198 	valuePtr = OBJ_AT_TOS;
3199 	part2Ptr = OBJ_UNDER_TOS;
3200 	arrayPtr = LOCAL(opnd);
3201 	TRACE(("%u \"%.30s\" <- \"%.30s\" => ", opnd, O2S(part2Ptr),
3202 		O2S(valuePtr)));
3203 	while (TclIsVarLink(arrayPtr)) {
3204 	    arrayPtr = arrayPtr->value.linkPtr;
3205 	}
3206 	if (TclIsVarArray(arrayPtr) && !WriteTraced(arrayPtr)) {
3207 	    varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
3208 	    if (varPtr && TclIsVarDirectWritable(varPtr)) {
3209 		tosPtr--;
3210 		Tcl_DecrRefCount(OBJ_AT_TOS);
3211 		OBJ_AT_TOS = valuePtr;
3212 		goto doStoreVarDirect;
3213 	    }
3214 	}
3215 	cleanup = 2;
3216 	storeFlags = TCL_LEAVE_ERR_MSG;
3217 	part1Ptr = NULL;
3218 	goto doStoreArrayDirectFailed;
3219 
3220     case INST_STORE_SCALAR4:
3221 	opnd = TclGetUInt4AtPtr(pc+1);
3222 	pcAdjustment = 5;
3223 	goto doStoreScalarDirect;
3224 
3225     case INST_STORE_SCALAR1:
3226 	opnd = TclGetUInt1AtPtr(pc+1);
3227 	pcAdjustment = 2;
3228 
3229     doStoreScalarDirect:
3230 	valuePtr = OBJ_AT_TOS;
3231 	varPtr = LOCAL(opnd);
3232 	TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr)));
3233 	while (TclIsVarLink(varPtr)) {
3234 	    varPtr = varPtr->value.linkPtr;
3235 	}
3236 	if (!TclIsVarDirectWritable(varPtr)) {
3237 	    storeFlags = TCL_LEAVE_ERR_MSG;
3238 	    part1Ptr = NULL;
3239 	    goto doStoreScalar;
3240 	}
3241 
3242 	/*
3243 	 * No traces, no errors, plain 'set': we can safely inline. The value
3244 	 * *will* be set to what's requested, so that the stack top remains
3245 	 * pointing to the same Tcl_Obj.
3246 	 */
3247 
3248     doStoreVarDirect:
3249 	valuePtr = varPtr->value.objPtr;
3250 	if (valuePtr != NULL) {
3251 	    TclDecrRefCount(valuePtr);
3252 	}
3253 	objResultPtr = OBJ_AT_TOS;
3254 	varPtr->value.objPtr = objResultPtr;
3255 #ifndef TCL_COMPILE_DEBUG
3256 	if (*(pc+pcAdjustment) == INST_POP) {
3257 	    tosPtr--;
3258 	    NEXT_INST_F((pcAdjustment+1), 0, 0);
3259 	}
3260 #else
3261 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
3262 #endif
3263 	Tcl_IncrRefCount(objResultPtr);
3264 	NEXT_INST_F(pcAdjustment, 0, 0);
3265 
3266     case INST_LAPPEND_STK:
3267 	valuePtr = OBJ_AT_TOS; /* value to append */
3268 	part2Ptr = NULL;
3269 	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
3270 		| TCL_LIST_ELEMENT);
3271 	goto doStoreStk;
3272 
3273     case INST_LAPPEND_ARRAY_STK:
3274 	valuePtr = OBJ_AT_TOS; /* value to append */
3275 	part2Ptr = OBJ_UNDER_TOS;
3276 	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
3277 		| TCL_LIST_ELEMENT);
3278 	goto doStoreStk;
3279 
3280     case INST_APPEND_STK:
3281 	valuePtr = OBJ_AT_TOS; /* value to append */
3282 	part2Ptr = NULL;
3283 	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
3284 	goto doStoreStk;
3285 
3286     case INST_APPEND_ARRAY_STK:
3287 	valuePtr = OBJ_AT_TOS; /* value to append */
3288 	part2Ptr = OBJ_UNDER_TOS;
3289 	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
3290 	goto doStoreStk;
3291 
3292     case INST_STORE_ARRAY_STK:
3293 	valuePtr = OBJ_AT_TOS;
3294 	part2Ptr = OBJ_UNDER_TOS;
3295 	storeFlags = TCL_LEAVE_ERR_MSG;
3296 	goto doStoreStk;
3297 
3298     case INST_STORE_STK:
3299     case INST_STORE_SCALAR_STK:
3300 	valuePtr = OBJ_AT_TOS;
3301 	part2Ptr = NULL;
3302 	storeFlags = TCL_LEAVE_ERR_MSG;
3303 
3304     doStoreStk:
3305 	objPtr = OBJ_AT_DEPTH(1 + (part2Ptr != NULL)); /* variable name */
3306 	part1Ptr = objPtr;
3307 #ifdef TCL_COMPILE_DEBUG
3308 	if (part2Ptr == NULL) {
3309 	    TRACE(("\"%.30s\" <- \"%.30s\" =>", O2S(part1Ptr),O2S(valuePtr)));
3310 	} else {
3311 	    TRACE(("\"%.30s(%.30s)\" <- \"%.30s\" => ",
3312 		    O2S(part1Ptr), O2S(part2Ptr), O2S(valuePtr)));
3313 	}
3314 #endif
3315 	varPtr = TclObjLookupVarEx(interp, objPtr,part2Ptr, TCL_LEAVE_ERR_MSG,
3316 		"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
3317 	if (!varPtr) {
3318 	    TRACE_ERROR(interp);
3319 	    goto gotError;
3320 	}
3321 	cleanup = ((part2Ptr == NULL)? 2 : 3);
3322 	pcAdjustment = 1;
3323 	opnd = -1;
3324 	goto doCallPtrSetVar;
3325 
3326     case INST_LAPPEND_ARRAY4:
3327 	opnd = TclGetUInt4AtPtr(pc+1);
3328 	pcAdjustment = 5;
3329 	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
3330 		| TCL_LIST_ELEMENT);
3331 	goto doStoreArray;
3332 
3333     case INST_LAPPEND_ARRAY1:
3334 	opnd = TclGetUInt1AtPtr(pc+1);
3335 	pcAdjustment = 2;
3336 	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
3337 		| TCL_LIST_ELEMENT);
3338 	goto doStoreArray;
3339 
3340     case INST_APPEND_ARRAY4:
3341 	opnd = TclGetUInt4AtPtr(pc+1);
3342 	pcAdjustment = 5;
3343 	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
3344 	goto doStoreArray;
3345 
3346     case INST_APPEND_ARRAY1:
3347 	opnd = TclGetUInt1AtPtr(pc+1);
3348 	pcAdjustment = 2;
3349 	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
3350 	goto doStoreArray;
3351 
3352     doStoreArray:
3353 	valuePtr = OBJ_AT_TOS;
3354 	part2Ptr = OBJ_UNDER_TOS;
3355 	arrayPtr = LOCAL(opnd);
3356 	TRACE(("%u \"%.30s\" <- \"%.30s\" => ", opnd, O2S(part2Ptr),
3357 		O2S(valuePtr)));
3358 	while (TclIsVarLink(arrayPtr)) {
3359 	    arrayPtr = arrayPtr->value.linkPtr;
3360 	}
3361 	cleanup = 2;
3362 	part1Ptr = NULL;
3363 
3364     doStoreArrayDirectFailed:
3365 	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
3366 		TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr, opnd);
3367 	if (!varPtr) {
3368 	    TRACE_ERROR(interp);
3369 	    goto gotError;
3370 	}
3371 	goto doCallPtrSetVar;
3372 
3373     case INST_LAPPEND_SCALAR4:
3374 	opnd = TclGetUInt4AtPtr(pc+1);
3375 	pcAdjustment = 5;
3376 	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
3377 		| TCL_LIST_ELEMENT);
3378 	goto doStoreScalar;
3379 
3380     case INST_LAPPEND_SCALAR1:
3381 	opnd = TclGetUInt1AtPtr(pc+1);
3382 	pcAdjustment = 2;
3383 	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
3384 		| TCL_LIST_ELEMENT);
3385 	goto doStoreScalar;
3386 
3387     case INST_APPEND_SCALAR4:
3388 	opnd = TclGetUInt4AtPtr(pc+1);
3389 	pcAdjustment = 5;
3390 	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
3391 	goto doStoreScalar;
3392 
3393     case INST_APPEND_SCALAR1:
3394 	opnd = TclGetUInt1AtPtr(pc+1);
3395 	pcAdjustment = 2;
3396 	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
3397 	goto doStoreScalar;
3398 
3399     doStoreScalar:
3400 	valuePtr = OBJ_AT_TOS;
3401 	varPtr = LOCAL(opnd);
3402 	TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr)));
3403 	while (TclIsVarLink(varPtr)) {
3404 	    varPtr = varPtr->value.linkPtr;
3405 	}
3406 	cleanup = 1;
3407 	arrayPtr = NULL;
3408 	part1Ptr = part2Ptr = NULL;
3409 
3410     doCallPtrSetVar:
3411 	DECACHE_STACK_INFO();
3412 	objResultPtr = TclPtrSetVarIdx(interp, varPtr, arrayPtr,
3413 		part1Ptr, part2Ptr, valuePtr, storeFlags, opnd);
3414 	CACHE_STACK_INFO();
3415 	if (!objResultPtr) {
3416 	    TRACE_ERROR(interp);
3417 	    goto gotError;
3418 	}
3419 #ifndef TCL_COMPILE_DEBUG
3420 	if (*(pc+pcAdjustment) == INST_POP) {
3421 	    NEXT_INST_V((pcAdjustment+1), cleanup, 0);
3422 	}
3423 #endif
3424 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
3425 	NEXT_INST_V(pcAdjustment, cleanup, 1);
3426 
3427     case INST_LAPPEND_LIST:
3428 	opnd = TclGetUInt4AtPtr(pc+1);
3429 	valuePtr = OBJ_AT_TOS;
3430 	varPtr = LOCAL(opnd);
3431 	cleanup = 1;
3432 	pcAdjustment = 5;
3433 	while (TclIsVarLink(varPtr)) {
3434 	    varPtr = varPtr->value.linkPtr;
3435 	}
3436 	TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr)));
3437 	if (TclListObjGetElements(interp, valuePtr, &objc, &objv)
3438 		!= TCL_OK) {
3439 	    TRACE_ERROR(interp);
3440 	    goto gotError;
3441 	}
3442 	if (TclIsVarDirectReadable(varPtr)
3443 		&& TclIsVarDirectWritable(varPtr)) {
3444 	    goto lappendListDirect;
3445 	}
3446 	arrayPtr = NULL;
3447 	part1Ptr = part2Ptr = NULL;
3448 	goto lappendListPtr;
3449 
3450     case INST_LAPPEND_LIST_ARRAY:
3451 	opnd = TclGetUInt4AtPtr(pc+1);
3452 	valuePtr = OBJ_AT_TOS;
3453 	part1Ptr = NULL;
3454 	part2Ptr = OBJ_UNDER_TOS;
3455 	arrayPtr = LOCAL(opnd);
3456 	cleanup = 2;
3457 	pcAdjustment = 5;
3458 	while (TclIsVarLink(arrayPtr)) {
3459 	    arrayPtr = arrayPtr->value.linkPtr;
3460 	}
3461 	TRACE(("%u \"%.30s\" \"%.30s\" => ",
3462 		opnd, O2S(part2Ptr), O2S(valuePtr)));
3463 	if (TclListObjGetElements(interp, valuePtr, &objc, &objv)
3464 		!= TCL_OK) {
3465 	    TRACE_ERROR(interp);
3466 	    goto gotError;
3467 	}
3468 	if (TclIsVarArray(arrayPtr) && !ReadTraced(arrayPtr)
3469 		&& !WriteTraced(arrayPtr)) {
3470 	    varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
3471 	    if (varPtr && TclIsVarDirectReadable(varPtr)
3472 		    && TclIsVarDirectWritable(varPtr)) {
3473 		goto lappendListDirect;
3474 	    }
3475 	}
3476 	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
3477 		TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr, opnd);
3478 	if (varPtr == NULL) {
3479 	    TRACE_ERROR(interp);
3480 	    goto gotError;
3481 	}
3482 	goto lappendListPtr;
3483 
3484     case INST_LAPPEND_LIST_ARRAY_STK:
3485 	pcAdjustment = 1;
3486 	cleanup = 3;
3487 	valuePtr = OBJ_AT_TOS;
3488 	part2Ptr = OBJ_UNDER_TOS;	/* element name */
3489 	part1Ptr = OBJ_AT_DEPTH(2);	/* array name */
3490 	TRACE(("\"%.30s(%.30s)\" \"%.30s\" => ",
3491 		O2S(part1Ptr), O2S(part2Ptr), O2S(valuePtr)));
3492 	goto lappendList;
3493 
3494     case INST_LAPPEND_LIST_STK:
3495 	pcAdjustment = 1;
3496 	cleanup = 2;
3497 	valuePtr = OBJ_AT_TOS;
3498 	part2Ptr = NULL;
3499 	part1Ptr = OBJ_UNDER_TOS;	/* variable name */
3500 	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(part1Ptr), O2S(valuePtr)));
3501 	goto lappendList;
3502 
3503     lappendListDirect:
3504 	objResultPtr = varPtr->value.objPtr;
3505 	if (TclListObjLength(interp, objResultPtr, &len) != TCL_OK) {
3506 	    TRACE_ERROR(interp);
3507 	    goto gotError;
3508 	}
3509 	if (Tcl_IsShared(objResultPtr)) {
3510 	    Tcl_Obj *newValue = Tcl_DuplicateObj(objResultPtr);
3511 
3512 	    TclDecrRefCount(objResultPtr);
3513 	    varPtr->value.objPtr = objResultPtr = newValue;
3514 	    Tcl_IncrRefCount(newValue);
3515 	}
3516 	if (Tcl_ListObjReplace(interp, objResultPtr, len, 0, objc, objv)
3517 		!= TCL_OK) {
3518 	    TRACE_ERROR(interp);
3519 	    goto gotError;
3520 	}
3521 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
3522 	NEXT_INST_V(pcAdjustment, cleanup, 1);
3523 
3524     lappendList:
3525 	opnd = -1;
3526 	if (TclListObjGetElements(interp, valuePtr, &objc, &objv)
3527 		!= TCL_OK) {
3528 	    TRACE_ERROR(interp);
3529 	    goto gotError;
3530 	}
3531 	DECACHE_STACK_INFO();
3532 	varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr,
3533 		TCL_LEAVE_ERR_MSG, "set", 1, 1, &arrayPtr);
3534 	CACHE_STACK_INFO();
3535 	if (!varPtr) {
3536 	    TRACE_ERROR(interp);
3537 	    goto gotError;
3538 	}
3539 
3540     lappendListPtr:
3541 	if (TclIsVarInHash(varPtr)) {
3542 	    VarHashRefCount(varPtr)++;
3543 	}
3544 	if (arrayPtr && TclIsVarInHash(arrayPtr)) {
3545 	    VarHashRefCount(arrayPtr)++;
3546 	}
3547 	DECACHE_STACK_INFO();
3548 	objResultPtr = TclPtrGetVarIdx(interp, varPtr, arrayPtr,
3549 		part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, opnd);
3550 	CACHE_STACK_INFO();
3551 	if (TclIsVarInHash(varPtr)) {
3552 	    VarHashRefCount(varPtr)--;
3553 	}
3554 	if (arrayPtr && TclIsVarInHash(arrayPtr)) {
3555 	    VarHashRefCount(arrayPtr)--;
3556 	}
3557 
3558 	{
3559 	    int createdNewObj = 0;
3560 	    Tcl_Obj *valueToAssign;
3561 
3562 	    if (!objResultPtr) {
3563 		valueToAssign = valuePtr;
3564 	    } else if (TclListObjLength(interp, objResultPtr, &len)!=TCL_OK) {
3565 		TRACE_ERROR(interp);
3566 		goto gotError;
3567 	    } else {
3568 		if (Tcl_IsShared(objResultPtr)) {
3569 		    valueToAssign = Tcl_DuplicateObj(objResultPtr);
3570 		    createdNewObj = 1;
3571 		} else {
3572 		    valueToAssign = objResultPtr;
3573 		}
3574 		if (Tcl_ListObjReplace(interp, valueToAssign, len, 0,
3575 			objc, objv) != TCL_OK) {
3576 		    if (createdNewObj) {
3577 			TclDecrRefCount(valueToAssign);
3578 		    }
3579 		    goto errorInLappendListPtr;
3580 		}
3581 	    }
3582 	    DECACHE_STACK_INFO();
3583 	    Tcl_IncrRefCount(valueToAssign);
3584 	    objResultPtr = TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr,
3585 		    part2Ptr, valueToAssign, TCL_LEAVE_ERR_MSG, opnd);
3586 	    TclDecrRefCount(valueToAssign);
3587 	    CACHE_STACK_INFO();
3588 	    if (!objResultPtr) {
3589 	    errorInLappendListPtr:
3590 		TRACE_ERROR(interp);
3591 		goto gotError;
3592 	    }
3593 	}
3594 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
3595 	NEXT_INST_V(pcAdjustment, cleanup, 1);
3596     }
3597 
3598     /*
3599      *	   End of INST_STORE and related instructions.
3600      * -----------------------------------------------------------------
3601      *	   Start of INST_INCR instructions.
3602      *
3603      * WARNING: more 'goto' here than your doctor recommended! The different
3604      * instructions set the value of some variables and then jump to somme
3605      * common execution code.
3606      */
3607 
3608 /*TODO: Consider more untangling here; merge with LOAD and STORE ? */
3609 
3610     {
3611 	Tcl_Obj *incrPtr;
3612 	Tcl_WideInt w;
3613 	long increment;
3614 
3615     case INST_INCR_SCALAR1:
3616     case INST_INCR_ARRAY1:
3617     case INST_INCR_ARRAY_STK:
3618     case INST_INCR_SCALAR_STK:
3619     case INST_INCR_STK:
3620 	opnd = TclGetUInt1AtPtr(pc+1);
3621 	incrPtr = POP_OBJECT();
3622 	switch (*pc) {
3623 	case INST_INCR_SCALAR1:
3624 	    pcAdjustment = 2;
3625 	    goto doIncrScalar;
3626 	case INST_INCR_ARRAY1:
3627 	    pcAdjustment = 2;
3628 	    goto doIncrArray;
3629 	default:
3630 	    pcAdjustment = 1;
3631 	    goto doIncrStk;
3632 	}
3633 
3634     case INST_INCR_ARRAY_STK_IMM:
3635     case INST_INCR_SCALAR_STK_IMM:
3636     case INST_INCR_STK_IMM:
3637 	increment = TclGetInt1AtPtr(pc+1);
3638 	TclNewIntObj(incrPtr, increment);
3639 	Tcl_IncrRefCount(incrPtr);
3640 	pcAdjustment = 2;
3641 
3642     doIncrStk:
3643 	if ((*pc == INST_INCR_ARRAY_STK_IMM)
3644 		|| (*pc == INST_INCR_ARRAY_STK)) {
3645 	    part2Ptr = OBJ_AT_TOS;
3646 	    objPtr = OBJ_UNDER_TOS;
3647 	    TRACE(("\"%.30s(%.30s)\" (by %ld) => ",
3648 		    O2S(objPtr), O2S(part2Ptr), increment));
3649 	} else {
3650 	    part2Ptr = NULL;
3651 	    objPtr = OBJ_AT_TOS;
3652 	    TRACE(("\"%.30s\" (by %ld) => ", O2S(objPtr), increment));
3653 	}
3654 	part1Ptr = objPtr;
3655 	opnd = -1;
3656 	varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr,
3657 		TCL_LEAVE_ERR_MSG, "read", 1, 1, &arrayPtr);
3658 	if (!varPtr) {
3659 	    DECACHE_STACK_INFO();
3660 	    Tcl_AddErrorInfo(interp,
3661 		    "\n    (reading value of variable to increment)");
3662 	    CACHE_STACK_INFO();
3663 	    TRACE_ERROR(interp);
3664 	    Tcl_DecrRefCount(incrPtr);
3665 	    goto gotError;
3666 	}
3667 	cleanup = ((part2Ptr == NULL)? 1 : 2);
3668 	goto doIncrVar;
3669 
3670     case INST_INCR_ARRAY1_IMM:
3671 	opnd = TclGetUInt1AtPtr(pc+1);
3672 	increment = TclGetInt1AtPtr(pc+2);
3673 	TclNewIntObj(incrPtr, increment);
3674 	Tcl_IncrRefCount(incrPtr);
3675 	pcAdjustment = 3;
3676 
3677     doIncrArray:
3678 	part1Ptr = NULL;
3679 	part2Ptr = OBJ_AT_TOS;
3680 	arrayPtr = LOCAL(opnd);
3681 	cleanup = 1;
3682 	while (TclIsVarLink(arrayPtr)) {
3683 	    arrayPtr = arrayPtr->value.linkPtr;
3684 	}
3685 	TRACE(("%u \"%.30s\" (by %ld) => ", opnd, O2S(part2Ptr), increment));
3686 	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
3687 		TCL_LEAVE_ERR_MSG, "read", 1, 1, arrayPtr, opnd);
3688 	if (!varPtr) {
3689 	    TRACE_ERROR(interp);
3690 	    Tcl_DecrRefCount(incrPtr);
3691 	    goto gotError;
3692 	}
3693 	goto doIncrVar;
3694 
3695     case INST_INCR_SCALAR1_IMM:
3696 	opnd = TclGetUInt1AtPtr(pc+1);
3697 	increment = TclGetInt1AtPtr(pc+2);
3698 	pcAdjustment = 3;
3699 	cleanup = 0;
3700 	varPtr = LOCAL(opnd);
3701 	while (TclIsVarLink(varPtr)) {
3702 	    varPtr = varPtr->value.linkPtr;
3703 	}
3704 
3705 	if (TclIsVarDirectModifyable(varPtr)) {
3706 	    ClientData ptr;
3707 	    int type;
3708 
3709 	    objPtr = varPtr->value.objPtr;
3710 	    if (GetNumberFromObj(NULL, objPtr, &ptr, &type) == TCL_OK) {
3711 		if (type == TCL_NUMBER_INT) {
3712 		    Tcl_WideInt augend = *((const Tcl_WideInt *)ptr);
3713 		    Tcl_WideInt sum = augend + increment;
3714 
3715 		    /*
3716 		     * Overflow when (augend and sum have different sign) and
3717 		     * (augend and increment have the same sign). This is
3718 		     * encapsulated in the Overflowing macro.
3719 		     */
3720 
3721 		    if (!Overflowing(augend, increment, sum)) {
3722 			TRACE(("%u %ld => ", opnd, increment));
3723 			if (Tcl_IsShared(objPtr)) {
3724 			    objPtr->refCount--;	/* We know it's shared. */
3725 			    TclNewIntObj(objResultPtr, sum);
3726 			    Tcl_IncrRefCount(objResultPtr);
3727 			    varPtr->value.objPtr = objResultPtr;
3728 			} else {
3729 			    objResultPtr = objPtr;
3730 			    TclSetIntObj(objPtr, sum);
3731 			}
3732 			goto doneIncr;
3733 		    }
3734 		    w = (Tcl_WideInt)augend;
3735 
3736 		    TRACE(("%u %ld => ", opnd, increment));
3737 		    if (Tcl_IsShared(objPtr)) {
3738 			objPtr->refCount--;	/* We know it's shared. */
3739 			TclNewIntObj(objResultPtr, w + increment);
3740 			Tcl_IncrRefCount(objResultPtr);
3741 			varPtr->value.objPtr = objResultPtr;
3742 		    } else {
3743 			objResultPtr = objPtr;
3744 
3745 			/*
3746 			 * We know the sum value is outside the long range;
3747 			 * use macro form that doesn't range test again.
3748 			 */
3749 
3750 			TclSetIntObj(objPtr, w+increment);
3751 		    }
3752 		    goto doneIncr;
3753 		}	/* end if (type == TCL_NUMBER_INT) */
3754 	    }
3755 	    if (Tcl_IsShared(objPtr)) {
3756 		objPtr->refCount--;	/* We know it's shared */
3757 		objResultPtr = Tcl_DuplicateObj(objPtr);
3758 		Tcl_IncrRefCount(objResultPtr);
3759 		varPtr->value.objPtr = objResultPtr;
3760 	    } else {
3761 		objResultPtr = objPtr;
3762 	    }
3763 	    TclNewIntObj(incrPtr, increment);
3764 	    if (TclIncrObj(interp, objResultPtr, incrPtr) != TCL_OK) {
3765 		Tcl_DecrRefCount(incrPtr);
3766 		TRACE_ERROR(interp);
3767 		goto gotError;
3768 	    }
3769 	    Tcl_DecrRefCount(incrPtr);
3770 	    goto doneIncr;
3771 	}
3772 
3773 	/*
3774 	 * All other cases, flow through to generic handling.
3775 	 */
3776 
3777 	TclNewIntObj(incrPtr, increment);
3778 	Tcl_IncrRefCount(incrPtr);
3779 
3780     doIncrScalar:
3781 	varPtr = LOCAL(opnd);
3782 	while (TclIsVarLink(varPtr)) {
3783 	    varPtr = varPtr->value.linkPtr;
3784 	}
3785 	arrayPtr = NULL;
3786 	part1Ptr = part2Ptr = NULL;
3787 	cleanup = 0;
3788 	TRACE(("%u %s => ", opnd, Tcl_GetString(incrPtr)));
3789 
3790     doIncrVar:
3791 	if (TclIsVarDirectModifyable2(varPtr, arrayPtr)) {
3792 	    objPtr = varPtr->value.objPtr;
3793 	    if (Tcl_IsShared(objPtr)) {
3794 		objPtr->refCount--;	/* We know it's shared */
3795 		objResultPtr = Tcl_DuplicateObj(objPtr);
3796 		Tcl_IncrRefCount(objResultPtr);
3797 		varPtr->value.objPtr = objResultPtr;
3798 	    } else {
3799 		objResultPtr = objPtr;
3800 	    }
3801 	    if (TclIncrObj(interp, objResultPtr, incrPtr) != TCL_OK) {
3802 		Tcl_DecrRefCount(incrPtr);
3803 		TRACE_ERROR(interp);
3804 		goto gotError;
3805 	    }
3806 	    Tcl_DecrRefCount(incrPtr);
3807 	} else {
3808 	    DECACHE_STACK_INFO();
3809 	    objResultPtr = TclPtrIncrObjVarIdx(interp, varPtr, arrayPtr,
3810 		    part1Ptr, part2Ptr, incrPtr, TCL_LEAVE_ERR_MSG, opnd);
3811 	    CACHE_STACK_INFO();
3812 	    Tcl_DecrRefCount(incrPtr);
3813 	    if (objResultPtr == NULL) {
3814 		TRACE_ERROR(interp);
3815 		goto gotError;
3816 	    }
3817 	}
3818     doneIncr:
3819 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
3820 #ifndef TCL_COMPILE_DEBUG
3821 	if (*(pc+pcAdjustment) == INST_POP) {
3822 	    NEXT_INST_V((pcAdjustment+1), cleanup, 0);
3823 	}
3824 #endif
3825 	NEXT_INST_V(pcAdjustment, cleanup, 1);
3826     }
3827 
3828     /*
3829      *	   End of INST_INCR instructions.
3830      * -----------------------------------------------------------------
3831      *	   Start of INST_EXIST instructions.
3832      */
3833 
3834     case INST_EXIST_SCALAR:
3835 	cleanup = 0;
3836 	pcAdjustment = 5;
3837 	opnd = TclGetUInt4AtPtr(pc+1);
3838 	varPtr = LOCAL(opnd);
3839 	while (TclIsVarLink(varPtr)) {
3840 	    varPtr = varPtr->value.linkPtr;
3841 	}
3842 	TRACE(("%u => ", opnd));
3843 	if (ReadTraced(varPtr)) {
3844 	    DECACHE_STACK_INFO();
3845 	    TclObjCallVarTraces(iPtr, NULL, varPtr, NULL, NULL,
3846 		    TCL_TRACE_READS, 0, opnd);
3847 	    CACHE_STACK_INFO();
3848 	    if (TclIsVarUndefined(varPtr)) {
3849 		TclCleanupVar(varPtr, NULL);
3850 		varPtr = NULL;
3851 	    }
3852 	}
3853 	goto afterExistsPeephole;
3854 
3855     case INST_EXIST_ARRAY:
3856 	cleanup = 1;
3857 	pcAdjustment = 5;
3858 	opnd = TclGetUInt4AtPtr(pc+1);
3859 	part2Ptr = OBJ_AT_TOS;
3860 	arrayPtr = LOCAL(opnd);
3861 	while (TclIsVarLink(arrayPtr)) {
3862 	    arrayPtr = arrayPtr->value.linkPtr;
3863 	}
3864 	TRACE(("%u \"%.30s\" => ", opnd, O2S(part2Ptr)));
3865 	if (TclIsVarArray(arrayPtr) && !ReadTraced(arrayPtr)) {
3866 	    varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
3867 	    if (!varPtr || !ReadTraced(varPtr)) {
3868 		goto afterExistsPeephole;
3869 	    }
3870 	}
3871 	varPtr = TclLookupArrayElement(interp, NULL, part2Ptr, 0, "access",
3872 		0, 1, arrayPtr, opnd);
3873 	if (varPtr) {
3874 	    if (ReadTraced(varPtr) || (arrayPtr && ReadTraced(arrayPtr))) {
3875 		DECACHE_STACK_INFO();
3876 		TclObjCallVarTraces(iPtr, arrayPtr, varPtr, NULL, part2Ptr,
3877 			TCL_TRACE_READS, 0, opnd);
3878 		CACHE_STACK_INFO();
3879 	    }
3880 	    if (TclIsVarUndefined(varPtr)) {
3881 		TclCleanupVar(varPtr, arrayPtr);
3882 		varPtr = NULL;
3883 	    }
3884 	}
3885 	goto afterExistsPeephole;
3886 
3887     case INST_EXIST_ARRAY_STK:
3888 	cleanup = 2;
3889 	pcAdjustment = 1;
3890 	part2Ptr = OBJ_AT_TOS;		/* element name */
3891 	part1Ptr = OBJ_UNDER_TOS;	/* array name */
3892 	TRACE(("\"%.30s(%.30s)\" => ", O2S(part1Ptr), O2S(part2Ptr)));
3893 	goto doExistStk;
3894 
3895     case INST_EXIST_STK:
3896 	cleanup = 1;
3897 	pcAdjustment = 1;
3898 	part2Ptr = NULL;
3899 	part1Ptr = OBJ_AT_TOS;		/* variable name */
3900 	TRACE(("\"%.30s\" => ", O2S(part1Ptr)));
3901 
3902     doExistStk:
3903 	varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, 0, "access",
3904 		/*createPart1*/0, /*createPart2*/1, &arrayPtr);
3905 	if (varPtr) {
3906 	    if (ReadTraced(varPtr) || (arrayPtr && ReadTraced(arrayPtr))) {
3907 		DECACHE_STACK_INFO();
3908 		TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr,part2Ptr,
3909 			TCL_TRACE_READS, 0, -1);
3910 		CACHE_STACK_INFO();
3911 	    }
3912 	    if (TclIsVarUndefined(varPtr)) {
3913 		TclCleanupVar(varPtr, arrayPtr);
3914 		varPtr = NULL;
3915 	    }
3916 	}
3917 
3918 	/*
3919 	 * Peep-hole optimisation: if you're about to jump, do jump from here.
3920 	 */
3921 
3922     afterExistsPeephole: {
3923 	int found = (varPtr && !TclIsVarUndefined(varPtr));
3924 
3925 	TRACE_APPEND(("%d\n", found ? 1 : 0));
3926 	JUMP_PEEPHOLE_V(found, pcAdjustment, cleanup);
3927     }
3928 
3929     /*
3930      *	   End of INST_EXIST instructions.
3931      * -----------------------------------------------------------------
3932      *	   Start of INST_UNSET instructions.
3933      */
3934 
3935     {
3936 	int flags;
3937 
3938     case INST_UNSET_SCALAR:
3939 	flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
3940 	opnd = TclGetUInt4AtPtr(pc+2);
3941 	varPtr = LOCAL(opnd);
3942 	while (TclIsVarLink(varPtr)) {
3943 	    varPtr = varPtr->value.linkPtr;
3944 	}
3945 	TRACE(("%s %u => ", (flags ? "normal" : "noerr"), opnd));
3946 	if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) {
3947 	    /*
3948 	     * No errors, no traces, no searches: just make the variable cease
3949 	     * to exist.
3950 	     */
3951 
3952 	    if (!TclIsVarUndefined(varPtr)) {
3953 		TclDecrRefCount(varPtr->value.objPtr);
3954 	    } else if (flags & TCL_LEAVE_ERR_MSG) {
3955 		goto slowUnsetScalar;
3956 	    }
3957 	    varPtr->value.objPtr = NULL;
3958 	    TRACE_APPEND(("OK\n"));
3959 	    NEXT_INST_F(6, 0, 0);
3960 	}
3961 
3962     slowUnsetScalar:
3963 	DECACHE_STACK_INFO();
3964 	if (TclPtrUnsetVarIdx(interp, varPtr, NULL, NULL, NULL, flags,
3965 		opnd) != TCL_OK && flags) {
3966 	    goto errorInUnset;
3967 	}
3968 	CACHE_STACK_INFO();
3969 	NEXT_INST_F(6, 0, 0);
3970 
3971     case INST_UNSET_ARRAY:
3972 	flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
3973 	opnd = TclGetUInt4AtPtr(pc+2);
3974 	part2Ptr = OBJ_AT_TOS;
3975 	arrayPtr = LOCAL(opnd);
3976 	while (TclIsVarLink(arrayPtr)) {
3977 	    arrayPtr = arrayPtr->value.linkPtr;
3978 	}
3979 	TRACE(("%s %u \"%.30s\" => ",
3980 		(flags ? "normal" : "noerr"), opnd, O2S(part2Ptr)));
3981 	if (TclIsVarArray(arrayPtr) && !UnsetTraced(arrayPtr)
3982 		&& !(arrayPtr->flags & VAR_SEARCH_ACTIVE)) {
3983 	    varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
3984 	    if (varPtr && TclIsVarDirectUnsettable(varPtr)) {
3985 		/*
3986 		 * No nasty traces and element exists, so we can proceed to
3987 		 * unset it. Might still not exist though...
3988 		 */
3989 
3990 		if (!TclIsVarUndefined(varPtr)) {
3991 		    TclDecrRefCount(varPtr->value.objPtr);
3992 		    TclSetVarUndefined(varPtr);
3993 		    TclClearVarNamespaceVar(varPtr);
3994 		    TclCleanupVar(varPtr, arrayPtr);
3995 		} else if (flags & TCL_LEAVE_ERR_MSG) {
3996 		    goto slowUnsetArray;
3997 		}
3998 		TRACE_APPEND(("OK\n"));
3999 		NEXT_INST_F(6, 1, 0);
4000 	    } else if (!varPtr && !(flags & TCL_LEAVE_ERR_MSG)) {
4001 		/*
4002 		 * Don't need to do anything here.
4003 		 */
4004 
4005 		TRACE_APPEND(("OK\n"));
4006 		NEXT_INST_F(6, 1, 0);
4007 	    }
4008 	}
4009     slowUnsetArray:
4010 	DECACHE_STACK_INFO();
4011 	varPtr = TclLookupArrayElement(interp, NULL, part2Ptr, flags, "unset",
4012 		0, 0, arrayPtr, opnd);
4013 	if (!varPtr) {
4014 	    if (flags & TCL_LEAVE_ERR_MSG) {
4015 		goto errorInUnset;
4016 	    }
4017 	} else if (TclPtrUnsetVarIdx(interp, varPtr, arrayPtr, NULL, part2Ptr,
4018 		flags, opnd) != TCL_OK && (flags & TCL_LEAVE_ERR_MSG)) {
4019 	    goto errorInUnset;
4020 	}
4021 	CACHE_STACK_INFO();
4022 	NEXT_INST_F(6, 1, 0);
4023 
4024     case INST_UNSET_ARRAY_STK:
4025 	flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
4026 	cleanup = 2;
4027 	part2Ptr = OBJ_AT_TOS;		/* element name */
4028 	part1Ptr = OBJ_UNDER_TOS;	/* array name */
4029 	TRACE(("%s \"%.30s(%.30s)\" => ", (flags ? "normal" : "noerr"),
4030 		O2S(part1Ptr), O2S(part2Ptr)));
4031 	goto doUnsetStk;
4032 
4033     case INST_UNSET_STK:
4034 	flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
4035 	cleanup = 1;
4036 	part2Ptr = NULL;
4037 	part1Ptr = OBJ_AT_TOS;		/* variable name */
4038 	TRACE(("%s \"%.30s\" => ", (flags ? "normal" : "noerr"),
4039 		O2S(part1Ptr)));
4040 
4041     doUnsetStk:
4042 	DECACHE_STACK_INFO();
4043 	if (TclObjUnsetVar2(interp, part1Ptr, part2Ptr, flags) != TCL_OK
4044 		&& (flags & TCL_LEAVE_ERR_MSG)) {
4045 	    goto errorInUnset;
4046 	}
4047 	CACHE_STACK_INFO();
4048 	TRACE_APPEND(("OK\n"));
4049 	NEXT_INST_V(2, cleanup, 0);
4050 
4051     errorInUnset:
4052 	CACHE_STACK_INFO();
4053 	TRACE_ERROR(interp);
4054 	goto gotError;
4055 
4056 	/*
4057 	 * This is really an unset operation these days. Do not issue.
4058 	 */
4059 
4060     case INST_DICT_DONE:
4061 	opnd = TclGetUInt4AtPtr(pc+1);
4062 	TRACE(("%u => OK\n", opnd));
4063 	varPtr = LOCAL(opnd);
4064 	while (TclIsVarLink(varPtr)) {
4065 	    varPtr = varPtr->value.linkPtr;
4066 	}
4067 	if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) {
4068 	    if (!TclIsVarUndefined(varPtr)) {
4069 		TclDecrRefCount(varPtr->value.objPtr);
4070 	    }
4071 	    varPtr->value.objPtr = NULL;
4072 	} else {
4073 	    DECACHE_STACK_INFO();
4074 	    TclPtrUnsetVarIdx(interp, varPtr, NULL, NULL, NULL, 0, opnd);
4075 	    CACHE_STACK_INFO();
4076 	}
4077 	NEXT_INST_F(5, 0, 0);
4078     }
4079     break;
4080 
4081     /*
4082      *	   End of INST_UNSET instructions.
4083      * -----------------------------------------------------------------
4084      *	   Start of INST_ARRAY instructions.
4085      */
4086 
4087     case INST_ARRAY_EXISTS_IMM:
4088 	opnd = TclGetUInt4AtPtr(pc+1);
4089 	pcAdjustment = 5;
4090 	cleanup = 0;
4091 	part1Ptr = NULL;
4092 	arrayPtr = NULL;
4093 	TRACE(("%u => ", opnd));
4094 	varPtr = LOCAL(opnd);
4095 	while (TclIsVarLink(varPtr)) {
4096 	    varPtr = varPtr->value.linkPtr;
4097 	}
4098 	goto doArrayExists;
4099     case INST_ARRAY_EXISTS_STK:
4100 	opnd = -1;
4101 	pcAdjustment = 1;
4102 	cleanup = 1;
4103 	part1Ptr = OBJ_AT_TOS;
4104 	TRACE(("\"%.30s\" => ", O2S(part1Ptr)));
4105 	varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, 0, NULL,
4106 		/*createPart1*/0, /*createPart2*/0, &arrayPtr);
4107     doArrayExists:
4108 	DECACHE_STACK_INFO();
4109 	result = TclCheckArrayTraces(interp, varPtr, arrayPtr, part1Ptr, opnd);
4110 	CACHE_STACK_INFO();
4111 	if (result == TCL_ERROR) {
4112 	    TRACE_ERROR(interp);
4113 	    goto gotError;
4114 	}
4115 	if (varPtr && TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
4116 	    objResultPtr = TCONST(1);
4117 	} else {
4118 	    objResultPtr = TCONST(0);
4119 	}
4120 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
4121 	NEXT_INST_V(pcAdjustment, cleanup, 1);
4122 
4123     case INST_ARRAY_MAKE_IMM:
4124 	opnd = TclGetUInt4AtPtr(pc+1);
4125 	pcAdjustment = 5;
4126 	cleanup = 0;
4127 	part1Ptr = NULL;
4128 	arrayPtr = NULL;
4129 	TRACE(("%u => ", opnd));
4130 	varPtr = LOCAL(opnd);
4131 	while (TclIsVarLink(varPtr)) {
4132 	    varPtr = varPtr->value.linkPtr;
4133 	}
4134 	goto doArrayMake;
4135     case INST_ARRAY_MAKE_STK:
4136 	opnd = -1;
4137 	pcAdjustment = 1;
4138 	cleanup = 1;
4139 	part1Ptr = OBJ_AT_TOS;
4140 	TRACE(("\"%.30s\" => ", O2S(part1Ptr)));
4141 	varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, TCL_LEAVE_ERR_MSG,
4142 		"set", /*createPart1*/1, /*createPart2*/0, &arrayPtr);
4143 	if (varPtr == NULL) {
4144 	    TRACE_ERROR(interp);
4145 	    goto gotError;
4146 	}
4147     doArrayMake:
4148 	if (varPtr && !TclIsVarArray(varPtr)) {
4149 	    if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) {
4150 		/*
4151 		 * Either an array element, or a scalar: lose!
4152 		 */
4153 
4154 		TclObjVarErrMsg(interp, part1Ptr, NULL, "array set",
4155 			"variable isn't array", opnd);
4156 		DECACHE_STACK_INFO();
4157 		Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
4158 		CACHE_STACK_INFO();
4159 		TRACE_ERROR(interp);
4160 		goto gotError;
4161 	    }
4162 	    TclInitArrayVar(varPtr);
4163 #ifdef TCL_COMPILE_DEBUG
4164 	    TRACE_APPEND(("done\n"));
4165 	} else {
4166 	    TRACE_APPEND(("nothing to do\n"));
4167 #endif
4168 	}
4169 	NEXT_INST_V(pcAdjustment, cleanup, 0);
4170 
4171     /*
4172      *	   End of INST_ARRAY instructions.
4173      * -----------------------------------------------------------------
4174      *	   Start of variable linking instructions.
4175      */
4176 
4177     {
4178 	Var *otherPtr;
4179 	CallFrame *framePtr, *savedFramePtr;
4180 	Tcl_Namespace *nsPtr;
4181 	Namespace *savedNsPtr;
4182 
4183     case INST_UPVAR:
4184 	TRACE(("%d %.30s %.30s => ", TclGetInt4AtPtr(pc+1),
4185 		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
4186 
4187 	if (TclObjGetFrame(interp, OBJ_UNDER_TOS, &framePtr) == -1) {
4188 	    TRACE_ERROR(interp);
4189 	    goto gotError;
4190 	}
4191 
4192 	/*
4193 	 * Locate the other variable.
4194 	 */
4195 
4196 	savedFramePtr = iPtr->varFramePtr;
4197 	iPtr->varFramePtr = framePtr;
4198 	otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
4199 		TCL_LEAVE_ERR_MSG, "access", /*createPart1*/ 1,
4200 		/*createPart2*/ 1, &varPtr);
4201 	iPtr->varFramePtr = savedFramePtr;
4202 	if (!otherPtr) {
4203 	    TRACE_ERROR(interp);
4204 	    goto gotError;
4205 	}
4206 	goto doLinkVars;
4207 
4208     case INST_NSUPVAR:
4209 	TRACE(("%d %.30s %.30s => ", TclGetInt4AtPtr(pc+1),
4210 		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
4211 	if (TclGetNamespaceFromObj(interp, OBJ_UNDER_TOS, &nsPtr) != TCL_OK) {
4212 	    TRACE_ERROR(interp);
4213 	    goto gotError;
4214 	}
4215 
4216 	/*
4217 	 * Locate the other variable.
4218 	 */
4219 
4220 	savedNsPtr = iPtr->varFramePtr->nsPtr;
4221 	iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr;
4222 	otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
4223 		(TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG|TCL_AVOID_RESOLVERS),
4224 		"access", /*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
4225 	iPtr->varFramePtr->nsPtr = savedNsPtr;
4226 	if (!otherPtr) {
4227 	    TRACE_ERROR(interp);
4228 	    goto gotError;
4229 	}
4230 	goto doLinkVars;
4231 
4232     case INST_VARIABLE:
4233 	TRACE(("%d, %.30s => ", TclGetInt4AtPtr(pc+1), O2S(OBJ_AT_TOS)));
4234 	otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
4235 		(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
4236 		/*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
4237 	if (!otherPtr) {
4238 	    TRACE_ERROR(interp);
4239 	    goto gotError;
4240 	}
4241 
4242 	/*
4243 	 * Do the [variable] magic.
4244 	 */
4245 
4246 	TclSetVarNamespaceVar(otherPtr);
4247 
4248     doLinkVars:
4249 
4250 	/*
4251 	 * If we are here, the local variable has already been created: do the
4252 	 * little work of TclPtrMakeUpvar that remains to be done right here
4253 	 * if there are no errors; otherwise, let it handle the case.
4254 	 */
4255 
4256 	opnd = TclGetInt4AtPtr(pc+1);
4257 	varPtr = LOCAL(opnd);
4258 	if ((varPtr != otherPtr) && !TclIsVarTraced(varPtr)
4259 		&& (TclIsVarUndefined(varPtr) || TclIsVarLink(varPtr))) {
4260 	    if (!TclIsVarUndefined(varPtr)) {
4261 		/*
4262 		 * Then it is a defined link.
4263 		 */
4264 
4265 		Var *linkPtr = varPtr->value.linkPtr;
4266 
4267 		if (linkPtr == otherPtr) {
4268 		    TRACE_APPEND(("already linked\n"));
4269 		    NEXT_INST_F(5, 1, 0);
4270 		}
4271 		if (TclIsVarInHash(linkPtr)) {
4272 		    VarHashRefCount(linkPtr)--;
4273 		    if (TclIsVarUndefined(linkPtr)) {
4274 			TclCleanupVar(linkPtr, NULL);
4275 		    }
4276 		}
4277 	    }
4278 	    TclSetVarLink(varPtr);
4279 	    varPtr->value.linkPtr = otherPtr;
4280 	    if (TclIsVarInHash(otherPtr)) {
4281 		VarHashRefCount(otherPtr)++;
4282 	    }
4283 	} else if (TclPtrObjMakeUpvarIdx(interp, otherPtr, NULL, 0,
4284 		opnd) != TCL_OK) {
4285 	    TRACE_ERROR(interp);
4286 	    goto gotError;
4287 	}
4288 
4289 	/*
4290 	 * Do not pop the namespace or frame index, it may be needed for other
4291 	 * variables - and [variable] did not push it at all.
4292 	 */
4293 
4294 	TRACE_APPEND(("link made\n"));
4295 	NEXT_INST_F(5, 1, 0);
4296     }
4297     break;
4298 
4299     /*
4300      *	   End of variable linking instructions.
4301      * -----------------------------------------------------------------
4302      */
4303 
4304     case INST_JUMP1:
4305 	opnd = TclGetInt1AtPtr(pc+1);
4306 	TRACE(("%d => new pc %u\n", opnd,
4307 		(unsigned)(pc + opnd - codePtr->codeStart)));
4308 	NEXT_INST_F(opnd, 0, 0);
4309     break;
4310 
4311     case INST_JUMP4:
4312 	opnd = TclGetInt4AtPtr(pc+1);
4313 	TRACE(("%d => new pc %u\n", opnd,
4314 		(unsigned)(pc + opnd - codePtr->codeStart)));
4315 	NEXT_INST_F(opnd, 0, 0);
4316 
4317     {
4318 	int jmpOffset[2], b;
4319 
4320 	/* TODO: consider rewrite so we don't compute the offset we're not
4321 	 * going to take. */
4322     case INST_JUMP_FALSE4:
4323 	jmpOffset[0] = TclGetInt4AtPtr(pc+1);	/* FALSE offset */
4324 	jmpOffset[1] = 5;			/* TRUE offset */
4325 	goto doCondJump;
4326 
4327     case INST_JUMP_TRUE4:
4328 	jmpOffset[0] = 5;
4329 	jmpOffset[1] = TclGetInt4AtPtr(pc+1);
4330 	goto doCondJump;
4331 
4332     case INST_JUMP_FALSE1:
4333 	jmpOffset[0] = TclGetInt1AtPtr(pc+1);
4334 	jmpOffset[1] = 2;
4335 	goto doCondJump;
4336 
4337     case INST_JUMP_TRUE1:
4338 	jmpOffset[0] = 2;
4339 	jmpOffset[1] = TclGetInt1AtPtr(pc+1);
4340 
4341     doCondJump:
4342 	valuePtr = OBJ_AT_TOS;
4343 	TRACE(("%d => ", jmpOffset[
4344 		(*pc==INST_JUMP_FALSE1 || *pc==INST_JUMP_FALSE4) ? 0 : 1]));
4345 
4346 	/* TODO - check claim that taking address of b harms performance */
4347 	/* TODO - consider optimization search for constants */
4348 	if (TclGetBooleanFromObj(interp, valuePtr, &b) != TCL_OK) {
4349 	    TRACE_ERROR(interp);
4350 	    goto gotError;
4351 	}
4352 
4353 #ifdef TCL_COMPILE_DEBUG
4354 	if (b) {
4355 	    if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) {
4356 		TRACE_APPEND(("%.20s true, new pc %u\n", O2S(valuePtr),
4357 			(unsigned)(pc + jmpOffset[1] - codePtr->codeStart)));
4358 	    } else {
4359 		TRACE_APPEND(("%.20s true\n", O2S(valuePtr)));
4360 	    }
4361 	} else {
4362 	    if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) {
4363 		TRACE_APPEND(("%.20s false\n", O2S(valuePtr)));
4364 	    } else {
4365 		TRACE_APPEND(("%.20s false, new pc %u\n", O2S(valuePtr),
4366 			(unsigned)(pc + jmpOffset[0] - codePtr->codeStart)));
4367 	    }
4368 	}
4369 #endif
4370 	NEXT_INST_F(jmpOffset[b], 1, 0);
4371     }
4372     break;
4373 
4374     case INST_JUMP_TABLE: {
4375 	Tcl_HashEntry *hPtr;
4376 	JumptableInfo *jtPtr;
4377 
4378 	/*
4379 	 * Jump to location looked up in a hashtable; fall through to next
4380 	 * instr if lookup fails.
4381 	 */
4382 
4383 	opnd = TclGetInt4AtPtr(pc+1);
4384 	jtPtr = (JumptableInfo *) codePtr->auxDataArrayPtr[opnd].clientData;
4385 	TRACE(("%d \"%.20s\" => ", opnd, O2S(OBJ_AT_TOS)));
4386 	hPtr = Tcl_FindHashEntry(&jtPtr->hashTable, TclGetString(OBJ_AT_TOS));
4387 	if (hPtr != NULL) {
4388 	    int jumpOffset = PTR2INT(Tcl_GetHashValue(hPtr));
4389 
4390 	    TRACE_APPEND(("found in table, new pc %u\n",
4391 		    (unsigned)(pc - codePtr->codeStart + jumpOffset)));
4392 	    NEXT_INST_F(jumpOffset, 1, 0);
4393 	} else {
4394 	    TRACE_APPEND(("not found in table\n"));
4395 	    NEXT_INST_F(5, 1, 0);
4396 	}
4397     }
4398     break;
4399 
4400     /*
4401      * These two instructions are now redundant: the complete logic of the LOR
4402      * and LAND is now handled by the expression compiler.
4403      */
4404 
4405     case INST_LOR:
4406     case INST_LAND: {
4407 	/*
4408 	 * Operands must be boolean or numeric. No int->double conversions are
4409 	 * performed.
4410 	 */
4411 
4412 	int i1, i2, iResult;
4413 
4414 	value2Ptr = OBJ_AT_TOS;
4415 	valuePtr = OBJ_UNDER_TOS;
4416 	if (TclGetBooleanFromObj(NULL, valuePtr, &i1) != TCL_OK) {
4417 	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
4418 		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
4419 	    DECACHE_STACK_INFO();
4420 	    IllegalExprOperandType(interp, pc, valuePtr);
4421 	    CACHE_STACK_INFO();
4422 	    goto gotError;
4423 	}
4424 
4425 	if (TclGetBooleanFromObj(NULL, value2Ptr, &i2) != TCL_OK) {
4426 	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr),
4427 		    (value2Ptr->typePtr? value2Ptr->typePtr->name : "null")));
4428 	    DECACHE_STACK_INFO();
4429 	    IllegalExprOperandType(interp, pc, value2Ptr);
4430 	    CACHE_STACK_INFO();
4431 	    goto gotError;
4432 	}
4433 
4434 	if (*pc == INST_LOR) {
4435 	    iResult = (i1 || i2);
4436 	} else {
4437 	    iResult = (i1 && i2);
4438 	}
4439 	objResultPtr = TCONST(iResult);
4440 	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr),O2S(value2Ptr),iResult));
4441 	NEXT_INST_F(1, 2, 1);
4442     }
4443     break;
4444 
4445     /*
4446      * -----------------------------------------------------------------
4447      *	   Start of general introspector instructions.
4448      */
4449 
4450     case INST_NS_CURRENT: {
4451 	Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
4452 
4453 	if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) {
4454 	    TclNewLiteralStringObj(objResultPtr, "::");
4455 	} else {
4456 	    TclNewStringObj(objResultPtr, currNsPtr->fullName,
4457 		    strlen(currNsPtr->fullName));
4458 	}
4459 	TRACE_WITH_OBJ(("=> "), objResultPtr);
4460 	NEXT_INST_F(1, 0, 1);
4461     }
4462     break;
4463     case INST_COROUTINE_NAME: {
4464 	CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
4465 
4466 	TclNewObj(objResultPtr);
4467 	if (corPtr && !(corPtr->cmdPtr->flags & CMD_DYING)) {
4468 	    Tcl_GetCommandFullName(interp, (Tcl_Command) corPtr->cmdPtr,
4469 		    objResultPtr);
4470 	}
4471 	TRACE_WITH_OBJ(("=> "), objResultPtr);
4472 	NEXT_INST_F(1, 0, 1);
4473     }
4474     break;
4475     case INST_INFO_LEVEL_NUM:
4476 	TclNewIntObj(objResultPtr, iPtr->varFramePtr->level);
4477 	TRACE_WITH_OBJ(("=> "), objResultPtr);
4478 	NEXT_INST_F(1, 0, 1);
4479     break;
4480     case INST_INFO_LEVEL_ARGS: {
4481 	int level;
4482 	CallFrame *framePtr = iPtr->varFramePtr;
4483 	CallFrame *rootFramePtr = iPtr->rootFramePtr;
4484 
4485 	TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
4486 	if (TclGetIntFromObj(interp, OBJ_AT_TOS, &level) != TCL_OK) {
4487 	    TRACE_ERROR(interp);
4488 	    goto gotError;
4489 	}
4490 	if (level <= 0) {
4491 	    level += framePtr->level;
4492 	}
4493 	for (; (framePtr->level!=level) && (framePtr!=rootFramePtr) ;
4494 		framePtr = framePtr->callerVarPtr) {
4495 	    /* Empty loop body */
4496 	}
4497 	if (framePtr == rootFramePtr) {
4498 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
4499 		    "bad level \"%s\"", TclGetString(OBJ_AT_TOS)));
4500 	    TRACE_ERROR(interp);
4501 	    DECACHE_STACK_INFO();
4502 	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL",
4503 		    TclGetString(OBJ_AT_TOS), NULL);
4504 	    CACHE_STACK_INFO();
4505 	    goto gotError;
4506 	}
4507 	objResultPtr = Tcl_NewListObj(framePtr->objc, framePtr->objv);
4508 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
4509 	NEXT_INST_F(1, 1, 1);
4510     }
4511     {
4512 	Tcl_Command cmd, origCmd;
4513 
4514     case INST_RESOLVE_COMMAND:
4515 	cmd = Tcl_GetCommandFromObj(interp, OBJ_AT_TOS);
4516 	TclNewObj(objResultPtr);
4517 	if (cmd != NULL) {
4518 	    Tcl_GetCommandFullName(interp, cmd, objResultPtr);
4519 	}
4520 	TRACE_WITH_OBJ(("\"%.20s\" => ", O2S(OBJ_AT_TOS)), objResultPtr);
4521 	NEXT_INST_F(1, 1, 1);
4522 
4523     case INST_ORIGIN_COMMAND:
4524 	TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
4525 	cmd = Tcl_GetCommandFromObj(interp, OBJ_AT_TOS);
4526 	if (cmd == NULL) {
4527 	    goto instOriginError;
4528 	}
4529 	origCmd = TclGetOriginalCommand(cmd);
4530 	if (origCmd == NULL) {
4531 	    origCmd = cmd;
4532 	}
4533 
4534 	TclNewObj(objResultPtr);
4535 	Tcl_GetCommandFullName(interp, origCmd, objResultPtr);
4536 	if (TclCheckEmptyString(objResultPtr) == TCL_EMPTYSTRING_YES ) {
4537 	    Tcl_DecrRefCount(objResultPtr);
4538 	    instOriginError:
4539 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
4540 		    "invalid command name \"%s\"", TclGetString(OBJ_AT_TOS)));
4541 	    DECACHE_STACK_INFO();
4542 	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
4543 		    TclGetString(OBJ_AT_TOS), NULL);
4544 	    CACHE_STACK_INFO();
4545 	    TRACE_APPEND(("ERROR: not command\n"));
4546 	    goto gotError;
4547 	}
4548 	TRACE_APPEND(("\"%.30s\"", O2S(OBJ_AT_TOS)));
4549 	NEXT_INST_F(1, 1, 1);
4550     }
4551 
4552     /*
4553      * -----------------------------------------------------------------
4554      *	   Start of TclOO support instructions.
4555      */
4556 
4557     {
4558 	Object *oPtr;
4559 	CallFrame *framePtr;
4560 	CallContext *contextPtr;
4561 	int skip, newDepth;
4562 
4563     case INST_TCLOO_SELF:
4564 	framePtr = iPtr->varFramePtr;
4565 	if (framePtr == NULL ||
4566 		!(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
4567 	    TRACE(("=> ERROR: no TclOO call context\n"));
4568 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
4569 		    "self may only be called from inside a method",
4570 		    -1));
4571 	    DECACHE_STACK_INFO();
4572 	    Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
4573 	    CACHE_STACK_INFO();
4574 	    goto gotError;
4575 	}
4576 	contextPtr = (CallContext *)framePtr->clientData;
4577 
4578 	/*
4579 	 * Call out to get the name; it's expensive to compute but cached.
4580 	 */
4581 
4582 	objResultPtr = TclOOObjectName(interp, contextPtr->oPtr);
4583 	TRACE_WITH_OBJ(("=> "), objResultPtr);
4584 	NEXT_INST_F(1, 0, 1);
4585 
4586     case INST_TCLOO_NEXT_CLASS:
4587 	opnd = TclGetUInt1AtPtr(pc+1);
4588 	framePtr = iPtr->varFramePtr;
4589 	valuePtr = OBJ_AT_DEPTH(opnd - 2);
4590 	objv = &OBJ_AT_DEPTH(opnd - 1);
4591 	skip = 2;
4592 	TRACE(("%d => ", opnd));
4593 	if (framePtr == NULL ||
4594 		!(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
4595 	    TRACE_APPEND(("ERROR: no TclOO call context\n"));
4596 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
4597 		    "nextto may only be called from inside a method",
4598 		    -1));
4599 	    DECACHE_STACK_INFO();
4600 	    Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
4601 	    CACHE_STACK_INFO();
4602 	    goto gotError;
4603 	}
4604 	contextPtr = (CallContext *)framePtr->clientData;
4605 
4606 	oPtr = (Object *) Tcl_GetObjectFromObj(interp, valuePtr);
4607 	if (oPtr == NULL) {
4608 	    TRACE_APPEND(("ERROR: \"%.30s\" not object\n", O2S(valuePtr)));
4609 	    goto gotError;
4610 	} else {
4611 	    Class *classPtr = oPtr->classPtr;
4612 	    struct MInvoke *miPtr;
4613 	    int i;
4614 	    const char *methodType;
4615 
4616 	    if (classPtr == NULL) {
4617 		TRACE_APPEND(("ERROR: \"%.30s\" not class\n", O2S(valuePtr)));
4618 		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
4619 			"\"%s\" is not a class", TclGetString(valuePtr)));
4620 		DECACHE_STACK_INFO();
4621 		Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_REQUIRED", NULL);
4622 		CACHE_STACK_INFO();
4623 		goto gotError;
4624 	    }
4625 
4626 	    for (i=contextPtr->index+1 ; i<contextPtr->callPtr->numChain ; i++) {
4627 		miPtr = contextPtr->callPtr->chain + i;
4628 		if (!miPtr->isFilter &&
4629 			miPtr->mPtr->declaringClassPtr == classPtr) {
4630 		    newDepth = i;
4631 #ifdef TCL_COMPILE_DEBUG
4632 		    if (tclTraceExec >= 2) {
4633 			if (traceInstructions) {
4634 			    strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
4635 			} else {
4636 			    fprintf(stdout, "%d: (%u) invoking ",
4637 				    iPtr->numLevels,
4638 				    (unsigned)(pc - codePtr->codeStart));
4639 			}
4640 			for (i = 0;  i < opnd;  i++) {
4641 			    TclPrintObject(stdout, objv[i], 15);
4642 			    fprintf(stdout, " ");
4643 			}
4644 			fprintf(stdout, "\n");
4645 			fflush(stdout);
4646 		    }
4647 #endif /*TCL_COMPILE_DEBUG*/
4648 		    goto doInvokeNext;
4649 		}
4650 	    }
4651 
4652 	    if (contextPtr->callPtr->flags & CONSTRUCTOR) {
4653 		methodType = "constructor";
4654 	    } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
4655 		methodType = "destructor";
4656 	    } else {
4657 		methodType = "method";
4658 	    }
4659 
4660 	    TRACE_APPEND(("ERROR: \"%.30s\" not on reachable chain\n",
4661 		    O2S(valuePtr)));
4662 	    for (i=contextPtr->index ; i>=0 ; i--) {
4663 		miPtr = contextPtr->callPtr->chain + i;
4664 		if (miPtr->isFilter
4665 			|| miPtr->mPtr->declaringClassPtr != classPtr) {
4666 		    continue;
4667 		}
4668 		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
4669 			"%s implementation by \"%s\" not reachable from here",
4670 			methodType, TclGetString(valuePtr)));
4671 		DECACHE_STACK_INFO();
4672 		Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_REACHABLE",
4673 			NULL);
4674 		CACHE_STACK_INFO();
4675 		goto gotError;
4676 	    }
4677 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
4678 		    "%s has no non-filter implementation by \"%s\"",
4679 		    methodType, TclGetString(valuePtr)));
4680 	    DECACHE_STACK_INFO();
4681 	    Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", NULL);
4682 	    CACHE_STACK_INFO();
4683 	    goto gotError;
4684 	}
4685 
4686     case INST_TCLOO_NEXT:
4687 	opnd = TclGetUInt1AtPtr(pc+1);
4688 	objv = &OBJ_AT_DEPTH(opnd - 1);
4689 	framePtr = iPtr->varFramePtr;
4690 	skip = 1;
4691 	TRACE(("%d => ", opnd));
4692 	if (framePtr == NULL ||
4693 		!(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
4694 	    TRACE_APPEND(("ERROR: no TclOO call context\n"));
4695 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
4696 		    "next may only be called from inside a method",
4697 		    -1));
4698 	    DECACHE_STACK_INFO();
4699 	    Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
4700 	    CACHE_STACK_INFO();
4701 	    goto gotError;
4702 	}
4703 	contextPtr = (CallContext *)framePtr->clientData;
4704 
4705 	newDepth = contextPtr->index + 1;
4706 	if (newDepth >= contextPtr->callPtr->numChain) {
4707 	    /*
4708 	     * We're at the end of the chain; generate an error message unless
4709 	     * the interpreter is being torn down, in which case we might be
4710 	     * getting here because of methods/destructors doing a [next] (or
4711 	     * equivalent) unexpectedly.
4712 	     */
4713 
4714 	    const char *methodType;
4715 
4716 	    if (contextPtr->callPtr->flags & CONSTRUCTOR) {
4717 		methodType = "constructor";
4718 	    } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
4719 		methodType = "destructor";
4720 	    } else {
4721 		methodType = "method";
4722 	    }
4723 
4724 	    TRACE_APPEND(("ERROR: no TclOO next impl\n"));
4725 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
4726 		    "no next %s implementation", methodType));
4727 	    DECACHE_STACK_INFO();
4728 	    Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL);
4729 	    CACHE_STACK_INFO();
4730 	    goto gotError;
4731 #ifdef TCL_COMPILE_DEBUG
4732 	} else if (tclTraceExec >= 2) {
4733 	    int i;
4734 
4735 	    if (traceInstructions) {
4736 		strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
4737 	    } else {
4738 		fprintf(stdout, "%d: (%u) invoking ",
4739 			iPtr->numLevels, (unsigned)(pc - codePtr->codeStart));
4740 	    }
4741 	    for (i = 0;  i < opnd;  i++) {
4742 		TclPrintObject(stdout, objv[i], 15);
4743 		fprintf(stdout, " ");
4744 	    }
4745 	    fprintf(stdout, "\n");
4746 	    fflush(stdout);
4747 #endif /*TCL_COMPILE_DEBUG*/
4748 	}
4749 
4750     doInvokeNext:
4751 	bcFramePtr->data.tebc.pc = (char *) pc;
4752 	iPtr->cmdFramePtr = bcFramePtr;
4753 
4754 	if (iPtr->flags & INTERP_DEBUG_FRAME) {
4755 	    ArgumentBCEnter(interp, codePtr, TD, pc, opnd, objv);
4756 	}
4757 
4758 	pcAdjustment = 2;
4759 	cleanup = opnd;
4760 	DECACHE_STACK_INFO();
4761 	iPtr->varFramePtr = framePtr->callerVarPtr;
4762 	pc += pcAdjustment;
4763 	TEBC_YIELD();
4764 
4765 	TclPushTailcallPoint(interp);
4766 	oPtr = contextPtr->oPtr;
4767 	if (oPtr->flags & FILTER_HANDLING) {
4768 	    TclNRAddCallback(interp, FinalizeOONextFilter,
4769 		    framePtr, contextPtr, INT2PTR(contextPtr->index),
4770 		    INT2PTR(contextPtr->skip));
4771 	} else {
4772 	    TclNRAddCallback(interp, FinalizeOONext,
4773 		    framePtr, contextPtr, INT2PTR(contextPtr->index),
4774 		    INT2PTR(contextPtr->skip));
4775 	}
4776 	contextPtr->skip = skip;
4777 	contextPtr->index = newDepth;
4778 	if (contextPtr->callPtr->chain[newDepth].isFilter
4779 		|| contextPtr->callPtr->flags & FILTER_HANDLING) {
4780 	    oPtr->flags |= FILTER_HANDLING;
4781 	} else {
4782 	    oPtr->flags &= ~FILTER_HANDLING;
4783 	}
4784 
4785 	{
4786 	    Method *const mPtr =
4787 		    contextPtr->callPtr->chain[newDepth].mPtr;
4788 
4789 	    return mPtr->typePtr->callProc(mPtr->clientData, interp,
4790 		    (Tcl_ObjectContext) contextPtr, opnd, objv);
4791 	}
4792 
4793     case INST_TCLOO_IS_OBJECT:
4794 	oPtr = (Object *) Tcl_GetObjectFromObj(interp, OBJ_AT_TOS);
4795 	objResultPtr = TCONST(oPtr != NULL ? 1 : 0);
4796 	TRACE_WITH_OBJ(("%.30s => ", O2S(OBJ_AT_TOS)), objResultPtr);
4797 	NEXT_INST_F(1, 1, 1);
4798     case INST_TCLOO_CLASS:
4799 	oPtr = (Object *) Tcl_GetObjectFromObj(interp, OBJ_AT_TOS);
4800 	if (oPtr == NULL) {
4801 	    TRACE(("%.30s => ERROR: not object\n", O2S(OBJ_AT_TOS)));
4802 	    goto gotError;
4803 	}
4804 	objResultPtr = TclOOObjectName(interp, oPtr->selfCls->thisPtr);
4805 	TRACE_WITH_OBJ(("%.30s => ", O2S(OBJ_AT_TOS)), objResultPtr);
4806 	NEXT_INST_F(1, 1, 1);
4807     case INST_TCLOO_NS:
4808 	oPtr = (Object *) Tcl_GetObjectFromObj(interp, OBJ_AT_TOS);
4809 	if (oPtr == NULL) {
4810 	    TRACE(("%.30s => ERROR: not object\n", O2S(OBJ_AT_TOS)));
4811 	    goto gotError;
4812 	}
4813 
4814 	/*
4815 	 * TclOO objects *never* have the global namespace as their NS.
4816 	 */
4817 
4818 	TclNewStringObj(objResultPtr, oPtr->namespacePtr->fullName,
4819 		strlen(oPtr->namespacePtr->fullName));
4820 	TRACE_WITH_OBJ(("%.30s => ", O2S(OBJ_AT_TOS)), objResultPtr);
4821 	NEXT_INST_F(1, 1, 1);
4822     }
4823 
4824     /*
4825      *     End of TclOO support instructions.
4826      * -----------------------------------------------------------------
4827      *	   Start of INST_LIST and related instructions.
4828      */
4829 
4830     {
4831 	int index, numIndices, fromIdx, toIdx;
4832 	int nocase, match, length2, cflags, s1len, s2len;
4833 	const char *s1, *s2;
4834 
4835     case INST_LIST:
4836 	/*
4837 	 * Pop the opnd (objc) top stack elements into a new list obj and then
4838 	 * decrement their ref counts.
4839 	 */
4840 
4841 	opnd = TclGetUInt4AtPtr(pc+1);
4842 	objResultPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1));
4843 	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
4844 	NEXT_INST_V(5, opnd, 1);
4845 
4846     case INST_LIST_LENGTH:
4847 	TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
4848 	if (TclListObjLength(interp, OBJ_AT_TOS, &length) != TCL_OK) {
4849 	    TRACE_ERROR(interp);
4850 	    goto gotError;
4851 	}
4852 	TclNewIntObj(objResultPtr, length);
4853 	TRACE_APPEND(("%d\n", length));
4854 	NEXT_INST_F(1, 1, 1);
4855 
4856     case INST_LIST_INDEX:	/* lindex with objc == 3 */
4857 	value2Ptr = OBJ_AT_TOS;
4858 	valuePtr = OBJ_UNDER_TOS;
4859 	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
4860 
4861 	/*
4862 	 * Extract the desired list element.
4863 	 */
4864 
4865 	if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK)
4866 		&& !TclHasIntRep(value2Ptr, &tclListType)) {
4867 	    int code;
4868 
4869 	    DECACHE_STACK_INFO();
4870 	    code = TclGetIntForIndexM(interp, value2Ptr, objc-1, &index);
4871 	    CACHE_STACK_INFO();
4872 	    if (code == TCL_OK) {
4873 		TclDecrRefCount(value2Ptr);
4874 		tosPtr--;
4875 		pcAdjustment = 1;
4876 		goto lindexFastPath;
4877 	    }
4878 	    Tcl_ResetResult(interp);
4879 	}
4880 
4881 	objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);
4882 	if (!objResultPtr) {
4883 	    TRACE_ERROR(interp);
4884 	    goto gotError;
4885 	}
4886 
4887 	/*
4888 	 * Stash the list element on the stack.
4889 	 */
4890 
4891 	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
4892 	NEXT_INST_F(1, 2, -1);	/* Already has the correct refCount */
4893 
4894     case INST_LIST_INDEX_IMM:	/* lindex with objc==3 and index in bytecode
4895 				 * stream */
4896 
4897 	/*
4898 	 * Pop the list and get the index.
4899 	 */
4900 
4901 	valuePtr = OBJ_AT_TOS;
4902 	opnd = TclGetInt4AtPtr(pc+1);
4903 	TRACE(("\"%.30s\" %d => ", O2S(valuePtr), opnd));
4904 
4905 	/*
4906 	 * Get the contents of the list, making sure that it really is a list
4907 	 * in the process.
4908 	 */
4909 
4910 	if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) {
4911 	    TRACE_ERROR(interp);
4912 	    goto gotError;
4913 	}
4914 
4915 	/* Decode end-offset index values. */
4916 
4917 	index = TclIndexDecode(opnd, objc - 1);
4918 	pcAdjustment = 5;
4919 
4920     lindexFastPath:
4921 	if (index >= 0 && index < objc) {
4922 	    objResultPtr = objv[index];
4923 	} else {
4924 	    TclNewObj(objResultPtr);
4925 	}
4926 
4927 	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
4928 	NEXT_INST_F(pcAdjustment, 1, 1);
4929 
4930     case INST_LIST_INDEX_MULTI:	/* 'lindex' with multiple index args */
4931 	/*
4932 	 * Determine the count of index args.
4933 	 */
4934 
4935 	opnd = TclGetUInt4AtPtr(pc+1);
4936 	numIndices = opnd-1;
4937 
4938 	/*
4939 	 * Do the 'lindex' operation.
4940 	 */
4941 
4942 	TRACE(("%d => ", opnd));
4943 	objResultPtr = TclLindexFlat(interp, OBJ_AT_DEPTH(numIndices),
4944 		numIndices, &OBJ_AT_DEPTH(numIndices - 1));
4945 	if (!objResultPtr) {
4946 	    TRACE_ERROR(interp);
4947 	    goto gotError;
4948 	}
4949 
4950 	/*
4951 	 * Set result.
4952 	 */
4953 
4954 	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
4955 	NEXT_INST_V(5, opnd, -1);
4956 
4957     case INST_LSET_FLAT:
4958 	/*
4959 	 * Lset with 3, 5, or more args. Get the number of index args.
4960 	 */
4961 
4962 	opnd = TclGetUInt4AtPtr(pc + 1);
4963 	numIndices = opnd - 2;
4964 	TRACE(("%d => ", opnd));
4965 
4966 	/*
4967 	 * Get the old value of variable, and remove the stack ref. This is
4968 	 * safe because the variable still references the object; the ref
4969 	 * count will never go zero here - we can use the smaller macro
4970 	 * Tcl_DecrRefCount.
4971 	 */
4972 
4973 	valuePtr = POP_OBJECT();
4974 	Tcl_DecrRefCount(valuePtr); /* This one should be done here */
4975 
4976 	/*
4977 	 * Compute the new variable value.
4978 	 */
4979 
4980 	objResultPtr = TclLsetFlat(interp, valuePtr, numIndices,
4981 		&OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);
4982 	if (!objResultPtr) {
4983 	    TRACE_ERROR(interp);
4984 	    goto gotError;
4985 	}
4986 
4987 	/*
4988 	 * Set result.
4989 	 */
4990 
4991 	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
4992 	NEXT_INST_V(5, numIndices+1, -1);
4993 
4994     case INST_LSET_LIST:	/* 'lset' with 4 args */
4995 	/*
4996 	 * Get the old value of variable, and remove the stack ref. This is
4997 	 * safe because the variable still references the object; the ref
4998 	 * count will never go zero here - we can use the smaller macro
4999 	 * Tcl_DecrRefCount.
5000 	 */
5001 
5002 	objPtr = POP_OBJECT();
5003 	Tcl_DecrRefCount(objPtr);	/* This one should be done here. */
5004 
5005 	/*
5006 	 * Get the new element value, and the index list.
5007 	 */
5008 
5009 	valuePtr = OBJ_AT_TOS;
5010 	value2Ptr = OBJ_UNDER_TOS;
5011 	TRACE(("\"%.30s\" \"%.30s\" \"%.30s\" => ",
5012 		O2S(value2Ptr), O2S(valuePtr), O2S(objPtr)));
5013 
5014 	/*
5015 	 * Compute the new variable value.
5016 	 */
5017 
5018 	objResultPtr = TclLsetList(interp, objPtr, value2Ptr, valuePtr);
5019 	if (!objResultPtr) {
5020 	    TRACE_ERROR(interp);
5021 	    goto gotError;
5022 	}
5023 
5024 	/*
5025 	 * Set result.
5026 	 */
5027 
5028 	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
5029 	NEXT_INST_F(1, 2, -1);
5030 
5031     case INST_LIST_RANGE_IMM:	/* lrange with objc==4 and both indices in
5032 				 * bytecode stream */
5033 
5034 	/*
5035 	 * Pop the list and get the indices.
5036 	 */
5037 
5038 	valuePtr = OBJ_AT_TOS;
5039 	fromIdx = TclGetInt4AtPtr(pc+1);
5040 	toIdx = TclGetInt4AtPtr(pc+5);
5041 	TRACE(("\"%.30s\" %d %d => ", O2S(valuePtr), TclGetInt4AtPtr(pc+1),
5042 		TclGetInt4AtPtr(pc+5)));
5043 
5044 	/*
5045 	 * Get the length of the list, making sure that it really is a list
5046 	 * in the process.
5047 	 */
5048 
5049 	if (TclListObjLength(interp, valuePtr, &objc) != TCL_OK) {
5050 	    TRACE_ERROR(interp);
5051 	    goto gotError;
5052 	}
5053 
5054 	/*
5055 	 * Skip a lot of work if we're about to throw the result away (common
5056 	 * with uses of [lassign]).
5057 	 */
5058 
5059 #ifndef TCL_COMPILE_DEBUG
5060 	if (*(pc+9) == INST_POP) {
5061 	    NEXT_INST_F(10, 1, 0);
5062 	}
5063 #endif
5064 
5065 	/* Every range of an empty list is an empty list */
5066 	if (objc == 0) {
5067 	    /* avoid return of not canonical list (e. g. spaces in string repr.) */
5068 	    if (!valuePtr->bytes || !valuePtr->length) {
5069 		TRACE_APPEND(("\n"));
5070 		NEXT_INST_F(9, 0, 0);
5071 	    }
5072 	    goto emptyList;
5073 	}
5074 
5075 	/* Decode index value operands. */
5076 
5077 	if (toIdx == TCL_INDEX_NONE) {
5078 	emptyList:
5079 	    TclNewObj(objResultPtr);
5080 	    TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
5081 	    NEXT_INST_F(9, 1, 1);
5082 	}
5083 	toIdx = TclIndexDecode(toIdx, objc - 1);
5084 	if (toIdx < 0) {
5085 	    goto emptyList;
5086 	} else if (toIdx >= objc) {
5087 	    toIdx = objc - 1;
5088 	}
5089 
5090 	assert ( toIdx >= 0 && toIdx < objc);
5091 	/*
5092 	assert ( fromIdx != TCL_INDEX_NONE );
5093 	 *
5094 	 * Extra safety for legacy bytecodes:
5095 	 */
5096 	if (fromIdx == TCL_INDEX_NONE) {
5097 	    fromIdx = TCL_INDEX_START;
5098 	}
5099 
5100 	fromIdx = TclIndexDecode(fromIdx, objc - 1);
5101 
5102 	objResultPtr = TclListObjRange(valuePtr, fromIdx, toIdx);
5103 
5104 	TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
5105 	NEXT_INST_F(9, 1, 1);
5106 
5107     case INST_LIST_IN:
5108     case INST_LIST_NOT_IN:	/* Basic list containment operators. */
5109 	value2Ptr = OBJ_AT_TOS;
5110 	valuePtr = OBJ_UNDER_TOS;
5111 
5112 	s1 = TclGetStringFromObj(valuePtr, &s1len);
5113 	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
5114 	if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) {
5115 	    TRACE_ERROR(interp);
5116 	    goto gotError;
5117 	}
5118 	match = 0;
5119 	if (length > 0) {
5120 	    int i = 0;
5121 	    Tcl_Obj *o;
5122 
5123 	    /*
5124 	     * An empty list doesn't match anything.
5125 	     */
5126 
5127 	    do {
5128 		Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
5129 		if (o != NULL) {
5130 		    s2 = TclGetStringFromObj(o, &s2len);
5131 		} else {
5132 		    s2 = "";
5133 		    s2len = 0;
5134 		}
5135 		if (s1len == s2len) {
5136 		    match = (memcmp(s1, s2, s1len) == 0);
5137 		}
5138 		i++;
5139 	    } while (i < length && match == 0);
5140 	}
5141 
5142 	if (*pc == INST_LIST_NOT_IN) {
5143 	    match = !match;
5144 	}
5145 
5146 	TRACE_APPEND(("%d\n", match));
5147 
5148 	/*
5149 	 * Peep-hole optimisation: if you're about to jump, do jump from here.
5150 	 * We're saving the effort of pushing a boolean value only to pop it
5151 	 * for branching.
5152 	 */
5153 
5154 	JUMP_PEEPHOLE_F(match, 1, 2);
5155 
5156     case INST_LIST_CONCAT:
5157 	value2Ptr = OBJ_AT_TOS;
5158 	valuePtr = OBJ_UNDER_TOS;
5159 	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
5160 	if (Tcl_IsShared(valuePtr)) {
5161 	    objResultPtr = Tcl_DuplicateObj(valuePtr);
5162 	    if (Tcl_ListObjAppendList(interp, objResultPtr,
5163 		    value2Ptr) != TCL_OK) {
5164 		TRACE_ERROR(interp);
5165 		TclDecrRefCount(objResultPtr);
5166 		goto gotError;
5167 	    }
5168 	    TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
5169 	    NEXT_INST_F(1, 2, 1);
5170 	} else {
5171 	    if (Tcl_ListObjAppendList(interp, valuePtr, value2Ptr) != TCL_OK){
5172 		TRACE_ERROR(interp);
5173 		goto gotError;
5174 	    }
5175 	    TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
5176 	    NEXT_INST_F(1, 1, 0);
5177 	}
5178 
5179     /*
5180      *	   End of INST_LIST and related instructions.
5181      * -----------------------------------------------------------------
5182      *	   Start of string-related instructions.
5183      */
5184 
5185     case INST_STR_EQ:
5186     case INST_STR_NEQ:		/* String (in)equality check */
5187     case INST_STR_CMP:		/* String compare. */
5188     case INST_STR_LT:
5189     case INST_STR_GT:
5190     case INST_STR_LE:
5191     case INST_STR_GE:
5192     stringCompare:
5193 	value2Ptr = OBJ_AT_TOS;
5194 	valuePtr = OBJ_UNDER_TOS;
5195 
5196 	{
5197 	    int checkEq = ((*pc == INST_EQ) || (*pc == INST_NEQ)
5198 		    || (*pc == INST_STR_EQ) || (*pc == INST_STR_NEQ));
5199 	    match = TclStringCmp(valuePtr, value2Ptr, checkEq, 0, -1);
5200 	}
5201 
5202 	/*
5203 	 * Make sure only -1,0,1 is returned
5204 	 * TODO: consider peephole opt.
5205 	 */
5206 
5207 	if (*pc != INST_STR_CMP) {
5208 	    /*
5209 	     * Take care of the opcodes that goto'ed into here.
5210 	     */
5211 
5212 	    switch (*pc) {
5213 	    case INST_STR_EQ:
5214 	    case INST_EQ:
5215 		match = (match == 0);
5216 		break;
5217 	    case INST_STR_NEQ:
5218 	    case INST_NEQ:
5219 		match = (match != 0);
5220 		break;
5221 	    case INST_LT:
5222 	    case INST_STR_LT:
5223 		match = (match < 0);
5224 		break;
5225 	    case INST_GT:
5226 	    case INST_STR_GT:
5227 		match = (match > 0);
5228 		break;
5229 	    case INST_LE:
5230 	    case INST_STR_LE:
5231 		match = (match <= 0);
5232 		break;
5233 	    case INST_GE:
5234 	    case INST_STR_GE:
5235 		match = (match >= 0);
5236 		break;
5237 	    }
5238 	}
5239 
5240 	TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr),
5241 		(match < 0 ? -1 : match > 0 ? 1 : 0)));
5242 	JUMP_PEEPHOLE_F(match, 1, 2);
5243 
5244     case INST_STR_LEN:
5245 	valuePtr = OBJ_AT_TOS;
5246 	length = Tcl_GetCharLength(valuePtr);
5247 	TclNewIntObj(objResultPtr, length);
5248 	TRACE(("\"%.20s\" => %d\n", O2S(valuePtr), length));
5249 	NEXT_INST_F(1, 1, 1);
5250 
5251     case INST_STR_UPPER:
5252 	valuePtr = OBJ_AT_TOS;
5253 	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
5254 	if (Tcl_IsShared(valuePtr)) {
5255 	    s1 = TclGetStringFromObj(valuePtr, &length);
5256 	    TclNewStringObj(objResultPtr, s1, length);
5257 	    length = Tcl_UtfToUpper(TclGetString(objResultPtr));
5258 	    Tcl_SetObjLength(objResultPtr, length);
5259 	    TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
5260 	    NEXT_INST_F(1, 1, 1);
5261 	} else {
5262 	    length = Tcl_UtfToUpper(TclGetString(valuePtr));
5263 	    Tcl_SetObjLength(valuePtr, length);
5264 	    TclFreeIntRep(valuePtr);
5265 	    TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
5266 	    NEXT_INST_F(1, 0, 0);
5267 	}
5268     case INST_STR_LOWER:
5269 	valuePtr = OBJ_AT_TOS;
5270 	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
5271 	if (Tcl_IsShared(valuePtr)) {
5272 	    s1 = TclGetStringFromObj(valuePtr, &length);
5273 	    TclNewStringObj(objResultPtr, s1, length);
5274 	    length = Tcl_UtfToLower(TclGetString(objResultPtr));
5275 	    Tcl_SetObjLength(objResultPtr, length);
5276 	    TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
5277 	    NEXT_INST_F(1, 1, 1);
5278 	} else {
5279 	    length = Tcl_UtfToLower(TclGetString(valuePtr));
5280 	    Tcl_SetObjLength(valuePtr, length);
5281 	    TclFreeIntRep(valuePtr);
5282 	    TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
5283 	    NEXT_INST_F(1, 0, 0);
5284 	}
5285     case INST_STR_TITLE:
5286 	valuePtr = OBJ_AT_TOS;
5287 	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
5288 	if (Tcl_IsShared(valuePtr)) {
5289 	    s1 = TclGetStringFromObj(valuePtr, &length);
5290 	    TclNewStringObj(objResultPtr, s1, length);
5291 	    length = Tcl_UtfToTitle(TclGetString(objResultPtr));
5292 	    Tcl_SetObjLength(objResultPtr, length);
5293 	    TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
5294 	    NEXT_INST_F(1, 1, 1);
5295 	} else {
5296 	    length = Tcl_UtfToTitle(TclGetString(valuePtr));
5297 	    Tcl_SetObjLength(valuePtr, length);
5298 	    TclFreeIntRep(valuePtr);
5299 	    TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
5300 	    NEXT_INST_F(1, 0, 0);
5301 	}
5302 
5303     case INST_STR_INDEX:
5304 	value2Ptr = OBJ_AT_TOS;
5305 	valuePtr = OBJ_UNDER_TOS;
5306 	TRACE(("\"%.20s\" %.20s => ", O2S(valuePtr), O2S(value2Ptr)));
5307 
5308 	/*
5309 	 * Get char length to calulate what 'end' means.
5310 	 */
5311 
5312 	length = Tcl_GetCharLength(valuePtr);
5313 	DECACHE_STACK_INFO();
5314 	if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
5315 	    CACHE_STACK_INFO();
5316 	    TRACE_ERROR(interp);
5317 	    goto gotError;
5318 	}
5319 	CACHE_STACK_INFO();
5320 
5321 	if ((index < 0) || (index >= length)) {
5322 	    TclNewObj(objResultPtr);
5323 	} else if (TclIsPureByteArray(valuePtr)) {
5324 	    objResultPtr = Tcl_NewByteArrayObj(
5325 		    TclGetByteArrayFromObj(valuePtr, NULL)+index, 1);
5326 	} else if (valuePtr->bytes && length == valuePtr->length) {
5327 	    objResultPtr = Tcl_NewStringObj((const char *)
5328 		    valuePtr->bytes+index, 1);
5329 	} else {
5330 	    char buf[4] = "";
5331 	    int ch = Tcl_GetUniChar(valuePtr, index);
5332 
5333 	    /*
5334 	     * This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch, 1)
5335 	     * but creating the object as a string seems to be faster in
5336 	     * practical use.
5337 	     */
5338 	    if (ch == -1) {
5339 		TclNewObj(objResultPtr);
5340 	    } else {
5341 		length = Tcl_UniCharToUtf(ch, buf);
5342 		if ((ch >= 0xD800) && (length < 3)) {
5343 		    length += Tcl_UniCharToUtf(-1, buf + length);
5344 		}
5345 		objResultPtr = Tcl_NewStringObj(buf, length);
5346 	    }
5347 	}
5348 
5349 	TRACE_APPEND(("\"%s\"\n", O2S(objResultPtr)));
5350 	NEXT_INST_F(1, 2, 1);
5351 
5352     case INST_STR_RANGE:
5353 	TRACE(("\"%.20s\" %.20s %.20s =>",
5354 		O2S(OBJ_AT_DEPTH(2)), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
5355 	length = Tcl_GetCharLength(OBJ_AT_DEPTH(2)) - 1;
5356 
5357 	DECACHE_STACK_INFO();
5358 	if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length,
5359 		    &fromIdx) != TCL_OK) {
5360 	    CACHE_STACK_INFO();
5361 	    TRACE_ERROR(interp);
5362 	    goto gotError;
5363 	}
5364 	if (TclGetIntForIndexM(interp, OBJ_AT_TOS, length,
5365 		    &toIdx) != TCL_OK) {
5366 	    CACHE_STACK_INFO();
5367 	    TRACE_ERROR(interp);
5368 	    goto gotError;
5369 	}
5370 	CACHE_STACK_INFO();
5371 
5372 	if (fromIdx < 0) {
5373 	    fromIdx = 0;
5374 	}
5375 	if (toIdx >= length) {
5376 	    toIdx = length;
5377 	}
5378 	if (toIdx >= fromIdx) {
5379 	    objResultPtr = Tcl_GetRange(OBJ_AT_DEPTH(2), fromIdx, toIdx);
5380 	} else {
5381 	    TclNewObj(objResultPtr);
5382 	}
5383 	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
5384 	NEXT_INST_V(1, 3, 1);
5385 
5386     case INST_STR_RANGE_IMM:
5387 	valuePtr = OBJ_AT_TOS;
5388 	fromIdx = TclGetInt4AtPtr(pc+1);
5389 	toIdx = TclGetInt4AtPtr(pc+5);
5390 	length = Tcl_GetCharLength(valuePtr);
5391 	TRACE(("\"%.20s\" %d %d => ", O2S(valuePtr), fromIdx, toIdx));
5392 
5393 	/* Every range of an empty value is an empty value */
5394 	if (length == 0) {
5395 	    TRACE_APPEND(("\n"));
5396 	    NEXT_INST_F(9, 0, 0);
5397 	}
5398 
5399 	/* Decode index operands. */
5400 
5401 	/*
5402 	assert ( toIdx != TCL_INDEX_NONE );
5403 	 *
5404 	 * Extra safety for legacy bytecodes:
5405 	 */
5406 	if (toIdx == TCL_INDEX_NONE) {
5407 	    goto emptyRange;
5408 	}
5409 
5410 	toIdx = TclIndexDecode(toIdx, length - 1);
5411 	if (toIdx < 0) {
5412 	    goto emptyRange;
5413 	} else if (toIdx >= length) {
5414 	    toIdx = length - 1;
5415 	}
5416 
5417 	assert ( toIdx >= 0 && toIdx < length );
5418 
5419 	/*
5420 	assert ( fromIdx != TCL_INDEX_NONE );
5421 	 *
5422 	 * Extra safety for legacy bytecodes:
5423 	 */
5424 	if (fromIdx == TCL_INDEX_NONE) {
5425 	    fromIdx = TCL_INDEX_START;
5426 	}
5427 
5428 	fromIdx = TclIndexDecode(fromIdx, length - 1);
5429 	if (fromIdx < 0) {
5430 	    fromIdx = 0;
5431 	}
5432 
5433 	if (fromIdx <= toIdx) {
5434 	    objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx);
5435 	} else {
5436 	emptyRange:
5437 	    TclNewObj(objResultPtr);
5438 	}
5439 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
5440 	NEXT_INST_F(9, 1, 1);
5441 
5442     {
5443 	Tcl_UniChar *ustring1, *ustring2, *ustring3, *end, *p;
5444 	int length3, endIdx;
5445 	Tcl_Obj *value3Ptr;
5446 
5447     case INST_STR_REPLACE:
5448 	value3Ptr = POP_OBJECT();
5449 	valuePtr = OBJ_AT_DEPTH(2);
5450 	endIdx = Tcl_GetCharLength(valuePtr) - 1;
5451 	TRACE(("\"%.20s\" %s %s \"%.20s\" => ", O2S(valuePtr),
5452 		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(value3Ptr)));
5453 	DECACHE_STACK_INFO();
5454 	if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, endIdx,
5455 		    &fromIdx) != TCL_OK
5456 	    || TclGetIntForIndexM(interp, OBJ_AT_TOS, endIdx,
5457 		    &toIdx) != TCL_OK) {
5458 	    CACHE_STACK_INFO();
5459 	    TclDecrRefCount(value3Ptr);
5460 	    TRACE_ERROR(interp);
5461 	    goto gotError;
5462 	}
5463 	CACHE_STACK_INFO();
5464 	TclDecrRefCount(OBJ_AT_TOS);
5465 	(void) POP_OBJECT();
5466 	TclDecrRefCount(OBJ_AT_TOS);
5467 	(void) POP_OBJECT();
5468 
5469 	if ((toIdx < 0) ||
5470 		(fromIdx > endIdx) ||
5471 		(toIdx < fromIdx)) {
5472 	    TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
5473 	    TclDecrRefCount(value3Ptr);
5474 	    NEXT_INST_F(1, 0, 0);
5475 	}
5476 
5477 	if (fromIdx < 0) {
5478 	    fromIdx = 0;
5479 	}
5480 
5481 	if (toIdx > endIdx) {
5482 	    toIdx = endIdx;
5483 	}
5484 
5485 	if (fromIdx == 0 && toIdx == endIdx) {
5486 	    TclDecrRefCount(OBJ_AT_TOS);
5487 	    OBJ_AT_TOS = value3Ptr;
5488 	    TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
5489 	    NEXT_INST_F(1, 0, 0);
5490 	}
5491 
5492 	objResultPtr = TclStringReplace(interp, valuePtr, fromIdx,
5493 		toIdx - fromIdx + 1, value3Ptr, TCL_STRING_IN_PLACE);
5494 
5495 	if (objResultPtr == value3Ptr) {
5496 	    /* See [Bug 82e7f67325] */
5497 	    TclDecrRefCount(OBJ_AT_TOS);
5498 	    OBJ_AT_TOS = value3Ptr;
5499 	    TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
5500 	    NEXT_INST_F(1, 0, 0);
5501 	}
5502 	TclDecrRefCount(value3Ptr);
5503 	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
5504 	NEXT_INST_F(1, 1, 1);
5505 
5506     case INST_STR_MAP:
5507 	valuePtr = OBJ_AT_TOS;		/* "Main" string. */
5508 	value3Ptr = OBJ_UNDER_TOS;	/* "Target" string. */
5509 	value2Ptr = OBJ_AT_DEPTH(2);	/* "Source" string. */
5510 	if (value3Ptr == value2Ptr) {
5511 	    objResultPtr = valuePtr;
5512 	    goto doneStringMap;
5513 	} else if (valuePtr == value2Ptr) {
5514 	    objResultPtr = value3Ptr;
5515 	    goto doneStringMap;
5516 	}
5517 	ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
5518 	if (length == 0) {
5519 	    objResultPtr = valuePtr;
5520 	    goto doneStringMap;
5521 	}
5522 	ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
5523 	if (length2 > length || length2 == 0) {
5524 	    objResultPtr = valuePtr;
5525 	    goto doneStringMap;
5526 	} else if (length2 == length) {
5527 	    if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length)) {
5528 		objResultPtr = valuePtr;
5529 	    } else {
5530 		objResultPtr = value3Ptr;
5531 	    }
5532 	    goto doneStringMap;
5533 	}
5534 	ustring3 = Tcl_GetUnicodeFromObj(value3Ptr, &length3);
5535 
5536 	objResultPtr = Tcl_NewUnicodeObj(ustring1, 0);
5537 	p = ustring1;
5538 	end = ustring1 + length;
5539 	for (; ustring1 < end; ustring1++) {
5540 	    if ((*ustring1 == *ustring2) && (length2==1 ||
5541 		    memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2)
5542 			    == 0)) {
5543 		if (p != ustring1) {
5544 		    Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1-p);
5545 		    p = ustring1 + length2;
5546 		} else {
5547 		    p += length2;
5548 		}
5549 		ustring1 = p - 1;
5550 
5551 		Tcl_AppendUnicodeToObj(objResultPtr, ustring3, length3);
5552 	    }
5553 	}
5554 	if (p != ustring1) {
5555 	    /*
5556 	     * Put the rest of the unmapped chars onto result.
5557 	     */
5558 
5559 	    Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1 - p);
5560 	}
5561     doneStringMap:
5562 	TRACE_WITH_OBJ(("%.20s %.20s %.20s => ",
5563 		O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr);
5564 	NEXT_INST_V(1, 3, 1);
5565 
5566     case INST_STR_FIND:
5567 	objResultPtr = TclStringFirst(OBJ_UNDER_TOS, OBJ_AT_TOS, 0);
5568 
5569 	TRACE(("%.20s %.20s => %s\n",
5570 		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(objResultPtr)));
5571 	NEXT_INST_F(1, 2, 1);
5572 
5573     case INST_STR_FIND_LAST:
5574 	objResultPtr = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, INT_MAX - 1);
5575 
5576 	TRACE(("%.20s %.20s => %s\n",
5577 		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(objResultPtr)));
5578 	NEXT_INST_F(1, 2, 1);
5579 
5580     case INST_STR_CLASS:
5581 	opnd = TclGetInt1AtPtr(pc+1);
5582 	valuePtr = OBJ_AT_TOS;
5583 	TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name,
5584 		O2S(valuePtr)));
5585 	ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
5586 	match = 1;
5587 	if (length > 0) {
5588 	    int ch;
5589 	    end = ustring1 + length;
5590 	    for (p=ustring1 ; p<end ; ) {
5591 		p += TclUniCharToUCS4(p, &ch);
5592 		if (!tclStringClassTable[opnd].comparator(ch)) {
5593 		    match = 0;
5594 		    break;
5595 		}
5596 	    }
5597 	}
5598 	TRACE_APPEND(("%d\n", match));
5599 	JUMP_PEEPHOLE_F(match, 2, 1);
5600     }
5601 
5602     case INST_STR_MATCH:
5603 	nocase = TclGetInt1AtPtr(pc+1);
5604 	valuePtr = OBJ_AT_TOS;		/* String */
5605 	value2Ptr = OBJ_UNDER_TOS;	/* Pattern */
5606 
5607 	/*
5608 	 * Check that at least one of the objects is Unicode before promoting
5609 	 * both.
5610 	 */
5611 
5612 	if (TclHasIntRep(valuePtr, &tclStringType)
5613 		|| TclHasIntRep(value2Ptr, &tclStringType)) {
5614 	    Tcl_UniChar *ustring1, *ustring2;
5615 
5616 	    ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
5617 	    ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
5618 	    match = TclUniCharMatch(ustring1, length, ustring2, length2,
5619 		    nocase);
5620 	} else if (TclIsPureByteArray(valuePtr) && !nocase) {
5621 	    unsigned char *bytes1, *bytes2;
5622 
5623 	    bytes1 = Tcl_GetByteArrayFromObj(valuePtr, &length);
5624 	    bytes2 = Tcl_GetByteArrayFromObj(value2Ptr, &length2);
5625 	    match = TclByteArrayMatch(bytes1, length, bytes2, length2, 0);
5626 	} else {
5627 	    match = Tcl_StringCaseMatch(TclGetString(valuePtr),
5628 		    TclGetString(value2Ptr), nocase);
5629 	}
5630 
5631 	/*
5632 	 * Reuse value2Ptr object already on stack if possible. Adjustment is
5633 	 * 2 due to the nocase byte
5634 	 */
5635 
5636 	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));
5637 
5638 	/*
5639 	 * Peep-hole optimisation: if you're about to jump, do jump from here.
5640 	 */
5641 
5642 	JUMP_PEEPHOLE_F(match, 2, 2);
5643 
5644     {
5645 	const char *string1, *string2;
5646 	int trim1, trim2;
5647 
5648     case INST_STR_TRIM_LEFT:
5649 	valuePtr = OBJ_UNDER_TOS;	/* String */
5650 	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
5651 	string2 = TclGetStringFromObj(value2Ptr, &length2);
5652 	string1 = TclGetStringFromObj(valuePtr, &length);
5653 	trim1 = TclTrimLeft(string1, length, string2, length2);
5654 	trim2 = 0;
5655 	goto createTrimmedString;
5656     case INST_STR_TRIM_RIGHT:
5657 	valuePtr = OBJ_UNDER_TOS;	/* String */
5658 	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
5659 	string2 = TclGetStringFromObj(value2Ptr, &length2);
5660 	string1 = TclGetStringFromObj(valuePtr, &length);
5661 	trim2 = TclTrimRight(string1, length, string2, length2);
5662 	trim1 = 0;
5663 	goto createTrimmedString;
5664     case INST_STR_TRIM:
5665 	valuePtr = OBJ_UNDER_TOS;	/* String */
5666 	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
5667 	string2 = TclGetStringFromObj(value2Ptr, &length2);
5668 	string1 = TclGetStringFromObj(valuePtr, &length);
5669 	trim1 = TclTrim(string1, length, string2, length2, &trim2);
5670     createTrimmedString:
5671 	/*
5672 	 * Careful here; trim set often contains non-ASCII characters so we
5673 	 * take care when printing. [Bug 971cb4f1db]
5674 	 */
5675 
5676 #ifdef TCL_COMPILE_DEBUG
5677 	if (traceInstructions) {
5678 	    TRACE(("\"%.30s\" ", O2S(valuePtr)));
5679 	    TclPrintObject(stdout, value2Ptr, 30);
5680 	    printf(" => ");
5681 	}
5682 #endif
5683 	if (trim1 == 0 && trim2 == 0) {
5684 #ifdef TCL_COMPILE_DEBUG
5685 	    if (traceInstructions) {
5686 		TclPrintObject(stdout, valuePtr, 30);
5687 		printf("\n");
5688 	    }
5689 #endif
5690 	    NEXT_INST_F(1, 1, 0);
5691 	} else {
5692 	    objResultPtr = Tcl_NewStringObj(string1+trim1, length-trim1-trim2);
5693 #ifdef TCL_COMPILE_DEBUG
5694 	    if (traceInstructions) {
5695 		TclPrintObject(stdout, objResultPtr, 30);
5696 		printf("\n");
5697 	    }
5698 #endif
5699 	    NEXT_INST_F(1, 2, 1);
5700 	}
5701     }
5702 
5703     case INST_REGEXP:
5704 	cflags = TclGetInt1AtPtr(pc+1); /* RE compile flages like NOCASE */
5705 	valuePtr = OBJ_AT_TOS;		/* String */
5706 	value2Ptr = OBJ_UNDER_TOS;	/* Pattern */
5707 	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
5708 
5709 	/*
5710 	 * Compile and match the regular expression.
5711 	 */
5712 
5713 	{
5714 	    Tcl_RegExp regExpr =
5715 		    Tcl_GetRegExpFromObj(interp, value2Ptr, cflags);
5716 
5717 	    if (regExpr == NULL) {
5718 		TRACE_ERROR(interp);
5719 		goto gotError;
5720 	    }
5721 	    match = Tcl_RegExpExecObj(interp, regExpr, valuePtr, 0, 0, 0);
5722 	    if (match < 0) {
5723 		TRACE_ERROR(interp);
5724 		goto gotError;
5725 	    }
5726 	}
5727 
5728 	TRACE_APPEND(("%d\n", match));
5729 
5730 	/*
5731 	 * Peep-hole optimisation: if you're about to jump, do jump from here.
5732 	 * Adjustment is 2 due to the nocase byte.
5733 	 */
5734 
5735 	JUMP_PEEPHOLE_F(match, 2, 2);
5736     }
5737 
5738     /*
5739      *	   End of string-related instructions.
5740      * -----------------------------------------------------------------
5741      *	   Start of numeric operator instructions.
5742      */
5743 
5744     {
5745 	ClientData ptr1, ptr2;
5746 	int type1, type2;
5747 	Tcl_WideInt w1, w2, wResult;
5748 
5749     case INST_NUM_TYPE:
5750 	if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
5751 	    type1 = 0;
5752 	} else if (type1 == TCL_NUMBER_BIG) {
5753 	    /* value is an integer outside the WIDE_MIN to WIDE_MAX range */
5754 	    /* [string is wideinteger] is WIDE_MIN to WIDE_MAX range */
5755 	    Tcl_WideInt w;
5756 
5757 	    if (TclGetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
5758 		type1 = TCL_NUMBER_INT;
5759 	    }
5760 	}
5761 	TclNewIntObj(objResultPtr, type1);
5762 	TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1));
5763 	NEXT_INST_F(1, 1, 1);
5764 
5765     case INST_EQ:
5766     case INST_NEQ:
5767     case INST_LT:
5768     case INST_GT:
5769     case INST_LE:
5770     case INST_GE: {
5771 	int iResult = 0, compare = 0;
5772 
5773 	value2Ptr = OBJ_AT_TOS;
5774 	valuePtr = OBJ_UNDER_TOS;
5775 
5776 	/*
5777 	    Try to determine, without triggering generation of a string
5778 	    representation, whether one value is not a number.
5779 	*/
5780 	if (TclCheckEmptyString(valuePtr) > 0 || TclCheckEmptyString(value2Ptr) > 0) {
5781 	    goto stringCompare;
5782 	}
5783 
5784 	if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK
5785 		|| GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK) {
5786 	    /*
5787 	     * At least one non-numeric argument - compare as strings.
5788 	     */
5789 
5790 	    goto stringCompare;
5791 	}
5792 	if (type1 == TCL_NUMBER_NAN || type2 == TCL_NUMBER_NAN) {
5793 	    /*
5794 	     * NaN arg: NaN != to everything, other compares are false.
5795 	     */
5796 
5797 	    iResult = (*pc == INST_NEQ);
5798 	    goto foundResult;
5799 	}
5800 	if (valuePtr == value2Ptr) {
5801 	    compare = MP_EQ;
5802 	    goto convertComparison;
5803 	}
5804 	if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
5805 	    w1 = *((const Tcl_WideInt *)ptr1);
5806 	    w2 = *((const Tcl_WideInt *)ptr2);
5807 	    compare = (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ);
5808 	} else {
5809 	    compare = TclCompareTwoNumbers(valuePtr, value2Ptr);
5810 	}
5811 
5812 	/*
5813 	 * Turn comparison outcome into appropriate result for opcode.
5814 	 */
5815 
5816     convertComparison:
5817 	switch (*pc) {
5818 	case INST_EQ:
5819 	    iResult = (compare == MP_EQ);
5820 	    break;
5821 	case INST_NEQ:
5822 	    iResult = (compare != MP_EQ);
5823 	    break;
5824 	case INST_LT:
5825 	    iResult = (compare == MP_LT);
5826 	    break;
5827 	case INST_GT:
5828 	    iResult = (compare == MP_GT);
5829 	    break;
5830 	case INST_LE:
5831 	    iResult = (compare != MP_GT);
5832 	    break;
5833 	case INST_GE:
5834 	    iResult = (compare != MP_LT);
5835 	    break;
5836 	}
5837 
5838 	/*
5839 	 * Peep-hole optimisation: if you're about to jump, do jump from here.
5840 	 */
5841 
5842     foundResult:
5843 	TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr),
5844 		iResult));
5845 	JUMP_PEEPHOLE_F(iResult, 1, 2);
5846     }
5847 
5848     case INST_MOD:
5849     case INST_LSHIFT:
5850     case INST_RSHIFT:
5851     case INST_BITOR:
5852     case INST_BITXOR:
5853     case INST_BITAND:
5854 	value2Ptr = OBJ_AT_TOS;
5855 	valuePtr = OBJ_UNDER_TOS;
5856 
5857 	if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
5858 		|| (type1==TCL_NUMBER_DOUBLE) || (type1==TCL_NUMBER_NAN)) {
5859 	    TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", O2S(valuePtr),
5860 		    O2S(value2Ptr), (valuePtr->typePtr?
5861 		    valuePtr->typePtr->name : "null")));
5862 	    DECACHE_STACK_INFO();
5863 	    IllegalExprOperandType(interp, pc, valuePtr);
5864 	    CACHE_STACK_INFO();
5865 	    goto gotError;
5866 	}
5867 
5868 	if ((GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK)
5869 		|| (type2==TCL_NUMBER_DOUBLE) || (type2==TCL_NUMBER_NAN)) {
5870 	    TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n", O2S(valuePtr),
5871 		    O2S(value2Ptr), (value2Ptr->typePtr?
5872 		    value2Ptr->typePtr->name : "null")));
5873 	    DECACHE_STACK_INFO();
5874 	    IllegalExprOperandType(interp, pc, value2Ptr);
5875 	    CACHE_STACK_INFO();
5876 	    goto gotError;
5877 	}
5878 
5879 	/*
5880 	 * Check for common, simple case.
5881 	 */
5882 
5883 	if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
5884 	    w1 = *((const Tcl_WideInt *)ptr1);
5885 	    w2 = *((const Tcl_WideInt *)ptr2);
5886 
5887 	    switch (*pc) {
5888 	    case INST_MOD:
5889 		if (w2 == 0) {
5890 		    TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr),
5891 			    O2S(value2Ptr)));
5892 		    goto divideByZero;
5893 		} else if ((w2 == 1) || (w2 == -1)) {
5894 		    /*
5895 		     * Div. by |1| always yields remainder of 0.
5896 		     */
5897 
5898 		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
5899 		    objResultPtr = TCONST(0);
5900 		    TRACE(("%s\n", O2S(objResultPtr)));
5901 		    NEXT_INST_F(1, 2, 1);
5902 		} else if (w1 == 0) {
5903 		    /*
5904 		     * 0 % (non-zero) always yields remainder of 0.
5905 		     */
5906 
5907 		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
5908 		    objResultPtr = TCONST(0);
5909 		    TRACE(("%s\n", O2S(objResultPtr)));
5910 		    NEXT_INST_F(1, 2, 1);
5911 		} else {
5912 		    wResult = w1 / w2;
5913 
5914 		    /*
5915 		     * Force Tcl's integer division rules.
5916 		     * TODO: examine for logic simplification
5917 		     */
5918 
5919 		    if ((wResult < 0 || (wResult == 0 &&
5920 			    ((w1 < 0 && w2 > 0) || (w1 > 0 && w2 < 0)))) &&
5921 			    (wResult * w2 != w1)) {
5922 			wResult -= 1;
5923 		    }
5924 		    wResult = w1 - w2*wResult;
5925 		    goto wideResultOfArithmetic;
5926 		}
5927 		break;
5928 
5929 	    case INST_RSHIFT:
5930 		if (w2 < 0) {
5931 		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
5932 			    "negative shift argument", -1));
5933 #ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
5934 		    DECACHE_STACK_INFO();
5935 		    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
5936 			    "domain error: argument not in valid range",
5937 			    NULL);
5938 		    CACHE_STACK_INFO();
5939 #endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
5940 		    goto gotError;
5941 		} else if (w1 == 0) {
5942 		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
5943 		    objResultPtr = TCONST(0);
5944 		    TRACE(("%s\n", O2S(objResultPtr)));
5945 		    NEXT_INST_F(1, 2, 1);
5946 		} else {
5947 		    /*
5948 		     * Quickly force large right shifts to 0 or -1.
5949 		     */
5950 
5951 		    if (w2 >= (Tcl_WideInt)(CHAR_BIT*sizeof(long))) {
5952 			/*
5953 			 * We assume that INT_MAX is much larger than the
5954 			 * number of bits in a long. This is a pretty safe
5955 			 * assumption, given that the former is usually around
5956 			 * 4e9 and the latter 32 or 64...
5957 			 */
5958 
5959 			TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
5960 			if (w1 > 0L) {
5961 			    objResultPtr = TCONST(0);
5962 			} else {
5963 			    TclNewIntObj(objResultPtr, -1);
5964 			}
5965 			TRACE(("%s\n", O2S(objResultPtr)));
5966 			NEXT_INST_F(1, 2, 1);
5967 		    }
5968 
5969 		    /*
5970 		     * Handle shifts within the native long range.
5971 		     */
5972 
5973 		    wResult = w1 >> ((int) w2);
5974 		    goto wideResultOfArithmetic;
5975 		}
5976 		break;
5977 
5978 	    case INST_LSHIFT:
5979 		if (w2 < 0) {
5980 		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
5981 			    "negative shift argument", -1));
5982 #ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
5983 		    DECACHE_STACK_INFO();
5984 		    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
5985 			    "domain error: argument not in valid range",
5986 			    NULL);
5987 		    CACHE_STACK_INFO();
5988 #endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
5989 		    goto gotError;
5990 		} else if (w1 == 0) {
5991 		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
5992 		    objResultPtr = TCONST(0);
5993 		    TRACE(("%s\n", O2S(objResultPtr)));
5994 		    NEXT_INST_F(1, 2, 1);
5995 		} else if (w2 > INT_MAX) {
5996 		    /*
5997 		     * Technically, we could hold the value (1 << (INT_MAX+1))
5998 		     * in an mp_int, but since we're using mp_mul_2d() to do
5999 		     * the work, and it takes only an int argument, that's a
6000 		     * good place to draw the line.
6001 		     */
6002 
6003 		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
6004 			    "integer value too large to represent", -1));
6005 #ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
6006 		    DECACHE_STACK_INFO();
6007 		    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
6008 			    "integer value too large to represent", NULL);
6009 		    CACHE_STACK_INFO();
6010 #endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
6011 		    goto gotError;
6012 		} else {
6013 		    int shift = (int) w2;
6014 
6015 		    /*
6016 		     * Handle shifts within the native long range.
6017 		     */
6018 
6019 		    if ((size_t) shift < CHAR_BIT*sizeof(long) && (w1 != 0)
6020 			    && !((w1>0 ? w1 : ~w1) &
6021 				-(1L<<(CHAR_BIT*sizeof(long) - 1 - shift)))) {
6022 			wResult = w1 << shift;
6023 			goto wideResultOfArithmetic;
6024 		    }
6025 		}
6026 
6027 		/*
6028 		 * Too large; need to use the broken-out function.
6029 		 */
6030 
6031 		TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
6032 		break;
6033 
6034 	    case INST_BITAND:
6035 		wResult = w1 & w2;
6036 		goto wideResultOfArithmetic;
6037 	    case INST_BITOR:
6038 		wResult = w1 | w2;
6039 		goto wideResultOfArithmetic;
6040 	    case INST_BITXOR:
6041 		wResult = w1 ^ w2;
6042 		goto wideResultOfArithmetic;
6043 	    }
6044 	}
6045 
6046 	/*
6047 	 * DO NOT MERGE THIS WITH THE EQUIVALENT SECTION LATER! That would
6048 	 * encourage the compiler to inline ExecuteExtendedBinaryMathOp, which
6049 	 * is highly undesirable due to the overall impact on size.
6050 	 */
6051 
6052 	TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
6053 	objResultPtr = ExecuteExtendedBinaryMathOp(interp, *pc, &TCONST(0),
6054 		valuePtr, value2Ptr);
6055 	if (objResultPtr == DIVIDED_BY_ZERO) {
6056 	    TRACE_APPEND(("DIVIDE BY ZERO\n"));
6057 	    goto divideByZero;
6058 	} else if (objResultPtr == GENERAL_ARITHMETIC_ERROR) {
6059 	    TRACE_ERROR(interp);
6060 	    goto gotError;
6061 	} else if (objResultPtr == NULL) {
6062 	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
6063 	    NEXT_INST_F(1, 1, 0);
6064 	} else {
6065 	    TRACE_APPEND(("%s\n", O2S(objResultPtr)));
6066 	    NEXT_INST_F(1, 2, 1);
6067 	}
6068 
6069     case INST_EXPON:
6070     case INST_ADD:
6071     case INST_SUB:
6072     case INST_DIV:
6073     case INST_MULT:
6074 	value2Ptr = OBJ_AT_TOS;
6075 	valuePtr = OBJ_UNDER_TOS;
6076 
6077 	if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
6078 		|| IsErroringNaNType(type1)) {
6079 	    TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n",
6080 		    O2S(value2Ptr), O2S(valuePtr),
6081 		    (valuePtr->typePtr? valuePtr->typePtr->name: "null")));
6082 	    DECACHE_STACK_INFO();
6083 	    IllegalExprOperandType(interp, pc, valuePtr);
6084 	    CACHE_STACK_INFO();
6085 	    goto gotError;
6086 	}
6087 
6088 #ifdef ACCEPT_NAN
6089 	if (type1 == TCL_NUMBER_NAN) {
6090 	    /*
6091 	     * NaN first argument -> result is also NaN.
6092 	     */
6093 
6094 	    NEXT_INST_F(1, 1, 0);
6095 	}
6096 #endif
6097 
6098 	if ((GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK)
6099 		|| IsErroringNaNType(type2)) {
6100 	    TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n",
6101 		    O2S(value2Ptr), O2S(valuePtr),
6102 		    (value2Ptr->typePtr? value2Ptr->typePtr->name: "null")));
6103 	    DECACHE_STACK_INFO();
6104 	    IllegalExprOperandType(interp, pc, value2Ptr);
6105 	    CACHE_STACK_INFO();
6106 	    goto gotError;
6107 	}
6108 
6109 #ifdef ACCEPT_NAN
6110 	if (type2 == TCL_NUMBER_NAN) {
6111 	    /*
6112 	     * NaN second argument -> result is also NaN.
6113 	     */
6114 
6115 	    objResultPtr = value2Ptr;
6116 	    NEXT_INST_F(1, 2, 1);
6117 	}
6118 #endif
6119 
6120 	/*
6121 	 * Handle (long,long) arithmetic as best we can without going out to
6122 	 * an external function.
6123 	 */
6124 
6125 	if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
6126 	    w1 = *((const Tcl_WideInt *)ptr1);
6127 	    w2 = *((const Tcl_WideInt *)ptr2);
6128 
6129 	    switch (*pc) {
6130 	    case INST_ADD:
6131 		wResult = w1 + w2;
6132 		/*
6133 		 * Check for overflow.
6134 		 */
6135 
6136 		if (Overflowing(w1, w2, wResult)) {
6137 		    goto overflow;
6138 		}
6139 		goto wideResultOfArithmetic;
6140 
6141 	    case INST_SUB:
6142 		wResult = w1 - w2;
6143 		/*
6144 		 * Must check for overflow. The macro tests for overflows in
6145 		 * sums by looking at the sign bits. As we have a subtraction
6146 		 * here, we are adding -w2. As -w2 could in turn overflow, we
6147 		 * test with ~w2 instead: it has the opposite sign bit to w2
6148 		 * so it does the job. Note that the only "bad" case (w2==0)
6149 		 * is irrelevant for this macro, as in that case w1 and
6150 		 * wResult have the same sign and there is no overflow anyway.
6151 		 */
6152 
6153 		if (Overflowing(w1, ~w2, wResult)) {
6154 		    goto overflow;
6155 		}
6156 	    wideResultOfArithmetic:
6157 		TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
6158 		if (Tcl_IsShared(valuePtr)) {
6159 		    TclNewIntObj(objResultPtr, wResult);
6160 		    TRACE(("%s\n", O2S(objResultPtr)));
6161 		    NEXT_INST_F(1, 2, 1);
6162 		}
6163 		TclSetIntObj(valuePtr, wResult);
6164 		TRACE(("%s\n", O2S(valuePtr)));
6165 		NEXT_INST_F(1, 1, 0);
6166 	    break;
6167 
6168 	    case INST_DIV:
6169 		if (w2 == 0) {
6170 		    TRACE(("%s %s => DIVIDE BY ZERO\n",
6171 			    O2S(valuePtr), O2S(value2Ptr)));
6172 		    goto divideByZero;
6173 		} else if ((w1 == WIDE_MIN) && (w2 == -1)) {
6174 		    /*
6175 		     * Can't represent (-WIDE_MIN) as a Tcl_WideInt.
6176 		     */
6177 
6178 		    goto overflow;
6179 		}
6180 		wResult = w1 / w2;
6181 
6182 		/*
6183 		 * Force Tcl's integer division rules.
6184 		 * TODO: examine for logic simplification
6185 		 */
6186 
6187 		if (((wResult < 0) || ((wResult == 0) &&
6188 			((w1 < 0 && w2 > 0) || (w1 > 0 && w2 < 0)))) &&
6189 			((wResult * w2) != w1)) {
6190 		    wResult -= 1;
6191 		}
6192 		goto wideResultOfArithmetic;
6193 
6194 	    case INST_MULT:
6195 		if (((sizeof(Tcl_WideInt) >= 2*sizeof(int))
6196 			&& (w1 <= INT_MAX) && (w1 >= INT_MIN)
6197 			&& (w2 <= INT_MAX) && (w2 >= INT_MIN))
6198 			|| ((sizeof(Tcl_WideInt) >= 2*sizeof(short))
6199 			&& (w1 <= SHRT_MAX) && (w1 >= SHRT_MIN)
6200 			&& (w2 <= SHRT_MAX) && (w2 >= SHRT_MIN))) {
6201 		    wResult = w1 * w2;
6202 		    goto wideResultOfArithmetic;
6203 		}
6204 	    }
6205 
6206 	    /*
6207 	     * Fall through with INST_EXPON, INST_DIV and large multiplies.
6208 	     */
6209 	}
6210 
6211     overflow:
6212 	TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
6213 	objResultPtr = ExecuteExtendedBinaryMathOp(interp, *pc, &TCONST(0),
6214 		valuePtr, value2Ptr);
6215 	if (objResultPtr == DIVIDED_BY_ZERO) {
6216 	    TRACE_APPEND(("DIVIDE BY ZERO\n"));
6217 	    goto divideByZero;
6218 	} else if (objResultPtr == EXPONENT_OF_ZERO) {
6219 	    TRACE_APPEND(("EXPONENT OF ZERO\n"));
6220 	    goto exponOfZero;
6221 	} else if (objResultPtr == GENERAL_ARITHMETIC_ERROR) {
6222 	    TRACE_ERROR(interp);
6223 	    goto gotError;
6224 	} else if (objResultPtr == OUT_OF_MEMORY) {
6225 	    TRACE_APPEND(("OUT OF MEMORY\n"));
6226 	    goto outOfMemory;
6227 	} else if (objResultPtr == NULL) {
6228 	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
6229 	    NEXT_INST_F(1, 1, 0);
6230 	} else {
6231 	    TRACE_APPEND(("%s\n", O2S(objResultPtr)));
6232 	    NEXT_INST_F(1, 2, 1);
6233 	}
6234 
6235     case INST_LNOT: {
6236 	int b;
6237 
6238 	valuePtr = OBJ_AT_TOS;
6239 
6240 	/* TODO - check claim that taking address of b harms performance */
6241 	/* TODO - consider optimization search for constants */
6242 	if (TclGetBooleanFromObj(NULL, valuePtr, &b) != TCL_OK) {
6243 	    TRACE(("\"%.20s\" => ERROR: illegal type %s\n", O2S(valuePtr),
6244 		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
6245 	    DECACHE_STACK_INFO();
6246 	    IllegalExprOperandType(interp, pc, valuePtr);
6247 	    CACHE_STACK_INFO();
6248 	    goto gotError;
6249 	}
6250 	/* TODO: Consider peephole opt. */
6251 	objResultPtr = TCONST(!b);
6252 	TRACE_WITH_OBJ(("%s => ", O2S(valuePtr)), objResultPtr);
6253 	NEXT_INST_F(1, 1, 1);
6254     }
6255 
6256     case INST_BITNOT:
6257 	valuePtr = OBJ_AT_TOS;
6258 	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
6259 	if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
6260 		|| (type1==TCL_NUMBER_NAN) || (type1==TCL_NUMBER_DOUBLE)) {
6261 	    /*
6262 	     * ... ~$NonInteger => raise an error.
6263 	     */
6264 
6265 	    TRACE_APPEND(("ERROR: illegal type %s\n",
6266 		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
6267 	    DECACHE_STACK_INFO();
6268 	    IllegalExprOperandType(interp, pc, valuePtr);
6269 	    CACHE_STACK_INFO();
6270 	    goto gotError;
6271 	}
6272 	if (type1 == TCL_NUMBER_INT) {
6273 	    w1 = *((const Tcl_WideInt *) ptr1);
6274 	    if (Tcl_IsShared(valuePtr)) {
6275 		TclNewIntObj(objResultPtr, ~w1);
6276 		TRACE_APPEND(("%s\n", O2S(objResultPtr)));
6277 		NEXT_INST_F(1, 1, 1);
6278 	    }
6279 	    TclSetIntObj(valuePtr, ~w1);
6280 	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
6281 	    NEXT_INST_F(1, 0, 0);
6282 	}
6283 	objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr);
6284 	if (objResultPtr != NULL) {
6285 	    TRACE_APPEND(("%s\n", O2S(objResultPtr)));
6286 	    NEXT_INST_F(1, 1, 1);
6287 	} else {
6288 	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
6289 	    NEXT_INST_F(1, 0, 0);
6290 	}
6291 
6292     case INST_UMINUS:
6293 	valuePtr = OBJ_AT_TOS;
6294 	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
6295 	if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
6296 		|| IsErroringNaNType(type1)) {
6297 	    TRACE_APPEND(("ERROR: illegal type %s \n",
6298 		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
6299 	    DECACHE_STACK_INFO();
6300 	    IllegalExprOperandType(interp, pc, valuePtr);
6301 	    CACHE_STACK_INFO();
6302 	    goto gotError;
6303 	}
6304 	switch (type1) {
6305 	case TCL_NUMBER_NAN:
6306 	    /* -NaN => NaN */
6307 	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
6308 	    NEXT_INST_F(1, 0, 0);
6309 	break;
6310 	case TCL_NUMBER_INT:
6311 	    w1 = *((const Tcl_WideInt *) ptr1);
6312 	    if (w1 != WIDE_MIN) {
6313 		if (Tcl_IsShared(valuePtr)) {
6314 		    TclNewIntObj(objResultPtr, -w1);
6315 		    TRACE_APPEND(("%s\n", O2S(objResultPtr)));
6316 		    NEXT_INST_F(1, 1, 1);
6317 		}
6318 		TclSetIntObj(valuePtr, -w1);
6319 		TRACE_APPEND(("%s\n", O2S(valuePtr)));
6320 		NEXT_INST_F(1, 0, 0);
6321 	    }
6322 	    /* FALLTHROUGH */
6323 	}
6324 	objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr);
6325 	if (objResultPtr != NULL) {
6326 	    TRACE_APPEND(("%s\n", O2S(objResultPtr)));
6327 	    NEXT_INST_F(1, 1, 1);
6328 	} else {
6329 	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
6330 	    NEXT_INST_F(1, 0, 0);
6331 	}
6332 
6333     case INST_UPLUS:
6334     case INST_TRY_CVT_TO_NUMERIC:
6335 	/*
6336 	 * Try to convert the topmost stack object to numeric object. This is
6337 	 * done in order to support [expr]'s policy of interpreting operands
6338 	 * if at all possible as numbers first, then strings.
6339 	 */
6340 
6341 	valuePtr = OBJ_AT_TOS;
6342 	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
6343 
6344 	if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) {
6345 	    if (*pc == INST_UPLUS) {
6346 		/*
6347 		 * ... +$NonNumeric => raise an error.
6348 		 */
6349 
6350 		TRACE_APPEND(("ERROR: illegal type %s\n",
6351 			(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
6352 		DECACHE_STACK_INFO();
6353 		IllegalExprOperandType(interp, pc, valuePtr);
6354 		CACHE_STACK_INFO();
6355 		goto gotError;
6356 	    }
6357 
6358 	    /* ... TryConvertToNumeric($NonNumeric) is acceptable */
6359 	    TRACE_APPEND(("not numeric\n"));
6360 	    NEXT_INST_F(1, 0, 0);
6361 	}
6362 	if (IsErroringNaNType(type1)) {
6363 	    if (*pc == INST_UPLUS) {
6364 		/*
6365 		 * ... +$NonNumeric => raise an error.
6366 		 */
6367 
6368 		TRACE_APPEND(("ERROR: illegal type %s\n",
6369 			(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
6370 		DECACHE_STACK_INFO();
6371 		IllegalExprOperandType(interp, pc, valuePtr);
6372 		CACHE_STACK_INFO();
6373 	    } else {
6374 		/*
6375 		 * Numeric conversion of NaN -> error.
6376 		 */
6377 
6378 		TRACE_APPEND(("ERROR: IEEE floating pt error\n"));
6379 		DECACHE_STACK_INFO();
6380 		TclExprFloatError(interp, *((const double *) ptr1));
6381 		CACHE_STACK_INFO();
6382 	    }
6383 	    goto gotError;
6384 	}
6385 
6386 	/*
6387 	 * Ensure that the numeric value has a string rep the same as the
6388 	 * formatted version of its internal rep. This is used, e.g., to make
6389 	 * sure that "expr {0001}" yields "1", not "0001". We implement this
6390 	 * by _discarding_ the string rep since we know it will be
6391 	 * regenerated, if needed later, by formatting the internal rep's
6392 	 * value.
6393 	 */
6394 
6395 	if (valuePtr->bytes == NULL) {
6396 	    TRACE_APPEND(("numeric, same Tcl_Obj\n"));
6397 	    NEXT_INST_F(1, 0, 0);
6398 	}
6399 	if (Tcl_IsShared(valuePtr)) {
6400 	    /*
6401 	     * Here we do some surgery within the Tcl_Obj internals. We want
6402 	     * to copy the intrep, but not the string, so we temporarily hide
6403 	     * the string so we do not copy it.
6404 	     */
6405 
6406 	    char *savedString = valuePtr->bytes;
6407 
6408 	    valuePtr->bytes = NULL;
6409 	    objResultPtr = Tcl_DuplicateObj(valuePtr);
6410 	    valuePtr->bytes = savedString;
6411 	    TRACE_APPEND(("numeric, new Tcl_Obj\n"));
6412 	    NEXT_INST_F(1, 1, 1);
6413 	}
6414 	TclInvalidateStringRep(valuePtr);
6415 	TRACE_APPEND(("numeric, same Tcl_Obj\n"));
6416 	NEXT_INST_F(1, 0, 0);
6417     }
6418     break;
6419 
6420     /*
6421      *	   End of numeric operator instructions.
6422      * -----------------------------------------------------------------
6423      */
6424 
6425     case INST_TRY_CVT_TO_BOOLEAN:
6426 	valuePtr = OBJ_AT_TOS;
6427 	if (TclHasIntRep(valuePtr,  &tclBooleanType)) {
6428 	    objResultPtr = TCONST(1);
6429 	} else {
6430 	    int res = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK);
6431 	    objResultPtr = TCONST(res);
6432 	}
6433 	TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr);
6434 	NEXT_INST_F(1, 0, 1);
6435     break;
6436 
6437     case INST_BREAK:
6438 	/*
6439 	DECACHE_STACK_INFO();
6440 	Tcl_ResetResult(interp);
6441 	CACHE_STACK_INFO();
6442 	*/
6443 	result = TCL_BREAK;
6444 	cleanup = 0;
6445 	TRACE(("=> BREAK!\n"));
6446 	goto processExceptionReturn;
6447 
6448     case INST_CONTINUE:
6449 	/*
6450 	DECACHE_STACK_INFO();
6451 	Tcl_ResetResult(interp);
6452 	CACHE_STACK_INFO();
6453 	*/
6454 	result = TCL_CONTINUE;
6455 	cleanup = 0;
6456 	TRACE(("=> CONTINUE!\n"));
6457 	goto processExceptionReturn;
6458 
6459     {
6460 	ForeachInfo *infoPtr;
6461 	Var *iterVarPtr, *listVarPtr;
6462 	Tcl_Obj *oldValuePtr, *listPtr, **elements;
6463 	ForeachVarList *varListPtr;
6464 	int numLists, listTmpIndex, listLen, numVars;
6465 	size_t iterNum;
6466 	int varIndex, valIndex, continueLoop, j, iterTmpIndex;
6467 	long i;
6468 
6469     case INST_FOREACH_START4: /* DEPRECATED */
6470 	/*
6471 	 * Initialize the temporary local var that holds the count of the
6472 	 * number of iterations of the loop body to -1.
6473 	 */
6474 
6475 	opnd = TclGetUInt4AtPtr(pc+1);
6476 	infoPtr = (ForeachInfo *)codePtr->auxDataArrayPtr[opnd].clientData;
6477 	iterTmpIndex = infoPtr->loopCtTemp;
6478 	iterVarPtr = LOCAL(iterTmpIndex);
6479 	oldValuePtr = iterVarPtr->value.objPtr;
6480 
6481 	if (oldValuePtr == NULL) {
6482 	    TclNewIntObj(iterVarPtr->value.objPtr, -1);
6483 	    Tcl_IncrRefCount(iterVarPtr->value.objPtr);
6484 	} else {
6485 	    TclSetIntObj(oldValuePtr, -1);
6486 	}
6487 	TRACE(("%u => loop iter count temp %d\n", opnd, iterTmpIndex));
6488 
6489 #ifndef TCL_COMPILE_DEBUG
6490 	/*
6491 	 * Remark that the compiler ALWAYS sets INST_FOREACH_STEP4 immediately
6492 	 * after INST_FOREACH_START4 - let us just fall through instead of
6493 	 * jumping back to the top.
6494 	 */
6495 
6496 	pc += 5;
6497 	TCL_DTRACE_INST_NEXT();
6498 #else
6499 	NEXT_INST_F(5, 0, 0);
6500 #endif
6501 
6502     case INST_FOREACH_STEP4: /* DEPRECATED */
6503 	/*
6504 	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
6505 	 * the next value list element to each loop var.
6506 	 */
6507 
6508 	opnd = TclGetUInt4AtPtr(pc+1);
6509 	TRACE(("%u => ", opnd));
6510 	infoPtr = (ForeachInfo *)codePtr->auxDataArrayPtr[opnd].clientData;
6511 	numLists = infoPtr->numLists;
6512 
6513 	/*
6514 	 * Increment the temp holding the loop iteration number.
6515 	 */
6516 
6517 	iterVarPtr = LOCAL(infoPtr->loopCtTemp);
6518 	valuePtr = iterVarPtr->value.objPtr;
6519 	iterNum = (size_t)valuePtr->internalRep.wideValue + 1;
6520 	TclSetIntObj(valuePtr, iterNum);
6521 
6522 	/*
6523 	 * Check whether all value lists are exhausted and we should stop the
6524 	 * loop.
6525 	 */
6526 
6527 	continueLoop = 0;
6528 	listTmpIndex = infoPtr->firstValueTemp;
6529 	for (i = 0;  i < numLists;  i++) {
6530 	    varListPtr = infoPtr->varLists[i];
6531 	    numVars = varListPtr->numVars;
6532 
6533 	    listVarPtr = LOCAL(listTmpIndex);
6534 	    listPtr = listVarPtr->value.objPtr;
6535 	    if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
6536 		TRACE_APPEND(("ERROR converting list %ld, \"%.30s\": %s\n",
6537 			i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
6538 		goto gotError;
6539 	    }
6540 	    if ((size_t)listLen > iterNum * numVars) {
6541 		continueLoop = 1;
6542 	    }
6543 	    listTmpIndex++;
6544 	}
6545 
6546 	/*
6547 	 * If some var in some var list still has a remaining list element
6548 	 * iterate one more time. Assign to var the next element from its
6549 	 * value list. We already checked above that each list temp holds a
6550 	 * valid list object (by calling Tcl_ListObjLength), but cannot rely
6551 	 * on that check remaining valid: one list could have been shimmered
6552 	 * as a side effect of setting a traced variable.
6553 	 */
6554 
6555 	if (continueLoop) {
6556 	    listTmpIndex = infoPtr->firstValueTemp;
6557 	    for (i = 0;  i < numLists;  i++) {
6558 		varListPtr = infoPtr->varLists[i];
6559 		numVars = varListPtr->numVars;
6560 
6561 		listVarPtr = LOCAL(listTmpIndex);
6562 		listPtr = TclListObjCopy(NULL, listVarPtr->value.objPtr);
6563 		TclListObjGetElements(interp, listPtr, &listLen, &elements);
6564 
6565 		valIndex = (iterNum * numVars);
6566 		for (j = 0;  j < numVars;  j++) {
6567 		    if (valIndex >= listLen) {
6568 			TclNewObj(valuePtr);
6569 		    } else {
6570 			valuePtr = elements[valIndex];
6571 		    }
6572 
6573 		    varIndex = varListPtr->varIndexes[j];
6574 		    varPtr = LOCAL(varIndex);
6575 		    while (TclIsVarLink(varPtr)) {
6576 			varPtr = varPtr->value.linkPtr;
6577 		    }
6578 		    if (TclIsVarDirectWritable(varPtr)) {
6579 			value2Ptr = varPtr->value.objPtr;
6580 			if (valuePtr != value2Ptr) {
6581 			    if (value2Ptr != NULL) {
6582 				TclDecrRefCount(value2Ptr);
6583 			    }
6584 			    varPtr->value.objPtr = valuePtr;
6585 			    Tcl_IncrRefCount(valuePtr);
6586 			}
6587 		    } else {
6588 			DECACHE_STACK_INFO();
6589 			if (TclPtrSetVarIdx(interp, varPtr, NULL, NULL, NULL,
6590 				valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
6591 			    CACHE_STACK_INFO();
6592 			    TRACE_APPEND((
6593 				    "ERROR init. index temp %d: %s\n",
6594 				    varIndex, O2S(Tcl_GetObjResult(interp))));
6595 			    TclDecrRefCount(listPtr);
6596 			    goto gotError;
6597 			}
6598 			CACHE_STACK_INFO();
6599 		    }
6600 		    valIndex++;
6601 		}
6602 		TclDecrRefCount(listPtr);
6603 		listTmpIndex++;
6604 	    }
6605 	}
6606 	TRACE_APPEND(("%d lists, iter %" TCL_Z_MODIFIER "u, %s loop\n",
6607 		numLists, iterNum, (continueLoop? "continue" : "exit")));
6608 
6609 	/*
6610 	 * Run-time peep-hole optimisation: the compiler ALWAYS follows
6611 	 * INST_FOREACH_STEP4 with an INST_JUMP_FALSE. We just skip that
6612 	 * instruction and jump direct from here.
6613 	 */
6614 
6615 	pc += 5;
6616 	if (*pc == INST_JUMP_FALSE1) {
6617 	    NEXT_INST_F((continueLoop? 2 : TclGetInt1AtPtr(pc+1)), 0, 0);
6618 	} else {
6619 	    NEXT_INST_F((continueLoop? 5 : TclGetInt4AtPtr(pc+1)), 0, 0);
6620 	}
6621 
6622     }
6623     {
6624 	ForeachInfo *infoPtr;
6625 	Tcl_Obj *listPtr, **elements;
6626 	ForeachVarList *varListPtr;
6627 	int numLists, listLen, numVars;
6628 	int listTmpDepth;
6629 	size_t iterNum, iterMax, iterTmp;
6630 	int varIndex, valIndex, j;
6631 	long i;
6632 
6633     case INST_FOREACH_START:
6634 	/*
6635 	 * Initialize the data for the looping construct, pushing the
6636 	 * corresponding Tcl_Objs to the stack.
6637 	 */
6638 
6639 	opnd = TclGetUInt4AtPtr(pc+1);
6640 	infoPtr = (ForeachInfo *)codePtr->auxDataArrayPtr[opnd].clientData;
6641 	numLists = infoPtr->numLists;
6642 	TRACE(("%u => ", opnd));
6643 
6644 	/*
6645 	 * Compute the number of iterations that will be run: iterMax
6646 	 */
6647 
6648 	iterMax = 0;
6649 	listTmpDepth = numLists-1;
6650 	for (i = 0;  i < numLists;  i++) {
6651 	    varListPtr = infoPtr->varLists[i];
6652 	    numVars = varListPtr->numVars;
6653 	    listPtr = OBJ_AT_DEPTH(listTmpDepth);
6654 	    if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
6655 		TRACE_APPEND(("ERROR converting list %ld, \"%s\": %s",
6656 			i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
6657 		goto gotError;
6658 	    }
6659 	    if (Tcl_IsShared(listPtr)) {
6660 		objPtr = TclListObjCopy(NULL, listPtr);
6661 		Tcl_IncrRefCount(objPtr);
6662 		Tcl_DecrRefCount(listPtr);
6663 		OBJ_AT_DEPTH(listTmpDepth) = objPtr;
6664 	    }
6665 	    iterTmp = (listLen + (numVars - 1))/numVars;
6666 	    if (iterTmp > iterMax) {
6667 		iterMax = iterTmp;
6668 	    }
6669 	    listTmpDepth--;
6670 	}
6671 
6672 	/*
6673 	 * Store the iterNum and iterMax in a single Tcl_Obj; we keep a
6674 	 * nul-string obj with the pointer stored in the ptrValue so that the
6675 	 * thing is properly garbage collected. THIS OBJ MAKES NO SENSE, but
6676 	 * it will never leave this scope and is read-only.
6677 	 */
6678 
6679 	TclNewObj(tmpPtr);
6680 	tmpPtr->internalRep.twoPtrValue.ptr1 = NULL;
6681 	tmpPtr->internalRep.twoPtrValue.ptr2 = (void *)iterMax;
6682 	PUSH_OBJECT(tmpPtr); /* iterCounts object */
6683 
6684 	/*
6685 	 * Store a pointer to the ForeachInfo struct; same dirty trick
6686 	 * as above
6687 	 */
6688 
6689 	TclNewObj(tmpPtr);
6690 	tmpPtr->internalRep.twoPtrValue.ptr1 = infoPtr;
6691 	PUSH_OBJECT(tmpPtr); /* infoPtr object */
6692 	TRACE_APPEND(("jump to loop step\n"));
6693 
6694 	/*
6695 	 * Jump directly to the INST_FOREACH_STEP instruction; the C code just
6696 	 * falls through.
6697 	 */
6698 
6699 	pc += 5 - infoPtr->loopCtTemp;
6700 
6701     case INST_FOREACH_STEP:
6702 	/*
6703 	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
6704 	 * the next value list element to each loop var.
6705 	 */
6706 
6707 	tmpPtr = OBJ_AT_TOS;
6708 	infoPtr = (ForeachInfo *)tmpPtr->internalRep.twoPtrValue.ptr1;
6709 	numLists = infoPtr->numLists;
6710 	TRACE(("=> "));
6711 
6712 	tmpPtr = OBJ_AT_DEPTH(1);
6713 	iterNum = (size_t)tmpPtr->internalRep.twoPtrValue.ptr1;
6714 	iterMax = (size_t)tmpPtr->internalRep.twoPtrValue.ptr2;
6715 
6716 	/*
6717 	 * If some list still has a remaining list element iterate one more
6718 	 * time. Assign to var the next element from its value list.
6719 	 */
6720 
6721 	if (iterNum < iterMax) {
6722 	    /*
6723 	     * Set the variables and jump back to run the body
6724 	     */
6725 
6726 	    tmpPtr->internalRep.twoPtrValue.ptr1 =(void *)(iterNum + 1);
6727 
6728 	    listTmpDepth = numLists + 1;
6729 
6730 	    for (i = 0;  i < numLists;  i++) {
6731 		varListPtr = infoPtr->varLists[i];
6732 		numVars = varListPtr->numVars;
6733 
6734 		listPtr = OBJ_AT_DEPTH(listTmpDepth);
6735 		TclListObjGetElements(interp, listPtr, &listLen, &elements);
6736 
6737 		valIndex = (iterNum * numVars);
6738 		for (j = 0;  j < numVars;  j++) {
6739 		    if (valIndex >= listLen) {
6740 			TclNewObj(valuePtr);
6741 		    } else {
6742 			valuePtr = elements[valIndex];
6743 		    }
6744 
6745 		    varIndex = varListPtr->varIndexes[j];
6746 		    varPtr = LOCAL(varIndex);
6747 		    while (TclIsVarLink(varPtr)) {
6748 			varPtr = varPtr->value.linkPtr;
6749 		    }
6750 		    if (TclIsVarDirectWritable(varPtr)) {
6751 			value2Ptr = varPtr->value.objPtr;
6752 			if (valuePtr != value2Ptr) {
6753 			    if (value2Ptr != NULL) {
6754 				TclDecrRefCount(value2Ptr);
6755 			    }
6756 			    varPtr->value.objPtr = valuePtr;
6757 			    Tcl_IncrRefCount(valuePtr);
6758 			}
6759 		    } else {
6760 			DECACHE_STACK_INFO();
6761 			if (TclPtrSetVarIdx(interp, varPtr, NULL, NULL, NULL,
6762 				valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
6763 			    CACHE_STACK_INFO();
6764 			    TRACE_APPEND(("ERROR init. index temp %d: %.30s",
6765 				    varIndex, O2S(Tcl_GetObjResult(interp))));
6766 			    goto gotError;
6767 			}
6768 			CACHE_STACK_INFO();
6769 		    }
6770 		    valIndex++;
6771 		}
6772 		listTmpDepth--;
6773 	    }
6774 	    TRACE_APPEND(("jump to loop start\n"));
6775 	    /* loopCtTemp being 'misused' for storing the jump size */
6776 	    NEXT_INST_F(infoPtr->loopCtTemp, 0, 0);
6777 	}
6778 
6779 	TRACE_APPEND(("loop has no more iterations\n"));
6780 #ifdef TCL_COMPILE_DEBUG
6781 	NEXT_INST_F(1, 0, 0);
6782 #else
6783 	/*
6784 	 * FALL THROUGH
6785 	 */
6786 	pc++;
6787 #endif
6788 
6789     case INST_FOREACH_END:
6790 	/* THIS INSTRUCTION IS ONLY CALLED AS A BREAK TARGET */
6791 	tmpPtr = OBJ_AT_TOS;
6792 	infoPtr = (ForeachInfo *)tmpPtr->internalRep.twoPtrValue.ptr1;
6793 	numLists = infoPtr->numLists;
6794 	TRACE(("=> loop terminated\n"));
6795 	NEXT_INST_V(1, numLists+2, 0);
6796 
6797     case INST_LMAP_COLLECT:
6798 	/*
6799 	 * This instruction is only issued by lmap. The stack is:
6800 	 *   - result
6801 	 *   - infoPtr
6802 	 *   - loop counters
6803 	 *   - valLists
6804 	 *   - collecting obj (unshared)
6805 	 * The instruction lappends the result to the collecting obj.
6806 	 */
6807 
6808 	tmpPtr = OBJ_AT_DEPTH(1);
6809 	infoPtr = (ForeachInfo *)tmpPtr->internalRep.twoPtrValue.ptr1;
6810 	numLists = infoPtr->numLists;
6811 	TRACE_APPEND(("=> appending to list at depth %d\n", 3 + numLists));
6812 
6813 	objPtr = OBJ_AT_DEPTH(3 + numLists);
6814 	Tcl_ListObjAppendElement(NULL, objPtr, OBJ_AT_TOS);
6815 	NEXT_INST_F(1, 1, 0);
6816     }
6817     break;
6818 
6819     case INST_BEGIN_CATCH4:
6820 	/*
6821 	 * Record start of the catch command with exception range index equal
6822 	 * to the operand. Push the current stack depth onto the special catch
6823 	 * stack.
6824 	 */
6825 
6826 	*(++catchTop) = CURR_DEPTH;
6827 	TRACE(("%u => catchTop=%d, stackTop=%d\n",
6828 		TclGetUInt4AtPtr(pc+1), (int) (catchTop - initCatchTop - 1),
6829 		(int) CURR_DEPTH));
6830 	NEXT_INST_F(5, 0, 0);
6831     break;
6832 
6833     case INST_END_CATCH:
6834 	catchTop--;
6835 	DECACHE_STACK_INFO();
6836 	Tcl_ResetResult(interp);
6837 	CACHE_STACK_INFO();
6838 	result = TCL_OK;
6839 	TRACE(("=> catchTop=%d\n", (int) (catchTop - initCatchTop - 1)));
6840 	NEXT_INST_F(1, 0, 0);
6841     break;
6842 
6843     case INST_PUSH_RESULT:
6844 	objResultPtr = Tcl_GetObjResult(interp);
6845 	TRACE_WITH_OBJ(("=> "), objResultPtr);
6846 
6847 	/*
6848 	 * See the comments at INST_INVOKE_STK
6849 	 */
6850 
6851 	TclNewObj(objPtr);
6852 	Tcl_IncrRefCount(objPtr);
6853 	iPtr->objResultPtr = objPtr;
6854 	NEXT_INST_F(1, 0, -1);
6855     break;
6856 
6857     case INST_PUSH_RETURN_CODE:
6858 	TclNewIntObj(objResultPtr, result);
6859 	TRACE(("=> %u\n", result));
6860 	NEXT_INST_F(1, 0, 1);
6861     break;
6862 
6863     case INST_PUSH_RETURN_OPTIONS:
6864 	DECACHE_STACK_INFO();
6865 	objResultPtr = Tcl_GetReturnOptions(interp, result);
6866 	CACHE_STACK_INFO();
6867 	TRACE_WITH_OBJ(("=> "), objResultPtr);
6868 	NEXT_INST_F(1, 0, 1);
6869     break;
6870 
6871     case INST_RETURN_CODE_BRANCH: {
6872 	int code;
6873 
6874 	if (TclGetIntFromObj(NULL, OBJ_AT_TOS, &code) != TCL_OK) {
6875 	    Tcl_Panic("INST_RETURN_CODE_BRANCH: TOS not a return code!");
6876 	}
6877 	if (code == TCL_OK) {
6878 	    Tcl_Panic("INST_RETURN_CODE_BRANCH: TOS is TCL_OK!");
6879 	}
6880 	if (code < TCL_ERROR || code > TCL_CONTINUE) {
6881 	    code = TCL_CONTINUE + 1;
6882 	}
6883 	TRACE(("\"%s\" => jump offset %d\n", O2S(OBJ_AT_TOS), 2*code-1));
6884 	NEXT_INST_F(2*code-1, 1, 0);
6885     }
6886 
6887     /*
6888      * -----------------------------------------------------------------
6889      *	   Start of dictionary-related instructions.
6890      */
6891 
6892     {
6893 	int opnd2, allocateDict, done, i, allocdict;
6894 	Tcl_Obj *dictPtr, *statePtr, *keyPtr, *listPtr, *varNamePtr, *keysPtr;
6895 	Tcl_Obj *emptyPtr, **keyPtrPtr;
6896 	Tcl_DictSearch *searchPtr;
6897 	DictUpdateInfo *duiPtr;
6898 
6899     case INST_DICT_VERIFY:
6900 	dictPtr = OBJ_AT_TOS;
6901 	TRACE(("\"%.30s\" => ", O2S(dictPtr)));
6902 	if (Tcl_DictObjSize(interp, dictPtr, &done) != TCL_OK) {
6903 	    TRACE_APPEND(("ERROR verifying dictionary nature of \"%.30s\": %s\n",
6904 		    O2S(dictPtr), O2S(Tcl_GetObjResult(interp))));
6905 	    goto gotError;
6906 	}
6907 	TRACE_APPEND(("OK\n"));
6908 	NEXT_INST_F(1, 1, 0);
6909     break;
6910 
6911     case INST_DICT_EXISTS: {
6912 	int found;
6913 
6914 	opnd = TclGetUInt4AtPtr(pc+1);
6915 	TRACE(("%u => ", opnd));
6916 	dictPtr = OBJ_AT_DEPTH(opnd);
6917 	if (opnd > 1) {
6918 	    dictPtr = TclTraceDictPath(NULL, dictPtr, opnd-1,
6919 		    &OBJ_AT_DEPTH(opnd-1), DICT_PATH_EXISTS);
6920 	    if (dictPtr == NULL || dictPtr == DICT_PATH_NON_EXISTENT) {
6921 		found = 0;
6922 		goto afterDictExists;
6923 	    }
6924 	}
6925 	if (Tcl_DictObjGet(NULL, dictPtr, OBJ_AT_TOS,
6926 		&objResultPtr) == TCL_OK) {
6927 	    found = (objResultPtr ? 1 : 0);
6928 	} else {
6929 	    found = 0;
6930 	}
6931     afterDictExists:
6932 	TRACE_APPEND(("%d\n", found));
6933 
6934 	/*
6935 	 * The INST_DICT_EXISTS instruction is usually followed by a
6936 	 * conditional jump, so we can take advantage of this to do some
6937 	 * peephole optimization (note that we're careful to not close out
6938 	 * someone doing something else).
6939 	 */
6940 
6941 	JUMP_PEEPHOLE_V(found, 5, opnd+1);
6942     }
6943     case INST_DICT_GET:
6944 	opnd = TclGetUInt4AtPtr(pc+1);
6945 	TRACE(("%u => ", opnd));
6946 	dictPtr = OBJ_AT_DEPTH(opnd);
6947 	if (opnd > 1) {
6948 	    dictPtr = TclTraceDictPath(interp, dictPtr, opnd-1,
6949 		    &OBJ_AT_DEPTH(opnd-1), DICT_PATH_READ);
6950 	    if (dictPtr == NULL) {
6951 		TRACE_WITH_OBJ((
6952 			"ERROR tracing dictionary path into \"%.30s\": ",
6953 			O2S(OBJ_AT_DEPTH(opnd))),
6954 			Tcl_GetObjResult(interp));
6955 		goto gotError;
6956 	    }
6957 	}
6958 	if (Tcl_DictObjGet(interp, dictPtr, OBJ_AT_TOS,
6959 		&objResultPtr) != TCL_OK) {
6960 	    TRACE_APPEND(("ERROR reading leaf dictionary key \"%.30s\": %s",
6961 		    O2S(dictPtr), O2S(Tcl_GetObjResult(interp))));
6962 	    goto gotError;
6963 	}
6964 	if (!objResultPtr) {
6965 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
6966 		    "key \"%s\" not known in dictionary",
6967 		    TclGetString(OBJ_AT_TOS)));
6968 	    DECACHE_STACK_INFO();
6969 	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
6970 		    TclGetString(OBJ_AT_TOS), NULL);
6971 	    CACHE_STACK_INFO();
6972 	    TRACE_ERROR(interp);
6973 	    goto gotError;
6974 	}
6975 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
6976 	NEXT_INST_V(5, opnd+1, 1);
6977     case INST_DICT_GET_DEF:
6978 	opnd = TclGetUInt4AtPtr(pc+1);
6979 	TRACE(("%u => ", opnd));
6980 	dictPtr = OBJ_AT_DEPTH(opnd+1);
6981 	if (opnd > 1) {
6982 	    dictPtr = TclTraceDictPath(interp, dictPtr, opnd-1,
6983 		    &OBJ_AT_DEPTH(opnd), DICT_PATH_EXISTS);
6984 	    if (dictPtr == NULL) {
6985 		TRACE_WITH_OBJ((
6986 			"ERROR tracing dictionary path into \"%.30s\": ",
6987 			O2S(OBJ_AT_DEPTH(opnd+1))),
6988 			Tcl_GetObjResult(interp));
6989 		goto gotError;
6990 	    } else if (dictPtr == DICT_PATH_NON_EXISTENT) {
6991 		goto dictGetDefUseDefault;
6992 	    }
6993 	}
6994 	if (Tcl_DictObjGet(interp, dictPtr, OBJ_UNDER_TOS,
6995 		&objResultPtr) != TCL_OK) {
6996 	    TRACE_APPEND(("ERROR reading leaf dictionary key \"%.30s\": %s",
6997 		    O2S(dictPtr), O2S(Tcl_GetObjResult(interp))));
6998 	    goto gotError;
6999 	} else if (!objResultPtr) {
7000 	dictGetDefUseDefault:
7001 	    objResultPtr = OBJ_AT_TOS;
7002 	}
7003 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
7004 	NEXT_INST_V(5, opnd+2, 1);
7005 
7006     case INST_DICT_SET:
7007     case INST_DICT_UNSET:
7008     case INST_DICT_INCR_IMM:
7009 	opnd = TclGetUInt4AtPtr(pc+1);
7010 	opnd2 = TclGetUInt4AtPtr(pc+5);
7011 
7012 	varPtr = LOCAL(opnd2);
7013 	while (TclIsVarLink(varPtr)) {
7014 	    varPtr = varPtr->value.linkPtr;
7015 	}
7016 	TRACE(("%u %u => ", opnd, opnd2));
7017 	if (TclIsVarDirectReadable(varPtr)) {
7018 	    dictPtr = varPtr->value.objPtr;
7019 	} else {
7020 	    DECACHE_STACK_INFO();
7021 	    dictPtr = TclPtrGetVarIdx(interp, varPtr, NULL, NULL, NULL, 0,
7022 		    opnd2);
7023 	    CACHE_STACK_INFO();
7024 	}
7025 	if (dictPtr == NULL) {
7026 	    TclNewObj(dictPtr);
7027 	    allocateDict = 1;
7028 	} else {
7029 	    allocateDict = Tcl_IsShared(dictPtr);
7030 	    if (allocateDict) {
7031 		dictPtr = Tcl_DuplicateObj(dictPtr);
7032 	    }
7033 	}
7034 
7035 	switch (*pc) {
7036 	case INST_DICT_SET:
7037 	    cleanup = opnd + 1;
7038 	    result = Tcl_DictObjPutKeyList(interp, dictPtr, opnd,
7039 		    &OBJ_AT_DEPTH(opnd), OBJ_AT_TOS);
7040 	    break;
7041 	case INST_DICT_INCR_IMM:
7042 	    cleanup = 1;
7043 	    opnd = TclGetInt4AtPtr(pc+1);
7044 	    result = Tcl_DictObjGet(interp, dictPtr, OBJ_AT_TOS, &valuePtr);
7045 	    if (result != TCL_OK) {
7046 		break;
7047 	    }
7048 	    if (valuePtr == NULL) {
7049 		Tcl_DictObjPut(NULL, dictPtr, OBJ_AT_TOS, Tcl_NewWideIntObj(opnd));
7050 	    } else {
7051 		TclNewIntObj(value2Ptr, opnd);
7052 		Tcl_IncrRefCount(value2Ptr);
7053 		if (Tcl_IsShared(valuePtr)) {
7054 		    valuePtr = Tcl_DuplicateObj(valuePtr);
7055 		    Tcl_DictObjPut(NULL, dictPtr, OBJ_AT_TOS, valuePtr);
7056 		}
7057 		result = TclIncrObj(interp, valuePtr, value2Ptr);
7058 		if (result == TCL_OK) {
7059 		    TclInvalidateStringRep(dictPtr);
7060 		}
7061 		TclDecrRefCount(value2Ptr);
7062 	    }
7063 	    break;
7064 	case INST_DICT_UNSET:
7065 	    cleanup = opnd;
7066 	    result = Tcl_DictObjRemoveKeyList(interp, dictPtr, opnd,
7067 		    &OBJ_AT_DEPTH(opnd-1));
7068 	    break;
7069 	default:
7070 	    cleanup = 0; /* stop compiler warning */
7071 	    Tcl_Panic("Should not happen!");
7072 	}
7073 
7074 	if (result != TCL_OK) {
7075 	    if (allocateDict) {
7076 		TclDecrRefCount(dictPtr);
7077 	    }
7078 	    TRACE_APPEND(("ERROR updating dictionary: %s\n",
7079 		    O2S(Tcl_GetObjResult(interp))));
7080 	    goto checkForCatch;
7081 	}
7082 
7083 	if (TclIsVarDirectWritable(varPtr)) {
7084 	    if (allocateDict) {
7085 		value2Ptr = varPtr->value.objPtr;
7086 		Tcl_IncrRefCount(dictPtr);
7087 		if (value2Ptr != NULL) {
7088 		    TclDecrRefCount(value2Ptr);
7089 		}
7090 		varPtr->value.objPtr = dictPtr;
7091 	    }
7092 	    objResultPtr = dictPtr;
7093 	} else {
7094 	    Tcl_IncrRefCount(dictPtr);
7095 	    DECACHE_STACK_INFO();
7096 	    objResultPtr = TclPtrSetVarIdx(interp, varPtr, NULL, NULL, NULL,
7097 		    dictPtr, TCL_LEAVE_ERR_MSG, opnd2);
7098 	    CACHE_STACK_INFO();
7099 	    TclDecrRefCount(dictPtr);
7100 	    if (objResultPtr == NULL) {
7101 		TRACE_ERROR(interp);
7102 		goto gotError;
7103 	    }
7104 	}
7105 #ifndef TCL_COMPILE_DEBUG
7106 	if (*(pc+9) == INST_POP) {
7107 	    NEXT_INST_V(10, cleanup, 0);
7108 	}
7109 #endif
7110 	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
7111 	NEXT_INST_V(9, cleanup, 1);
7112 
7113     case INST_DICT_APPEND:
7114     case INST_DICT_LAPPEND:
7115 	opnd = TclGetUInt4AtPtr(pc+1);
7116 	varPtr = LOCAL(opnd);
7117 	while (TclIsVarLink(varPtr)) {
7118 	    varPtr = varPtr->value.linkPtr;
7119 	}
7120 	TRACE(("%u => ", opnd));
7121 	if (TclIsVarDirectReadable(varPtr)) {
7122 	    dictPtr = varPtr->value.objPtr;
7123 	} else {
7124 	    DECACHE_STACK_INFO();
7125 	    dictPtr = TclPtrGetVarIdx(interp, varPtr, NULL, NULL, NULL, 0,
7126 		    opnd);
7127 	    CACHE_STACK_INFO();
7128 	}
7129 	if (dictPtr == NULL) {
7130 	    TclNewObj(dictPtr);
7131 	    allocateDict = 1;
7132 	} else {
7133 	    allocateDict = Tcl_IsShared(dictPtr);
7134 	    if (allocateDict) {
7135 		dictPtr = Tcl_DuplicateObj(dictPtr);
7136 	    }
7137 	}
7138 
7139 	if (Tcl_DictObjGet(interp, dictPtr, OBJ_UNDER_TOS,
7140 		&valuePtr) != TCL_OK) {
7141 	    if (allocateDict) {
7142 		TclDecrRefCount(dictPtr);
7143 	    }
7144 	    TRACE_ERROR(interp);
7145 	    goto gotError;
7146 	}
7147 
7148 	/*
7149 	 * Note that a non-existent key results in a NULL valuePtr, which is a
7150 	 * case handled separately below. What we *can* say at this point is
7151 	 * that the write-back will always succeed.
7152 	 */
7153 
7154 	switch (*pc) {
7155 	case INST_DICT_APPEND:
7156 	    if (valuePtr == NULL) {
7157 		Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, OBJ_AT_TOS);
7158 	    } else if (Tcl_IsShared(valuePtr)) {
7159 		valuePtr = Tcl_DuplicateObj(valuePtr);
7160 		Tcl_AppendObjToObj(valuePtr, OBJ_AT_TOS);
7161 		Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, valuePtr);
7162 	    } else {
7163 		Tcl_AppendObjToObj(valuePtr, OBJ_AT_TOS);
7164 
7165 		/*
7166 		 * Must invalidate the string representation of dictionary
7167 		 * here because we have directly updated the internal
7168 		 * representation; if we don't, callers could see the wrong
7169 		 * string rep despite the internal version of the dictionary
7170 		 * having the correct value. [Bug 3079830]
7171 		 */
7172 
7173 		TclInvalidateStringRep(dictPtr);
7174 	    }
7175 	    break;
7176 	case INST_DICT_LAPPEND:
7177 	    /*
7178 	     * More complex because list-append can fail.
7179 	     */
7180 
7181 	    if (valuePtr == NULL) {
7182 		Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS,
7183 			Tcl_NewListObj(1, &OBJ_AT_TOS));
7184 		break;
7185 	    } else if (Tcl_IsShared(valuePtr)) {
7186 		valuePtr = Tcl_DuplicateObj(valuePtr);
7187 		if (Tcl_ListObjAppendElement(interp, valuePtr,
7188 			OBJ_AT_TOS) != TCL_OK) {
7189 		    TclDecrRefCount(valuePtr);
7190 		    if (allocateDict) {
7191 			TclDecrRefCount(dictPtr);
7192 		    }
7193 		    TRACE_ERROR(interp);
7194 		    goto gotError;
7195 		}
7196 		Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, valuePtr);
7197 	    } else {
7198 		if (Tcl_ListObjAppendElement(interp, valuePtr,
7199 			OBJ_AT_TOS) != TCL_OK) {
7200 		    if (allocateDict) {
7201 			TclDecrRefCount(dictPtr);
7202 		    }
7203 		    TRACE_ERROR(interp);
7204 		    goto gotError;
7205 		}
7206 
7207 		/*
7208 		 * Must invalidate the string representation of dictionary
7209 		 * here because we have directly updated the internal
7210 		 * representation; if we don't, callers could see the wrong
7211 		 * string rep despite the internal version of the dictionary
7212 		 * having the correct value. [Bug 3079830]
7213 		 */
7214 
7215 		TclInvalidateStringRep(dictPtr);
7216 	    }
7217 	    break;
7218 	default:
7219 	    Tcl_Panic("Should not happen!");
7220 	}
7221 
7222 	if (TclIsVarDirectWritable(varPtr)) {
7223 	    if (allocateDict) {
7224 		value2Ptr = varPtr->value.objPtr;
7225 		Tcl_IncrRefCount(dictPtr);
7226 		if (value2Ptr != NULL) {
7227 		    TclDecrRefCount(value2Ptr);
7228 		}
7229 		varPtr->value.objPtr = dictPtr;
7230 	    }
7231 	    objResultPtr = dictPtr;
7232 	} else {
7233 	    Tcl_IncrRefCount(dictPtr);
7234 	    DECACHE_STACK_INFO();
7235 	    objResultPtr = TclPtrSetVarIdx(interp, varPtr, NULL, NULL, NULL,
7236 		    dictPtr, TCL_LEAVE_ERR_MSG, opnd);
7237 	    CACHE_STACK_INFO();
7238 	    TclDecrRefCount(dictPtr);
7239 	    if (objResultPtr == NULL) {
7240 		TRACE_ERROR(interp);
7241 		goto gotError;
7242 	    }
7243 	}
7244 #ifndef TCL_COMPILE_DEBUG
7245 	if (*(pc+5) == INST_POP) {
7246 	    NEXT_INST_F(6, 2, 0);
7247 	}
7248 #endif
7249 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
7250 	NEXT_INST_F(5, 2, 1);
7251 
7252     case INST_DICT_FIRST:
7253 	opnd = TclGetUInt4AtPtr(pc+1);
7254 	TRACE(("%u => ", opnd));
7255 	dictPtr = POP_OBJECT();
7256 	searchPtr = (Tcl_DictSearch *)ckalloc(sizeof(Tcl_DictSearch));
7257 	if (Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr,
7258 		&valuePtr, &done) != TCL_OK) {
7259 
7260 	    /*
7261 	     * dictPtr is no longer on the stack, and we're not
7262 	     * moving it into the intrep of an iterator.  We need
7263 	     * to drop the refcount [Tcl Bug 9b352768e6].
7264 	     */
7265 
7266 	    Tcl_DecrRefCount(dictPtr);
7267 	    ckfree(searchPtr);
7268 	    TRACE_ERROR(interp);
7269 	    goto gotError;
7270 	}
7271 	{
7272 	    Tcl_ObjIntRep ir;
7273 	    TclNewObj(statePtr);
7274 	    ir.twoPtrValue.ptr1 = searchPtr;
7275 	    ir.twoPtrValue.ptr2 = dictPtr;
7276 	    Tcl_StoreIntRep(statePtr, &dictIteratorType, &ir);
7277 	}
7278 	varPtr = LOCAL(opnd);
7279 	if (varPtr->value.objPtr) {
7280 	    if (TclHasIntRep(varPtr->value.objPtr, &dictIteratorType)) {
7281 		Tcl_Panic("mis-issued dictFirst!");
7282 	    }
7283 	    TclDecrRefCount(varPtr->value.objPtr);
7284 	}
7285 	varPtr->value.objPtr = statePtr;
7286 	Tcl_IncrRefCount(statePtr);
7287 	goto pushDictIteratorResult;
7288 
7289     case INST_DICT_NEXT:
7290 	opnd = TclGetUInt4AtPtr(pc+1);
7291 	TRACE(("%u => ", opnd));
7292 	statePtr = (*LOCAL(opnd)).value.objPtr;
7293 	{
7294 	    const Tcl_ObjIntRep *irPtr;
7295 
7296 	    if (statePtr &&
7297 		    (irPtr = TclFetchIntRep(statePtr, &dictIteratorType))) {
7298 		searchPtr = (Tcl_DictSearch *)irPtr->twoPtrValue.ptr1;
7299 		Tcl_DictObjNext(searchPtr, &keyPtr, &valuePtr, &done);
7300 	    } else {
7301 		Tcl_Panic("mis-issued dictNext!");
7302 	    }
7303 	}
7304     pushDictIteratorResult:
7305 	if (done) {
7306 	    TclNewObj(emptyPtr);
7307 	    PUSH_OBJECT(emptyPtr);
7308 	    PUSH_OBJECT(emptyPtr);
7309 	} else {
7310 	    PUSH_OBJECT(valuePtr);
7311 	    PUSH_OBJECT(keyPtr);
7312 	}
7313 	TRACE_APPEND(("\"%.30s\" \"%.30s\" %d\n",
7314 		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done));
7315 
7316 	/*
7317 	 * The INST_DICT_FIRST and INST_DICT_NEXT instructsions are always
7318 	 * followed by a conditional jump, so we can take advantage of this to
7319 	 * do some peephole optimization (note that we're careful to not close
7320 	 * out someone doing something else).
7321 	 */
7322 
7323 	JUMP_PEEPHOLE_F(done, 5, 0);
7324 
7325     case INST_DICT_UPDATE_START:
7326 	opnd = TclGetUInt4AtPtr(pc+1);
7327 	opnd2 = TclGetUInt4AtPtr(pc+5);
7328 	TRACE(("%u => ", opnd));
7329 	varPtr = LOCAL(opnd);
7330 	duiPtr = (DictUpdateInfo *)codePtr->auxDataArrayPtr[opnd2].clientData;
7331 	while (TclIsVarLink(varPtr)) {
7332 	    varPtr = varPtr->value.linkPtr;
7333 	}
7334 	if (TclIsVarDirectReadable(varPtr)) {
7335 	    dictPtr = varPtr->value.objPtr;
7336 	} else {
7337 	    DECACHE_STACK_INFO();
7338 	    dictPtr = TclPtrGetVarIdx(interp, varPtr, NULL, NULL, NULL,
7339 		    TCL_LEAVE_ERR_MSG, opnd);
7340 	    CACHE_STACK_INFO();
7341 	    if (dictPtr == NULL) {
7342 		TRACE_ERROR(interp);
7343 		goto gotError;
7344 	    }
7345 	}
7346 	Tcl_IncrRefCount(dictPtr);
7347 	if (TclListObjGetElements(interp, OBJ_AT_TOS, &length,
7348 		&keyPtrPtr) != TCL_OK) {
7349 	    TRACE_ERROR(interp);
7350 	    goto gotError;
7351 	}
7352 	if (length != duiPtr->length) {
7353 	    Tcl_Panic("dictUpdateStart argument length mismatch");
7354 	}
7355 	for (i=0 ; i<length ; i++) {
7356 	    if (Tcl_DictObjGet(interp, dictPtr, keyPtrPtr[i],
7357 		    &valuePtr) != TCL_OK) {
7358 		TRACE_ERROR(interp);
7359 		Tcl_DecrRefCount(dictPtr);
7360 		goto gotError;
7361 	    }
7362 	    varPtr = LOCAL(duiPtr->varIndices[i]);
7363 	    while (TclIsVarLink(varPtr)) {
7364 		varPtr = varPtr->value.linkPtr;
7365 	    }
7366 	    DECACHE_STACK_INFO();
7367 	    if (valuePtr == NULL) {
7368 		TclObjUnsetVar2(interp,
7369 			localName(iPtr->varFramePtr, duiPtr->varIndices[i]),
7370 			NULL, 0);
7371 	    } else if (TclPtrSetVarIdx(interp, varPtr, NULL, NULL, NULL,
7372 		    valuePtr, TCL_LEAVE_ERR_MSG,
7373 		    duiPtr->varIndices[i]) == NULL) {
7374 		CACHE_STACK_INFO();
7375 		TRACE_ERROR(interp);
7376 		Tcl_DecrRefCount(dictPtr);
7377 		goto gotError;
7378 	    }
7379 	    CACHE_STACK_INFO();
7380 	}
7381 	TclDecrRefCount(dictPtr);
7382 	TRACE_APPEND(("OK\n"));
7383 	NEXT_INST_F(9, 0, 0);
7384 
7385     case INST_DICT_UPDATE_END:
7386 	opnd = TclGetUInt4AtPtr(pc+1);
7387 	opnd2 = TclGetUInt4AtPtr(pc+5);
7388 	TRACE(("%u => ", opnd));
7389 	varPtr = LOCAL(opnd);
7390 	duiPtr = (DictUpdateInfo *)codePtr->auxDataArrayPtr[opnd2].clientData;
7391 	while (TclIsVarLink(varPtr)) {
7392 	    varPtr = varPtr->value.linkPtr;
7393 	}
7394 	if (TclIsVarDirectReadable(varPtr)) {
7395 	    dictPtr = varPtr->value.objPtr;
7396 	} else {
7397 	    DECACHE_STACK_INFO();
7398 	    dictPtr = TclPtrGetVarIdx(interp, varPtr, NULL, NULL, NULL, 0,
7399 		    opnd);
7400 	    CACHE_STACK_INFO();
7401 	}
7402 	if (dictPtr == NULL) {
7403 	    TRACE_APPEND(("storage was unset\n"));
7404 	    NEXT_INST_F(9, 1, 0);
7405 	}
7406 	if (Tcl_DictObjSize(interp, dictPtr, &length) != TCL_OK
7407 		|| TclListObjGetElements(interp, OBJ_AT_TOS, &length,
7408 			&keyPtrPtr) != TCL_OK) {
7409 	    TRACE_ERROR(interp);
7410 	    goto gotError;
7411 	}
7412 	allocdict = Tcl_IsShared(dictPtr);
7413 	if (allocdict) {
7414 	    dictPtr = Tcl_DuplicateObj(dictPtr);
7415 	}
7416 	if (length > 0) {
7417 	    TclInvalidateStringRep(dictPtr);
7418 	}
7419 	for (i=0 ; i<length ; i++) {
7420 	    Var *var2Ptr = LOCAL(duiPtr->varIndices[i]);
7421 
7422 	    while (TclIsVarLink(var2Ptr)) {
7423 		var2Ptr = var2Ptr->value.linkPtr;
7424 	    }
7425 	    if (TclIsVarDirectReadable(var2Ptr)) {
7426 		valuePtr = var2Ptr->value.objPtr;
7427 	    } else {
7428 		DECACHE_STACK_INFO();
7429 		valuePtr = TclPtrGetVarIdx(interp, var2Ptr, NULL, NULL, NULL,
7430 			0, duiPtr->varIndices[i]);
7431 		CACHE_STACK_INFO();
7432 	    }
7433 	    if (valuePtr == NULL) {
7434 		Tcl_DictObjRemove(interp, dictPtr, keyPtrPtr[i]);
7435 	    } else if (dictPtr == valuePtr) {
7436 		Tcl_DictObjPut(interp, dictPtr, keyPtrPtr[i],
7437 			Tcl_DuplicateObj(valuePtr));
7438 	    } else {
7439 		Tcl_DictObjPut(interp, dictPtr, keyPtrPtr[i], valuePtr);
7440 	    }
7441 	}
7442 	if (TclIsVarDirectWritable(varPtr)) {
7443 	    Tcl_IncrRefCount(dictPtr);
7444 	    TclDecrRefCount(varPtr->value.objPtr);
7445 	    varPtr->value.objPtr = dictPtr;
7446 	} else {
7447 	    DECACHE_STACK_INFO();
7448 	    objResultPtr = TclPtrSetVarIdx(interp, varPtr, NULL, NULL, NULL,
7449 		    dictPtr, TCL_LEAVE_ERR_MSG, opnd);
7450 	    CACHE_STACK_INFO();
7451 	    if (objResultPtr == NULL) {
7452 		if (allocdict) {
7453 		    TclDecrRefCount(dictPtr);
7454 		}
7455 		TRACE_ERROR(interp);
7456 		goto gotError;
7457 	    }
7458 	}
7459 	TRACE_APPEND(("written back\n"));
7460 	NEXT_INST_F(9, 1, 0);
7461 
7462     case INST_DICT_EXPAND:
7463 	dictPtr = OBJ_UNDER_TOS;
7464 	listPtr = OBJ_AT_TOS;
7465 	TRACE(("\"%.30s\" \"%.30s\" =>", O2S(dictPtr), O2S(listPtr)));
7466 	if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
7467 	    TRACE_ERROR(interp);
7468 	    goto gotError;
7469 	}
7470 	objResultPtr = TclDictWithInit(interp, dictPtr, objc, objv);
7471 	if (objResultPtr == NULL) {
7472 	    TRACE_ERROR(interp);
7473 	    goto gotError;
7474 	}
7475 	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
7476 	NEXT_INST_F(1, 2, 1);
7477 
7478     case INST_DICT_RECOMBINE_STK:
7479 	keysPtr = POP_OBJECT();
7480 	varNamePtr = OBJ_UNDER_TOS;
7481 	listPtr = OBJ_AT_TOS;
7482 	TRACE(("\"%.30s\" \"%.30s\" \"%.30s\" => ",
7483 		O2S(varNamePtr), O2S(valuePtr), O2S(keysPtr)));
7484 	if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
7485 	    TRACE_ERROR(interp);
7486 	    TclDecrRefCount(keysPtr);
7487 	    goto gotError;
7488 	}
7489 	varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL,
7490 		TCL_LEAVE_ERR_MSG, "set", 1, 1, &arrayPtr);
7491 	if (varPtr == NULL) {
7492 	    TRACE_ERROR(interp);
7493 	    TclDecrRefCount(keysPtr);
7494 	    goto gotError;
7495 	}
7496 	DECACHE_STACK_INFO();
7497 	result = TclDictWithFinish(interp, varPtr,arrayPtr,varNamePtr,NULL,-1,
7498 		objc, objv, keysPtr);
7499 	CACHE_STACK_INFO();
7500 	TclDecrRefCount(keysPtr);
7501 	if (result != TCL_OK) {
7502 	    TRACE_ERROR(interp);
7503 	    goto gotError;
7504 	}
7505 	TRACE_APPEND(("OK\n"));
7506 	NEXT_INST_F(1, 2, 0);
7507 
7508     case INST_DICT_RECOMBINE_IMM:
7509 	opnd = TclGetUInt4AtPtr(pc+1);
7510 	listPtr = OBJ_UNDER_TOS;
7511 	keysPtr = OBJ_AT_TOS;
7512 	varPtr = LOCAL(opnd);
7513 	TRACE(("%u <- \"%.30s\" \"%.30s\" => ", opnd, O2S(valuePtr),
7514 		O2S(keysPtr)));
7515 	if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
7516 	    TRACE_ERROR(interp);
7517 	    goto gotError;
7518 	}
7519 	while (TclIsVarLink(varPtr)) {
7520 	    varPtr = varPtr->value.linkPtr;
7521 	}
7522 	DECACHE_STACK_INFO();
7523 	result = TclDictWithFinish(interp, varPtr, NULL, NULL, NULL, opnd,
7524 		objc, objv, keysPtr);
7525 	CACHE_STACK_INFO();
7526 	if (result != TCL_OK) {
7527 	    TRACE_ERROR(interp);
7528 	    goto gotError;
7529 	}
7530 	TRACE_APPEND(("OK\n"));
7531 	NEXT_INST_F(5, 2, 0);
7532     }
7533     break;
7534 
7535     /*
7536      *	   End of dictionary-related instructions.
7537      * -----------------------------------------------------------------
7538      */
7539 
7540     case INST_CLOCK_READ:
7541 	{			/* Read the wall clock */
7542 	    Tcl_WideInt wval;
7543 	    Tcl_Time now;
7544 	    switch(TclGetUInt1AtPtr(pc+1)) {
7545 	    case 0:		/* clicks */
7546 #ifdef TCL_WIDE_CLICKS
7547 		wval = TclpGetWideClicks();
7548 #else
7549 		wval = (Tcl_WideInt) TclpGetClicks();
7550 #endif
7551 		break;
7552 	    case 1:		/* microseconds */
7553 		Tcl_GetTime(&now);
7554 		wval = (Tcl_WideInt) now.sec * 1000000 + now.usec;
7555 		break;
7556 	    case 2:		/* milliseconds */
7557 		Tcl_GetTime(&now);
7558 		wval = (Tcl_WideInt) now.sec * 1000 + now.usec / 1000;
7559 		break;
7560 	    case 3:		/* seconds */
7561 		Tcl_GetTime(&now);
7562 		wval = (Tcl_WideInt) now.sec;
7563 		break;
7564 	    default:
7565 		Tcl_Panic("clockRead instruction with unknown clock#");
7566 	    }
7567 	    TclNewIntObj(objResultPtr, wval);
7568 	    TRACE_WITH_OBJ(("=> "), objResultPtr);
7569 	    NEXT_INST_F(2, 0, 1);
7570 	}
7571 	break;
7572 
7573     default:
7574 	Tcl_Panic("TclNRExecuteByteCode: unrecognized opCode %u", *pc);
7575     } /* end of switch on opCode */
7576 
7577     /*
7578      * Block for variables needed to process exception returns.
7579      */
7580 
7581     {
7582 	ExceptionRange *rangePtr;
7583 				/* Points to closest loop or catch exception
7584 				 * range enclosing the pc. Used by various
7585 				 * instructions and processCatch to process
7586 				 * break, continue, and errors. */
7587 	const char *bytes;
7588 
7589 	/*
7590 	 * An external evaluation (INST_INVOKE or INST_EVAL) returned
7591 	 * something different from TCL_OK, or else INST_BREAK or
7592 	 * INST_CONTINUE were called.
7593 	 */
7594 
7595     processExceptionReturn:
7596 #ifdef TCL_COMPILE_DEBUG
7597 	switch (*pc) {
7598 	case INST_INVOKE_STK1:
7599 	    opnd = TclGetUInt1AtPtr(pc+1);
7600 	    TRACE(("%u => ... after \"%.20s\": ", opnd, cmdNameBuf));
7601 	    break;
7602 	case INST_INVOKE_STK4:
7603 	    opnd = TclGetUInt4AtPtr(pc+1);
7604 	    TRACE(("%u => ... after \"%.20s\": ", opnd, cmdNameBuf));
7605 	    break;
7606 	case INST_EVAL_STK:
7607 	    /*
7608 	     * Note that the object at stacktop has to be used before doing
7609 	     * the cleanup.
7610 	     */
7611 
7612 	    TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
7613 	    break;
7614 	default:
7615 	    TRACE(("=> "));
7616 	}
7617 #endif
7618 	if ((result == TCL_CONTINUE) || (result == TCL_BREAK)) {
7619 	    rangePtr = GetExceptRangeForPc(pc, result, codePtr);
7620 	    if (rangePtr == NULL) {
7621 		TRACE_APPEND(("no encl. loop or catch, returning %s\n",
7622 			StringForResultCode(result)));
7623 		goto abnormalReturn;
7624 	    }
7625 	    if (rangePtr->type == CATCH_EXCEPTION_RANGE) {
7626 		TRACE_APPEND(("%s ...\n", StringForResultCode(result)));
7627 		goto processCatch;
7628 	    }
7629 	    while (cleanup--) {
7630 		valuePtr = POP_OBJECT();
7631 		TclDecrRefCount(valuePtr);
7632 	    }
7633 	    if (result == TCL_BREAK) {
7634 		result = TCL_OK;
7635 		pc = (codePtr->codeStart + rangePtr->breakOffset);
7636 		TRACE_APPEND(("%s, range at %d, new pc %d\n",
7637 			StringForResultCode(result),
7638 			rangePtr->codeOffset, rangePtr->breakOffset));
7639 		NEXT_INST_F(0, 0, 0);
7640 	    }
7641 	    if (rangePtr->continueOffset == -1) {
7642 		TRACE_APPEND(("%s, loop w/o continue, checking for catch\n",
7643 			StringForResultCode(result)));
7644 		goto checkForCatch;
7645 	    }
7646 	    result = TCL_OK;
7647 	    pc = (codePtr->codeStart + rangePtr->continueOffset);
7648 	    TRACE_APPEND(("%s, range at %d, new pc %d\n",
7649 		    StringForResultCode(result),
7650 		    rangePtr->codeOffset, rangePtr->continueOffset));
7651 	    NEXT_INST_F(0, 0, 0);
7652 	}
7653 #ifdef TCL_COMPILE_DEBUG
7654 	if (traceInstructions) {
7655 	    objPtr = Tcl_GetObjResult(interp);
7656 	    if ((result != TCL_ERROR) && (result != TCL_RETURN)) {
7657 		TRACE_APPEND(("OTHER RETURN CODE %d, result=\"%.30s\"\n ",
7658 			result, O2S(objPtr)));
7659 	    } else {
7660 		TRACE_APPEND(("%s, result=\"%.30s\"\n",
7661 			StringForResultCode(result), O2S(objPtr)));
7662 	    }
7663 	}
7664 #endif
7665 	goto checkForCatch;
7666 
7667 	/*
7668 	 * Division by zero in an expression. Control only reaches this point
7669 	 * by "goto divideByZero".
7670 	 */
7671 
7672     divideByZero:
7673 	Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1));
7674 	DECACHE_STACK_INFO();
7675 	Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL);
7676 	CACHE_STACK_INFO();
7677 	goto gotError;
7678 
7679     outOfMemory:
7680 	Tcl_SetObjResult(interp, Tcl_NewStringObj("out of memory", -1));
7681 	DECACHE_STACK_INFO();
7682 	Tcl_SetErrorCode(interp, "ARITH", "OUTOFMEMORY", "out of memory", NULL);
7683 	CACHE_STACK_INFO();
7684 	goto gotError;
7685 
7686 	/*
7687 	 * Exponentiation of zero by negative number in an expression. Control
7688 	 * only reaches this point by "goto exponOfZero".
7689 	 */
7690 
7691     exponOfZero:
7692 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
7693 		"exponentiation of zero by negative power", -1));
7694 	DECACHE_STACK_INFO();
7695 	Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
7696 		"exponentiation of zero by negative power", NULL);
7697 	CACHE_STACK_INFO();
7698 
7699 	/*
7700 	 * Almost all error paths feed through here rather than assigning to
7701 	 * result themselves (for a small but consistent saving).
7702 	 */
7703 
7704     gotError:
7705 	result = TCL_ERROR;
7706 
7707 	/*
7708 	 * Execution has generated an "exception" such as TCL_ERROR. If the
7709 	 * exception is an error, record information about what was being
7710 	 * executed when the error occurred. Find the closest enclosing catch
7711 	 * range, if any. If no enclosing catch range is found, stop execution
7712 	 * and return the "exception" code.
7713 	 */
7714 
7715     checkForCatch:
7716 	if (iPtr->execEnvPtr->rewind) {
7717 	    goto abnormalReturn;
7718 	}
7719 	if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
7720 	    const unsigned char *pcBeg;
7721 
7722 	    bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg, NULL);
7723 	    DECACHE_STACK_INFO();
7724 	    TclLogCommandInfo(interp, codePtr->source, bytes,
7725 		    bytes ? length : 0, pcBeg, tosPtr);
7726 	    CACHE_STACK_INFO();
7727 	}
7728 	iPtr->flags &= ~ERR_ALREADY_LOGGED;
7729 
7730 	/*
7731 	 * Clear all expansions that may have started after the last
7732 	 * INST_BEGIN_CATCH.
7733 	 */
7734 
7735 	while (auxObjList) {
7736 	    if ((catchTop != initCatchTop)
7737 		    && (*catchTop > (ptrdiff_t)
7738 			auxObjList->internalRep.twoPtrValue.ptr2)) {
7739 		break;
7740 	    }
7741 	    POP_TAUX_OBJ();
7742 	}
7743 
7744 	/*
7745 	 * We must not catch if the script in progress has been canceled with
7746 	 * the TCL_CANCEL_UNWIND flag. Instead, it blows outwards until we
7747 	 * either hit another interpreter (presumably where the script in
7748 	 * progress has not been canceled) or we get to the top-level. We do
7749 	 * NOT modify the interpreter result here because we know it will
7750 	 * already be set prior to vectoring down to this point in the code.
7751 	 */
7752 
7753 	if (TclCanceled(iPtr) && (Tcl_Canceled(interp, 0) == TCL_ERROR)) {
7754 #ifdef TCL_COMPILE_DEBUG
7755 	    if (traceInstructions) {
7756 		fprintf(stdout, "   ... cancel with unwind, returning %s\n",
7757 			StringForResultCode(result));
7758 	    }
7759 #endif
7760 	    goto abnormalReturn;
7761 	}
7762 
7763 	/*
7764 	 * We must not catch an exceeded limit. Instead, it blows outwards
7765 	 * until we either hit another interpreter (presumably where the limit
7766 	 * is not exceeded) or we get to the top-level.
7767 	 */
7768 
7769 	if (TclLimitExceeded(iPtr->limit)) {
7770 #ifdef TCL_COMPILE_DEBUG
7771 	    if (traceInstructions) {
7772 		fprintf(stdout, "   ... limit exceeded, returning %s\n",
7773 			StringForResultCode(result));
7774 	    }
7775 #endif
7776 	    goto abnormalReturn;
7777 	}
7778 	if (catchTop == initCatchTop) {
7779 #ifdef TCL_COMPILE_DEBUG
7780 	    if (traceInstructions) {
7781 		fprintf(stdout, "   ... no enclosing catch, returning %s\n",
7782 			StringForResultCode(result));
7783 	    }
7784 #endif
7785 	    goto abnormalReturn;
7786 	}
7787 	rangePtr = GetExceptRangeForPc(pc, TCL_ERROR, codePtr);
7788 	if (rangePtr == NULL) {
7789 	    /*
7790 	     * This is only possible when compiling a [catch] that sends its
7791 	     * script to INST_EVAL. Cannot correct the compiler without
7792 	     * breaking compat with previous .tbc compiled scripts.
7793 	     */
7794 
7795 #ifdef TCL_COMPILE_DEBUG
7796 	    if (traceInstructions) {
7797 		fprintf(stdout, "   ... no enclosing catch, returning %s\n",
7798 			StringForResultCode(result));
7799 	    }
7800 #endif
7801 	    goto abnormalReturn;
7802 	}
7803 
7804 	/*
7805 	 * A catch exception range (rangePtr) was found to handle an
7806 	 * "exception". It was found either by checkForCatch just above or by
7807 	 * an instruction during break, continue, or error processing. Jump to
7808 	 * its catchOffset after unwinding the operand stack to the depth it
7809 	 * had when starting to execute the range's catch command.
7810 	 */
7811 
7812     processCatch:
7813 	while (CURR_DEPTH > *catchTop) {
7814 	    valuePtr = POP_OBJECT();
7815 	    TclDecrRefCount(valuePtr);
7816 	}
7817 #ifdef TCL_COMPILE_DEBUG
7818 	if (traceInstructions) {
7819 	    fprintf(stdout, "  ... found catch at %d, catchTop=%d, "
7820 		    "unwound to %ld, new pc %u\n",
7821 		    rangePtr->codeOffset, (int) (catchTop - initCatchTop - 1),
7822 		    (long) *catchTop, (unsigned) rangePtr->catchOffset);
7823 	}
7824 #endif
7825 	pc = (codePtr->codeStart + rangePtr->catchOffset);
7826 	NEXT_INST_F(0, 0, 0);	/* Restart the execution loop at pc. */
7827 
7828 	/*
7829 	 * end of infinite loop dispatching on instructions.
7830 	 */
7831 
7832 	/*
7833 	 * Done or abnormal return code. Restore the stack to state it had when
7834 	 * starting to execute the ByteCode. Panic if the stack is below the
7835 	 * initial level.
7836 	 */
7837 
7838     abnormalReturn:
7839 	TCL_DTRACE_INST_LAST();
7840 
7841 	/*
7842 	 * Clear all expansions and same-level NR calls.
7843 	 *
7844 	 * Note that expansion markers have a NULL type; avoid removing other
7845 	 * markers.
7846 	 */
7847 
7848 	while (auxObjList) {
7849 	    POP_TAUX_OBJ();
7850 	}
7851 	while (tosPtr > initTosPtr) {
7852 	    objPtr = POP_OBJECT();
7853 	    Tcl_DecrRefCount(objPtr);
7854 	}
7855 
7856 	if (tosPtr < initTosPtr) {
7857 	    fprintf(stderr,
7858 		    "\nTclNRExecuteByteCode: abnormal return at pc %u: "
7859 		    "stack top %d < entry stack top %d\n",
7860 		    (unsigned)(pc - codePtr->codeStart),
7861 		    (unsigned) CURR_DEPTH, (unsigned) 0);
7862 	    Tcl_Panic("TclNRExecuteByteCode execution failure: end stack top < start stack top");
7863 	}
7864 	CLANG_ASSERT(bcFramePtr);
7865     }
7866 
7867     iPtr->cmdFramePtr = bcFramePtr->nextPtr;
7868     TclReleaseByteCode(codePtr);
7869     TclStackFree(interp, TD);	/* free my stack */
7870 
7871     return result;
7872 
7873     /*
7874      * INST_START_CMD failure case removed where it doesn't bother that much
7875      *
7876      * Remark that if the interpreter is marked for deletion its
7877      * compileEpoch is modified, so that the epoch check also verifies
7878      * that the interp is not deleted. If no outside call has been made
7879      * since the last check, it is safe to omit the check.
7880 
7881      * case INST_START_CMD:
7882      */
7883 
7884 	instStartCmdFailed:
7885 	{
7886 	    const char *bytes;
7887 
7888 	    length = 0;
7889 
7890 	    if (TclInterpReady(interp) == TCL_ERROR) {
7891 		goto gotError;
7892 	    }
7893 
7894 	    /*
7895 	     * We used to switch to direct eval; for NRE-awareness we now
7896 	     * compile and eval the command so that this evaluation does not
7897 	     * add a new TEBC instance. Bug [2910748], bug [fa6bf38d07]
7898 	     *
7899 	     * TODO: recompile, search this command and eval a code starting from,
7900 	     * so that this evaluation does not add a new TEBC instance without
7901 	     * NRE-trampoline.
7902 	     */
7903 
7904 	    codePtr->flags |= TCL_BYTECODE_RECOMPILE;
7905 	    bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL, NULL);
7906 	    opnd = TclGetUInt4AtPtr(pc+1);
7907 	    pc += (opnd-1);
7908 	    assert(bytes);
7909 	    PUSH_OBJECT(Tcl_NewStringObj(bytes, length));
7910 	    goto instEvalStk;
7911 	}
7912 }
7913 
7914 #undef codePtr
7915 #undef iPtr
7916 #undef bcFramePtr
7917 #undef initCatchTop
7918 #undef initTosPtr
7919 #undef auxObjList
7920 #undef catchTop
7921 #undef TCONST
7922 #undef esPtr
7923 
7924 static int
FinalizeOONext(ClientData data[],Tcl_Interp * interp,int result)7925 FinalizeOONext(
7926     ClientData data[],
7927     Tcl_Interp *interp,
7928     int result)
7929 {
7930     Interp *iPtr = (Interp *) interp;
7931     CallContext *contextPtr = (CallContext *)data[1];
7932 
7933     /*
7934      * Reset the variable lookup frame.
7935      */
7936 
7937     iPtr->varFramePtr = (CallFrame *)data[0];
7938 
7939     /*
7940      * Restore the call chain context index as we've finished the inner invoke
7941      * and want to operate in the outer context again.
7942      */
7943 
7944     contextPtr->index = PTR2INT(data[2]);
7945     contextPtr->skip = PTR2INT(data[3]);
7946     contextPtr->oPtr->flags &= ~FILTER_HANDLING;
7947     return result;
7948 }
7949 
7950 static int
FinalizeOONextFilter(ClientData data[],Tcl_Interp * interp,int result)7951 FinalizeOONextFilter(
7952     ClientData data[],
7953     Tcl_Interp *interp,
7954     int result)
7955 {
7956     Interp *iPtr = (Interp *) interp;
7957     CallContext *contextPtr = (CallContext *)data[1];
7958 
7959     /*
7960      * Reset the variable lookup frame.
7961      */
7962 
7963     iPtr->varFramePtr = (CallFrame *)data[0];
7964 
7965     /*
7966      * Restore the call chain context index as we've finished the inner invoke
7967      * and want to operate in the outer context again.
7968      */
7969 
7970     contextPtr->index = PTR2INT(data[2]);
7971     contextPtr->skip = PTR2INT(data[3]);
7972     contextPtr->oPtr->flags |= FILTER_HANDLING;
7973     return result;
7974 }
7975 
7976 /*
7977  * WidePwrSmallExpon --
7978  *
7979  * Helper to calculate small powers of integers whose result is wide.
7980  */
7981 static inline Tcl_WideInt
WidePwrSmallExpon(Tcl_WideInt w1,long exponent)7982 WidePwrSmallExpon(Tcl_WideInt w1, long exponent) {
7983 
7984     Tcl_WideInt wResult;
7985 
7986     wResult = w1 * w1;		/* b**2 */
7987     switch (exponent) {
7988     case 2:
7989 	break;
7990     case 3:
7991 	wResult *= w1;		/* b**3 */
7992 	break;
7993     case 4:
7994 	wResult *= wResult;	/* b**4 */
7995 	break;
7996     case 5:
7997 	wResult *= wResult;	/* b**4 */
7998 	wResult *= w1;		/* b**5 */
7999 	break;
8000     case 6:
8001 	wResult *= w1;		/* b**3 */
8002 	wResult *= wResult;	/* b**6 */
8003 	break;
8004     case 7:
8005 	wResult *= w1;		/* b**3 */
8006 	wResult *= wResult;	/* b**6 */
8007 	wResult *= w1;		/* b**7 */
8008 	break;
8009     case 8:
8010 	wResult *= wResult;	/* b**4 */
8011 	wResult *= wResult;	/* b**8 */
8012 	break;
8013     case 9:
8014 	wResult *= wResult;	/* b**4 */
8015 	wResult *= wResult;	/* b**8 */
8016 	wResult *= w1;		/* b**9 */
8017 	break;
8018     case 10:
8019 	wResult *= wResult;	/* b**4 */
8020 	wResult *= w1;		/* b**5 */
8021 	wResult *= wResult;	/* b**10 */
8022 	break;
8023     case 11:
8024 	wResult *= wResult;	/* b**4 */
8025 	wResult *= w1;		/* b**5 */
8026 	wResult *= wResult;	/* b**10 */
8027 	wResult *= w1;		/* b**11 */
8028 	break;
8029     case 12:
8030 	wResult *= w1;		/* b**3 */
8031 	wResult *= wResult;	/* b**6 */
8032 	wResult *= wResult;	/* b**12 */
8033 	break;
8034     case 13:
8035 	wResult *= w1;		/* b**3 */
8036 	wResult *= wResult;	/* b**6 */
8037 	wResult *= wResult;	/* b**12 */
8038 	wResult *= w1;		/* b**13 */
8039 	break;
8040     case 14:
8041 	wResult *= w1;		/* b**3 */
8042 	wResult *= wResult;	/* b**6 */
8043 	wResult *= w1;		/* b**7 */
8044 	wResult *= wResult;	/* b**14 */
8045 	break;
8046     case 15:
8047 	wResult *= w1;		/* b**3 */
8048 	wResult *= wResult;	/* b**6 */
8049 	wResult *= w1;		/* b**7 */
8050 	wResult *= wResult;	/* b**14 */
8051 	wResult *= w1;		/* b**15 */
8052 	break;
8053     case 16:
8054 	wResult *= wResult;	/* b**4 */
8055 	wResult *= wResult;	/* b**8 */
8056 	wResult *= wResult;	/* b**16 */
8057 	break;
8058     }
8059     return wResult;
8060 }
8061 /*
8062  *----------------------------------------------------------------------
8063  *
8064  * ExecuteExtendedBinaryMathOp, ExecuteExtendedUnaryMathOp --
8065  *
8066  *	These functions do advanced math for binary and unary operators
8067  *	respectively, so that the main TEBC code does not bear the cost of
8068  *	them.
8069  *
8070  * Results:
8071  *	A Tcl_Obj* result, or a NULL (in which case valuePtr is updated to
8072  *	hold the result value), or one of the special flag values
8073  *	GENERAL_ARITHMETIC_ERROR, EXPONENT_OF_ZERO or DIVIDED_BY_ZERO. The
8074  *	latter two signify a zero value raised to a negative power or a value
8075  *	divided by zero, respectively. With GENERAL_ARITHMETIC_ERROR, all
8076  *	error information will have already been reported in the interpreter
8077  *	result.
8078  *
8079  * Side effects:
8080  *	May update the Tcl_Obj indicated valuePtr if it is unshared. Will
8081  *	return a NULL when that happens.
8082  *
8083  *----------------------------------------------------------------------
8084  */
8085 
8086 static Tcl_Obj *
ExecuteExtendedBinaryMathOp(Tcl_Interp * interp,int opcode,Tcl_Obj ** constants,Tcl_Obj * valuePtr,Tcl_Obj * value2Ptr)8087 ExecuteExtendedBinaryMathOp(
8088     Tcl_Interp *interp,		/* Where to report errors. */
8089     int opcode,			/* What operation to perform. */
8090     Tcl_Obj **constants,	/* The execution environment's constants. */
8091     Tcl_Obj *valuePtr,		/* The first operand on the stack. */
8092     Tcl_Obj *value2Ptr)		/* The second operand on the stack. */
8093 {
8094 #define WIDE_RESULT(w) \
8095     if (Tcl_IsShared(valuePtr)) {		\
8096 	return Tcl_NewWideIntObj(w);		\
8097     } else {					\
8098 	TclSetIntObj(valuePtr, w);		\
8099 	return NULL;				\
8100     }
8101 #define BIG_RESULT(b) \
8102     if (Tcl_IsShared(valuePtr)) {		\
8103 	return Tcl_NewBignumObj(b);		\
8104     } else {					\
8105 	Tcl_SetBignumObj(valuePtr, b);		\
8106 	return NULL;				\
8107     }
8108 #define DOUBLE_RESULT(d) \
8109     if (Tcl_IsShared(valuePtr)) {		\
8110 	TclNewDoubleObj(objResultPtr, (d));	\
8111 	return objResultPtr;			\
8112     } else {					\
8113 	Tcl_SetDoubleObj(valuePtr, (d));	\
8114 	return NULL;				\
8115     }
8116 
8117     int type1, type2;
8118     ClientData ptr1, ptr2;
8119     double d1, d2, dResult;
8120     Tcl_WideInt w1, w2, wResult;
8121     mp_int big1, big2, bigResult, bigRemainder;
8122     Tcl_Obj *objResultPtr;
8123     int invalid, zero;
8124     long shift;
8125 	mp_err err;
8126 
8127     (void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
8128     (void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);
8129 
8130     switch (opcode) {
8131     case INST_MOD:
8132 	/* TODO: Attempts to re-use unshared operands on stack */
8133 
8134 	w2 = 0;			/* silence gcc warning */
8135 	if (type2 == TCL_NUMBER_INT) {
8136 	    w2 = *((const Tcl_WideInt *)ptr2);
8137 	    if (w2 == 0) {
8138 		return DIVIDED_BY_ZERO;
8139 	    }
8140 	    if ((w2 == 1) || (w2 == -1)) {
8141 		/*
8142 		 * Div. by |1| always yields remainder of 0.
8143 		 */
8144 
8145 		return constants[0];
8146 	    }
8147 	}
8148 	if (type1 == TCL_NUMBER_INT) {
8149 	    w1 = *((const Tcl_WideInt *)ptr1);
8150 
8151 	    if (w1 == 0) {
8152 		/*
8153 		 * 0 % (non-zero) always yields remainder of 0.
8154 		 */
8155 
8156 		return constants[0];
8157 	    }
8158 	    if (type2 == TCL_NUMBER_INT) {
8159 		Tcl_WideInt wQuotient, wRemainder;
8160 		w2 = *((const Tcl_WideInt *)ptr2);
8161 		wQuotient = w1 / w2;
8162 
8163 		/*
8164 		 * Force Tcl's integer division rules.
8165 		 * TODO: examine for logic simplification
8166 		 */
8167 
8168 		if (((wQuotient < (Tcl_WideInt) 0)
8169 			|| ((wQuotient == (Tcl_WideInt) 0)
8170 			&& ((w1 < 0 && w2 > 0)
8171 			|| (w1 > 0 && w2 < 0))))
8172 			&& (wQuotient * w2 != w1)) {
8173 		    wQuotient -= (Tcl_WideInt) 1;
8174 		}
8175 		wRemainder = w1 - w2*wQuotient;
8176 		WIDE_RESULT(wRemainder);
8177 	    }
8178 
8179 	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
8180 
8181 	    /* TODO: internals intrusion */
8182 	    if ((w1 > ((Tcl_WideInt) 0)) ^ !mp_isneg(&big2)) {
8183 		/*
8184 		 * Arguments are opposite sign; remainder is sum.
8185 		 */
8186 
8187 		err = mp_init_i64(&big1, w1);
8188 		if (err == MP_OKAY) {
8189 		    err = mp_add(&big2, &big1, &big2);
8190 		    mp_clear(&big1);
8191 		}
8192 		if (err != MP_OKAY) {
8193 		    return OUT_OF_MEMORY;
8194 		}
8195 		BIG_RESULT(&big2);
8196 	    }
8197 
8198 	    /*
8199 	     * Arguments are same sign; remainder is first operand.
8200 	     */
8201 
8202 	    mp_clear(&big2);
8203 	    return NULL;
8204 	}
8205 	Tcl_GetBignumFromObj(NULL, valuePtr, &big1);
8206 	Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
8207 	err = mp_init_multi(&bigResult, &bigRemainder, NULL);
8208 	if (err == MP_OKAY) {
8209 	    err = mp_div(&big1, &big2, &bigResult, &bigRemainder);
8210 	}
8211 	if ((err == MP_OKAY) && !mp_iszero(&bigRemainder) && (bigRemainder.sign != big2.sign)) {
8212 	    /*
8213 	     * Convert to Tcl's integer division rules.
8214 	     */
8215 
8216 	    if ((mp_sub_d(&bigResult, 1, &bigResult) != MP_OKAY)
8217 		    || (mp_add(&bigRemainder, &big2, &bigRemainder) != MP_OKAY)) {
8218 		return OUT_OF_MEMORY;
8219 	    }
8220 	}
8221 	err = mp_copy(&bigRemainder, &bigResult);
8222 	mp_clear(&bigRemainder);
8223 	mp_clear(&big1);
8224 	mp_clear(&big2);
8225 	if (err != MP_OKAY) {
8226 	    return OUT_OF_MEMORY;
8227 	}
8228 	BIG_RESULT(&bigResult);
8229 
8230     case INST_LSHIFT:
8231     case INST_RSHIFT: {
8232 	/*
8233 	 * Reject negative shift argument.
8234 	 */
8235 
8236 	switch (type2) {
8237 	case TCL_NUMBER_INT:
8238 	    invalid = (*((const Tcl_WideInt *)ptr2) < 0);
8239 	    break;
8240 	case TCL_NUMBER_BIG:
8241 	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
8242 	    invalid = mp_isneg(&big2);
8243 	    mp_clear(&big2);
8244 	    break;
8245 	default:
8246 	    /* Unused, here to silence compiler warning */
8247 	    invalid = 0;
8248 	}
8249 	if (invalid) {
8250 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
8251 		    "negative shift argument", -1));
8252 	    return GENERAL_ARITHMETIC_ERROR;
8253 	}
8254 
8255 	/*
8256 	 * Zero shifted any number of bits is still zero.
8257 	 */
8258 
8259 	if ((type1==TCL_NUMBER_INT) && (*((const Tcl_WideInt *)ptr1) == 0)) {
8260 	    return constants[0];
8261 	}
8262 
8263 	if (opcode == INST_LSHIFT) {
8264 	    /*
8265 	     * Large left shifts create integer overflow.
8266 	     *
8267 	     * BEWARE! Can't use Tcl_GetIntFromObj() here because that
8268 	     * converts values in the (unsigned) range to their signed int
8269 	     * counterparts, leading to incorrect results.
8270 	     */
8271 
8272 	    if ((type2 != TCL_NUMBER_INT)
8273 		    || (*((const Tcl_WideInt *)ptr2) > INT_MAX)) {
8274 		/*
8275 		 * Technically, we could hold the value (1 << (INT_MAX+1)) in
8276 		 * an mp_int, but since we're using mp_mul_2d() to do the
8277 		 * work, and it takes only an int argument, that's a good
8278 		 * place to draw the line.
8279 		 */
8280 
8281 		Tcl_SetObjResult(interp, Tcl_NewStringObj(
8282 			"integer value too large to represent", -1));
8283 		return GENERAL_ARITHMETIC_ERROR;
8284 	    }
8285 	    shift = (int)(*((const Tcl_WideInt *)ptr2));
8286 
8287 	    /*
8288 	     * Handle shifts within the native wide range.
8289 	     */
8290 
8291 	    if ((type1 == TCL_NUMBER_INT)
8292 		    && ((size_t)shift < CHAR_BIT*sizeof(Tcl_WideInt))) {
8293 		w1 = *((const Tcl_WideInt *)ptr1);
8294 		if (!((w1>0 ? w1 : ~w1)
8295 			& -(((Tcl_WideInt)1)
8296 			<< (CHAR_BIT*sizeof(Tcl_WideInt) - 1 - shift)))) {
8297 		    WIDE_RESULT(w1 << shift);
8298 		}
8299 	    }
8300 	} else {
8301 	    /*
8302 	     * Quickly force large right shifts to 0 or -1.
8303 	     */
8304 
8305 	    if ((type2 != TCL_NUMBER_INT)
8306 		    || (*(const Tcl_WideInt *)ptr2 > INT_MAX)) {
8307 		/*
8308 		 * Again, technically, the value to be shifted could be an
8309 		 * mp_int so huge that a right shift by (INT_MAX+1) bits could
8310 		 * not take us to the result of 0 or -1, but since we're using
8311 		 * mp_div_2d to do the work, and it takes only an int
8312 		 * argument, we draw the line there.
8313 		 */
8314 
8315 		switch (type1) {
8316 		case TCL_NUMBER_INT:
8317 		    zero = (*(const Tcl_WideInt *)ptr1 > 0);
8318 		    break;
8319 		case TCL_NUMBER_BIG:
8320 		    Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
8321 		    zero = !mp_isneg(&big1);
8322 		    mp_clear(&big1);
8323 		    break;
8324 		default:
8325 		    /* Unused, here to silence compiler warning. */
8326 		    zero = 0;
8327 		}
8328 		if (zero) {
8329 		    return constants[0];
8330 		}
8331 		WIDE_RESULT(-1);
8332 	    }
8333 	    shift = (int)(*(const Tcl_WideInt *)ptr2);
8334 
8335 	    /*
8336 	     * Handle shifts within the native wide range.
8337 	     */
8338 
8339 	    if (type1 == TCL_NUMBER_INT) {
8340 		w1 = *(const Tcl_WideInt *)ptr1;
8341 		if ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideInt)) {
8342 		    if (w1 >= 0) {
8343 			return constants[0];
8344 		    }
8345 		    WIDE_RESULT(-1);
8346 		}
8347 		WIDE_RESULT(w1 >> shift);
8348 	    }
8349 	}
8350 
8351 	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
8352 
8353 	err = mp_init(&bigResult);
8354 	if (err == MP_OKAY) {
8355 	    if (opcode == INST_LSHIFT) {
8356 		err = mp_mul_2d(&big1, shift, &bigResult);
8357 	    } else {
8358 		err = mp_signed_rsh(&big1, shift, &bigResult);
8359 	    }
8360 	}
8361 	if (err != MP_OKAY) {
8362 	    return OUT_OF_MEMORY;
8363 	}
8364 	mp_clear(&big1);
8365 	BIG_RESULT(&bigResult);
8366     }
8367 
8368     case INST_BITOR:
8369     case INST_BITXOR:
8370     case INST_BITAND:
8371 	if ((type1 != TCL_NUMBER_INT) || (type2 != TCL_NUMBER_INT)) {
8372 	    Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
8373 	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
8374 
8375 	    err = mp_init(&bigResult);
8376 
8377 	    if (err == MP_OKAY) {
8378 		switch (opcode) {
8379 		case INST_BITAND:
8380 		    err = mp_and(&big1, &big2, &bigResult);
8381 		    break;
8382 
8383 		case INST_BITOR:
8384 		    err = mp_or(&big1, &big2, &bigResult);
8385 		    break;
8386 
8387 		case INST_BITXOR:
8388 		    err = mp_xor(&big1, &big2, &bigResult);
8389 		    break;
8390 		}
8391 	    }
8392 	    if (err != MP_OKAY) {
8393 		return OUT_OF_MEMORY;
8394 	    }
8395 
8396 	    mp_clear(&big1);
8397 	    mp_clear(&big2);
8398 	    BIG_RESULT(&bigResult);
8399 	}
8400 
8401 	w1 = *((const Tcl_WideInt *)ptr1);
8402 	w2 = *((const Tcl_WideInt *)ptr2);
8403 
8404 	switch (opcode) {
8405 	case INST_BITAND:
8406 	    wResult = w1 & w2;
8407 	    break;
8408 	case INST_BITOR:
8409 	    wResult = w1 | w2;
8410 	    break;
8411 	case INST_BITXOR:
8412 	    wResult = w1 ^ w2;
8413 	    break;
8414 	default:
8415 	    /* Unused, here to silence compiler warning. */
8416 	    wResult = 0;
8417 	}
8418 	WIDE_RESULT(wResult);
8419 
8420     case INST_EXPON: {
8421 	int oddExponent = 0, negativeExponent = 0;
8422 	unsigned short base;
8423 
8424 	if ((type1 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_DOUBLE)) {
8425 	    Tcl_GetDoubleFromObj(NULL, valuePtr, &d1);
8426 	    Tcl_GetDoubleFromObj(NULL, value2Ptr, &d2);
8427 
8428 	    if (d1==0.0 && d2<0.0) {
8429 		return EXPONENT_OF_ZERO;
8430 	    }
8431 	    dResult = pow(d1, d2);
8432 	    goto doubleResult;
8433 	}
8434 	w1 = w2 = 0; /* to silence compiler warning (maybe-uninitialized) */
8435 	if (type2 == TCL_NUMBER_INT) {
8436 	    w2 = *((const Tcl_WideInt *) ptr2);
8437 	    if (w2 == 0) {
8438 		/*
8439 		 * Anything to the zero power is 1.
8440 		 */
8441 
8442 		return constants[1];
8443 	    } else if (w2 == 1) {
8444 		/*
8445 		 * Anything to the first power is itself
8446 		 */
8447 
8448 		return NULL;
8449 	    }
8450 
8451 	    negativeExponent = (w2 < 0);
8452 	    oddExponent = (int) (w2 & (Tcl_WideInt)1);
8453 	} else {
8454 	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
8455 	    negativeExponent = mp_isneg(&big2);
8456 	    err = mp_mod_2d(&big2, 1, &big2);
8457 	    oddExponent = (err == MP_OKAY) && !mp_iszero(&big2);
8458 	    mp_clear(&big2);
8459 	}
8460 
8461 	if (type1 == TCL_NUMBER_INT) {
8462 	    w1 = *((const Tcl_WideInt *)ptr1);
8463 
8464 	    if (negativeExponent) {
8465 		switch (w1) {
8466 		case 0:
8467 		    /*
8468 		     * Zero to a negative power is div by zero error.
8469 		     */
8470 
8471 		    return EXPONENT_OF_ZERO;
8472 		case -1:
8473 		    if (oddExponent) {
8474 			WIDE_RESULT(-1);
8475 		    }
8476 		    /* fallthrough */
8477 		case 1:
8478 		    /*
8479 		     * 1 to any power is 1.
8480 		     */
8481 
8482 		    return constants[1];
8483 		}
8484 	    }
8485 	}
8486 	if (negativeExponent) {
8487 
8488 	    /*
8489 	     * Integers with magnitude greater than 1 raise to a negative
8490 	     * power yield the answer zero (see TIP 123).
8491 	     */
8492 	    return constants[0];
8493 	}
8494 
8495 	if (type1 != TCL_NUMBER_INT) {
8496 	    goto overflowExpon;
8497 	}
8498 
8499 	switch (w1) {
8500 	    case 0:
8501 		/*
8502 		 * Zero to a positive power is zero.
8503 		 */
8504 
8505 		return constants[0];
8506 	    case 1:
8507 		/*
8508 		 * 1 to any power is 1.
8509 		 */
8510 
8511 		return constants[1];
8512 	    case -1:
8513 		if (!oddExponent) {
8514 		    return constants[1];
8515 		}
8516 		WIDE_RESULT(-1);
8517 	}
8518 
8519 	/*
8520 	 * We refuse to accept exponent arguments that exceed one mp_digit
8521 	 * which means the max exponent value is 2**28-1 = 0x0FFFFFFF =
8522 	 * 268435455, which fits into a signed 32 bit int which is within the
8523 	 * range of the long int type. This means any numeric Tcl_Obj value
8524 	 * not using TCL_NUMBER_INT type must hold a value larger than we
8525 	 * accept.
8526 	 */
8527 
8528 	if (type2 != TCL_NUMBER_INT) {
8529 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
8530 		    "exponent too large", -1));
8531 	    return GENERAL_ARITHMETIC_ERROR;
8532 	}
8533 
8534 	/* From here (up to overflowExpon) w1 and exponent w2 are wide-int's. */
8535 	assert(type1 == TCL_NUMBER_INT && type2 == TCL_NUMBER_INT);
8536 
8537 	if (w1 == 2) {
8538 	    /*
8539 	     * Reduce small powers of 2 to shifts.
8540 	     */
8541 
8542 	    if ((Tcl_WideUInt) w2 < (Tcl_WideUInt) CHAR_BIT*sizeof(Tcl_WideInt) - 1) {
8543 		WIDE_RESULT(((Tcl_WideInt) 1) << (int)w2);
8544 	    }
8545 	    goto overflowExpon;
8546 	}
8547 	if (w1 == -2) {
8548 	    int signum = oddExponent ? -1 : 1;
8549 
8550 	    /*
8551 	     * Reduce small powers of 2 to shifts.
8552 	     */
8553 
8554 	    if ((Tcl_WideUInt) w2 < CHAR_BIT * sizeof(Tcl_WideInt) - 1) {
8555 		WIDE_RESULT(signum * (((Tcl_WideInt) 1) << (int) w2));
8556 	    }
8557 	    goto overflowExpon;
8558 	}
8559 	if (w2 - 2 < (long)MaxBase64Size
8560 		&& w1 <=  MaxBase64[w2 - 2]
8561 		&& w1 >= -MaxBase64[w2 - 2]) {
8562 	    /*
8563 	     * Small powers of integers whose result is wide.
8564 	     */
8565 	    wResult = WidePwrSmallExpon(w1, (long)w2);
8566 
8567 	    WIDE_RESULT(wResult);
8568 	}
8569 
8570 	/*
8571 	 * Handle cases of powers > 16 that still fit in a 64-bit word by
8572 	 * doing table lookup.
8573 	 */
8574 
8575 	if (w1 - 3 >= 0 && w1 - 2 < (long)Exp64IndexSize
8576 		&& w2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) {
8577 	    base = Exp64Index[w1 - 3]
8578 		    + (unsigned short) (w2 - 2 - MaxBase64Size);
8579 	    if (base < Exp64Index[w1 - 2]) {
8580 		/*
8581 		 * 64-bit number raised to intermediate power, done by
8582 		 * table lookup.
8583 		 */
8584 
8585 		WIDE_RESULT(Exp64Value[base]);
8586 	    }
8587 	}
8588 
8589 	if (-w1 - 3 >= 0 && -w1 - 2 < (long)Exp64IndexSize
8590 		&& w2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) {
8591 	    base = Exp64Index[-w1 - 3]
8592 		    + (unsigned short) (w2 - 2 - MaxBase64Size);
8593 	    if (base < Exp64Index[-w1 - 2]) {
8594 		/*
8595 		 * 64-bit number raised to intermediate power, done by
8596 		 * table lookup.
8597 		 */
8598 
8599 		wResult = oddExponent ? -Exp64Value[base] : Exp64Value[base];
8600 		WIDE_RESULT(wResult);
8601 	    }
8602 	}
8603 
8604     overflowExpon:
8605 
8606 	if ((TclGetWideIntFromObj(NULL, value2Ptr, &w2) != TCL_OK)
8607 		|| (value2Ptr->typePtr != &tclIntType)
8608 		|| (Tcl_WideUInt)w2 >= (1<<28)) {
8609 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
8610 		    "exponent too large", -1));
8611 	    return GENERAL_ARITHMETIC_ERROR;
8612 	}
8613 	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
8614 	err = mp_init(&bigResult);
8615 	if (err == MP_OKAY) {
8616 	    err = mp_expt_u32(&big1, (unsigned int)w2, &bigResult);
8617 	}
8618 	if (err != MP_OKAY) {
8619 	    return OUT_OF_MEMORY;
8620 	}
8621 	mp_clear(&big1);
8622 	BIG_RESULT(&bigResult);
8623     }
8624 
8625     case INST_ADD:
8626     case INST_SUB:
8627     case INST_MULT:
8628     case INST_DIV:
8629 	if ((type1 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_DOUBLE)) {
8630 	    /*
8631 	     * At least one of the values is floating-point, so perform
8632 	     * floating point calculations.
8633 	     */
8634 
8635 	    Tcl_GetDoubleFromObj(NULL, valuePtr, &d1);
8636 	    Tcl_GetDoubleFromObj(NULL, value2Ptr, &d2);
8637 
8638 	    switch (opcode) {
8639 	    case INST_ADD:
8640 		dResult = d1 + d2;
8641 		break;
8642 	    case INST_SUB:
8643 		dResult = d1 - d2;
8644 		break;
8645 	    case INST_MULT:
8646 		dResult = d1 * d2;
8647 		break;
8648 	    case INST_DIV:
8649 #ifndef IEEE_FLOATING_POINT
8650 		if (d2 == 0.0) {
8651 		    return DIVIDED_BY_ZERO;
8652 		}
8653 #endif
8654 		/*
8655 		 * We presume that we are running with zero-divide unmasked if
8656 		 * we're on an IEEE box. Otherwise, this statement might cause
8657 		 * demons to fly out our noses.
8658 		 */
8659 
8660 		dResult = d1 / d2;
8661 		break;
8662 	    default:
8663 		/* Unused, here to silence compiler warning. */
8664 		dResult = 0;
8665 	    }
8666 
8667 	doubleResult:
8668 #ifndef ACCEPT_NAN
8669 	    /*
8670 	     * Check now for IEEE floating-point error.
8671 	     */
8672 
8673 	    if (TclIsNaN(dResult)) {
8674 		TclExprFloatError(interp, dResult);
8675 		return GENERAL_ARITHMETIC_ERROR;
8676 	    }
8677 #endif
8678 	    DOUBLE_RESULT(dResult);
8679 	}
8680 	if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
8681 	    w1 = *((const Tcl_WideInt *)ptr1);
8682 	    w2 = *((const Tcl_WideInt *)ptr2);
8683 
8684 	    switch (opcode) {
8685 	    case INST_ADD:
8686 		wResult = w1 + w2;
8687 		if ((type1 == TCL_NUMBER_INT) || (type2 == TCL_NUMBER_INT))
8688 		{
8689 		    /*
8690 		     * Check for overflow.
8691 		     */
8692 
8693 		    if (Overflowing(w1, w2, wResult)) {
8694 			goto overflowBasic;
8695 		    }
8696 		}
8697 		break;
8698 
8699 	    case INST_SUB:
8700 		wResult = w1 - w2;
8701 		if ((type1 == TCL_NUMBER_INT) || (type2 == TCL_NUMBER_INT))
8702 		{
8703 		    /*
8704 		     * Must check for overflow. The macro tests for overflows
8705 		     * in sums by looking at the sign bits. As we have a
8706 		     * subtraction here, we are adding -w2. As -w2 could in
8707 		     * turn overflow, we test with ~w2 instead: it has the
8708 		     * opposite sign bit to w2 so it does the job. Note that
8709 		     * the only "bad" case (w2==0) is irrelevant for this
8710 		     * macro, as in that case w1 and wResult have the same
8711 		     * sign and there is no overflow anyway.
8712 		     */
8713 
8714 		    if (Overflowing(w1, ~w2, wResult)) {
8715 			goto overflowBasic;
8716 		    }
8717 		}
8718 		break;
8719 
8720 	    case INST_MULT:
8721 		if ((w1 < INT_MIN) || (w1 > INT_MAX) || (w2 < INT_MIN) || (w2 > INT_MAX)) {
8722 		    goto overflowBasic;
8723 		}
8724 		wResult = w1 * w2;
8725 		break;
8726 
8727 	    case INST_DIV:
8728 		if (w2 == 0) {
8729 		    return DIVIDED_BY_ZERO;
8730 		}
8731 
8732 		/*
8733 		 * Need a bignum to represent (WIDE_MIN / -1)
8734 		 */
8735 
8736 		if ((w1 == WIDE_MIN) && (w2 == -1)) {
8737 		    goto overflowBasic;
8738 		}
8739 		wResult = w1 / w2;
8740 
8741 		/*
8742 		 * Force Tcl's integer division rules.
8743 		 * TODO: examine for logic simplification
8744 		 */
8745 
8746 		if (((wResult < 0) || ((wResult == 0) &&
8747 			((w1 < 0 && w2 > 0) || (w1 > 0 && w2 < 0)))) &&
8748 			(wResult*w2 != w1)) {
8749 		    wResult -= 1;
8750 		}
8751 		break;
8752 
8753 	    default:
8754 		/*
8755 		 * Unused, here to silence compiler warning.
8756 		 */
8757 
8758 		wResult = 0;
8759 	    }
8760 
8761 	    WIDE_RESULT(wResult);
8762 	}
8763 
8764     overflowBasic:
8765 	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
8766 	Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
8767 	err = mp_init(&bigResult);
8768 	if (err == MP_OKAY) {
8769 	switch (opcode) {
8770 	case INST_ADD:
8771 		err = mp_add(&big1, &big2, &bigResult);
8772 		break;
8773 	case INST_SUB:
8774 		err = mp_sub(&big1, &big2, &bigResult);
8775 		break;
8776 	case INST_MULT:
8777 		err = mp_mul(&big1, &big2, &bigResult);
8778 		break;
8779 	case INST_DIV:
8780 		if (mp_iszero(&big2)) {
8781 		    mp_clear(&big1);
8782 		    mp_clear(&big2);
8783 		    mp_clear(&bigResult);
8784 		    return DIVIDED_BY_ZERO;
8785 		}
8786 		err = mp_init(&bigRemainder);
8787 		if (err == MP_OKAY) {
8788 		    err = mp_div(&big1, &big2, &bigResult, &bigRemainder);
8789 		}
8790 		/* TODO: internals intrusion */
8791 		if (!mp_iszero(&bigRemainder)
8792 			&& (bigRemainder.sign != big2.sign)) {
8793 		    /*
8794 		     * Convert to Tcl's integer division rules.
8795 		     */
8796 
8797 		    err = mp_sub_d(&bigResult, 1, &bigResult);
8798 		    if (err == MP_OKAY) {
8799 			err = mp_add(&bigRemainder, &big2, &bigRemainder);
8800 		    }
8801 		}
8802 		mp_clear(&bigRemainder);
8803 		break;
8804 	    }
8805 	}
8806 	mp_clear(&big1);
8807 	mp_clear(&big2);
8808 	BIG_RESULT(&bigResult);
8809     }
8810 
8811     Tcl_Panic("unexpected opcode");
8812     return NULL;
8813 }
8814 
8815 static Tcl_Obj *
ExecuteExtendedUnaryMathOp(int opcode,Tcl_Obj * valuePtr)8816 ExecuteExtendedUnaryMathOp(
8817     int opcode,			/* What operation to perform. */
8818     Tcl_Obj *valuePtr)		/* The operand on the stack. */
8819 {
8820     ClientData ptr = NULL;
8821     int type;
8822     Tcl_WideInt w;
8823     mp_int big;
8824     Tcl_Obj *objResultPtr;
8825     mp_err err = MP_OKAY;
8826 
8827     (void) GetNumberFromObj(NULL, valuePtr, &ptr, &type);
8828 
8829     switch (opcode) {
8830     case INST_BITNOT:
8831 	if (type == TCL_NUMBER_INT) {
8832 	    w = *((const Tcl_WideInt *) ptr);
8833 	    WIDE_RESULT(~w);
8834 	}
8835 	Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
8836 	/* ~a = - a - 1 */
8837 	err = mp_neg(&big, &big);
8838 	if (err == MP_OKAY) {
8839 	    err = mp_sub_d(&big, 1, &big);
8840 	}
8841 	if (err != MP_OKAY) {
8842 	    return OUT_OF_MEMORY;
8843 	}
8844 	BIG_RESULT(&big);
8845     case INST_UMINUS:
8846 	switch (type) {
8847 	case TCL_NUMBER_DOUBLE:
8848 	    DOUBLE_RESULT(-(*((const double *) ptr)));
8849 	case TCL_NUMBER_INT:
8850 	    w = *((const Tcl_WideInt *) ptr);
8851 	    if (w != WIDE_MIN) {
8852 		WIDE_RESULT(-w);
8853 	    }
8854 	    err = mp_init_i64(&big, w);
8855 	    if (err != MP_OKAY) {
8856 		return OUT_OF_MEMORY;
8857 	    }
8858 	    break;
8859 	default:
8860 	    Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
8861 	}
8862 	err = mp_neg(&big, &big);
8863 	if (err != MP_OKAY) {
8864 	    return OUT_OF_MEMORY;
8865 	}
8866 	BIG_RESULT(&big);
8867     }
8868 
8869     Tcl_Panic("unexpected opcode");
8870     return NULL;
8871 }
8872 #undef WIDE_RESULT
8873 #undef BIG_RESULT
8874 #undef DOUBLE_RESULT
8875 
8876 /*
8877  *----------------------------------------------------------------------
8878  *
8879  * CompareTwoNumbers --
8880  *
8881  *	This function compares a pair of numbers in Tcl_Objs. Each argument
8882  *	must already be known to be numeric and not NaN.
8883  *
8884  * Results:
8885  *	One of MP_LT, MP_EQ or MP_GT, depending on whether valuePtr is less
8886  *	than, equal to, or greater than value2Ptr (respectively).
8887  *
8888  * Side effects:
8889  *	None, provided both values are numeric.
8890  *
8891  *----------------------------------------------------------------------
8892  */
8893 
8894 int
TclCompareTwoNumbers(Tcl_Obj * valuePtr,Tcl_Obj * value2Ptr)8895 TclCompareTwoNumbers(
8896     Tcl_Obj *valuePtr,
8897     Tcl_Obj *value2Ptr)
8898 {
8899     int type1 = TCL_NUMBER_NAN, type2 = TCL_NUMBER_NAN, compare;
8900     ClientData ptr1, ptr2;
8901     mp_int big1, big2;
8902     double d1, d2, tmp;
8903     Tcl_WideInt w1, w2;
8904 
8905     (void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
8906     (void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);
8907 
8908     switch (type1) {
8909     case TCL_NUMBER_INT:
8910 	w1 = *((const Tcl_WideInt *)ptr1);
8911 	switch (type2) {
8912 	case TCL_NUMBER_INT:
8913 	    w2 = *((const Tcl_WideInt *)ptr2);
8914 	wideCompare:
8915 	    return (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ);
8916 	case TCL_NUMBER_DOUBLE:
8917 	    d2 = *((const double *)ptr2);
8918 	    d1 = (double) w1;
8919 
8920 	    /*
8921 	     * If the double has a fractional part, or if the long can be
8922 	     * converted to double without loss of precision, then compare as
8923 	     * doubles.
8924 	     */
8925 
8926 	    if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt) || w1 == (Tcl_WideInt) d1
8927 		    || modf(d2, &tmp) != 0.0) {
8928 		goto doubleCompare;
8929 	    }
8930 
8931 	    /*
8932 	     * Otherwise, to make comparision based on full precision, need to
8933 	     * convert the double to a suitably sized integer.
8934 	     *
8935 	     * Need this to get comparsions like
8936 	     *	  expr 20000000000000003 < 20000000000000004.0
8937 	     * right. Converting the first argument to double will yield two
8938 	     * double values that are equivalent within double precision.
8939 	     * Converting the double to an integer gets done exactly, then
8940 	     * integer comparison can tell the difference.
8941 	     */
8942 
8943 	    if (d2 < (double)WIDE_MIN) {
8944 		return MP_GT;
8945 	    }
8946 	    if (d2 > (double)WIDE_MAX) {
8947 		return MP_LT;
8948 	    }
8949 	    w2 = (Tcl_WideInt) d2;
8950 	    goto wideCompare;
8951 	case TCL_NUMBER_BIG:
8952 	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
8953 	    if (mp_isneg(&big2)) {
8954 		compare = MP_GT;
8955 	    } else {
8956 		compare = MP_LT;
8957 	    }
8958 	    mp_clear(&big2);
8959 	    return compare;
8960 	}
8961     break;
8962 
8963     case TCL_NUMBER_DOUBLE:
8964 	d1 = *((const double *)ptr1);
8965 	switch (type2) {
8966 	case TCL_NUMBER_DOUBLE:
8967 	    d2 = *((const double *)ptr2);
8968 	doubleCompare:
8969 	    return (d1 < d2) ? MP_LT : ((d1 > d2) ? MP_GT : MP_EQ);
8970 	case TCL_NUMBER_INT:
8971 	    w2 = *((const Tcl_WideInt *)ptr2);
8972 	    d2 = (double) w2;
8973 	    if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)
8974 		    || w2 == (Tcl_WideInt) d2 || modf(d1, &tmp) != 0.0) {
8975 		goto doubleCompare;
8976 	    }
8977 	    if (d1 < (double)WIDE_MIN) {
8978 		return MP_LT;
8979 	    }
8980 	    if (d1 > (double)WIDE_MAX) {
8981 		return MP_GT;
8982 	    }
8983 	    w1 = (Tcl_WideInt) d1;
8984 	    goto wideCompare;
8985 	case TCL_NUMBER_BIG:
8986 	    if (TclIsInfinite(d1)) {
8987 		return (d1 > 0.0) ? MP_GT : MP_LT;
8988 	    }
8989 	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
8990 	    if ((d1 < (double)WIDE_MAX) && (d1 > (double)WIDE_MIN)) {
8991 		if (mp_isneg(&big2)) {
8992 		    compare = MP_GT;
8993 		} else {
8994 		    compare = MP_LT;
8995 		}
8996 		mp_clear(&big2);
8997 		return compare;
8998 	    }
8999 	    if (DBL_MANT_DIG > CHAR_BIT*sizeof(long)
9000 		    && modf(d1, &tmp) != 0.0) {
9001 		d2 = TclBignumToDouble(&big2);
9002 		mp_clear(&big2);
9003 		goto doubleCompare;
9004 	    }
9005 	    Tcl_InitBignumFromDouble(NULL, d1, &big1);
9006 	    goto bigCompare;
9007 	}
9008     break;
9009 
9010     case TCL_NUMBER_BIG:
9011 	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
9012 	switch (type2) {
9013 	case TCL_NUMBER_INT:
9014 	    compare = mp_cmp_d(&big1, 0);
9015 	    mp_clear(&big1);
9016 	    return compare;
9017 	case TCL_NUMBER_DOUBLE:
9018 	    d2 = *((const double *)ptr2);
9019 	    if (TclIsInfinite(d2)) {
9020 		compare = (d2 > 0.0) ? MP_LT : MP_GT;
9021 		mp_clear(&big1);
9022 		return compare;
9023 	    }
9024 	    if ((d2 < (double)WIDE_MAX) && (d2 > (double)WIDE_MIN)) {
9025 		compare = mp_cmp_d(&big1, 0);
9026 		mp_clear(&big1);
9027 		return compare;
9028 	    }
9029 	    if (DBL_MANT_DIG > CHAR_BIT*sizeof(long)
9030 		    && modf(d2, &tmp) != 0.0) {
9031 		d1 = TclBignumToDouble(&big1);
9032 		mp_clear(&big1);
9033 		goto doubleCompare;
9034 	    }
9035 	    Tcl_InitBignumFromDouble(NULL, d2, &big2);
9036 	    goto bigCompare;
9037 	case TCL_NUMBER_BIG:
9038 	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
9039 	bigCompare:
9040 	    compare = mp_cmp(&big1, &big2);
9041 	    mp_clear(&big1);
9042 	    mp_clear(&big2);
9043 	    return compare;
9044 	}
9045     break;
9046     default:
9047 	Tcl_Panic("unexpected number type");
9048     }
9049     return TCL_ERROR;
9050 }
9051 
9052 #ifdef TCL_COMPILE_DEBUG
9053 /*
9054  *----------------------------------------------------------------------
9055  *
9056  * PrintByteCodeInfo --
9057  *
9058  *	This procedure prints a summary about a bytecode object to stdout. It
9059  *	is called by TclNRExecuteByteCode when starting to execute the bytecode
9060  *	object if tclTraceExec has the value 2 or more.
9061  *
9062  * Results:
9063  *	None.
9064  *
9065  * Side effects:
9066  *	None.
9067  *
9068  *----------------------------------------------------------------------
9069  */
9070 
9071 static void
PrintByteCodeInfo(ByteCode * codePtr)9072 PrintByteCodeInfo(
9073     ByteCode *codePtr)	/* The bytecode whose summary is printed to
9074 				 * stdout. */
9075 {
9076     Proc *procPtr = codePtr->procPtr;
9077     Interp *iPtr = (Interp *) *codePtr->interpHandle;
9078 
9079     fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER "u, epoch %u, interp 0x%p (epoch %u)\n",
9080 	    codePtr, (size_t)codePtr->refCount, codePtr->compileEpoch, iPtr,
9081 	    iPtr->compileEpoch);
9082 
9083     fprintf(stdout, "  Source: ");
9084     TclPrintSource(stdout, codePtr->source, 60);
9085 
9086     fprintf(stdout, "\n  Cmds %d, src %d, inst %u, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
9087 	    codePtr->numCommands, codePtr->numSrcBytes,
9088 	    codePtr->numCodeBytes, codePtr->numLitObjects,
9089 	    codePtr->numAuxDataItems, codePtr->maxStackDepth,
9090 #ifdef TCL_COMPILE_STATS
9091 	    codePtr->numSrcBytes?
9092 		    ((float)codePtr->structureSize)/codePtr->numSrcBytes :
9093 #endif
9094 	    0.0);
9095 
9096 #ifdef TCL_COMPILE_STATS
9097     fprintf(stdout, "  Code %lu = header %lu+inst %d+litObj %lu+exc %lu+aux %lu+cmdMap %d\n",
9098 	    (unsigned long) codePtr->structureSize,
9099 	    (unsigned long) (sizeof(ByteCode)-sizeof(size_t)-sizeof(Tcl_Time)),
9100 	    codePtr->numCodeBytes,
9101 	    (unsigned long) (codePtr->numLitObjects * sizeof(Tcl_Obj *)),
9102 	    (unsigned long) (codePtr->numExceptRanges*sizeof(ExceptionRange)),
9103 	    (unsigned long) (codePtr->numAuxDataItems * sizeof(AuxData)),
9104 	    codePtr->numCmdLocBytes);
9105 #endif /* TCL_COMPILE_STATS */
9106     if (procPtr != NULL) {
9107 	fprintf(stdout,
9108 		"  Proc 0x%p, refCt %d, args %d, compiled locals %d\n",
9109 		procPtr, procPtr->refCount, procPtr->numArgs,
9110 		procPtr->numCompiledLocals);
9111     }
9112 }
9113 #endif /* TCL_COMPILE_DEBUG */
9114 
9115 /*
9116  *----------------------------------------------------------------------
9117  *
9118  * ValidatePcAndStackTop --
9119  *
9120  *	This procedure is called by TclNRExecuteByteCode when debugging to
9121  *	verify that the program counter and stack top are valid during
9122  *	execution.
9123  *
9124  * Results:
9125  *	None.
9126  *
9127  * Side effects:
9128  *	Prints a message to stderr and panics if either the pc or stack top
9129  *	are invalid.
9130  *
9131  *----------------------------------------------------------------------
9132  */
9133 
9134 #ifdef TCL_COMPILE_DEBUG
9135 static void
ValidatePcAndStackTop(ByteCode * codePtr,const unsigned char * pc,int stackTop,int checkStack)9136 ValidatePcAndStackTop(
9137     ByteCode *codePtr,	/* The bytecode whose summary is printed to
9138 				 * stdout. */
9139     const unsigned char *pc,	/* Points to first byte of a bytecode
9140 				 * instruction. The program counter. */
9141     int stackTop,		/* Current stack top. Must be between
9142 				 * stackLowerBound and stackUpperBound
9143 				 * (inclusive). */
9144     int checkStack)		/* 0 if the stack depth check should be
9145 				 * skipped. */
9146 {
9147     int stackUpperBound = codePtr->maxStackDepth;
9148 				/* Greatest legal value for stackTop. */
9149     size_t relativePc = (size_t) (pc - codePtr->codeStart);
9150     size_t codeStart = (size_t) codePtr->codeStart;
9151     size_t codeEnd = (size_t)
9152 	    (codePtr->codeStart + codePtr->numCodeBytes);
9153     unsigned char opCode = *pc;
9154 
9155     if (((size_t) pc < codeStart) || ((size_t) pc > codeEnd)) {
9156 	fprintf(stderr, "\nBad instruction pc 0x%p in TclNRExecuteByteCode\n",
9157 		pc);
9158 	Tcl_Panic("TclNRExecuteByteCode execution failure: bad pc");
9159     }
9160     if ((unsigned) opCode > LAST_INST_OPCODE) {
9161 	fprintf(stderr, "\nBad opcode %d at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode\n",
9162 		(unsigned) opCode, relativePc);
9163 	Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode");
9164     }
9165     if (checkStack &&
9166 	    ((stackTop < 0) || (stackTop > stackUpperBound))) {
9167 	int numChars;
9168 	const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL);
9169 
9170 	fprintf(stderr, "\nBad stack top %d at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode (min 0, max %i)",
9171 		stackTop, relativePc, stackUpperBound);
9172 	if (cmd != NULL) {
9173 	    Tcl_Obj *message;
9174 
9175 	    TclNewLiteralStringObj(message, "\n executing ");
9176 	    Tcl_IncrRefCount(message);
9177 	    Tcl_AppendLimitedToObj(message, cmd, numChars, 100, NULL);
9178 	    fprintf(stderr,"%s\n", TclGetString(message));
9179 	    Tcl_DecrRefCount(message);
9180 	} else {
9181 	    fprintf(stderr, "\n");
9182 	}
9183 	Tcl_Panic("TclNRExecuteByteCode execution failure: bad stack top");
9184     }
9185 }
9186 #endif /* TCL_COMPILE_DEBUG */
9187 
9188 /*
9189  *----------------------------------------------------------------------
9190  *
9191  * IllegalExprOperandType --
9192  *
9193  *	Used by TclNRExecuteByteCode to append an error message to the interp
9194  *	result when an illegal operand type is detected by an expression
9195  *	instruction. The argument opndPtr holds the operand object in error.
9196  *
9197  * Results:
9198  *	None.
9199  *
9200  * Side effects:
9201  *	An error message is appended to the interp result.
9202  *
9203  *----------------------------------------------------------------------
9204  */
9205 
9206 static void
IllegalExprOperandType(Tcl_Interp * interp,const unsigned char * pc,Tcl_Obj * opndPtr)9207 IllegalExprOperandType(
9208     Tcl_Interp *interp,		/* Interpreter to which error information
9209 				 * pertains. */
9210     const unsigned char *pc, /* Points to the instruction being executed
9211 				 * when the illegal type was found. */
9212     Tcl_Obj *opndPtr)		/* Points to the operand holding the value
9213 				 * with the illegal type. */
9214 {
9215     ClientData ptr;
9216     int type;
9217     const unsigned char opcode = *pc;
9218     const char *description, *op = "unknown";
9219 
9220     if (opcode == INST_EXPON) {
9221 	op = "**";
9222     } else if (opcode <= INST_LNOT) {
9223 	op = operatorStrings[opcode - INST_LOR];
9224     }
9225 
9226     if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) {
9227 	int numBytes;
9228 	const char *bytes = TclGetStringFromObj(opndPtr, &numBytes);
9229 
9230 	if (numBytes == 0) {
9231 	    description = "empty string";
9232 	} else if (TclCheckBadOctal(NULL, bytes)) {
9233 	    description = "invalid octal number";
9234 	} else {
9235 	    description = "non-numeric string";
9236 	}
9237     } else if (type == TCL_NUMBER_NAN) {
9238 	description = "non-numeric floating-point value";
9239     } else if (type == TCL_NUMBER_DOUBLE) {
9240 	description = "floating-point value";
9241     } else {
9242 	/* TODO: No caller needs this. Eliminate? */
9243 	description = "(big) integer";
9244     }
9245 
9246     Tcl_SetObjResult(interp, Tcl_ObjPrintf(
9247 	    "can't use %s as operand of \"%s\"", description, op));
9248     Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL);
9249 }
9250 
9251 /*
9252  *----------------------------------------------------------------------
9253  *
9254  * TclGetSrcInfoForPc, GetSrcInfoForPc, TclGetSourceFromFrame --
9255  *
9256  *	Given a program counter value, finds the closest command in the
9257  *	bytecode code unit's CmdLocation array and returns information about
9258  *	that command's source: a pointer to its first byte and the number of
9259  *	characters.
9260  *
9261  * Results:
9262  *	If a command is found that encloses the program counter value, a
9263  *	pointer to the command's source is returned and the length of the
9264  *	source is stored at *lengthPtr. If multiple commands resulted in code
9265  *	at pc, information about the closest enclosing command is returned. If
9266  *	no matching command is found, NULL is returned and *lengthPtr is
9267  *	unchanged.
9268  *
9269  * Side effects:
9270  *	The CmdFrame at *cfPtr is updated.
9271  *
9272  *----------------------------------------------------------------------
9273  */
9274 
9275 Tcl_Obj *
TclGetSourceFromFrame(CmdFrame * cfPtr,int objc,Tcl_Obj * const objv[])9276 TclGetSourceFromFrame(
9277     CmdFrame *cfPtr,
9278     int objc,
9279     Tcl_Obj *const objv[])
9280 {
9281     if (cfPtr == NULL) {
9282         return Tcl_NewListObj(objc, objv);
9283     }
9284     if (cfPtr->cmdObj == NULL) {
9285         if (cfPtr->cmd == NULL) {
9286 	    ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
9287 
9288             cfPtr->cmd = GetSrcInfoForPc((unsigned char *)
9289 		    cfPtr->data.tebc.pc, codePtr, &cfPtr->len, NULL, NULL);
9290         }
9291 	if (cfPtr->cmd) {
9292 	    cfPtr->cmdObj = Tcl_NewStringObj(cfPtr->cmd, cfPtr->len);
9293 	} else {
9294 	    cfPtr->cmdObj = Tcl_NewListObj(objc, objv);
9295 	}
9296         Tcl_IncrRefCount(cfPtr->cmdObj);
9297     }
9298     return cfPtr->cmdObj;
9299 }
9300 
9301 void
TclGetSrcInfoForPc(CmdFrame * cfPtr)9302 TclGetSrcInfoForPc(
9303     CmdFrame *cfPtr)
9304 {
9305     ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
9306 
9307     assert(cfPtr->type == TCL_LOCATION_BC);
9308 
9309     if (cfPtr->cmd == NULL) {
9310 
9311 	cfPtr->cmd = GetSrcInfoForPc(
9312 		(unsigned char *) cfPtr->data.tebc.pc, codePtr,
9313 		&cfPtr->len, NULL, NULL);
9314     }
9315 
9316     if (cfPtr->cmd != NULL) {
9317 	/*
9318 	 * We now have the command. We can get the srcOffset back and from
9319 	 * there find the list of word locations for this command.
9320 	 */
9321 
9322 	ExtCmdLoc *eclPtr;
9323 	ECL *locPtr = NULL;
9324 	int srcOffset, i;
9325 	Interp *iPtr = (Interp *) *codePtr->interpHandle;
9326 	Tcl_HashEntry *hePtr =
9327 		Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);
9328 
9329 	if (!hePtr) {
9330 	    return;
9331 	}
9332 
9333 	srcOffset = cfPtr->cmd - codePtr->source;
9334 	eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hePtr);
9335 
9336 	for (i=0; i < eclPtr->nuloc; i++) {
9337 	    if (eclPtr->loc[i].srcOffset == srcOffset) {
9338 		locPtr = eclPtr->loc+i;
9339 		break;
9340 	    }
9341 	}
9342 	if (locPtr == NULL) {
9343 	    Tcl_Panic("LocSearch failure");
9344 	}
9345 
9346 	cfPtr->line = locPtr->line;
9347 	cfPtr->nline = locPtr->nline;
9348 	cfPtr->type = eclPtr->type;
9349 
9350 	if (eclPtr->type == TCL_LOCATION_SOURCE) {
9351 	    cfPtr->data.eval.path = eclPtr->path;
9352 	    Tcl_IncrRefCount(cfPtr->data.eval.path);
9353 	}
9354 
9355 	/*
9356 	 * Do not set cfPtr->data.eval.path NULL for non-SOURCE. Needed for
9357 	 * cfPtr->data.tebc.codePtr.
9358 	 */
9359     }
9360 }
9361 
9362 static const char *
GetSrcInfoForPc(const unsigned char * pc,ByteCode * codePtr,int * lengthPtr,const unsigned char ** pcBeg,int * cmdIdxPtr)9363 GetSrcInfoForPc(
9364     const unsigned char *pc,	/* The program counter value for which to
9365 				 * return the closest command's source info.
9366 				 * This points within a bytecode instruction
9367 				 * in codePtr's code. */
9368     ByteCode *codePtr,		/* The bytecode sequence in which to look up
9369 				 * the command source for the pc. */
9370     int *lengthPtr,		/* If non-NULL, the location where the length
9371 				 * of the command's source should be stored.
9372 				 * If NULL, no length is stored. */
9373     const unsigned char **pcBeg,/* If non-NULL, the bytecode location
9374 				 * where the current instruction starts.
9375 				 * If NULL; no pointer is stored. */
9376     int *cmdIdxPtr)		/* If non-NULL, the location where the index
9377 				 * of the command containing the pc should
9378 				 * be stored. */
9379 {
9380     int pcOffset = (pc - codePtr->codeStart);
9381     int numCmds = codePtr->numCommands;
9382     unsigned char *codeDeltaNext, *codeLengthNext;
9383     unsigned char *srcDeltaNext, *srcLengthNext;
9384     int codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i;
9385     int bestDist = INT_MAX;	/* Distance of pc to best cmd's start pc. */
9386     int bestSrcOffset = -1;	/* Initialized to avoid compiler warning. */
9387     int bestSrcLength = -1;	/* Initialized to avoid compiler warning. */
9388     int bestCmdIdx = -1;
9389 
9390     /* The pc must point within the bytecode */
9391     assert ((pcOffset >= 0) && (pcOffset < codePtr->numCodeBytes));
9392 
9393     /*
9394      * Decode the code and source offset and length for each command. The
9395      * closest enclosing command is the last one whose code started before
9396      * pcOffset.
9397      */
9398 
9399     codeDeltaNext = codePtr->codeDeltaStart;
9400     codeLengthNext = codePtr->codeLengthStart;
9401     srcDeltaNext = codePtr->srcDeltaStart;
9402     srcLengthNext = codePtr->srcLengthStart;
9403     codeOffset = srcOffset = 0;
9404     for (i = 0;  i < numCmds;  i++) {
9405 	if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) {
9406 	    codeDeltaNext++;
9407 	    delta = TclGetInt4AtPtr(codeDeltaNext);
9408 	    codeDeltaNext += 4;
9409 	} else {
9410 	    delta = TclGetInt1AtPtr(codeDeltaNext);
9411 	    codeDeltaNext++;
9412 	}
9413 	codeOffset += delta;
9414 
9415 	if ((unsigned) *codeLengthNext == (unsigned) 0xFF) {
9416 	    codeLengthNext++;
9417 	    codeLen = TclGetInt4AtPtr(codeLengthNext);
9418 	    codeLengthNext += 4;
9419 	} else {
9420 	    codeLen = TclGetInt1AtPtr(codeLengthNext);
9421 	    codeLengthNext++;
9422 	}
9423 	codeEnd = (codeOffset + codeLen - 1);
9424 
9425 	if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
9426 	    srcDeltaNext++;
9427 	    delta = TclGetInt4AtPtr(srcDeltaNext);
9428 	    srcDeltaNext += 4;
9429 	} else {
9430 	    delta = TclGetInt1AtPtr(srcDeltaNext);
9431 	    srcDeltaNext++;
9432 	}
9433 	srcOffset += delta;
9434 
9435 	if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
9436 	    srcLengthNext++;
9437 	    srcLen = TclGetInt4AtPtr(srcLengthNext);
9438 	    srcLengthNext += 4;
9439 	} else {
9440 	    srcLen = TclGetInt1AtPtr(srcLengthNext);
9441 	    srcLengthNext++;
9442 	}
9443 
9444 	if (codeOffset > pcOffset) {	/* Best cmd already found */
9445 	    break;
9446 	}
9447 	if (pcOffset <= codeEnd) {	/* This cmd's code encloses pc */
9448 	    int dist = (pcOffset - codeOffset);
9449 
9450 	    if (dist <= bestDist) {
9451 		bestDist = dist;
9452 		bestSrcOffset = srcOffset;
9453 		bestSrcLength = srcLen;
9454 		bestCmdIdx = i;
9455 	    }
9456 	}
9457     }
9458 
9459     if (pcBeg != NULL) {
9460 	const unsigned char *curr, *prev;
9461 
9462 	/*
9463 	 * Walk from beginning of command or BC to pc, by complete
9464 	 * instructions. Stop when crossing pc; keep previous.
9465 	 */
9466 
9467 	curr = ((bestDist == INT_MAX) ? codePtr->codeStart : pc - bestDist);
9468 	prev = curr;
9469 	while (curr <= pc) {
9470 	    prev = curr;
9471 	    curr += tclInstructionTable[*curr].numBytes;
9472 	}
9473 	*pcBeg = prev;
9474     }
9475 
9476     if (bestDist == INT_MAX) {
9477 	return NULL;
9478     }
9479 
9480     if (lengthPtr != NULL) {
9481 	*lengthPtr = bestSrcLength;
9482     }
9483 
9484     if (cmdIdxPtr != NULL) {
9485 	*cmdIdxPtr = bestCmdIdx;
9486     }
9487 
9488     return (codePtr->source + bestSrcOffset);
9489 }
9490 
9491 /*
9492  *----------------------------------------------------------------------
9493  *
9494  * GetExceptRangeForPc --
9495  *
9496  *	Given a program counter value, return the closest enclosing
9497  *	ExceptionRange.
9498  *
9499  * Results:
9500  *	If the searchMode is TCL_ERROR, this procedure ignores loop exception
9501  *	ranges and returns a pointer to the closest catch range. If the
9502  *	searchMode is TCL_BREAK, this procedure returns a pointer to the most
9503  *	closely enclosing ExceptionRange regardless of whether it is a loop or
9504  *	catch exception range. If the searchMode is TCL_CONTINUE, this
9505  *	procedure returns a pointer to the most closely enclosing
9506  *	ExceptionRange (of any type) skipping only loop exception ranges if
9507  *	they don't have a sensible continueOffset defined. If no matching
9508  *	ExceptionRange is found that encloses pc, a NULL is returned.
9509  *
9510  * Side effects:
9511  *	None.
9512  *
9513  *----------------------------------------------------------------------
9514  */
9515 
9516 static ExceptionRange *
GetExceptRangeForPc(const unsigned char * pc,int searchMode,ByteCode * codePtr)9517 GetExceptRangeForPc(
9518     const unsigned char *pc,	/* The program counter value for which to
9519 				 * search for a closest enclosing exception
9520 				 * range. This points to a bytecode
9521 				 * instruction in codePtr's code. */
9522     int searchMode,		/* If TCL_BREAK, consider either loop or catch
9523 				 * ExceptionRanges in search. If TCL_ERROR
9524 				 * consider only catch ranges (and ignore any
9525 				 * closer loop ranges). If TCL_CONTINUE, look
9526 				 * for loop ranges that define a continue
9527 				 * point or a catch range. */
9528     ByteCode *codePtr)		/* Points to the ByteCode in which to search
9529 				 * for the enclosing ExceptionRange. */
9530 {
9531     ExceptionRange *rangeArrayPtr;
9532     int numRanges = codePtr->numExceptRanges;
9533     ExceptionRange *rangePtr;
9534     int pcOffset = pc - codePtr->codeStart;
9535     int start;
9536 
9537     if (numRanges == 0) {
9538 	return NULL;
9539     }
9540 
9541     /*
9542      * This exploits peculiarities of our compiler: nested ranges are always
9543      * *after* their containing ranges, so that by scanning backwards we are
9544      * sure that the first matching range is indeed the deepest.
9545      */
9546 
9547     rangeArrayPtr = codePtr->exceptArrayPtr;
9548     rangePtr = rangeArrayPtr + numRanges;
9549     while (--rangePtr >= rangeArrayPtr) {
9550 	start = rangePtr->codeOffset;
9551 	if ((start <= pcOffset) &&
9552 		(pcOffset < (start + rangePtr->numCodeBytes))) {
9553 	    if (rangePtr->type == CATCH_EXCEPTION_RANGE) {
9554 		return rangePtr;
9555 	    }
9556 	    if (searchMode == TCL_BREAK) {
9557 		return rangePtr;
9558 	    }
9559 	    if (searchMode == TCL_CONTINUE && rangePtr->continueOffset != -1){
9560 		return rangePtr;
9561 	    }
9562 	}
9563     }
9564     return NULL;
9565 }
9566 
9567 /*
9568  *----------------------------------------------------------------------
9569  *
9570  * GetOpcodeName --
9571  *
9572  *	This procedure is called by the TRACE and TRACE_WITH_OBJ macros used
9573  *	in TclNRExecuteByteCode when debugging. It returns the name of the
9574  *	bytecode instruction at a specified instruction pc.
9575  *
9576  * Results:
9577  *	A character string for the instruction.
9578  *
9579  * Side effects:
9580  *	None.
9581  *
9582  *----------------------------------------------------------------------
9583  */
9584 
9585 #ifdef TCL_COMPILE_DEBUG
9586 static const char *
GetOpcodeName(const unsigned char * pc)9587 GetOpcodeName(
9588     const unsigned char *pc)	/* Points to the instruction whose name should
9589 				 * be returned. */
9590 {
9591     unsigned char opCode = *pc;
9592 
9593     return tclInstructionTable[opCode].name;
9594 }
9595 #endif /* TCL_COMPILE_DEBUG */
9596 
9597 /*
9598  *----------------------------------------------------------------------
9599  *
9600  * TclExprFloatError --
9601  *
9602  *	This procedure is called when an error occurs during a floating-point
9603  *	operation. It reads errno and sets interp->objResultPtr accordingly.
9604  *
9605  * Results:
9606  *	interp->objResultPtr is set to hold an error message.
9607  *
9608  * Side effects:
9609  *	None.
9610  *
9611  *----------------------------------------------------------------------
9612  */
9613 
9614 void
TclExprFloatError(Tcl_Interp * interp,double value)9615 TclExprFloatError(
9616     Tcl_Interp *interp,		/* Where to store error message. */
9617     double value)		/* Value returned after error; used to
9618 				 * distinguish underflows from overflows. */
9619 {
9620     const char *s;
9621 
9622     if ((errno == EDOM) || TclIsNaN(value)) {
9623 	s = "domain error: argument not in valid range";
9624 	Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
9625 	Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", s, NULL);
9626     } else if ((errno == ERANGE) || TclIsInfinite(value)) {
9627 	if (value == 0.0) {
9628 	    s = "floating-point value too small to represent";
9629 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
9630 	    Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", s, NULL);
9631 	} else {
9632 	    s = "floating-point value too large to represent";
9633 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
9634 	    Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, NULL);
9635 	}
9636     } else {
9637 	Tcl_Obj *objPtr = Tcl_ObjPrintf(
9638 		"unknown floating-point error, errno = %d", errno);
9639 
9640 	Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN",
9641 		TclGetString(objPtr), NULL);
9642 	Tcl_SetObjResult(interp, objPtr);
9643     }
9644 }
9645 
9646 #ifdef TCL_COMPILE_STATS
9647 /*
9648  *----------------------------------------------------------------------
9649  *
9650  * TclLog2 --
9651  *
9652  *	Procedure used while collecting compilation statistics to determine
9653  *	the log base 2 of an integer.
9654  *
9655  * Results:
9656  *	Returns the log base 2 of the operand. If the argument is less than or
9657  *	equal to zero, a zero is returned.
9658  *
9659  * Side effects:
9660  *	None.
9661  *
9662  *----------------------------------------------------------------------
9663  */
9664 
9665 int
TclLog2(int value)9666 TclLog2(
9667     int value)		/* The integer for which to compute the log
9668 				 * base 2. */
9669 {
9670     int n = value;
9671     int result = 0;
9672 
9673     while (n > 1) {
9674 	n = n >> 1;
9675 	result++;
9676     }
9677     return result;
9678 }
9679 
9680 /*
9681  *----------------------------------------------------------------------
9682  *
9683  * EvalStatsCmd --
9684  *
9685  *	Implements the "evalstats" command that prints instruction execution
9686  *	counts to stdout.
9687  *
9688  * Results:
9689  *	Standard Tcl results.
9690  *
9691  * Side effects:
9692  *	None.
9693  *
9694  *----------------------------------------------------------------------
9695  */
9696 
9697 static int
EvalStatsCmd(TCL_UNUSED (void *),Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])9698 EvalStatsCmd(
9699     TCL_UNUSED(void *),		/* Unused. */
9700     Tcl_Interp *interp,		/* The current interpreter. */
9701     int objc,			/* The number of arguments. */
9702     Tcl_Obj *const objv[])	/* The argument strings. */
9703 {
9704     Interp *iPtr = (Interp *) interp;
9705     LiteralTable *globalTablePtr = &iPtr->literalTable;
9706     ByteCodeStats *statsPtr = &iPtr->stats;
9707     double totalCodeBytes, currentCodeBytes;
9708     double totalLiteralBytes, currentLiteralBytes;
9709     double objBytesIfUnshared, strBytesIfUnshared, sharingBytesSaved;
9710     double strBytesSharedMultX, strBytesSharedOnce;
9711     double numInstructions, currentHeaderBytes;
9712     size_t numCurrentByteCodes, numByteCodeLits;
9713     size_t refCountSum, literalMgmtBytes, sum;
9714     size_t numSharedMultX, numSharedOnce, minSizeDecade, maxSizeDecade, i;
9715     int decadeHigh, length;
9716     char *litTableStats;
9717     LiteralEntry *entryPtr;
9718     Tcl_Obj *objPtr;
9719 
9720 #define Percent(a,b) ((a) * 100.0 / (b))
9721 
9722     TclNewObj(objPtr);
9723     Tcl_IncrRefCount(objPtr);
9724 
9725     numInstructions = 0.0;
9726     for (i = 0;  i < 256;  i++) {
9727 	if (statsPtr->instructionCount[i] != 0) {
9728 	    numInstructions += statsPtr->instructionCount[i];
9729 	}
9730     }
9731 
9732     totalLiteralBytes = sizeof(LiteralTable)
9733 	    + iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)
9734 	    + (statsPtr->numLiteralsCreated * sizeof(LiteralEntry))
9735 	    + (statsPtr->numLiteralsCreated * sizeof(Tcl_Obj))
9736 	    + statsPtr->totalLitStringBytes;
9737     totalCodeBytes = statsPtr->totalByteCodeBytes + totalLiteralBytes;
9738 
9739     numCurrentByteCodes =
9740 	    statsPtr->numCompilations - statsPtr->numByteCodesFreed;
9741     currentHeaderBytes = numCurrentByteCodes
9742 	    * (sizeof(ByteCode) - sizeof(size_t) - sizeof(Tcl_Time));
9743     literalMgmtBytes = sizeof(LiteralTable)
9744 	    + (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *))
9745 	    + (iPtr->literalTable.numEntries * sizeof(LiteralEntry));
9746     currentLiteralBytes = literalMgmtBytes
9747 	    + iPtr->literalTable.numEntries * sizeof(Tcl_Obj)
9748 	    + statsPtr->currentLitStringBytes;
9749     currentCodeBytes = statsPtr->currentByteCodeBytes + currentLiteralBytes;
9750 
9751     /*
9752      * Summary statistics, total and current source and ByteCode sizes.
9753      */
9754 
9755     Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n");
9756     Tcl_AppendPrintfToObj(objPtr,
9757 	    "Compilation and execution statistics for interpreter %#" TCL_Z_MODIFIER "x\n",
9758 	    (size_t)iPtr);
9759 
9760     Tcl_AppendPrintfToObj(objPtr, "\nNumber ByteCodes executed\t%" TCL_Z_MODIFIER "u\n",
9761 	    statsPtr->numExecutions);
9762     Tcl_AppendPrintfToObj(objPtr, "Number ByteCodes compiled\t%" TCL_Z_MODIFIER "u\n",
9763 	    statsPtr->numCompilations);
9764     Tcl_AppendPrintfToObj(objPtr, "  Mean executions/compile\t%.1f\n",
9765 	    statsPtr->numExecutions / (float)statsPtr->numCompilations);
9766 
9767     Tcl_AppendPrintfToObj(objPtr, "\nInstructions executed\t\t%.0f\n",
9768 	    numInstructions);
9769     Tcl_AppendPrintfToObj(objPtr, "  Mean inst/compile\t\t%.0f\n",
9770 	    numInstructions / statsPtr->numCompilations);
9771     Tcl_AppendPrintfToObj(objPtr, "  Mean inst/execution\t\t%.0f\n",
9772 	    numInstructions / statsPtr->numExecutions);
9773 
9774     Tcl_AppendPrintfToObj(objPtr, "\nTotal ByteCodes\t\t\t%" TCL_Z_MODIFIER "u\n",
9775 	    statsPtr->numCompilations);
9776     Tcl_AppendPrintfToObj(objPtr, "  Source bytes\t\t\t%.6g\n",
9777 	    statsPtr->totalSrcBytes);
9778     Tcl_AppendPrintfToObj(objPtr, "  Code bytes\t\t\t%.6g\n",
9779 	    totalCodeBytes);
9780     Tcl_AppendPrintfToObj(objPtr, "    ByteCode bytes\t\t%.6g\n",
9781 	    statsPtr->totalByteCodeBytes);
9782     Tcl_AppendPrintfToObj(objPtr, "    Literal bytes\t\t%.6g\n",
9783 	    totalLiteralBytes);
9784     Tcl_AppendPrintfToObj(objPtr, "      table %" TCL_Z_MODIFIER "u + bkts %" TCL_Z_MODIFIER "u + entries %" TCL_Z_MODIFIER "u + objects %" TCL_Z_MODIFIER "u + strings %.6g\n",
9785 	    sizeof(LiteralTable),
9786 	    iPtr->literalTable.numBuckets * sizeof(LiteralEntry *),
9787 	    statsPtr->numLiteralsCreated * sizeof(LiteralEntry),
9788 	    statsPtr->numLiteralsCreated * sizeof(Tcl_Obj),
9789 	    statsPtr->totalLitStringBytes);
9790     Tcl_AppendPrintfToObj(objPtr, "  Mean code/compile\t\t%.1f\n",
9791 	    totalCodeBytes / statsPtr->numCompilations);
9792     Tcl_AppendPrintfToObj(objPtr, "  Mean code/source\t\t%.1f\n",
9793 	    totalCodeBytes / statsPtr->totalSrcBytes);
9794 
9795     Tcl_AppendPrintfToObj(objPtr, "\nCurrent (active) ByteCodes\t%" TCL_Z_MODIFIER "u\n",
9796 	    numCurrentByteCodes);
9797     Tcl_AppendPrintfToObj(objPtr, "  Source bytes\t\t\t%.6g\n",
9798 	    statsPtr->currentSrcBytes);
9799     Tcl_AppendPrintfToObj(objPtr, "  Code bytes\t\t\t%.6g\n",
9800 	    currentCodeBytes);
9801     Tcl_AppendPrintfToObj(objPtr, "    ByteCode bytes\t\t%.6g\n",
9802 	    statsPtr->currentByteCodeBytes);
9803     Tcl_AppendPrintfToObj(objPtr, "    Literal bytes\t\t%.6g\n",
9804 	    currentLiteralBytes);
9805     Tcl_AppendPrintfToObj(objPtr, "      table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n",
9806 	    (unsigned long) sizeof(LiteralTable),
9807 	    (unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)),
9808 	    (unsigned long) (iPtr->literalTable.numEntries * sizeof(LiteralEntry)),
9809 	    (unsigned long) (iPtr->literalTable.numEntries * sizeof(Tcl_Obj)),
9810 	    statsPtr->currentLitStringBytes);
9811     Tcl_AppendPrintfToObj(objPtr, "  Mean code/source\t\t%.1f\n",
9812 	    currentCodeBytes / statsPtr->currentSrcBytes);
9813     Tcl_AppendPrintfToObj(objPtr, "  Code + source bytes\t\t%.6g (%0.1f mean code/src)\n",
9814 	    (currentCodeBytes + statsPtr->currentSrcBytes),
9815 	    (currentCodeBytes / statsPtr->currentSrcBytes) + 1.0);
9816 
9817     /*
9818      * Tcl_IsShared statistics check
9819      *
9820      * This gives the refcount of each obj as Tcl_IsShared was called for it.
9821      * Shared objects must be duplicated before they can be modified.
9822      */
9823 
9824     numSharedMultX = 0;
9825     Tcl_AppendPrintfToObj(objPtr, "\nTcl_IsShared object check (all objects):\n");
9826     Tcl_AppendPrintfToObj(objPtr, "  Object had refcount <=1 (not shared)\t%" TCL_Z_MODIFIER "u\n",
9827 	    tclObjsShared[1]);
9828     for (i = 2;  i < TCL_MAX_SHARED_OBJ_STATS;  i++) {
9829 	Tcl_AppendPrintfToObj(objPtr, "  refcount ==%" TCL_Z_MODIFIER "u\t\t%" TCL_Z_MODIFIER "u\n",
9830 		i, tclObjsShared[i]);
9831 	numSharedMultX += tclObjsShared[i];
9832     }
9833     Tcl_AppendPrintfToObj(objPtr, "  refcount >=%" TCL_Z_MODIFIER "u\t\t%" TCL_Z_MODIFIER "u\n",
9834 	    i, tclObjsShared[0]);
9835     numSharedMultX += tclObjsShared[0];
9836     Tcl_AppendPrintfToObj(objPtr, "  Total shared objects\t\t\t%" TCL_Z_MODIFIER "u\n",
9837 	    numSharedMultX);
9838 
9839     /*
9840      * Literal table statistics.
9841      */
9842 
9843     numByteCodeLits = 0;
9844     refCountSum = 0;
9845     numSharedMultX = 0;
9846     numSharedOnce = 0;
9847     objBytesIfUnshared = 0.0;
9848     strBytesIfUnshared = 0.0;
9849     strBytesSharedMultX = 0.0;
9850     strBytesSharedOnce = 0.0;
9851     for (i = 0;  i < globalTablePtr->numBuckets;  i++) {
9852 	for (entryPtr = globalTablePtr->buckets[i];  entryPtr != NULL;
9853 		entryPtr = entryPtr->nextPtr) {
9854 	    if (TclHasIntRep(entryPtr->objPtr, &tclByteCodeType)) {
9855 		numByteCodeLits++;
9856 	    }
9857 	    (void) TclGetStringFromObj(entryPtr->objPtr, &length);
9858 	    refCountSum += entryPtr->refCount;
9859 	    objBytesIfUnshared += (entryPtr->refCount * sizeof(Tcl_Obj));
9860 	    strBytesIfUnshared += (entryPtr->refCount * (length+1));
9861 	    if (entryPtr->refCount > 1) {
9862 		numSharedMultX++;
9863 		strBytesSharedMultX += (length+1);
9864 	    } else {
9865 		numSharedOnce++;
9866 		strBytesSharedOnce += (length+1);
9867 	    }
9868 	}
9869     }
9870     sharingBytesSaved = (objBytesIfUnshared + strBytesIfUnshared)
9871 	    - currentLiteralBytes;
9872 
9873     Tcl_AppendPrintfToObj(objPtr, "\nTotal objects (all interps)\t%" TCL_Z_MODIFIER "u\n",
9874 	    tclObjsAlloced);
9875     Tcl_AppendPrintfToObj(objPtr, "Current objects\t\t\t%" TCL_Z_MODIFIER "u\n",
9876 	    (tclObjsAlloced - tclObjsFreed));
9877     Tcl_AppendPrintfToObj(objPtr, "Total literal objects\t\t%" TCL_Z_MODIFIER "u\n",
9878 	    statsPtr->numLiteralsCreated);
9879 
9880     Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal objects\t\t%d (%0.1f%% of current objects)\n",
9881 	    globalTablePtr->numEntries,
9882 	    Percent(globalTablePtr->numEntries, tclObjsAlloced-tclObjsFreed));
9883     Tcl_AppendPrintfToObj(objPtr, "  ByteCode literals\t\t%" TCL_Z_MODIFIER "u (%0.1f%% of current literals)\n",
9884 	    numByteCodeLits,
9885 	    Percent(numByteCodeLits, globalTablePtr->numEntries));
9886     Tcl_AppendPrintfToObj(objPtr, "  Literals reused > 1x\t\t%" TCL_Z_MODIFIER "u\n",
9887 	    numSharedMultX);
9888     Tcl_AppendPrintfToObj(objPtr, "  Mean reference count\t\t%.2f\n",
9889 	    ((double) refCountSum) / globalTablePtr->numEntries);
9890     Tcl_AppendPrintfToObj(objPtr, "  Mean len, str reused >1x \t%.2f\n",
9891 	    (numSharedMultX ? strBytesSharedMultX/numSharedMultX : 0.0));
9892     Tcl_AppendPrintfToObj(objPtr, "  Mean len, str used 1x\t\t%.2f\n",
9893 	    (numSharedOnce ? strBytesSharedOnce/numSharedOnce : 0.0));
9894     Tcl_AppendPrintfToObj(objPtr, "  Total sharing savings\t\t%.6g (%0.1f%% of bytes if no sharing)\n",
9895 	    sharingBytesSaved,
9896 	    Percent(sharingBytesSaved, objBytesIfUnshared+strBytesIfUnshared));
9897     Tcl_AppendPrintfToObj(objPtr, "    Bytes with sharing\t\t%.6g\n",
9898 	    currentLiteralBytes);
9899     Tcl_AppendPrintfToObj(objPtr, "      table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n",
9900 	    (unsigned long) sizeof(LiteralTable),
9901 	    (unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)),
9902 	    (unsigned long) (iPtr->literalTable.numEntries * sizeof(LiteralEntry)),
9903 	    (unsigned long) (iPtr->literalTable.numEntries * sizeof(Tcl_Obj)),
9904 	    statsPtr->currentLitStringBytes);
9905     Tcl_AppendPrintfToObj(objPtr, "    Bytes if no sharing\t\t%.6g = objects %.6g + strings %.6g\n",
9906 	    (objBytesIfUnshared + strBytesIfUnshared),
9907 	    objBytesIfUnshared, strBytesIfUnshared);
9908     Tcl_AppendPrintfToObj(objPtr, "  String sharing savings \t%.6g = unshared %.6g - shared %.6g\n",
9909 	    (strBytesIfUnshared - statsPtr->currentLitStringBytes),
9910 	    strBytesIfUnshared, statsPtr->currentLitStringBytes);
9911     Tcl_AppendPrintfToObj(objPtr, "  Literal mgmt overhead\t\t%" TCL_Z_MODIFIER "u (%0.1f%% of bytes with sharing)\n",
9912 	    literalMgmtBytes,
9913 	    Percent(literalMgmtBytes, currentLiteralBytes));
9914     Tcl_AppendPrintfToObj(objPtr, "    table %lu + buckets %lu + entries %lu\n",
9915 	    (unsigned long) sizeof(LiteralTable),
9916 	    (unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)),
9917 	    (unsigned long) (iPtr->literalTable.numEntries * sizeof(LiteralEntry)));
9918 
9919     /*
9920      * Breakdown of current ByteCode space requirements.
9921      */
9922 
9923     Tcl_AppendPrintfToObj(objPtr, "\nBreakdown of current ByteCode requirements:\n");
9924     Tcl_AppendPrintfToObj(objPtr, "                         Bytes      Pct of    Avg per\n");
9925     Tcl_AppendPrintfToObj(objPtr, "                                     total    ByteCode\n");
9926     Tcl_AppendPrintfToObj(objPtr, "Total             %12.6g     100.00%%   %8.1f\n",
9927 	    statsPtr->currentByteCodeBytes,
9928 	    statsPtr->currentByteCodeBytes / numCurrentByteCodes);
9929     Tcl_AppendPrintfToObj(objPtr, "Header            %12.6g   %8.1f%%   %8.1f\n",
9930 	    currentHeaderBytes,
9931 	    Percent(currentHeaderBytes, statsPtr->currentByteCodeBytes),
9932 	    currentHeaderBytes / numCurrentByteCodes);
9933     Tcl_AppendPrintfToObj(objPtr, "Instructions      %12.6g   %8.1f%%   %8.1f\n",
9934 	    statsPtr->currentInstBytes,
9935 	    Percent(statsPtr->currentInstBytes,statsPtr->currentByteCodeBytes),
9936 	    statsPtr->currentInstBytes / numCurrentByteCodes);
9937     Tcl_AppendPrintfToObj(objPtr, "Literal ptr array %12.6g   %8.1f%%   %8.1f\n",
9938 	    statsPtr->currentLitBytes,
9939 	    Percent(statsPtr->currentLitBytes,statsPtr->currentByteCodeBytes),
9940 	    statsPtr->currentLitBytes / numCurrentByteCodes);
9941     Tcl_AppendPrintfToObj(objPtr, "Exception table   %12.6g   %8.1f%%   %8.1f\n",
9942 	    statsPtr->currentExceptBytes,
9943 	    Percent(statsPtr->currentExceptBytes,statsPtr->currentByteCodeBytes),
9944 	    statsPtr->currentExceptBytes / numCurrentByteCodes);
9945     Tcl_AppendPrintfToObj(objPtr, "Auxiliary data    %12.6g   %8.1f%%   %8.1f\n",
9946 	    statsPtr->currentAuxBytes,
9947 	    Percent(statsPtr->currentAuxBytes,statsPtr->currentByteCodeBytes),
9948 	    statsPtr->currentAuxBytes / numCurrentByteCodes);
9949     Tcl_AppendPrintfToObj(objPtr, "Command map       %12.6g   %8.1f%%   %8.1f\n",
9950 	    statsPtr->currentCmdMapBytes,
9951 	    Percent(statsPtr->currentCmdMapBytes,statsPtr->currentByteCodeBytes),
9952 	    statsPtr->currentCmdMapBytes / numCurrentByteCodes);
9953 
9954     /*
9955      * Detailed literal statistics.
9956      */
9957 
9958     Tcl_AppendPrintfToObj(objPtr, "\nLiteral string sizes:\n");
9959     Tcl_AppendPrintfToObj(objPtr, "\t Up to length\t\tPercentage\n");
9960     maxSizeDecade = 0;
9961     i = 32;
9962     while (i-- > 0) {
9963 	if (statsPtr->literalCount[i] > 0) {
9964 	    maxSizeDecade = i;
9965 	    break;
9966 	}
9967     }
9968     sum = 0;
9969     for (i = 0;  i <= maxSizeDecade;  i++) {
9970 	decadeHigh = (1 << (i+1)) - 1;
9971 	sum += statsPtr->literalCount[i];
9972 	Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n",
9973 		decadeHigh, Percent(sum, statsPtr->numLiteralsCreated));
9974     }
9975 
9976     litTableStats = TclLiteralStats(globalTablePtr);
9977     Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal table statistics:\n%s\n",
9978 	    litTableStats);
9979     ckfree(litTableStats);
9980 
9981     /*
9982      * Source and ByteCode size distributions.
9983      */
9984 
9985     Tcl_AppendPrintfToObj(objPtr, "\nSource sizes:\n");
9986     Tcl_AppendPrintfToObj(objPtr, "\t Up to size\t\tPercentage\n");
9987     minSizeDecade = maxSizeDecade = 0;
9988     for (i = 0;  i < 31;  i++) {
9989 	if (statsPtr->srcCount[i] > 0) {
9990 	    minSizeDecade = i;
9991 	    break;
9992 	}
9993     }
9994     for (i = 31;  i != (size_t)-1;  i--) {
9995 	if (statsPtr->srcCount[i] > 0) {
9996 	    maxSizeDecade = i;
9997 	    break;
9998 	}
9999     }
10000     sum = 0;
10001     for (i = minSizeDecade;  i <= maxSizeDecade;  i++) {
10002 	decadeHigh = (1 << (i+1)) - 1;
10003 	sum += statsPtr->srcCount[i];
10004 	Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n",
10005 		decadeHigh, Percent(sum, statsPtr->numCompilations));
10006     }
10007 
10008     Tcl_AppendPrintfToObj(objPtr, "\nByteCode sizes:\n");
10009     Tcl_AppendPrintfToObj(objPtr, "\t Up to size\t\tPercentage\n");
10010     minSizeDecade = maxSizeDecade = 0;
10011     for (i = 0;  i < 31;  i++) {
10012 	if (statsPtr->byteCodeCount[i] > 0) {
10013 	    minSizeDecade = i;
10014 	    break;
10015 	}
10016     }
10017     for (i = 31;  i != (size_t)-1;  i--) {
10018 	if (statsPtr->byteCodeCount[i] > 0) {
10019 	    maxSizeDecade = i;
10020 	    break;
10021 	}
10022     }
10023     sum = 0;
10024     for (i = minSizeDecade;  i <= maxSizeDecade;  i++) {
10025 	decadeHigh = (1 << (i+1)) - 1;
10026 	sum += statsPtr->byteCodeCount[i];
10027 	Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n",
10028 		decadeHigh, Percent(sum, statsPtr->numCompilations));
10029     }
10030 
10031     Tcl_AppendPrintfToObj(objPtr, "\nByteCode longevity (excludes Current ByteCodes):\n");
10032     Tcl_AppendPrintfToObj(objPtr, "\t       Up to ms\t\tPercentage\n");
10033     minSizeDecade = maxSizeDecade = 0;
10034     for (i = 0;  i < 31;  i++) {
10035 	if (statsPtr->lifetimeCount[i] > 0) {
10036 	    minSizeDecade = i;
10037 	    break;
10038 	}
10039     }
10040     for (i = 31;  i != (size_t)-1;  i--) {
10041 	if (statsPtr->lifetimeCount[i] > 0) {
10042 	    maxSizeDecade = i;
10043 	    break;
10044 	}
10045     }
10046     sum = 0;
10047     for (i = minSizeDecade;  i <= maxSizeDecade;  i++) {
10048 	decadeHigh = (1 << (i+1)) - 1;
10049 	sum += statsPtr->lifetimeCount[i];
10050 	Tcl_AppendPrintfToObj(objPtr, "\t%12.3f\t\t%8.0f%%\n",
10051 		decadeHigh/1000.0, Percent(sum, statsPtr->numByteCodesFreed));
10052     }
10053 
10054     /*
10055      * Instruction counts.
10056      */
10057 
10058     Tcl_AppendPrintfToObj(objPtr, "\nInstruction counts:\n");
10059     for (i = 0;  i <= LAST_INST_OPCODE;  i++) {
10060 	Tcl_AppendPrintfToObj(objPtr, "%20s %8" TCL_Z_MODIFIER "u ",
10061 		tclInstructionTable[i].name, statsPtr->instructionCount[i]);
10062 	if (statsPtr->instructionCount[i]) {
10063 	    Tcl_AppendPrintfToObj(objPtr, "%6.1f%%\n",
10064 		    Percent(statsPtr->instructionCount[i], numInstructions));
10065 	} else {
10066 	    Tcl_AppendPrintfToObj(objPtr, "0\n");
10067 	}
10068     }
10069 
10070 #ifdef TCL_MEM_DEBUG
10071     Tcl_AppendPrintfToObj(objPtr, "\nHeap Statistics:\n");
10072     TclDumpMemoryInfo((ClientData) objPtr, 1);
10073 #endif
10074     Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n");
10075 
10076     if (objc == 1) {
10077 	Tcl_SetObjResult(interp, objPtr);
10078     } else {
10079 	Tcl_Channel outChan;
10080 	char *str = TclGetStringFromObj(objv[1], &length);
10081 
10082 	if (length) {
10083 	    if (strcmp(str, "stdout") == 0) {
10084 		outChan = Tcl_GetStdChannel(TCL_STDOUT);
10085 	    } else if (strcmp(str, "stderr") == 0) {
10086 		outChan = Tcl_GetStdChannel(TCL_STDERR);
10087 	    } else {
10088 		outChan = Tcl_OpenFileChannel(NULL, str, "w", 0664);
10089 	    }
10090 	} else {
10091 	    outChan = Tcl_GetStdChannel(TCL_STDOUT);
10092 	}
10093 	if (outChan != NULL) {
10094 	    Tcl_WriteObj(outChan, objPtr);
10095 	}
10096     }
10097     Tcl_DecrRefCount(objPtr);
10098     return TCL_OK;
10099 }
10100 #endif /* TCL_COMPILE_STATS */
10101 
10102 #ifdef TCL_COMPILE_DEBUG
10103 /*
10104  *----------------------------------------------------------------------
10105  *
10106  * StringForResultCode --
10107  *
10108  *	Procedure that returns a human-readable string representing a Tcl
10109  *	result code such as TCL_ERROR.
10110  *
10111  * Results:
10112  *	If the result code is one of the standard Tcl return codes, the result
10113  *	is a string representing that code such as "TCL_ERROR". Otherwise, the
10114  *	result string is that code formatted as a sequence of decimal digit
10115  *	characters. Note that the resulting string must not be modified by the
10116  *	caller.
10117  *
10118  * Side effects:
10119  *	None.
10120  *
10121  *----------------------------------------------------------------------
10122  */
10123 
10124 static const char *
StringForResultCode(int result)10125 StringForResultCode(
10126     int result)			/* The Tcl result code for which to generate a
10127 				 * string. */
10128 {
10129     static char buf[TCL_INTEGER_SPACE];
10130 
10131     if ((result >= TCL_OK) && (result <= TCL_CONTINUE)) {
10132 	return resultStrings[result];
10133     }
10134     TclFormatInt(buf, result);
10135     return buf;
10136 }
10137 #endif /* TCL_COMPILE_DEBUG */
10138 
10139 /*
10140  * Local Variables:
10141  * mode: c
10142  * c-basic-offset: 4
10143  * fill-column: 78
10144  * End:
10145  */
10146