Fork me on GitHub

Context Navigation

source: git/external/tcl/tclExecute.c@ d612dec

Visit:

Last change on this file since d612dec was adeddd8, checked in by Pavel Demin <pavel-demin@…>, 6 years ago
remove debug code from Tcl
Property mode set to `100644`
File size: 108.2 KB

Rev	Line
[d7d2da3]	1	/*
	2	* tclExecute.c --
	3	*
	4	* This file contains procedures that execute byte-compiled Tcl
	5	* commands.
	6	*
	7	* Copyright (c) 1996-1997 Sun Microsystems, Inc.
	8	*
	9	* See the file "license.terms" for information on usage and redistribution
	10	* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
	11	*
	12	* RCS: @(#) $Id: tclExecute.c,v 1.1 2008-06-04 13:58:06 demin Exp $
	13	*/
	14
	15	#include "tclInt.h"
	16	#include "tclCompile.h"
	17
	18	#ifdef NO_FLOAT_H
	19	# include "../compat/float.h"
	20	#else
	21	# include <float.h>
	22	#endif
	23	#ifndef TCL_NO_MATH
	24	#include "tclMath.h"
	25	#endif
	26
	27	/*
	28	* The stuff below is a bit of a hack so that this file can be used
	29	* in environments that include no UNIX, i.e. no errno. Just define
	30	* errno here.
	31	*/
	32
	33	#ifndef TCL_GENERIC_ONLY
	34	#include "tclPort.h"
	35	#else
	36	#define NO_ERRNO_H
	37	#endif
	38
	39	#ifdef NO_ERRNO_H
	40	int errno;
	41	#define EDOM 33
	42	#define ERANGE 34
	43	#endif
	44
	45	/*
	46	* Boolean flag indicating whether the Tcl bytecode interpreter has been
	47	* initialized.
	48	*/
	49
	50	static int execInitialized = 0;
	51
	52	/*
	53	* The following global variable is use to signal matherr that Tcl
	54	* is responsible for the arithmetic, so errors can be handled in a
	55	* fashion appropriate for Tcl. Zero means no Tcl math is in
	56	* progress; non-zero means Tcl is doing math.
	57	*/
	58
	59	int tcl_MathInProgress = 0;
	60
	61	/*
	62	* The variable below serves no useful purpose except to generate
	63	* a reference to matherr, so that the Tcl version of matherr is
	64	* linked in rather than the system version. Without this reference
	65	* the need for matherr won't be discovered during linking until after
	66	* libtcl.a has been processed, so Tcl's version won't be used.
	67	*/
	68
	69	#ifdef NEED_MATHERR
	70	extern int matherr();
	71	int (*tclMatherrPtr)() = matherr;
	72	#endif
	73
	74	/*
	75	* Array of instruction names.
	76	*/
	77
	78	static char *opName[256];
	79
	80	/*
	81	* Mapping from expression instruction opcodes to strings; used for error
	82	* messages. Note that these entries must match the order and number of the
	83	* expression opcodes (e.g., INST_LOR) in tclCompile.h.
	84	*/
	85
	86	static char *operatorStrings[] = {
	87	"\|\|", "&&", "\|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>",
	88	"+", "-", "*", "/", "%", "+", "-", "~", "!",
	89	"BUILTIN FUNCTION", "FUNCTION"
	90	};
	91
	92	/*
	93	* Macros for testing floating-point values for certain special cases. Test
	94	* for not-a-number by comparing a value against itself; test for infinity
	95	* by comparing against the largest floating-point value.
	96	*/
	97
	98	#define IS_NAN(v) ((v) != (v))
	99	#ifdef DBL_MAX
	100	# define IS_INF(v) (((v) > DBL_MAX) \|\| ((v) < -DBL_MAX))
	101	#else
	102	# define IS_INF(v) 0
	103	#endif
	104
	105	/*
	106	* Macro to adjust the program counter and restart the instruction execution
	107	* loop after each instruction is executed.
	108	*/
	109
	110	#define ADJUST_PC(instBytes) \
	111	pc += instBytes; continue
	112
	113	/*
	114	* Macros used to cache often-referenced Tcl evaluation stack information
	115	* in local variables. Note that a DECACHE_STACK_INFO()-CACHE_STACK_INFO()
	116	* pair must surround any call inside TclExecuteByteCode (and a few other
	117	* procedures that use this scheme) that could result in a recursive call
	118	* to TclExecuteByteCode.
	119	*/
	120
	121	#define CACHE_STACK_INFO() \
	122	stackPtr = eePtr->stackPtr; \
	123	stackTop = eePtr->stackTop
	124
	125	#define DECACHE_STACK_INFO() \
	126	eePtr->stackTop = stackTop
	127
	128	/*
	129	* Macros used to access items on the Tcl evaluation stack. PUSH_OBJECT
	130	* increments the object's ref count since it makes the stack have another
	131	* reference pointing to the object. However, POP_OBJECT does not decrement
	132	* the ref count. This is because the stack may hold the only reference to
	133	* the object, so the object would be destroyed if its ref count were
	134	* decremented before the caller had a chance to, e.g., store it in a
	135	* variable. It is the caller's responsibility to decrement the ref count
	136	* when it is finished with an object.
	137	*/
	138
	139	#define STK_ITEM(offset) (stackPtr[stackTop + (offset)])
	140	#define STK_OBJECT(offset) (STK_ITEM(offset).o)
	141	#define STK_INT(offset) (STK_ITEM(offset).i)
	142	#define STK_POINTER(offset) (STK_ITEM(offset).p)
	143
	144	/*
	145	* WARNING! It is essential that objPtr only appear once in the PUSH_OBJECT
	146	* macro. The actual parameter might be an expression with side effects,
	147	* and this ensures that it will be executed only once.
	148	*/
	149
	150	#define PUSH_OBJECT(objPtr) \
	151	Tcl_IncrRefCount(stackPtr[++stackTop].o = (objPtr))
	152
	153	#define POP_OBJECT() \
	154	(stackPtr[stackTop--].o)
	155
	156	/*
	157	* Declarations for local procedures to this file:
	158	*/
	159
	160	static void CallTraceProcedure _ANSI_ARGS_((Tcl_Interp *interp,
	161	Trace tracePtr, Command cmdPtr,
	162	char *command, int numChars,
	163	int objc, Tcl_Obj *objv[]));
	164	static void DupCmdNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
	165	Tcl_Obj *copyPtr));
	166	static int ExprAbsFunc _ANSI_ARGS_((Tcl_Interp *interp,
	167	ExecEnv *eePtr, ClientData clientData));
	168	static int ExprBinaryFunc _ANSI_ARGS_((Tcl_Interp *interp,
	169	ExecEnv *eePtr, ClientData clientData));
	170	static int ExprCallMathFunc _ANSI_ARGS_((Tcl_Interp *interp,
	171	ExecEnv eePtr, int objc, Tcl_Obj *objv));
	172	static int ExprDoubleFunc _ANSI_ARGS_((Tcl_Interp *interp,
	173	ExecEnv *eePtr, ClientData clientData));
	174	static int ExprIntFunc _ANSI_ARGS_((Tcl_Interp *interp,
	175	ExecEnv *eePtr, ClientData clientData));
	176	static int ExprRoundFunc _ANSI_ARGS_((Tcl_Interp *interp,
	177	ExecEnv *eePtr, ClientData clientData));
	178	static int ExprUnaryFunc _ANSI_ARGS_((Tcl_Interp *interp,
	179	ExecEnv *eePtr, ClientData clientData));
	180	static void FreeCmdNameInternalRep _ANSI_ARGS_((
	181	Tcl_Obj *objPtr));
	182	static char * GetSrcInfoForPc _ANSI_ARGS_((unsigned char *pc,
	183	ByteCode* codePtr, int *lengthPtr));
	184	static void GrowEvaluationStack _ANSI_ARGS_((ExecEnv *eePtr));
	185	static void IllegalExprOperandType _ANSI_ARGS_((
	186	Tcl_Interp *interp, unsigned int opCode,
	187	Tcl_Obj *opndPtr));
	188	static void InitByteCodeExecution _ANSI_ARGS_((
	189	Tcl_Interp *interp));
	190	static void PrintByteCodeInfo _ANSI_ARGS_((ByteCode *codePtr));
	191	static void RecordTracebackInfo _ANSI_ARGS_((Tcl_Interp *interp,
	192	unsigned char pc, ByteCode codePtr));
	193	static int SetCmdNameFromAny _ANSI_ARGS_((Tcl_Interp *interp,
	194	Tcl_Obj *objPtr));
	195	static void UpdateStringOfCmdName _ANSI_ARGS_((Tcl_Obj *objPtr));
	196
	197	/*
	198	* Table describing the built-in math functions. Entries in this table are
	199	* indexed by the values of the INST_CALL_BUILTIN_FUNC instruction's
	200	* operand byte.
	201	*/
	202
	203	BuiltinFunc builtinFuncTable[] = {
	204	#ifndef TCL_NO_MATH
	205	{"acos", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) acos},
	206	{"asin", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) asin},
	207	{"atan", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) atan},
	208	{"atan2", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) atan2},
	209	{"ceil", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) ceil},
	210	{"cos", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) cos},
	211	{"cosh", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) cosh},
	212	{"exp", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) exp},
	213	{"floor", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) floor},
	214	{"fmod", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) fmod},
	215	{"hypot", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) hypot},
	216	{"log", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) log},
	217	{"log10", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) log10},
	218	{"pow", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) pow},
	219	{"sin", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) sin},
	220	{"sinh", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) sinh},
	221	{"sqrt", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) sqrt},
	222	{"tan", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) tan},
	223	{"tanh", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) tanh},
	224	#endif
	225	{"abs", 1, {TCL_EITHER}, ExprAbsFunc, 0},
	226	{"double", 1, {TCL_EITHER}, ExprDoubleFunc, 0},
	227	{"int", 1, {TCL_EITHER}, ExprIntFunc, 0},
	228	{"round", 1, {TCL_EITHER}, ExprRoundFunc, 0},
	229	{0},
	230	};
	231
	232	/*
	233	* The structure below defines the command name Tcl object type by means of
	234	* procedures that can be invoked by generic object code. Objects of this
	235	* type cache the Command pointer that results from looking up command names
	236	* in the command hashtable. Such objects appear as the zeroth ("command
	237	* name") argument in a Tcl command.
	238	*/
	239
	240	Tcl_ObjType tclCmdNameType = {
	241	"cmdName", /* name */
	242	FreeCmdNameInternalRep, /* freeIntRepProc */
	243	DupCmdNameInternalRep, /* dupIntRepProc */
	244	UpdateStringOfCmdName, /* updateStringProc */
	245	SetCmdNameFromAny /* setFromAnyProc */
	246	};
	247
	248
	249	/*
	250	*----------------------------------------------------------------------
	251	*
	252	* InitByteCodeExecution --
	253	*
	254	* This procedure is called once to initialize the Tcl bytecode
	255	* interpreter.
	256	*
	257	* Results:
	258	* None.
	259	*
[adeddd8]	260	* Side effects:
[d7d2da3]	261	* This procedure initializes the array of instruction names.
	262	*
	263	*----------------------------------------------------------------------
	264	*/
	265
	266	static void
	267	InitByteCodeExecution(interp)
	268	Tcl_Interp interp; / Interpreter for which the Tcl variable
	269	* "tcl_traceExec" is linked to control
	270	* instruction tracing. */
	271	{
	272	int i;
	273
	274	Tcl_RegisterObjType(&tclCmdNameType);
	275
	276	(VOID *) memset(opName, 0, sizeof(opName));
	277	for (i = 0; instructionTable[i].name != NULL; i++) {
	278	opName[i] = instructionTable[i].name;
	279	}
	280	}
	281
	282
	283	/*
	284	*----------------------------------------------------------------------
	285	*
	286	* TclCreateExecEnv --
	287	*
	288	* This procedure creates a new execution environment for Tcl bytecode
	289	* execution. An ExecEnv points to a Tcl evaluation stack. An ExecEnv
	290	* is typically created once for each Tcl interpreter (Interp
	291	* structure) and recursively passed to TclExecuteByteCode to execute
	292	* ByteCode sequences for nested commands.
	293	*
	294	* Results:
	295	* A newly allocated ExecEnv is returned. This points to an empty
	296	* evaluation stack of the standard initial size.
	297	*
	298	* Side effects:
	299	* The bytecode interpreter is also initialized here, as this
	300	* procedure will be called before any call to TclExecuteByteCode.
	301	*
	302	*----------------------------------------------------------------------
	303	*/
	304
	305	#define TCL_STACK_INITIAL_SIZE 2000
	306
	307	ExecEnv *
	308	TclCreateExecEnv(interp)
	309	Tcl_Interp interp; / Interpreter for which the execution
	310	* environment is being created. */
	311	{
	312	ExecEnv eePtr = (ExecEnv ) ckalloc(sizeof(ExecEnv));
	313
	314	eePtr->stackPtr = (StackItem *)
	315	ckalloc((unsigned) (TCL_STACK_INITIAL_SIZE * sizeof(StackItem)));
	316	eePtr->stackTop = -1;
	317	eePtr->stackEnd = (TCL_STACK_INITIAL_SIZE - 1);
	318
	319	if (!execInitialized) {
	320	TclInitAuxDataTypeTable();
	321	InitByteCodeExecution(interp);
	322	execInitialized = 1;
	323	}
	324
	325	return eePtr;
	326	}
	327	#undef TCL_STACK_INITIAL_SIZE
	328
	329
	330	/*
	331	*----------------------------------------------------------------------
	332	*
	333	* TclDeleteExecEnv --
	334	*
	335	* Frees the storage for an ExecEnv.
	336	*
	337	* Results:
	338	* None.
	339	*
	340	* Side effects:
	341	* Storage for an ExecEnv and its contained storage (e.g. the
	342	* evaluation stack) is freed.
	343	*
	344	*----------------------------------------------------------------------
	345	*/
	346
	347	void
	348	TclDeleteExecEnv(eePtr)
	349	ExecEnv eePtr; / Execution environment to free. */
	350	{
	351	ckfree((char *) eePtr->stackPtr);
	352	ckfree((char *) eePtr);
	353	}
	354
	355
	356	/*
	357	*----------------------------------------------------------------------
	358	*
	359	* TclFinalizeExecEnv --
	360	*
	361	* Finalizes the execution environment setup so that it can be
	362	* later reinitialized.
	363	*
	364	* Results:
	365	* None.
	366	*
	367	* Side effects:
	368	* After this call, the next time TclCreateExecEnv will be called
	369	* it will call InitByteCodeExecution.
	370	*
	371	*----------------------------------------------------------------------
	372	*/
	373
	374	void
	375	TclFinalizeExecEnv()
	376	{
	377	execInitialized = 0;
	378	TclFinalizeAuxDataTypeTable();
	379	}
	380
	381
	382	/*
	383	*----------------------------------------------------------------------
	384	*
	385	* GrowEvaluationStack --
	386	*
	387	* This procedure grows a Tcl evaluation stack stored in an ExecEnv.
	388	*
	389	* Results:
	390	* None.
	391	*
	392	* Side effects:
	393	* The size of the evaluation stack is doubled.
	394	*
	395	*----------------------------------------------------------------------
	396	*/
	397
	398	static void
	399	GrowEvaluationStack(eePtr)
	400	register ExecEnv eePtr; / Points to the ExecEnv with an evaluation
	401	* stack to enlarge. */
	402	{
	403	/*
	404	* The current Tcl stack elements are stored from eePtr->stackPtr[0]
	405	* to eePtr->stackPtr[eePtr->stackEnd] (inclusive).
	406	*/
	407
	408	int currElems = (eePtr->stackEnd + 1);
	409	int newElems = 2*currElems;
	410	int currBytes = currElems * sizeof(StackItem);
	411	int newBytes = 2*currBytes;
	412	StackItem newStackPtr = (StackItem ) ckalloc((unsigned) newBytes);
	413
	414	/*
	415	* Copy the existing stack items to the new stack space, free the old
	416	* storage if appropriate, and mark new space as malloc'ed.
	417	*/
	418
	419	memcpy((VOID ) newStackPtr, (VOID ) eePtr->stackPtr,
	420	(size_t) currBytes);
	421	ckfree((char *) eePtr->stackPtr);
	422	eePtr->stackPtr = newStackPtr;
	423	eePtr->stackEnd = (newElems - 1); /* i.e. index of last usable item */
	424	}
	425
	426
	427	/*
	428	*----------------------------------------------------------------------
	429	*
	430	* TclExecuteByteCode --
	431	*
	432	* This procedure executes the instructions of a ByteCode structure.
	433	* It returns when a "done" instruction is executed or an error occurs.
	434	*
	435	* Results:
	436	* The return value is one of the return codes defined in tcl.h
	437	* (such as TCL_OK), and interp->objResultPtr refers to a Tcl object
	438	* that either contains the result of executing the code or an
	439	* error message.
	440	*
	441	* Side effects:
	442	* Almost certainly, depending on the ByteCode's instructions.
	443	*
	444	*----------------------------------------------------------------------
	445	*/
	446
	447	int
	448	TclExecuteByteCode(interp, codePtr)
	449	Tcl_Interp interp; / Token for command interpreter. */
	450	ByteCode codePtr; / The bytecode sequence to interpret. */
	451	{
	452	Interp iPtr = (Interp ) interp;
	453	ExecEnv *eePtr = iPtr->execEnvPtr;
	454	/* Points to the execution environment. */
	455	register StackItem *stackPtr = eePtr->stackPtr;
	456	/* Cached evaluation stack base pointer. */
	457	register int stackTop = eePtr->stackTop;
	458	/* Cached top index of evaluation stack. */
	459	Tcl_Obj **objArrayPtr = codePtr->objArrayPtr;
	460	/* Points to the ByteCode's object array. */
	461	unsigned char *pc = codePtr->codeStart;
	462	/* The current program counter. */
	463	unsigned char opCode; /* The current instruction code. */
	464	int opnd; /* Current instruction's operand byte. */
	465	int pcAdjustment; /* Hold pc adjustment after instruction. */
	466	int initStackTop = stackTop;/* Stack top at start of execution. */
	467	ExceptionRange rangePtr; / Points to closest loop or catch exception
	468	* range enclosing the pc. Used by various
	469	* instructions and processCatch to
	470	* process break, continue, and errors. */
	471	int result = TCL_OK; /* Return code returned after execution. */
	472	Tcl_Obj valuePtr, value2Ptr, namePtr, objPtr;
	473	char *bytes;
	474	int length;
	475	long i;
	476
	477	/*
	478	* This procedure uses a stack to hold information about catch commands.
	479	* This information is the current operand stack top when starting to
	480	* execute the code for each catch command. It starts out with stack-
	481	* allocated space but uses dynamically-allocated storage if needed.
	482	*/
	483
	484	#define STATIC_CATCH_STACK_SIZE 5
	485	int (catchStackStorage[STATIC_CATCH_STACK_SIZE]);
	486	int *catchStackPtr = catchStackStorage;
	487	int catchTop = -1;
	488
	489	/*
	490	* Make sure the catch stack is large enough to hold the maximum number
	491	* of catch commands that could ever be executing at the same time. This
	492	* will be no more than the exception range array's depth.
	493	*/
	494
	495	if (codePtr->maxExcRangeDepth > STATIC_CATCH_STACK_SIZE) {
	496	catchStackPtr = (int *)
	497	ckalloc(codePtr->maxExcRangeDepth * sizeof(int));
	498	}
	499
	500	/*
	501	* Make sure the stack has enough room to execute this ByteCode.
	502	*/
	503
	504	while ((stackTop + codePtr->maxStackDepth) > eePtr->stackEnd) {
	505	GrowEvaluationStack(eePtr);
	506	stackPtr = eePtr->stackPtr;
	507	}
	508
	509	/*
	510	* Loop executing instructions until a "done" instruction, a TCL_RETURN,
	511	* or some error.
	512	*/
	513
	514	for (;;) {
	515	opCode = *pc;
	516
	517	switch (opCode) {
	518	case INST_DONE:
	519	/*
	520	* Pop the topmost object from the stack, set the interpreter's
	521	* object result to point to it, and return.
	522	*/
	523	valuePtr = POP_OBJECT();
	524	Tcl_SetObjResult(interp, valuePtr);
	525	TclDecrRefCount(valuePtr);
	526	if (stackTop != initStackTop) {
	527	fprintf(stderr, "\nTclExecuteByteCode: done instruction at pc %u: stack top %d != entry stack top %d\n",
	528	(unsigned int)(pc - codePtr->codeStart),
	529	(unsigned int) stackTop,
	530	(unsigned int) initStackTop);
	531	fprintf(stderr, " Source: ");
	532	TclPrintSource(stderr, codePtr->source, 150);
	533	panic("TclExecuteByteCode execution failure: end stack top != start stack top");
	534	}
	535	goto done;
	536
	537	case INST_PUSH1:
	538	valuePtr = objArrayPtr[TclGetUInt1AtPtr(pc+1)];
	539	PUSH_OBJECT(valuePtr);
	540	ADJUST_PC(2);
	541
	542	case INST_PUSH4:
	543	valuePtr = objArrayPtr[TclGetUInt4AtPtr(pc+1)];
	544	PUSH_OBJECT(valuePtr);
	545	ADJUST_PC(5);
	546
	547	case INST_POP:
	548	valuePtr = POP_OBJECT();
	549	TclDecrRefCount(valuePtr); /* finished with pop'ed object. */
	550	ADJUST_PC(1);
	551
	552	case INST_DUP:
	553	valuePtr = stackPtr[stackTop].o;
	554	PUSH_OBJECT(Tcl_DuplicateObj(valuePtr));
	555	ADJUST_PC(1);
	556
	557	case INST_CONCAT1:
	558	opnd = TclGetUInt1AtPtr(pc+1);
	559	{
	560	Tcl_Obj *concatObjPtr;
	561	int totalLen = 0;
	562
	563	/*
	564	* Concatenate strings (with no separators) from the top
	565	* opnd items on the stack starting with the deepest item.
	566	* First, determine how many characters are needed.
	567	*/
	568
	569	for (i = (stackTop - (opnd-1)); i <= stackTop; i++) {
	570	valuePtr = stackPtr[i].o;
	571	bytes = TclGetStringFromObj(valuePtr, &length);
	572	if (bytes != NULL) {
	573	totalLen += length;
	574	}
	575	}
	576
	577	/*
	578	* Initialize the new append string object by appending the
	579	* strings of the opnd stack objects. Also pop the objects.
	580	*/
	581
	582	TclNewObj(concatObjPtr);
	583	if (totalLen > 0) {
	584	char p = (char ) ckalloc((unsigned) (totalLen + 1));
	585	concatObjPtr->bytes = p;
	586	concatObjPtr->length = totalLen;
	587	for (i = (stackTop - (opnd-1)); i <= stackTop; i++) {
	588	valuePtr = stackPtr[i].o;
	589	bytes = TclGetStringFromObj(valuePtr, &length);
	590	if (bytes != NULL) {
	591	memcpy((VOID ) p, (VOID ) bytes,
	592	(size_t) length);
	593	p += length;
	594	}
	595	TclDecrRefCount(valuePtr);
	596	}
	597	*p = '\0';
	598	} else {
	599	for (i = (stackTop - (opnd-1)); i <= stackTop; i++) {
	600	valuePtr = stackPtr[i].o;
	601	Tcl_DecrRefCount(valuePtr);
	602	}
	603	}
	604	stackTop -= opnd;
	605
	606	PUSH_OBJECT(concatObjPtr);
	607	ADJUST_PC(2);
	608	}
	609
	610	case INST_INVOKE_STK4:
	611	opnd = TclGetUInt4AtPtr(pc+1);
	612	pcAdjustment = 5;
	613	goto doInvocation;
	614
	615	case INST_INVOKE_STK1:
	616	opnd = TclGetUInt1AtPtr(pc+1);
	617	pcAdjustment = 2;
	618
	619	doInvocation:
	620	{
	621	char *cmdName;
	622	Command cmdPtr; / Points to command's Command struct. */
	623	int objc = opnd; /* The number of arguments. */
	624	Tcl_Obj *objv; / The array of argument objects. */
	625	Tcl_Obj objv0Ptr; / Holds objv[0], the command name. */
	626	int newPcOffset = 0;
	627	/* Instruction offset computed during
	628	* break, continue, error processing.
	629	* Init. to avoid compiler warning. */
	630	Tcl_Command cmd;
	631
	632	/*
	633	* If the interpreter was deleted, return an error.
	634	*/
	635
	636	if (iPtr->flags & DELETED) {
	637	Tcl_ResetResult(interp);
	638	Tcl_AppendToObj(Tcl_GetObjResult(interp),
	639	"attempt to call eval in deleted interpreter", -1);
	640	Tcl_SetErrorCode(interp, "CORE", "IDELETE",
	641	"attempt to call eval in deleted interpreter",
	642	(char *) NULL);
	643	result = TCL_ERROR;
	644	goto checkForCatch;
	645	}
	646
	647	objv = &(stackPtr[stackTop - (objc-1)].o);
	648	objv0Ptr = objv[0];
	649	cmdName = TclGetStringFromObj(objv0Ptr, (int *) NULL);
	650
	651	/*
	652	* Find the procedure to execute this command. If there
	653	* isn't one, then see if there is a command "unknown". If
	654	* so, invoke it, passing it the original command words as
	655	* arguments.
	656	*
	657	* We convert the objv[0] object to be a CmdName object.
	658	* This caches a pointer to the Command structure for the
	659	* command; this pointer is held in a ResolvedCmdName
	660	* structure the object's internal rep. points to.
	661	*/
	662
	663	cmd = Tcl_GetCommandFromObj(interp, objv0Ptr);
	664	cmdPtr = (Command *) cmd;
	665
	666	/*
	667	* If the command is still not found, handle it with the
	668	* "unknown" proc.
	669	*/
	670
	671	if (cmdPtr == NULL) {
	672	cmd = Tcl_FindCommand(interp, "unknown",
	673	(Tcl_Namespace ) NULL, /flags*/ TCL_GLOBAL_ONLY);
	674	if (cmd == (Tcl_Command) NULL) {
	675	Tcl_ResetResult(interp);
	676	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
	677	"invalid command name \"", cmdName, "\"",
	678	(char *) NULL);
	679	result = TCL_ERROR;
	680	goto checkForCatch;
	681	}
	682	cmdPtr = (Command *) cmd;
	683	stackTop++; /* need room for new inserted objv[0] */
	684	for (i = objc; i >= 0; i--) {
	685	objv[i+1] = objv[i];
	686	}
	687	objc++;
	688	objv[0] = Tcl_NewStringObj("unknown", -1);
	689	Tcl_IncrRefCount(objv[0]);
	690	}
	691
	692	/*
	693	* Call any trace procedures.
	694	*/
	695
	696	if (iPtr->tracePtr != NULL) {
	697	Trace tracePtr, nextTracePtr;
	698
	699	for (tracePtr = iPtr->tracePtr; tracePtr != NULL;
	700	tracePtr = nextTracePtr) {
	701	nextTracePtr = tracePtr->nextPtr;
	702	if (iPtr->numLevels <= tracePtr->level) {
	703	int numChars;
	704	char *cmd = GetSrcInfoForPc(pc, codePtr,
	705	&numChars);
	706	if (cmd != NULL) {
	707	DECACHE_STACK_INFO();
	708	CallTraceProcedure(interp, tracePtr, cmdPtr,
	709	cmd, numChars, objc, objv);
	710	CACHE_STACK_INFO();
	711	}
	712	}
	713	}
	714	}
	715
	716	/*
	717	* Finally, invoke the command's Tcl_ObjCmdProc. First reset
	718	* the interpreter's string and object results to their
	719	* default empty values since they could have gotten changed
	720	* by earlier invocations.
	721	*/
	722
	723	Tcl_ResetResult(interp);
	724
	725	iPtr->cmdCount++;
	726	DECACHE_STACK_INFO();
	727	result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp,
	728	objc, objv);
	729	if (Tcl_AsyncReady()) {
	730	result = Tcl_AsyncInvoke(interp, result);
	731	}
	732	CACHE_STACK_INFO();
	733
	734	/*
	735	* If the interpreter has a non-empty string result, the
	736	* result object is either empty or stale because some
	737	* procedure set interp->result directly. If so, move the
	738	* string result to the result object, then reset the
	739	* string result.
	740	*/
	741
	742	if (*(iPtr->result) != 0) {
	743	(void) Tcl_GetObjResult(interp);
	744	}
	745
	746	/*
	747	* Pop the objc top stack elements and decrement their ref
	748	* counts.
	749	*/
	750
	751	i = (stackTop - (objc-1));
	752	while (i <= stackTop) {
	753	valuePtr = stackPtr[i].o;
	754	TclDecrRefCount(valuePtr);
	755	i++;
	756	}
	757	stackTop -= objc;
	758
	759	/*
	760	* Process the result of the Tcl_ObjCmdProc call.
	761	*/
	762
	763	switch (result) {
	764	case TCL_OK:
	765	/*
	766	* Push the call's object result and continue execution
	767	* with the next instruction.
	768	*/
	769	PUSH_OBJECT(Tcl_GetObjResult(interp));
	770	ADJUST_PC(pcAdjustment);
	771
	772	case TCL_BREAK:
	773	case TCL_CONTINUE:
	774	/*
	775	* The invoked command requested a break or continue.
	776	* Find the closest enclosing loop or catch exception
	777	* range, if any. If a loop is found, terminate its
	778	* execution or skip to its next iteration. If the
	779	* closest is a catch exception range, jump to its
	780	* catchOffset. If no enclosing range is found, stop
	781	* execution and return the TCL_BREAK or TCL_CONTINUE.
	782	*/
	783	rangePtr = TclGetExceptionRangeForPc(pc,
	784	/catchOnly/ 0, codePtr);
	785	if (rangePtr == NULL) {
	786	goto abnormalReturn; /* no catch exists to check */
	787	}
	788	switch (rangePtr->type) {
	789	case LOOP_EXCEPTION_RANGE:
	790	if (result == TCL_BREAK) {
	791	newPcOffset = rangePtr->breakOffset;
	792	} else if (rangePtr->continueOffset == -1) {
	793	goto checkForCatch;
	794	} else {
	795	newPcOffset = rangePtr->continueOffset;
	796	}
	797	break;
	798	case CATCH_EXCEPTION_RANGE:
	799	goto processCatch; /* it will use rangePtr */
	800	default:
	801	panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
	802	}
	803	result = TCL_OK;
	804	pc = (codePtr->codeStart + newPcOffset);
	805	continue; /* restart outer instruction loop at pc */
	806
	807	case TCL_ERROR:
	808	/*
	809	* The invoked command returned an error. Look for an
	810	* enclosing catch exception range, if any.
	811	*/
	812	goto checkForCatch;
	813
	814	case TCL_RETURN:
	815	/*
	816	* The invoked command requested that the current
	817	* procedure stop execution and return. First check
	818	* for an enclosing catch exception range, if any.
	819	*/
	820	goto checkForCatch;
	821
	822	default:
	823	goto checkForCatch;
	824	} /* end of switch on result from invoke instruction */
	825	}
	826
	827	case INST_EVAL_STK:
	828	objPtr = POP_OBJECT();
	829	DECACHE_STACK_INFO();
	830	result = Tcl_EvalObj(interp, objPtr);
	831	CACHE_STACK_INFO();
	832	if (result == TCL_OK) {
	833	/*
	834	* Normal return; push the eval's object result.
	835	*/
	836
	837	PUSH_OBJECT(Tcl_GetObjResult(interp));
	838	TclDecrRefCount(objPtr);
	839	ADJUST_PC(1);
	840	} else if ((result == TCL_BREAK) \|\| (result == TCL_CONTINUE)) {
	841	/*
	842	* Find the closest enclosing loop or catch exception range,
	843	* if any. If a loop is found, terminate its execution or
	844	* skip to its next iteration. If the closest is a catch
	845	* exception range, jump to its catchOffset. If no enclosing
	846	* range is found, stop execution and return that same
	847	* TCL_BREAK or TCL_CONTINUE.
	848	*/
	849
	850	int newPcOffset = 0; /* Pc offset computed during break,
	851	* continue, error processing. Init.
	852	* to avoid compiler warning. */
	853
	854	rangePtr = TclGetExceptionRangeForPc(pc, /catchOnly/ 0,
	855	codePtr);
	856	if (rangePtr == NULL) {
	857	Tcl_DecrRefCount(objPtr);
	858	goto abnormalReturn; /* no catch exists to check */
	859	}
	860	switch (rangePtr->type) {
	861	case LOOP_EXCEPTION_RANGE:
	862	if (result == TCL_BREAK) {
	863	newPcOffset = rangePtr->breakOffset;
	864	} else if (rangePtr->continueOffset == -1) {
	865	Tcl_DecrRefCount(objPtr);
	866	goto checkForCatch;
	867	} else {
	868	newPcOffset = rangePtr->continueOffset;
	869	}
	870	result = TCL_OK;
	871	break;
	872	case CATCH_EXCEPTION_RANGE:
	873	Tcl_DecrRefCount(objPtr);
	874	goto processCatch; /* it will use rangePtr */
	875	default:
	876	panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
	877	}
	878	Tcl_DecrRefCount(objPtr);
	879	pc = (codePtr->codeStart + newPcOffset);
	880	continue; /* restart outer instruction loop at pc */
	881	} else { /* eval returned TCL_ERROR, TCL_RETURN, unknown code */
	882	Tcl_DecrRefCount(objPtr);
	883	goto checkForCatch;
	884	}
	885
	886	case INST_EXPR_STK:
	887	objPtr = POP_OBJECT();
	888	Tcl_ResetResult(interp);
	889	DECACHE_STACK_INFO();
	890	result = Tcl_ExprObj(interp, objPtr, &valuePtr);
	891	CACHE_STACK_INFO();
	892	if (result != TCL_OK) {
	893	Tcl_DecrRefCount(objPtr);
	894	goto checkForCatch;
	895	}
	896	stackPtr[++stackTop].o = valuePtr; /* already has right refct */
	897	TclDecrRefCount(objPtr);
	898	ADJUST_PC(1);
	899
	900	case INST_LOAD_SCALAR4:
	901	opnd = TclGetInt4AtPtr(pc+1);
	902	pcAdjustment = 5;
	903	goto doLoadScalar;
	904
	905	case INST_LOAD_SCALAR1:
	906	opnd = TclGetUInt1AtPtr(pc+1);
	907	pcAdjustment = 2;
	908
	909	doLoadScalar:
	910	DECACHE_STACK_INFO();
	911	valuePtr = TclGetIndexedScalar(interp, opnd,
	912	/leaveErrorMsg/ 1);
	913	CACHE_STACK_INFO();
	914	if (valuePtr == NULL) {
	915	result = TCL_ERROR;
	916	goto checkForCatch;
	917	}
	918	PUSH_OBJECT(valuePtr);
	919	ADJUST_PC(pcAdjustment);
	920
	921	case INST_LOAD_SCALAR_STK:
	922	namePtr = POP_OBJECT();
	923	DECACHE_STACK_INFO();
	924	valuePtr = Tcl_ObjGetVar2(interp, namePtr, (Tcl_Obj *) NULL,
	925	TCL_LEAVE_ERR_MSG);
	926	CACHE_STACK_INFO();
	927	if (valuePtr == NULL) {
	928	Tcl_DecrRefCount(namePtr);
	929	result = TCL_ERROR;
	930	goto checkForCatch;
	931	}
	932	PUSH_OBJECT(valuePtr);
	933	TclDecrRefCount(namePtr);
	934	ADJUST_PC(1);
	935
	936	case INST_LOAD_ARRAY4:
	937	opnd = TclGetUInt4AtPtr(pc+1);
	938	pcAdjustment = 5;
	939	goto doLoadArray;
	940
	941	case INST_LOAD_ARRAY1:
	942	opnd = TclGetUInt1AtPtr(pc+1);
	943	pcAdjustment = 2;
	944
	945	doLoadArray:
	946	{
	947	Tcl_Obj *elemPtr = POP_OBJECT();
	948
	949	DECACHE_STACK_INFO();
	950	valuePtr = TclGetElementOfIndexedArray(interp, opnd,
	951	elemPtr, /leaveErrorMsg/ 1);
	952	CACHE_STACK_INFO();
	953	if (valuePtr == NULL) {
	954	Tcl_DecrRefCount(elemPtr);
	955	result = TCL_ERROR;
	956	goto checkForCatch;
	957	}
	958	PUSH_OBJECT(valuePtr);
	959	TclDecrRefCount(elemPtr);
	960	}
	961	ADJUST_PC(pcAdjustment);
	962
	963	case INST_LOAD_ARRAY_STK:
	964	{
	965	Tcl_Obj *elemPtr = POP_OBJECT();
	966
	967	namePtr = POP_OBJECT();
	968	DECACHE_STACK_INFO();
	969	valuePtr = Tcl_ObjGetVar2(interp, namePtr, elemPtr,
	970	TCL_LEAVE_ERR_MSG);
	971	CACHE_STACK_INFO();
	972	if (valuePtr == NULL) {
	973	Tcl_DecrRefCount(namePtr);
	974	Tcl_DecrRefCount(elemPtr);
	975	result = TCL_ERROR;
	976	goto checkForCatch;
	977	}
	978	PUSH_OBJECT(valuePtr);
	979	TclDecrRefCount(namePtr);
	980	TclDecrRefCount(elemPtr);
	981	}
	982	ADJUST_PC(1);
	983
	984	case INST_LOAD_STK:
	985	namePtr = POP_OBJECT();
	986	DECACHE_STACK_INFO();
	987	valuePtr = Tcl_ObjGetVar2(interp, namePtr, NULL,
	988	TCL_PARSE_PART1\|TCL_LEAVE_ERR_MSG);
	989	CACHE_STACK_INFO();
	990	if (valuePtr == NULL) {
	991	Tcl_DecrRefCount(namePtr);
	992	result = TCL_ERROR;
	993	goto checkForCatch;
	994	}
	995	PUSH_OBJECT(valuePtr);
	996	TclDecrRefCount(namePtr);
	997	ADJUST_PC(1);
	998
	999	case INST_STORE_SCALAR4:
	1000	opnd = TclGetUInt4AtPtr(pc+1);
	1001	pcAdjustment = 5;
	1002	goto doStoreScalar;
	1003
	1004	case INST_STORE_SCALAR1:
	1005	opnd = TclGetUInt1AtPtr(pc+1);
	1006	pcAdjustment = 2;
	1007
	1008	doStoreScalar:
	1009	valuePtr = POP_OBJECT();
	1010	DECACHE_STACK_INFO();
	1011	value2Ptr = TclSetIndexedScalar(interp, opnd, valuePtr,
	1012	/leaveErrorMsg/ 1);
	1013	CACHE_STACK_INFO();
	1014	if (value2Ptr == NULL) {
	1015	Tcl_DecrRefCount(valuePtr);
	1016	result = TCL_ERROR;
	1017	goto checkForCatch;
	1018	}
	1019	PUSH_OBJECT(value2Ptr);
	1020	TclDecrRefCount(valuePtr);
	1021	ADJUST_PC(pcAdjustment);
	1022
	1023	case INST_STORE_SCALAR_STK:
	1024	valuePtr = POP_OBJECT();
	1025	namePtr = POP_OBJECT();
	1026	DECACHE_STACK_INFO();
	1027	value2Ptr = Tcl_ObjSetVar2(interp, namePtr, NULL, valuePtr,
	1028	TCL_LEAVE_ERR_MSG);
	1029	CACHE_STACK_INFO();
	1030	if (value2Ptr == NULL) {
	1031	Tcl_DecrRefCount(namePtr);
	1032	Tcl_DecrRefCount(valuePtr);
	1033	result = TCL_ERROR;
	1034	goto checkForCatch;
	1035	}
	1036	PUSH_OBJECT(value2Ptr);
	1037	TclDecrRefCount(namePtr);
	1038	TclDecrRefCount(valuePtr);
	1039	ADJUST_PC(1);
	1040
	1041	case INST_STORE_ARRAY4:
	1042	opnd = TclGetUInt4AtPtr(pc+1);
	1043	pcAdjustment = 5;
	1044	goto doStoreArray;
	1045
	1046	case INST_STORE_ARRAY1:
	1047	opnd = TclGetUInt1AtPtr(pc+1);
	1048	pcAdjustment = 2;
	1049
	1050	doStoreArray:
	1051	{
	1052	Tcl_Obj *elemPtr;
	1053
	1054	valuePtr = POP_OBJECT();
	1055	elemPtr = POP_OBJECT();
	1056	DECACHE_STACK_INFO();
	1057	value2Ptr = TclSetElementOfIndexedArray(interp, opnd,
	1058	elemPtr, valuePtr, TCL_LEAVE_ERR_MSG);
	1059	CACHE_STACK_INFO();
	1060	if (value2Ptr == NULL) {
	1061	Tcl_DecrRefCount(elemPtr);
	1062	Tcl_DecrRefCount(valuePtr);
	1063	result = TCL_ERROR;
	1064	goto checkForCatch;
	1065	}
	1066	PUSH_OBJECT(value2Ptr);
	1067	TclDecrRefCount(elemPtr);
	1068	TclDecrRefCount(valuePtr);
	1069	}
	1070	ADJUST_PC(pcAdjustment);
	1071
	1072	case INST_STORE_ARRAY_STK:
	1073	{
	1074	Tcl_Obj *elemPtr;
	1075
	1076	valuePtr = POP_OBJECT();
	1077	elemPtr = POP_OBJECT();
	1078	namePtr = POP_OBJECT();
	1079	DECACHE_STACK_INFO();
	1080	value2Ptr = Tcl_ObjSetVar2(interp, namePtr, elemPtr,
	1081	valuePtr, TCL_LEAVE_ERR_MSG);
	1082	CACHE_STACK_INFO();
	1083	if (value2Ptr == NULL) {
	1084	Tcl_DecrRefCount(namePtr);
	1085	Tcl_DecrRefCount(elemPtr);
	1086	Tcl_DecrRefCount(valuePtr);
	1087	result = TCL_ERROR;
	1088	goto checkForCatch;
	1089	}
	1090	PUSH_OBJECT(value2Ptr);
	1091	TclDecrRefCount(namePtr);
	1092	TclDecrRefCount(elemPtr);
	1093	TclDecrRefCount(valuePtr);
	1094	}
	1095	ADJUST_PC(1);
	1096
	1097	case INST_STORE_STK:
	1098	valuePtr = POP_OBJECT();
	1099	namePtr = POP_OBJECT();
	1100	DECACHE_STACK_INFO();
	1101	value2Ptr = Tcl_ObjSetVar2(interp, namePtr, NULL, valuePtr,
	1102	TCL_PARSE_PART1\|TCL_LEAVE_ERR_MSG);
	1103	CACHE_STACK_INFO();
	1104	if (value2Ptr == NULL) {
	1105	Tcl_DecrRefCount(namePtr);
	1106	Tcl_DecrRefCount(valuePtr);
	1107	result = TCL_ERROR;
	1108	goto checkForCatch;
	1109	}
	1110	PUSH_OBJECT(value2Ptr);
	1111	TclDecrRefCount(namePtr);
	1112	TclDecrRefCount(valuePtr);
	1113	ADJUST_PC(1);
	1114
	1115	case INST_INCR_SCALAR1:
	1116	opnd = TclGetUInt1AtPtr(pc+1);
	1117	valuePtr = POP_OBJECT();
	1118	if (valuePtr->typePtr != &tclIntType) {
	1119	result = tclIntType.setFromAnyProc(interp, valuePtr);
	1120	if (result != TCL_OK) {
	1121	Tcl_DecrRefCount(valuePtr);
	1122	goto checkForCatch;
	1123	}
	1124	}
	1125	i = valuePtr->internalRep.longValue;
	1126	DECACHE_STACK_INFO();
	1127	value2Ptr = TclIncrIndexedScalar(interp, opnd, i);
	1128	CACHE_STACK_INFO();
	1129	if (value2Ptr == NULL) {
	1130	Tcl_DecrRefCount(valuePtr);
	1131	result = TCL_ERROR;
	1132	goto checkForCatch;
	1133	}
	1134	PUSH_OBJECT(value2Ptr);
	1135	TclDecrRefCount(valuePtr);
	1136	ADJUST_PC(2);
	1137
	1138	case INST_INCR_SCALAR_STK:
	1139	case INST_INCR_STK:
	1140	valuePtr = POP_OBJECT();
	1141	namePtr = POP_OBJECT();
	1142	if (valuePtr->typePtr != &tclIntType) {
	1143	result = tclIntType.setFromAnyProc(interp, valuePtr);
	1144	if (result != TCL_OK) {
	1145	Tcl_DecrRefCount(namePtr);
	1146	Tcl_DecrRefCount(valuePtr);
	1147	goto checkForCatch;
	1148	}
	1149	}
	1150	i = valuePtr->internalRep.longValue;
	1151	DECACHE_STACK_INFO();
	1152	value2Ptr = TclIncrVar2(interp, namePtr, (Tcl_Obj *) NULL, i,
	1153	/part1NotParsed/ (opCode == INST_INCR_STK));
	1154	CACHE_STACK_INFO();
	1155	if (value2Ptr == NULL) {
	1156	Tcl_DecrRefCount(namePtr);
	1157	Tcl_DecrRefCount(valuePtr);
	1158	result = TCL_ERROR;
	1159	goto checkForCatch;
	1160	}
	1161	PUSH_OBJECT(value2Ptr);
	1162	Tcl_DecrRefCount(namePtr);
	1163	Tcl_DecrRefCount(valuePtr);
	1164	ADJUST_PC(1);
	1165
	1166	case INST_INCR_ARRAY1:
	1167	{
	1168	Tcl_Obj *elemPtr;
	1169
	1170	opnd = TclGetUInt1AtPtr(pc+1);
	1171	valuePtr = POP_OBJECT();
	1172	elemPtr = POP_OBJECT();
	1173	if (valuePtr->typePtr != &tclIntType) {
	1174	result = tclIntType.setFromAnyProc(interp, valuePtr);
	1175	if (result != TCL_OK) {
	1176	Tcl_DecrRefCount(elemPtr);
	1177	Tcl_DecrRefCount(valuePtr);
	1178	goto checkForCatch;
	1179	}
	1180	}
	1181	i = valuePtr->internalRep.longValue;
	1182	DECACHE_STACK_INFO();
	1183	value2Ptr = TclIncrElementOfIndexedArray(interp, opnd,
	1184	elemPtr, i);
	1185	CACHE_STACK_INFO();
	1186	if (value2Ptr == NULL) {
	1187	Tcl_DecrRefCount(elemPtr);
	1188	Tcl_DecrRefCount(valuePtr);
	1189	result = TCL_ERROR;
	1190	goto checkForCatch;
	1191	}
	1192	PUSH_OBJECT(value2Ptr);
	1193	Tcl_DecrRefCount(elemPtr);
	1194	Tcl_DecrRefCount(valuePtr);
	1195	}
	1196	ADJUST_PC(2);
	1197
	1198	case INST_INCR_ARRAY_STK:
	1199	{
	1200	Tcl_Obj *elemPtr;
	1201
	1202	valuePtr = POP_OBJECT();
	1203	elemPtr = POP_OBJECT();
	1204	namePtr = POP_OBJECT();
	1205	if (valuePtr->typePtr != &tclIntType) {
	1206	result = tclIntType.setFromAnyProc(interp, valuePtr);
	1207	if (result != TCL_OK) {
	1208	Tcl_DecrRefCount(namePtr);
	1209	Tcl_DecrRefCount(elemPtr);
	1210	Tcl_DecrRefCount(valuePtr);
	1211	goto checkForCatch;
	1212	}
	1213	}
	1214	i = valuePtr->internalRep.longValue;
	1215	DECACHE_STACK_INFO();
	1216	value2Ptr = TclIncrVar2(interp, namePtr, elemPtr, i,
	1217	/part1NotParsed/ 0);
	1218	CACHE_STACK_INFO();
	1219	if (value2Ptr == NULL) {
	1220	Tcl_DecrRefCount(namePtr);
	1221	Tcl_DecrRefCount(elemPtr);
	1222	Tcl_DecrRefCount(valuePtr);
	1223	result = TCL_ERROR;
	1224	goto checkForCatch;
	1225	}
	1226	PUSH_OBJECT(value2Ptr);
	1227	Tcl_DecrRefCount(namePtr);
	1228	Tcl_DecrRefCount(elemPtr);
	1229	Tcl_DecrRefCount(valuePtr);
	1230	}
	1231	ADJUST_PC(1);
	1232
	1233	case INST_INCR_SCALAR1_IMM:
	1234	opnd = TclGetUInt1AtPtr(pc+1);
	1235	i = TclGetInt1AtPtr(pc+2);
	1236	DECACHE_STACK_INFO();
	1237	value2Ptr = TclIncrIndexedScalar(interp, opnd, i);
	1238	CACHE_STACK_INFO();
	1239	if (value2Ptr == NULL) {
	1240	result = TCL_ERROR;
	1241	goto checkForCatch;
	1242	}
	1243	PUSH_OBJECT(value2Ptr);
	1244	ADJUST_PC(3);
	1245
	1246	case INST_INCR_SCALAR_STK_IMM:
	1247	case INST_INCR_STK_IMM:
	1248	namePtr = POP_OBJECT();
	1249	i = TclGetInt1AtPtr(pc+1);
	1250	DECACHE_STACK_INFO();
	1251	value2Ptr = TclIncrVar2(interp, namePtr, (Tcl_Obj *) NULL, i,
	1252	/part1NotParsed/ (opCode == INST_INCR_STK_IMM));
	1253	CACHE_STACK_INFO();
	1254	if (value2Ptr == NULL) {
	1255	result = TCL_ERROR;
	1256	Tcl_DecrRefCount(namePtr);
	1257	goto checkForCatch;
	1258	}
	1259	PUSH_OBJECT(value2Ptr);
	1260	TclDecrRefCount(namePtr);
	1261	ADJUST_PC(2);
	1262
	1263	case INST_INCR_ARRAY1_IMM:
	1264	{
	1265	Tcl_Obj *elemPtr;
	1266
	1267	opnd = TclGetUInt1AtPtr(pc+1);
	1268	i = TclGetInt1AtPtr(pc+2);
	1269	elemPtr = POP_OBJECT();
	1270	DECACHE_STACK_INFO();
	1271	value2Ptr = TclIncrElementOfIndexedArray(interp, opnd,
	1272	elemPtr, i);
	1273	CACHE_STACK_INFO();
	1274	if (value2Ptr == NULL) {
	1275	Tcl_DecrRefCount(elemPtr);
	1276	result = TCL_ERROR;
	1277	goto checkForCatch;
	1278	}
	1279	PUSH_OBJECT(value2Ptr);
	1280	Tcl_DecrRefCount(elemPtr);
	1281	}
	1282	ADJUST_PC(3);
	1283
	1284	case INST_INCR_ARRAY_STK_IMM:
	1285	{
	1286	Tcl_Obj *elemPtr;
	1287
	1288	i = TclGetInt1AtPtr(pc+1);
	1289	elemPtr = POP_OBJECT();
	1290	namePtr = POP_OBJECT();
	1291	DECACHE_STACK_INFO();
	1292	value2Ptr = TclIncrVar2(interp, namePtr, elemPtr, i,
	1293	/part1NotParsed/ 0);
	1294	CACHE_STACK_INFO();
	1295	if (value2Ptr == NULL) {
	1296	Tcl_DecrRefCount(namePtr);
	1297	Tcl_DecrRefCount(elemPtr);
	1298	result = TCL_ERROR;
	1299	goto checkForCatch;
	1300	}
	1301	PUSH_OBJECT(value2Ptr);
	1302	Tcl_DecrRefCount(namePtr);
	1303	Tcl_DecrRefCount(elemPtr);
	1304	}
	1305	ADJUST_PC(2);
	1306
	1307	case INST_JUMP1:
	1308	opnd = TclGetInt1AtPtr(pc+1);
	1309	ADJUST_PC(opnd);
	1310
	1311	case INST_JUMP4:
	1312	opnd = TclGetInt4AtPtr(pc+1);
	1313	ADJUST_PC(opnd);
	1314
	1315	case INST_JUMP_TRUE4:
	1316	opnd = TclGetInt4AtPtr(pc+1);
	1317	pcAdjustment = 5;
	1318	goto doJumpTrue;
	1319
	1320	case INST_JUMP_TRUE1:
	1321	opnd = TclGetInt1AtPtr(pc+1);
	1322	pcAdjustment = 2;
	1323
	1324	doJumpTrue:
	1325	{
	1326	int b;
	1327
	1328	valuePtr = POP_OBJECT();
	1329	if (valuePtr->typePtr == &tclIntType) {
	1330	b = (valuePtr->internalRep.longValue != 0);
	1331	} else if (valuePtr->typePtr == &tclDoubleType) {
	1332	b = (valuePtr->internalRep.doubleValue != 0.0);
	1333	} else {
	1334	result = Tcl_GetBooleanFromObj(interp, valuePtr, &b);
	1335	if (result != TCL_OK) {
	1336	Tcl_DecrRefCount(valuePtr);
	1337	goto checkForCatch;
	1338	}
	1339	}
	1340	if (b) {
	1341	TclDecrRefCount(valuePtr);
	1342	ADJUST_PC(opnd);
	1343	} else {
	1344	TclDecrRefCount(valuePtr);
	1345	ADJUST_PC(pcAdjustment);
	1346	}
	1347	}
	1348
	1349	case INST_JUMP_FALSE4:
	1350	opnd = TclGetInt4AtPtr(pc+1);
	1351	pcAdjustment = 5;
	1352	goto doJumpFalse;
	1353
	1354	case INST_JUMP_FALSE1:
	1355	opnd = TclGetInt1AtPtr(pc+1);
	1356	pcAdjustment = 2;
	1357
	1358	doJumpFalse:
	1359	{
	1360	int b;
	1361
	1362	valuePtr = POP_OBJECT();
	1363	if (valuePtr->typePtr == &tclIntType) {
	1364	b = (valuePtr->internalRep.longValue != 0);
	1365	} else if (valuePtr->typePtr == &tclDoubleType) {
	1366	b = (valuePtr->internalRep.doubleValue != 0.0);
	1367	} else {
	1368	result = Tcl_GetBooleanFromObj(interp, valuePtr, &b);
	1369	if (result != TCL_OK) {
	1370	Tcl_DecrRefCount(valuePtr);
	1371	goto checkForCatch;
	1372	}
	1373	}
	1374	if (b) {
	1375	TclDecrRefCount(valuePtr);
	1376	ADJUST_PC(pcAdjustment);
	1377	} else {
	1378	TclDecrRefCount(valuePtr);
	1379	ADJUST_PC(opnd);
	1380	}
	1381	}
	1382
	1383	case INST_LOR:
	1384	case INST_LAND:
	1385	{
	1386	/*
	1387	* Operands must be boolean or numeric. No int->double
	1388	* conversions are performed.
	1389	*/
	1390
	1391	int i1, i2;
	1392	int iResult;
	1393	char *s;
	1394	Tcl_ObjType t1Ptr, t2Ptr;
	1395
	1396	value2Ptr = POP_OBJECT();
	1397	valuePtr = POP_OBJECT();
	1398	t1Ptr = valuePtr->typePtr;
	1399	t2Ptr = value2Ptr->typePtr;
	1400
	1401	if ((t1Ptr == &tclIntType) \|\| (t1Ptr == &tclBooleanType)) {
	1402	i1 = (valuePtr->internalRep.longValue != 0);
	1403	} else if (t1Ptr == &tclDoubleType) {
	1404	i1 = (valuePtr->internalRep.doubleValue != 0.0);
	1405	} else { /* FAILS IF NULL STRING REP */
	1406	s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
	1407	if (TclLooksLikeInt(s)) {
	1408	result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
	1409	valuePtr, &i);
	1410	i1 = (i != 0);
	1411	} else {
	1412	result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL,
	1413	valuePtr, &i1);
	1414	i1 = (i1 != 0);
	1415	}
	1416	if (result != TCL_OK) {
	1417	IllegalExprOperandType(interp, opCode, valuePtr);
	1418	Tcl_DecrRefCount(valuePtr);
	1419	Tcl_DecrRefCount(value2Ptr);
	1420	goto checkForCatch;
	1421	}
	1422	}
	1423
	1424	if ((t2Ptr == &tclIntType) \|\| (t2Ptr == &tclBooleanType)) {
	1425	i2 = (value2Ptr->internalRep.longValue != 0);
	1426	} else if (t2Ptr == &tclDoubleType) {
	1427	i2 = (value2Ptr->internalRep.doubleValue != 0.0);
	1428	} else { /* FAILS IF NULL STRING REP */
	1429	s = Tcl_GetStringFromObj(value2Ptr, (int *) NULL);
	1430	if (TclLooksLikeInt(s)) {
	1431	result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
	1432	value2Ptr, &i);
	1433	i2 = (i != 0);
	1434	} else {
	1435	result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL,
	1436	value2Ptr, &i2);
	1437	i2 = (i2 != 0);
	1438	}
	1439	if (result != TCL_OK) {
	1440	IllegalExprOperandType(interp, opCode, value2Ptr);
	1441	Tcl_DecrRefCount(valuePtr);
	1442	Tcl_DecrRefCount(value2Ptr);
	1443	goto checkForCatch;
	1444	}
	1445	}
	1446
	1447	/*
	1448	* Reuse the valuePtr object already on stack if possible.
	1449	*/
	1450
	1451	if (opCode == INST_LOR) {
	1452	iResult = (i1 \|\| i2);
	1453	} else {
	1454	iResult = (i1 && i2);
	1455	}
	1456	if (Tcl_IsShared(valuePtr)) {
	1457	PUSH_OBJECT(Tcl_NewLongObj(iResult));
	1458	TclDecrRefCount(valuePtr);
	1459	} else { /* reuse the valuePtr object */
	1460	Tcl_SetLongObj(valuePtr, iResult);
	1461	++stackTop; /* valuePtr now on stk top has right r.c. */
	1462	}
	1463	TclDecrRefCount(value2Ptr);
	1464	}
	1465	ADJUST_PC(1);
	1466
	1467	case INST_EQ:
	1468	case INST_NEQ:
	1469	case INST_LT:
	1470	case INST_GT:
	1471	case INST_LE:
	1472	case INST_GE:
	1473	{
	1474	/*
	1475	* Any type is allowed but the two operands must have the
	1476	* same type. We will compute value op value2.
	1477	*/
	1478
	1479	Tcl_ObjType t1Ptr, t2Ptr;
	1480	char s1 = NULL; / Init. avoids compiler warning. */
	1481	char s2 = NULL; / Init. avoids compiler warning. */
	1482	long i2 = 0; /* Init. avoids compiler warning. */
	1483	double d1 = 0.0; /* Init. avoids compiler warning. */
	1484	double d2 = 0.0; /* Init. avoids compiler warning. */
	1485	long iResult = 0; /* Init. avoids compiler warning. */
	1486
	1487	value2Ptr = POP_OBJECT();
	1488	valuePtr = POP_OBJECT();
	1489	t1Ptr = valuePtr->typePtr;
	1490	t2Ptr = value2Ptr->typePtr;
	1491
	1492	if ((t1Ptr != &tclIntType) && (t1Ptr != &tclDoubleType)) {
	1493	s1 = Tcl_GetStringFromObj(valuePtr, &length);
	1494	if (TclLooksLikeInt(s1)) { /* FAILS IF NULLS */
	1495	(void) Tcl_GetLongFromObj((Tcl_Interp *) NULL,
	1496	valuePtr, &i);
	1497	} else {
	1498	(void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
	1499	valuePtr, &d1);
	1500	}
	1501	t1Ptr = valuePtr->typePtr;
	1502	}
	1503	if ((t2Ptr != &tclIntType) && (t2Ptr != &tclDoubleType)) {
	1504	s2 = Tcl_GetStringFromObj(value2Ptr, &length);
	1505	if (TclLooksLikeInt(s2)) { /* FAILS IF NULLS */
	1506	(void) Tcl_GetLongFromObj((Tcl_Interp *) NULL,
	1507	value2Ptr, &i2);
	1508	} else {
	1509	(void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
	1510	value2Ptr, &d2);
	1511	}
	1512	t2Ptr = value2Ptr->typePtr;
	1513	}
	1514
	1515	if (((t1Ptr != &tclIntType) && (t1Ptr != &tclDoubleType))
	1516	\|\| ((t2Ptr != &tclIntType) && (t2Ptr != &tclDoubleType))) {
	1517	/*
	1518	* One operand is not numeric. Compare as strings.
	1519	* THIS FAILS IF AN OBJECT'S STRING REP CONTAINS NULLS.
	1520	*/
	1521	int cmpValue;
	1522	s1 = TclGetStringFromObj(valuePtr, &length);
	1523	s2 = TclGetStringFromObj(value2Ptr, &length);
	1524	cmpValue = strcmp(s1, s2);
	1525	switch (opCode) {
	1526	case INST_EQ:
	1527	iResult = (cmpValue == 0);
	1528	break;
	1529	case INST_NEQ:
	1530	iResult = (cmpValue != 0);
	1531	break;
	1532	case INST_LT:
	1533	iResult = (cmpValue < 0);
	1534	break;
	1535	case INST_GT:
	1536	iResult = (cmpValue > 0);
	1537	break;
	1538	case INST_LE:
	1539	iResult = (cmpValue <= 0);
	1540	break;
	1541	case INST_GE:
	1542	iResult = (cmpValue >= 0);
	1543	break;
	1544	}
	1545	} else if ((t1Ptr == &tclDoubleType)
	1546	\|\| (t2Ptr == &tclDoubleType)) {
	1547	/*
	1548	* Compare as doubles.
	1549	*/
	1550	if (t1Ptr == &tclDoubleType) {
	1551	d1 = valuePtr->internalRep.doubleValue;
	1552	if (t2Ptr == &tclIntType) {
	1553	d2 = value2Ptr->internalRep.longValue;
	1554	} else {
	1555	d2 = value2Ptr->internalRep.doubleValue;
	1556	}
	1557	} else { /* t1Ptr is int, t2Ptr is double */
	1558	d1 = valuePtr->internalRep.longValue;
	1559	d2 = value2Ptr->internalRep.doubleValue;
	1560	}
	1561	switch (opCode) {
	1562	case INST_EQ:
	1563	iResult = d1 == d2;
	1564	break;
	1565	case INST_NEQ:
	1566	iResult = d1 != d2;
	1567	break;
	1568	case INST_LT:
	1569	iResult = d1 < d2;
	1570	break;
	1571	case INST_GT:
	1572	iResult = d1 > d2;
	1573	break;
	1574	case INST_LE:
	1575	iResult = d1 <= d2;
	1576	break;
	1577	case INST_GE:
	1578	iResult = d1 >= d2;
	1579	break;
	1580	}
	1581	} else {
	1582	/*
	1583	* Compare as ints.
	1584	*/
	1585	i = valuePtr->internalRep.longValue;
	1586	i2 = value2Ptr->internalRep.longValue;
	1587	switch (opCode) {
	1588	case INST_EQ:
	1589	iResult = i == i2;
	1590	break;
	1591	case INST_NEQ:
	1592	iResult = i != i2;
	1593	break;
	1594	case INST_LT:
	1595	iResult = i < i2;
	1596	break;
	1597	case INST_GT:
	1598	iResult = i > i2;
	1599	break;
	1600	case INST_LE:
	1601	iResult = i <= i2;
	1602	break;
	1603	case INST_GE:
	1604	iResult = i >= i2;
	1605	break;
	1606	}
	1607	}
	1608
	1609	/*
	1610	* Reuse the valuePtr object already on stack if possible.
	1611	*/
	1612
	1613	if (Tcl_IsShared(valuePtr)) {
	1614	PUSH_OBJECT(Tcl_NewLongObj(iResult));
	1615	TclDecrRefCount(valuePtr);
	1616	} else { /* reuse the valuePtr object */
	1617	Tcl_SetLongObj(valuePtr, iResult);
	1618	++stackTop; /* valuePtr now on stk top has right r.c. */
	1619	}
	1620	TclDecrRefCount(value2Ptr);
	1621	}
	1622	ADJUST_PC(1);
	1623
	1624	case INST_MOD:
	1625	case INST_LSHIFT:
	1626	case INST_RSHIFT:
	1627	case INST_BITOR:
	1628	case INST_BITXOR:
	1629	case INST_BITAND:
	1630	{
	1631	/*
	1632	* Only integers are allowed. We compute value op value2.
	1633	*/
	1634
	1635	long i2, rem, negative;
	1636	long iResult = 0; /* Init. avoids compiler warning. */
	1637
	1638	value2Ptr = POP_OBJECT();
	1639	valuePtr = POP_OBJECT();
	1640	if (valuePtr->typePtr == &tclIntType) {
	1641	i = valuePtr->internalRep.longValue;
	1642	} else { /* try to convert to int */
	1643	result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
	1644	valuePtr, &i);
	1645	if (result != TCL_OK) {
	1646	IllegalExprOperandType(interp, opCode, valuePtr);
	1647	Tcl_DecrRefCount(valuePtr);
	1648	Tcl_DecrRefCount(value2Ptr);
	1649	goto checkForCatch;
	1650	}
	1651	}
	1652	if (value2Ptr->typePtr == &tclIntType) {
	1653	i2 = value2Ptr->internalRep.longValue;
	1654	} else {
	1655	result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
	1656	value2Ptr, &i2);
	1657	if (result != TCL_OK) {
	1658	IllegalExprOperandType(interp, opCode, value2Ptr);
	1659	Tcl_DecrRefCount(valuePtr);
	1660	Tcl_DecrRefCount(value2Ptr);
	1661	goto checkForCatch;
	1662	}
	1663	}
	1664
	1665	switch (opCode) {
	1666	case INST_MOD:
	1667	/*
	1668	* This code is tricky: C doesn't guarantee much about
	1669	* the quotient or remainder, but Tcl does. The
	1670	* remainder always has the same sign as the divisor and
	1671	* a smaller absolute value.
	1672	*/
	1673	if (i2 == 0) {
	1674	Tcl_DecrRefCount(valuePtr);
	1675	Tcl_DecrRefCount(value2Ptr);
	1676	goto divideByZero;
	1677	}
	1678	negative = 0;
	1679	if (i2 < 0) {
	1680	i2 = -i2;
	1681	i = -i;
	1682	negative = 1;
	1683	}
	1684	rem = i % i2;
	1685	if (rem < 0) {
	1686	rem += i2;
	1687	}
	1688	if (negative) {
	1689	rem = -rem;
	1690	}
	1691	iResult = rem;
	1692	break;
	1693	case INST_LSHIFT:
	1694	iResult = i << i2;
	1695	break;
	1696	case INST_RSHIFT:
	1697	/*
	1698	* The following code is a bit tricky: it ensures that
	1699	* right shifts propagate the sign bit even on machines
	1700	* where ">>" won't do it by default.
	1701	*/
	1702	if (i < 0) {
	1703	iResult = ~((~i) >> i2);
	1704	} else {
	1705	iResult = i >> i2;
	1706	}
	1707	break;
	1708	case INST_BITOR:
	1709	iResult = i \| i2;
	1710	break;
	1711	case INST_BITXOR:
	1712	iResult = i ^ i2;
	1713	break;
	1714	case INST_BITAND:
	1715	iResult = i & i2;
	1716	break;
	1717	}
	1718
	1719	/*
	1720	* Reuse the valuePtr object already on stack if possible.
	1721	*/
	1722
	1723	if (Tcl_IsShared(valuePtr)) {
	1724	PUSH_OBJECT(Tcl_NewLongObj(iResult));
	1725	TclDecrRefCount(valuePtr);
	1726	} else { /* reuse the valuePtr object */
	1727	Tcl_SetLongObj(valuePtr, iResult);
	1728	++stackTop; /* valuePtr now on stk top has right r.c. */
	1729	}
	1730	TclDecrRefCount(value2Ptr);
	1731	}
	1732	ADJUST_PC(1);
	1733
	1734	case INST_ADD:
	1735	case INST_SUB:
	1736	case INST_MULT:
	1737	case INST_DIV:
	1738	{
	1739	/*
	1740	* Operands must be numeric and ints get converted to floats
	1741	* if necessary. We compute value op value2.
	1742	*/
	1743
	1744	Tcl_ObjType t1Ptr, t2Ptr;
	1745	long i2, quot, rem;
	1746	double d1, d2;
	1747	long iResult = 0; /* Init. avoids compiler warning. */
	1748	double dResult = 0.0; /* Init. avoids compiler warning. */
	1749	int doDouble = 0; /* 1 if doing floating arithmetic */
	1750
	1751	value2Ptr = POP_OBJECT();
	1752	valuePtr = POP_OBJECT();
	1753	t1Ptr = valuePtr->typePtr;
	1754	t2Ptr = value2Ptr->typePtr;
	1755
	1756	if (t1Ptr == &tclIntType) {
	1757	i = valuePtr->internalRep.longValue;
	1758	} else if (t1Ptr == &tclDoubleType) {
	1759	d1 = valuePtr->internalRep.doubleValue;
	1760	} else { /* try to convert; FAILS IF NULLS */
	1761	char *s = Tcl_GetStringFromObj(valuePtr, &length);
	1762	if (TclLooksLikeInt(s)) {
	1763	result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
	1764	valuePtr, &i);
	1765	} else {
	1766	result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
	1767	valuePtr, &d1);
	1768	}
	1769	if (result != TCL_OK) {
	1770	IllegalExprOperandType(interp, opCode, valuePtr);
	1771	Tcl_DecrRefCount(valuePtr);
	1772	Tcl_DecrRefCount(value2Ptr);
	1773	goto checkForCatch;
	1774	}
	1775	t1Ptr = valuePtr->typePtr;
	1776	}
	1777
	1778	if (t2Ptr == &tclIntType) {
	1779	i2 = value2Ptr->internalRep.longValue;
	1780	} else if (t2Ptr == &tclDoubleType) {
	1781	d2 = value2Ptr->internalRep.doubleValue;
	1782	} else { /* try to convert; FAILS IF NULLS */
	1783	char *s = Tcl_GetStringFromObj(value2Ptr, &length);
	1784	if (TclLooksLikeInt(s)) {
	1785	result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
	1786	value2Ptr, &i2);
	1787	} else {
	1788	result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
	1789	value2Ptr, &d2);
	1790	}
	1791	if (result != TCL_OK) {
	1792	IllegalExprOperandType(interp, opCode, value2Ptr);
	1793	Tcl_DecrRefCount(valuePtr);
	1794	Tcl_DecrRefCount(value2Ptr);
	1795	goto checkForCatch;
	1796	}
	1797	t2Ptr = value2Ptr->typePtr;
	1798	}
	1799
	1800	if ((t1Ptr == &tclDoubleType) \|\| (t2Ptr == &tclDoubleType)) {
	1801	/*
	1802	* Do double arithmetic.
	1803	*/
	1804	doDouble = 1;
	1805	if (t1Ptr == &tclIntType) {
	1806	d1 = i; /* promote value 1 to double */
	1807	} else if (t2Ptr == &tclIntType) {
	1808	d2 = i2; /* promote value 2 to double */
	1809	}
	1810	switch (opCode) {
	1811	case INST_ADD:
	1812	dResult = d1 + d2;
	1813	break;
	1814	case INST_SUB:
	1815	dResult = d1 - d2;
	1816	break;
	1817	case INST_MULT:
	1818	dResult = d1 * d2;
	1819	break;
	1820	case INST_DIV:
	1821	if (d2 == 0.0) {
	1822	Tcl_DecrRefCount(valuePtr);
	1823	Tcl_DecrRefCount(value2Ptr);
	1824	goto divideByZero;
	1825	}
	1826	dResult = d1 / d2;
	1827	break;
	1828	}
	1829
	1830	/*
	1831	* Check now for IEEE floating-point error.
	1832	*/
	1833
	1834	if (IS_NAN(dResult) \|\| IS_INF(dResult)) {
	1835	TclExprFloatError(interp, dResult);
	1836	result = TCL_ERROR;
	1837	Tcl_DecrRefCount(valuePtr);
	1838	Tcl_DecrRefCount(value2Ptr);
	1839	goto checkForCatch;
	1840	}
	1841	} else {
	1842	/*
	1843	* Do integer arithmetic.
	1844	*/
	1845	switch (opCode) {
	1846	case INST_ADD:
	1847	iResult = i + i2;
	1848	break;
	1849	case INST_SUB:
	1850	iResult = i - i2;
	1851	break;
	1852	case INST_MULT:
	1853	iResult = i * i2;
	1854	break;
	1855	case INST_DIV:
	1856	/*
	1857	* This code is tricky: C doesn't guarantee much
	1858	* about the quotient or remainder, but Tcl does.
	1859	* The remainder always has the same sign as the
	1860	* divisor and a smaller absolute value.
	1861	*/
	1862	if (i2 == 0) {
	1863	Tcl_DecrRefCount(valuePtr);
	1864	Tcl_DecrRefCount(value2Ptr);
	1865	goto divideByZero;
	1866	}
	1867	if (i2 < 0) {
	1868	i2 = -i2;
	1869	i = -i;
	1870	}
	1871	quot = i / i2;
	1872	rem = i % i2;
	1873	if (rem < 0) {
	1874	quot -= 1;
	1875	}
	1876	iResult = quot;
	1877	break;
	1878	}
	1879	}
	1880
	1881	/*
	1882	* Reuse the valuePtr object already on stack if possible.
	1883	*/
	1884
	1885	if (Tcl_IsShared(valuePtr)) {
	1886	if (doDouble) {
	1887	PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
	1888	} else {
	1889	PUSH_OBJECT(Tcl_NewLongObj(iResult));
	1890	}
	1891	TclDecrRefCount(valuePtr);
	1892	} else { /* reuse the valuePtr object */
	1893	if (doDouble) { /* NB: stack top is off by 1 */
	1894	Tcl_SetDoubleObj(valuePtr, dResult);
	1895	} else {
	1896	Tcl_SetLongObj(valuePtr, iResult);
	1897	}
	1898	++stackTop; /* valuePtr now on stk top has right r.c. */
	1899	}
	1900	TclDecrRefCount(value2Ptr);
	1901	}
	1902	ADJUST_PC(1);
	1903
	1904	case INST_UPLUS:
	1905	{
	1906	/*
	1907	* Operand must be numeric.
	1908	*/
	1909
	1910	double d;
	1911	Tcl_ObjType *tPtr;
	1912
	1913	valuePtr = stackPtr[stackTop].o;
	1914	tPtr = valuePtr->typePtr;
	1915	if ((tPtr != &tclIntType) && (tPtr != &tclDoubleType)) {
	1916	char s = Tcl_GetStringFromObj(valuePtr, (int ) NULL);
	1917	if (TclLooksLikeInt(s)) { /* FAILS IF NULLS */
	1918	result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
	1919	valuePtr, &i);
	1920	} else {
	1921	result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
	1922	valuePtr, &d);
	1923	}
	1924	if (result != TCL_OK) {
	1925	IllegalExprOperandType(interp, opCode, valuePtr);
	1926	goto checkForCatch;
	1927	}
	1928	}
	1929	}
	1930	ADJUST_PC(1);
	1931
	1932	case INST_UMINUS:
	1933	case INST_LNOT:
	1934	{
	1935	/*
	1936	* The operand must be numeric. If the operand object is
	1937	* unshared modify it directly, otherwise create a copy to
	1938	* modify: this is "copy on write". free any old string
	1939	* representation since it is now invalid.
	1940	*/
	1941
	1942	double d;
	1943	Tcl_ObjType *tPtr;
	1944
	1945	valuePtr = POP_OBJECT();
	1946	tPtr = valuePtr->typePtr;
	1947	if ((tPtr != &tclIntType) && (tPtr != &tclDoubleType)) {
	1948	char s = Tcl_GetStringFromObj(valuePtr, (int ) NULL);
	1949	if (TclLooksLikeInt(s)) { /* FAILS IF NULLS */
	1950	result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
	1951	valuePtr, &i);
	1952	} else {
	1953	result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
	1954	valuePtr, &d);
	1955	}
	1956	if (result != TCL_OK) {
	1957	IllegalExprOperandType(interp, opCode, valuePtr);
	1958	Tcl_DecrRefCount(valuePtr);
	1959	goto checkForCatch;
	1960	}
	1961	tPtr = valuePtr->typePtr;
	1962	}
	1963
	1964	if (Tcl_IsShared(valuePtr)) {
	1965	/*
	1966	* Create a new object.
	1967	*/
	1968	if (tPtr == &tclIntType) {
	1969	i = valuePtr->internalRep.longValue;
	1970	objPtr = Tcl_NewLongObj(
	1971	(opCode == INST_UMINUS)? -i : !i);
	1972	} else {
	1973	d = valuePtr->internalRep.doubleValue;
	1974	if (opCode == INST_UMINUS) {
	1975	objPtr = Tcl_NewDoubleObj(-d);
	1976	} else {
	1977	/*
	1978	* Should be able to use "!d", but apparently
	1979	* some compilers can't handle it.
	1980	*/
	1981	objPtr = Tcl_NewLongObj((d==0.0)? 1 : 0);
	1982	}
	1983	}
	1984	PUSH_OBJECT(objPtr);
	1985	TclDecrRefCount(valuePtr);
	1986	} else {
	1987	/*
	1988	* valuePtr is unshared. Modify it directly.
	1989	*/
	1990	if (tPtr == &tclIntType) {
	1991	i = valuePtr->internalRep.longValue;
	1992	Tcl_SetLongObj(valuePtr,
	1993	(opCode == INST_UMINUS)? -i : !i);
	1994	} else {
	1995	d = valuePtr->internalRep.doubleValue;
	1996	if (opCode == INST_UMINUS) {
	1997	Tcl_SetDoubleObj(valuePtr, -d);
	1998	} else {
	1999	/*
	2000	* Should be able to use "!d", but apparently
	2001	* some compilers can't handle it.
	2002	*/
	2003	Tcl_SetLongObj(valuePtr, (d==0.0)? 1 : 0);
	2004	}
	2005	}
	2006	++stackTop; /* valuePtr now on stk top has right r.c. */
	2007	}
	2008	}
	2009	ADJUST_PC(1);
	2010
	2011	case INST_BITNOT:
	2012	{
	2013	/*
	2014	* The operand must be an integer. If the operand object is
	2015	* unshared modify it directly, otherwise modify a copy.
	2016	* Free any old string representation since it is now
	2017	* invalid.
	2018	*/
	2019
	2020	Tcl_ObjType *tPtr;
	2021
	2022	valuePtr = POP_OBJECT();
	2023	tPtr = valuePtr->typePtr;
	2024	if (tPtr != &tclIntType) {
	2025	result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
	2026	valuePtr, &i);
	2027	if (result != TCL_OK) { /* try to convert to double */
	2028	IllegalExprOperandType(interp, opCode, valuePtr);
	2029	Tcl_DecrRefCount(valuePtr);
	2030	goto checkForCatch;
	2031	}
	2032	}
	2033
	2034	i = valuePtr->internalRep.longValue;
	2035	if (Tcl_IsShared(valuePtr)) {
	2036	PUSH_OBJECT(Tcl_NewLongObj(~i));
	2037	TclDecrRefCount(valuePtr);
	2038	} else {
	2039	/*
	2040	* valuePtr is unshared. Modify it directly.
	2041	*/
	2042	Tcl_SetLongObj(valuePtr, ~i);
	2043	++stackTop; /* valuePtr now on stk top has right r.c. */
	2044	}
	2045	}
	2046	ADJUST_PC(1);
	2047
	2048	case INST_CALL_BUILTIN_FUNC1:
	2049	opnd = TclGetUInt1AtPtr(pc+1);
	2050	{
	2051	/*
	2052	* Call one of the built-in Tcl math functions.
	2053	*/
	2054
	2055	BuiltinFunc *mathFuncPtr;
	2056
	2057	if ((opnd < 0) \|\| (opnd > LAST_BUILTIN_FUNC)) {
	2058	panic("TclExecuteByteCode: unrecognized builtin function code %d", opnd);
	2059	}
	2060	mathFuncPtr = &(builtinFuncTable[opnd]);
	2061	DECACHE_STACK_INFO();
	2062	tcl_MathInProgress++;
	2063	result = (*mathFuncPtr->proc)(interp, eePtr,
	2064	mathFuncPtr->clientData);
	2065	tcl_MathInProgress--;
	2066	CACHE_STACK_INFO();
	2067	if (result != TCL_OK) {
	2068	goto checkForCatch;
	2069	}
	2070	}
	2071	ADJUST_PC(2);
	2072
	2073	case INST_CALL_FUNC1:
	2074	opnd = TclGetUInt1AtPtr(pc+1);
	2075	{
	2076	/*
	2077	* Call a non-builtin Tcl math function previously
	2078	* registered by a call to Tcl_CreateMathFunc.
	2079	*/
	2080
	2081	int objc = opnd; /* Number of arguments. The function name
	2082	* is the 0-th argument. */
	2083	Tcl_Obj *objv; / The array of arguments. The function
	2084	* name is objv[0]. */
	2085
	2086	objv = &(stackPtr[stackTop - (objc-1)].o); /* "objv[0]" */
	2087	DECACHE_STACK_INFO();
	2088	tcl_MathInProgress++;
	2089	result = ExprCallMathFunc(interp, eePtr, objc, objv);
	2090	tcl_MathInProgress--;
	2091	CACHE_STACK_INFO();
	2092	if (result != TCL_OK) {
	2093	goto checkForCatch;
	2094	}
	2095	ADJUST_PC(2);
	2096	}
	2097
	2098	case INST_TRY_CVT_TO_NUMERIC:
	2099	{
	2100	/*
	2101	* Try to convert the topmost stack object to an int or
	2102	* double object. This is done in order to support Tcl's
	2103	* policy of interpreting operands if at all possible as
	2104	* first integers, else floating-point numbers.
	2105	*/
	2106
	2107	double d;
	2108	char *s;
	2109	Tcl_ObjType *tPtr;
	2110	int converted, shared;
	2111
	2112	valuePtr = stackPtr[stackTop].o;
	2113	tPtr = valuePtr->typePtr;
	2114	converted = 0;
	2115	if ((tPtr != &tclIntType) && (tPtr != &tclDoubleType)) {
	2116	s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
	2117	if (TclLooksLikeInt(s)) { /* FAILS IF NULLS */
	2118	result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
	2119	valuePtr, &i);
	2120	} else {
	2121	result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
	2122	valuePtr, &d);
	2123	}
	2124	if (result == TCL_OK) {
	2125	converted = 1;
	2126	}
	2127	result = TCL_OK; /* reset the result variable */
	2128	tPtr = valuePtr->typePtr;
	2129	}
	2130
	2131	/*
	2132	* Ensure that the topmost stack object, if numeric, has a
	2133	* string rep the same as the formatted version of its
	2134	* internal rep. This is used, e.g., to make sure that "expr
	2135	* {0001}" yields "1", not "0001". We implement this by
	2136	* _discarding_ the string rep since we know it will be
	2137	* regenerated, if needed later, by formatting the internal
	2138	* rep's value. Also check if there has been an IEEE
	2139	* floating point error.
	2140	*/
	2141
	2142	if ((tPtr == &tclIntType) \|\| (tPtr == &tclDoubleType)) {
	2143	shared = 0;
	2144	if (Tcl_IsShared(valuePtr)) {
	2145	shared = 1;
	2146	if (tPtr == &tclIntType) {
	2147	i = valuePtr->internalRep.longValue;
	2148	objPtr = Tcl_NewLongObj(i);
	2149	} else {
	2150	d = valuePtr->internalRep.doubleValue;
	2151	objPtr = Tcl_NewDoubleObj(d);
	2152	}
	2153	Tcl_IncrRefCount(objPtr);
	2154	TclDecrRefCount(valuePtr);
	2155	valuePtr = objPtr;
	2156	tPtr = valuePtr->typePtr;
	2157	} else {
	2158	Tcl_InvalidateStringRep(valuePtr);
	2159	}
	2160	stackPtr[stackTop].o = valuePtr;
	2161
	2162	if (tPtr == &tclDoubleType) {
	2163	d = valuePtr->internalRep.doubleValue;
	2164	if (IS_NAN(d) \|\| IS_INF(d)) {
	2165	TclExprFloatError(interp, d);
	2166	result = TCL_ERROR;
	2167	goto checkForCatch;
	2168	}
	2169	}
	2170	shared = shared; /* lint, shared not used. */
	2171	converted = converted; /* lint, converted not used. */
	2172	}
	2173	}
	2174	ADJUST_PC(1);
	2175
	2176	case INST_BREAK:
	2177	/*
	2178	* First reset the interpreter's result. Then find the closest
	2179	* enclosing loop or catch exception range, if any. If a loop is
	2180	* found, terminate its execution. If the closest is a catch
	2181	* exception range, jump to its catchOffset. If no enclosing
	2182	* range is found, stop execution and return TCL_BREAK.
	2183	*/
	2184
	2185	Tcl_ResetResult(interp);
	2186	rangePtr = TclGetExceptionRangeForPc(pc, /catchOnly/ 0,
	2187	codePtr);
	2188	if (rangePtr == NULL) {
	2189	result = TCL_BREAK;
	2190	goto abnormalReturn; /* no catch exists to check */
	2191	}
	2192	switch (rangePtr->type) {
	2193	case LOOP_EXCEPTION_RANGE:
	2194	result = TCL_OK;
	2195	break;
	2196	case CATCH_EXCEPTION_RANGE:
	2197	result = TCL_BREAK;
	2198	goto processCatch; /* it will use rangePtr */
	2199	default:
	2200	panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
	2201	}
	2202	pc = (codePtr->codeStart + rangePtr->breakOffset);
	2203	continue; /* restart outer instruction loop at pc */
	2204
	2205	case INST_CONTINUE:
	2206	/*
	2207	* Find the closest enclosing loop or catch exception range,
	2208	* if any. If a loop is found, skip to its next iteration.
	2209	* If the closest is a catch exception range, jump to its
	2210	* catchOffset. If no enclosing range is found, stop
	2211	* execution and return TCL_CONTINUE.
	2212	*/
	2213
	2214	Tcl_ResetResult(interp);
	2215	rangePtr = TclGetExceptionRangeForPc(pc, /catchOnly/ 0,
	2216	codePtr);
	2217	if (rangePtr == NULL) {
	2218	result = TCL_CONTINUE;
	2219	goto abnormalReturn;
	2220	}
	2221	switch (rangePtr->type) {
	2222	case LOOP_EXCEPTION_RANGE:
	2223	if (rangePtr->continueOffset == -1) {
	2224	goto checkForCatch;
	2225	} else {
	2226	result = TCL_OK;
	2227	}
	2228	break;
	2229	case CATCH_EXCEPTION_RANGE:
	2230	result = TCL_CONTINUE;
	2231	goto processCatch; /* it will use rangePtr */
	2232	default:
	2233	panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
	2234	}
	2235	pc = (codePtr->codeStart + rangePtr->continueOffset);
	2236	continue; /* restart outer instruction loop at pc */
	2237
	2238	case INST_FOREACH_START4:
	2239	opnd = TclGetUInt4AtPtr(pc+1);
	2240	{
	2241	/*
	2242	* Initialize the temporary local var that holds the count
	2243	* of the number of iterations of the loop body to -1.
	2244	*/
	2245
	2246	ForeachInfo infoPtr = (ForeachInfo )
	2247	codePtr->auxDataArrayPtr[opnd].clientData;
	2248	int iterTmpIndex = infoPtr->loopIterNumTmp;
	2249	CallFrame *varFramePtr = iPtr->varFramePtr;
	2250	Var *compiledLocals = varFramePtr->compiledLocals;
	2251	Var *iterVarPtr;
	2252	Tcl_Obj *oldValuePtr;
	2253
	2254	iterVarPtr = &(compiledLocals[iterTmpIndex]);
	2255	oldValuePtr = iterVarPtr->value.objPtr;
	2256	if (oldValuePtr == NULL) {
	2257	iterVarPtr->value.objPtr = Tcl_NewLongObj(-1);
	2258	Tcl_IncrRefCount(iterVarPtr->value.objPtr);
	2259	} else {
	2260	Tcl_SetLongObj(oldValuePtr, -1);
	2261	}
	2262	TclSetVarScalar(iterVarPtr);
	2263	TclClearVarUndefined(iterVarPtr);
	2264	}
	2265	ADJUST_PC(5);
	2266
	2267	case INST_FOREACH_STEP4:
	2268	opnd = TclGetUInt4AtPtr(pc+1);
	2269	{
	2270	/*
	2271	* "Step" a foreach loop (i.e., begin its next iteration) by
	2272	* assigning the next value list element to each loop var.
	2273	*/
	2274
	2275	ForeachInfo infoPtr = (ForeachInfo )
	2276	codePtr->auxDataArrayPtr[opnd].clientData;
	2277	ForeachVarList *varListPtr;
	2278	int numLists = infoPtr->numLists;
	2279	int iterTmpIndex = infoPtr->loopIterNumTmp;
	2280	CallFrame *varFramePtr = iPtr->varFramePtr;
	2281	Var *compiledLocals = varFramePtr->compiledLocals;
	2282	int iterNum, listTmpIndex, listLen, numVars;
	2283	int varIndex, valIndex, j;
	2284	Tcl_Obj listPtr, elemPtr, *oldValuePtr;
	2285	List *listRepPtr;
	2286	Var iterVarPtr, listVarPtr;
	2287	int continueLoop = 0;
	2288
	2289	/*
	2290	* Increment the temp holding the loop iteration number.
	2291	*/
	2292
	2293	iterVarPtr = &(compiledLocals[iterTmpIndex]);
	2294	oldValuePtr = iterVarPtr->value.objPtr;
	2295	iterNum = (oldValuePtr->internalRep.longValue + 1);
	2296	Tcl_SetLongObj(oldValuePtr, iterNum);
	2297
	2298	/*
	2299	* Check whether all value lists are exhausted and we should
	2300	* stop the loop.
	2301	*/
	2302
	2303	listTmpIndex = infoPtr->firstListTmp;
	2304	for (i = 0; i < numLists; i++) {
	2305	varListPtr = infoPtr->varLists[i];
	2306	numVars = varListPtr->numVars;
	2307
	2308	listVarPtr = &(compiledLocals[listTmpIndex]);
	2309	listPtr = listVarPtr->value.objPtr;
	2310	result = Tcl_ListObjLength(interp, listPtr, &listLen);
	2311	if (result != TCL_OK) {
	2312	goto checkForCatch;
	2313	}
	2314	if (listLen > (iterNum * numVars)) {
	2315	continueLoop = 1;
	2316	}
	2317	listTmpIndex++;
	2318	}
	2319
	2320	/*
	2321	* If some var in some var list still has a remaining list
	2322	* element iterate one more time. Assign to var the next
	2323	* element from its value list. We already checked above
	2324	* that each list temp holds a valid list object.
	2325	*/
	2326
	2327	if (continueLoop) {
	2328	listTmpIndex = infoPtr->firstListTmp;
	2329	for (i = 0; i < numLists; i++) {
	2330	varListPtr = infoPtr->varLists[i];
	2331	numVars = varListPtr->numVars;
	2332
	2333	listVarPtr = &(compiledLocals[listTmpIndex]);
	2334	listPtr = listVarPtr->value.objPtr;
	2335	listRepPtr = (List *)
	2336	listPtr->internalRep.otherValuePtr;
	2337	listLen = listRepPtr->elemCount;
	2338
	2339	valIndex = (iterNum * numVars);
	2340	for (j = 0; j < numVars; j++) {
	2341	int setEmptyStr = 0;
	2342	if (valIndex >= listLen) {
	2343	setEmptyStr = 1;
	2344	elemPtr = Tcl_NewObj();
	2345	} else {
	2346	elemPtr = listRepPtr->elements[valIndex];
	2347	}
	2348
	2349	varIndex = varListPtr->varIndexes[j];
	2350	DECACHE_STACK_INFO();
	2351	value2Ptr = TclSetIndexedScalar(interp,
	2352	varIndex, elemPtr, /leaveErrorMsg/ 1);
	2353	CACHE_STACK_INFO();
	2354	if (value2Ptr == NULL) {
	2355	if (setEmptyStr) {
	2356	Tcl_DecrRefCount(elemPtr); /* unneeded */
	2357	}
	2358	result = TCL_ERROR;
	2359	goto checkForCatch;
	2360	}
	2361	valIndex++;
	2362	}
	2363	listTmpIndex++;
	2364	}
	2365	}
	2366
	2367	/*
	2368	* Now push a "1" object if at least one value list had a
	2369	* remaining element and the loop should continue.
	2370	* Otherwise push "0".
	2371	*/
	2372
	2373	PUSH_OBJECT(Tcl_NewLongObj(continueLoop));
	2374	}
	2375	ADJUST_PC(5);
	2376
	2377	case INST_BEGIN_CATCH4:
	2378	/*
	2379	* Record start of the catch command with exception range index
	2380	* equal to the operand. Push the current stack depth onto the
	2381	* special catch stack.
	2382	*/
	2383	catchStackPtr[++catchTop] = stackTop;
	2384	ADJUST_PC(5);
	2385
	2386	case INST_END_CATCH:
	2387	catchTop--;
	2388	result = TCL_OK;
	2389	ADJUST_PC(1);
	2390
	2391	case INST_PUSH_RESULT:
	2392	PUSH_OBJECT(Tcl_GetObjResult(interp));
	2393	ADJUST_PC(1);
	2394
	2395	case INST_PUSH_RETURN_CODE:
	2396	PUSH_OBJECT(Tcl_NewLongObj(result));
	2397	ADJUST_PC(1);
	2398
	2399	default:
	2400	panic("TclExecuteByteCode: unrecognized opCode %u", opCode);
	2401	} /* end of switch on opCode */
	2402
	2403	/*
	2404	* Division by zero in an expression. Control only reaches this
	2405	* point by "goto divideByZero".
	2406	*/
	2407
	2408	divideByZero:
	2409	Tcl_ResetResult(interp);
	2410	Tcl_AppendToObj(Tcl_GetObjResult(interp), "divide by zero", -1);
	2411	Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero",
	2412	(char *) NULL);
	2413	result = TCL_ERROR;
	2414
	2415	/*
	2416	* Execution has generated an "exception" such as TCL_ERROR. If the
	2417	* exception is an error, record information about what was being
	2418	* executed when the error occurred. Find the closest enclosing
	2419	* catch range, if any. If no enclosing catch range is found, stop
	2420	* execution and return the "exception" code.
	2421	*/
	2422
	2423	checkForCatch:
	2424	if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
	2425	RecordTracebackInfo(interp, pc, codePtr);
	2426	}
	2427	rangePtr = TclGetExceptionRangeForPc(pc, /catchOnly/ 1, codePtr);
	2428	if (rangePtr == NULL) {
	2429	goto abnormalReturn;
	2430	}
	2431
	2432	/*
	2433	* A catch exception range (rangePtr) was found to handle an
	2434	* "exception". It was found either by checkForCatch just above or
	2435	* by an instruction during break, continue, or error processing.
	2436	* Jump to its catchOffset after unwinding the operand stack to
	2437	* the depth it had when starting to execute the range's catch
	2438	* command.
	2439	*/
	2440
	2441	processCatch:
	2442	while (stackTop > catchStackPtr[catchTop]) {
	2443	valuePtr = POP_OBJECT();
	2444	TclDecrRefCount(valuePtr);
	2445	}
	2446	pc = (codePtr->codeStart + rangePtr->catchOffset);
	2447	continue; /* restart the execution loop at pc */
	2448	} /* end of infinite loop dispatching on instructions */
	2449
	2450	/*
	2451	* Abnormal return code. Restore the stack to state it had when starting
	2452	* to execute the ByteCode.
	2453	*/
	2454
	2455	abnormalReturn:
	2456	while (stackTop > initStackTop) {
	2457	valuePtr = POP_OBJECT();
	2458	Tcl_DecrRefCount(valuePtr);
	2459	}
	2460
	2461	/*
	2462	* Free the catch stack array if malloc'ed storage was used.
	2463	*/
	2464
	2465	done:
	2466	if (catchStackPtr != catchStackStorage) {
	2467	ckfree((char *) catchStackPtr);
	2468	}
	2469	eePtr->stackTop = initStackTop;
	2470	return result;
	2471	#undef STATIC_CATCH_STACK_SIZE
	2472	}
	2473
	2474
	2475	/*
	2476	*----------------------------------------------------------------------
	2477	*
	2478	* IllegalExprOperandType --
	2479	*
	2480	* Used by TclExecuteByteCode to add an error message to errorInfo
	2481	* when an illegal operand type is detected by an expression
	2482	* instruction. The argument opCode holds the failing instruction's
	2483	* opcode and opndPtr holds the operand object in error.
	2484	*
	2485	* Results:
	2486	* None.
	2487	*
	2488	* Side effects:
	2489	* An error message is appended to errorInfo.
	2490	*
	2491	*----------------------------------------------------------------------
	2492	*/
	2493
	2494	static void
	2495	IllegalExprOperandType(interp, opCode, opndPtr)
	2496	Tcl_Interp interp; / Interpreter to which error information
	2497	* pertains. */
	2498	unsigned int opCode; /* The instruction opcode being executed
	2499	* when the illegal type was found. */
	2500	Tcl_Obj opndPtr; / Points to the operand holding the value
	2501	* with the illegal type. */
	2502	{
	2503	Tcl_ResetResult(interp);
	2504	if ((opndPtr->bytes == NULL) \|\| (opndPtr->length == 0)) {
	2505	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
	2506	"can't use empty string as operand of \"",
	2507	operatorStrings[opCode - INST_LOR], "\"", (char *) NULL);
	2508	} else {
	2509	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't use ",
	2510	((opndPtr->typePtr == &tclDoubleType) ?
	2511	"floating-point value" : "non-numeric string"),
	2512	" as operand of \"", operatorStrings[opCode - INST_LOR],
	2513	"\"", (char *) NULL);
	2514	}
	2515	}
	2516
	2517
	2518	/*
	2519	*----------------------------------------------------------------------
	2520	*
	2521	* CallTraceProcedure --
	2522	*
	2523	* Invokes a trace procedure registered with an interpreter. These
	2524	* procedures trace command execution. Currently this trace procedure
	2525	* is called with the address of the string-based Tcl_CmdProc for the
	2526	* command, not the Tcl_ObjCmdProc.
	2527	*
	2528	* Results:
	2529	* None.
	2530	*
	2531	* Side effects:
	2532	* Those side effects made by the trace procedure.
	2533	*
	2534	*----------------------------------------------------------------------
	2535	*/
	2536
	2537	static void
	2538	CallTraceProcedure(interp, tracePtr, cmdPtr, command, numChars, objc, objv)
	2539	Tcl_Interp interp; / The current interpreter. */
	2540	register Trace tracePtr; / Describes the trace procedure to call. */
	2541	Command cmdPtr; / Points to command's Command struct. */
	2542	char command; / Points to the first character of the
	2543	* command's source before substitutions. */
	2544	int numChars; /* The number of characters in the
	2545	* command's source. */
	2546	register int objc; /* Number of arguments for the command. */
	2547	Tcl_Obj objv[]; / Pointers to Tcl_Obj of each argument. */
	2548	{
	2549	Interp iPtr = (Interp ) interp;
	2550	register char **argv;
	2551	register int i;
	2552	int length;
	2553	char *p;
	2554
	2555	/*
	2556	* Get the string rep from the objv argument objects and place their
	2557	* pointers in argv. First make sure argv is large enough to hold the
	2558	* objc args plus 1 extra word for the zero end-of-argv word.
	2559	* THIS FAILS IF AN OBJECT'S STRING REP CONTAINS NULLS.
	2560	*/
	2561
	2562	argv = (char *) ckalloc((unsigned)(objc + 1) sizeof(char *));
	2563	for (i = 0; i < objc; i++) {
	2564	argv[i] = Tcl_GetStringFromObj(objv[i], &length);
	2565	}
	2566	argv[objc] = 0;
	2567
	2568	/*
	2569	* Copy the command characters into a new string.
	2570	*/
	2571
	2572	p = (char *) ckalloc((unsigned) (numChars + 1));
	2573	memcpy((VOID ) p, (VOID ) command, (size_t) numChars);
	2574	p[numChars] = '\0';
	2575
	2576	/*
	2577	* Call the trace procedure then free allocated storage.
	2578	*/
	2579
	2580	(*tracePtr->proc)(tracePtr->clientData, interp, iPtr->numLevels,
	2581	p, cmdPtr->proc, cmdPtr->clientData, objc, argv);
	2582
	2583	ckfree((char *) argv);
	2584	ckfree((char *) p);
	2585	}
	2586
	2587
	2588	/*
	2589	*----------------------------------------------------------------------
	2590	*
	2591	* RecordTracebackInfo --
	2592	*
	2593	* Procedure called by TclExecuteByteCode to record information
	2594	* about what was being executed when the error occurred.
	2595	*
	2596	* Results:
	2597	* None.
	2598	*
	2599	* Side effects:
	2600	* Appends information about the command being executed to the
	2601	* "errorInfo" variable. Sets the errorLine field in the interpreter
	2602	* to the line number of that command. Sets the ERR_ALREADY_LOGGED
	2603	* bit in the interpreter's execution flags.
	2604	*
	2605	*----------------------------------------------------------------------
	2606	*/
	2607
	2608	static void
	2609	RecordTracebackInfo(interp, pc, codePtr)
	2610	Tcl_Interp interp; / The interpreter in which the error
	2611	* occurred. */
	2612	unsigned char pc; / The program counter value where the error * occurred. This points to a bytecode
	2613	* instruction in codePtr's code. */
	2614	ByteCode codePtr; / The bytecode sequence being executed. */
	2615	{
	2616	register Interp iPtr = (Interp ) interp;
	2617	char cmd, ellipsis;
	2618	char buf[200];
	2619	register char *p;
	2620	int numChars;
	2621
	2622	/*
	2623	* Record the command in errorInfo (up to a certain number of
	2624	* characters, or up to the first newline).
	2625	*/
	2626
	2627	iPtr->errorLine = 1;
	2628	cmd = GetSrcInfoForPc(pc, codePtr, &numChars);
	2629	if (cmd != NULL) {
	2630	for (p = codePtr->source; p != cmd; p++) {
	2631	if (*p == '\n') {
	2632	iPtr->errorLine++;
	2633	}
	2634	}
	2635	for ( ; (isspace(UCHAR(p)) \|\| (p == ';')); p++) {
	2636	if (*p == '\n') {
	2637	iPtr->errorLine++;
	2638	}
	2639	}
	2640
	2641	ellipsis = "";
	2642	if (numChars > 150) {
	2643	numChars = 150;
	2644	ellipsis = "...";
	2645	}
	2646	if (!(iPtr->flags & ERR_IN_PROGRESS)) {
	2647	sprintf(buf, "\n while executing\n\"%.*s%s\"",
	2648	numChars, cmd, ellipsis);
	2649	} else {
	2650	sprintf(buf, "\n invoked from within\n\"%.*s%s\"",
	2651	numChars, cmd, ellipsis);
	2652	}
	2653	Tcl_AddObjErrorInfo(interp, buf, -1);
	2654	iPtr->flags \|= ERR_ALREADY_LOGGED;
	2655	}
	2656	}
	2657
	2658
	2659	/*
	2660	*----------------------------------------------------------------------
	2661	*
	2662	* GetSrcInfoForPc --
	2663	*
	2664	* Given a program counter value, finds the closest command in the
	2665	* bytecode code unit's CmdLocation array and returns information about
	2666	* that command's source: a pointer to its first byte and the number of
	2667	* characters.
	2668	*
	2669	* Results:
	2670	* If a command is found that encloses the program counter value, a
	2671	* pointer to the command's source is returned and the length of the
	2672	* source is stored at *lengthPtr. If multiple commands resulted in
	2673	* code at pc, information about the closest enclosing command is
	2674	* returned. If no matching command is found, NULL is returned and
	2675	* *lengthPtr is unchanged.
	2676	*
	2677	* Side effects:
	2678	* None.
	2679	*
	2680	*----------------------------------------------------------------------
	2681	*/
	2682
	2683	static char *
	2684	GetSrcInfoForPc(pc, codePtr, lengthPtr)
	2685	unsigned char pc; / The program counter value for which to
	2686	* return the closest command's source info.
	2687	* This points to a bytecode instruction
	2688	* in codePtr's code. */
	2689	ByteCode codePtr; / The bytecode sequence in which to look
	2690	* up the command source for the pc. */
	2691	int lengthPtr; / If non-NULL, the location where the
	2692	* length of the command's source should be
	2693	* stored. If NULL, no length is stored. */
	2694	{
	2695	register int pcOffset = (pc - codePtr->codeStart);
	2696	int numCmds = codePtr->numCommands;
	2697	unsigned char codeDeltaNext, codeLengthNext;
	2698	unsigned char srcDeltaNext, srcLengthNext;
	2699	int codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i;
	2700	int bestDist = INT_MAX; /* Distance of pc to best cmd's start pc. */
	2701	int bestSrcOffset = -1; /* Initialized to avoid compiler warning. */
	2702	int bestSrcLength = -1; /* Initialized to avoid compiler warning. */
	2703
	2704	if ((pcOffset < 0) \|\| (pcOffset >= codePtr->numCodeBytes)) {
	2705	return NULL;
	2706	}
	2707
	2708	/*
	2709	* Decode the code and source offset and length for each command. The
	2710	* closest enclosing command is the last one whose code started before
	2711	* pcOffset.
	2712	*/
	2713
	2714	codeDeltaNext = codePtr->codeDeltaStart;
	2715	codeLengthNext = codePtr->codeLengthStart;
	2716	srcDeltaNext = codePtr->srcDeltaStart;
	2717	srcLengthNext = codePtr->srcLengthStart;
	2718	codeOffset = srcOffset = 0;
	2719	for (i = 0; i < numCmds; i++) {
	2720	if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
	2721	codeDeltaNext++;
	2722	delta = TclGetInt4AtPtr(codeDeltaNext);
	2723	codeDeltaNext += 4;
	2724	} else {
	2725	delta = TclGetInt1AtPtr(codeDeltaNext);
	2726	codeDeltaNext++;
	2727	}
	2728	codeOffset += delta;
	2729
	2730	if ((unsigned int) (*codeLengthNext) == (unsigned int) 0xFF) {
	2731	codeLengthNext++;
	2732	codeLen = TclGetInt4AtPtr(codeLengthNext);
	2733	codeLengthNext += 4;
	2734	} else {
	2735	codeLen = TclGetInt1AtPtr(codeLengthNext);
	2736	codeLengthNext++;
	2737	}
	2738	codeEnd = (codeOffset + codeLen - 1);
	2739
	2740	if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
	2741	srcDeltaNext++;
	2742	delta = TclGetInt4AtPtr(srcDeltaNext);
	2743	srcDeltaNext += 4;
	2744	} else {
	2745	delta = TclGetInt1AtPtr(srcDeltaNext);
	2746	srcDeltaNext++;
	2747	}
	2748	srcOffset += delta;
	2749
	2750	if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
	2751	srcLengthNext++;
	2752	srcLen = TclGetInt4AtPtr(srcLengthNext);
	2753	srcLengthNext += 4;
	2754	} else {
	2755	srcLen = TclGetInt1AtPtr(srcLengthNext);
	2756	srcLengthNext++;
	2757	}
	2758
	2759	if (codeOffset > pcOffset) { /* best cmd already found */
	2760	break;
	2761	} else if (pcOffset <= codeEnd) { /* this cmd's code encloses pc */
	2762	int dist = (pcOffset - codeOffset);
	2763	if (dist <= bestDist) {
	2764	bestDist = dist;
	2765	bestSrcOffset = srcOffset;
	2766	bestSrcLength = srcLen;
	2767	}
	2768	}
	2769	}
	2770
	2771	if (bestDist == INT_MAX) {
	2772	return NULL;
	2773	}
	2774
	2775	if (lengthPtr != NULL) {
	2776	*lengthPtr = bestSrcLength;
	2777	}
	2778	return (codePtr->source + bestSrcOffset);
	2779	}
	2780
	2781
	2782	/*
	2783	*----------------------------------------------------------------------
	2784	*
	2785	* TclGetExceptionRangeForPc --
	2786	*
	2787	* Procedure that given a program counter value, returns the closest
	2788	* enclosing ExceptionRange that matches the kind requested.
	2789	*
	2790	* Results:
	2791	* In the normal case, catchOnly is 0 (false) and this procedure
	2792	* returns a pointer to the most closely enclosing ExceptionRange
	2793	* structure regardless of whether it is a loop or catch exception
	2794	* range. This is appropriate when processing a TCL_BREAK or
	2795	* TCL_CONTINUE, which will be "handled" either by a loop exception
	2796	* range or a closer catch range. If catchOnly is nonzero (true), this
	2797	* procedure ignores loop exception ranges and returns a pointer to the
	2798	* closest catch range. If no matching ExceptionRange is found that
	2799	* encloses pc, a NULL is returned.
	2800	*
	2801	* Side effects:
	2802	* None.
	2803	*
	2804	*----------------------------------------------------------------------
	2805	*/
	2806
	2807	ExceptionRange *
	2808	TclGetExceptionRangeForPc(pc, catchOnly, codePtr)
	2809	unsigned char pc; / The program counter value for which to
	2810	* search for a closest enclosing exception
	2811	* range. This points to a bytecode
	2812	* instruction in codePtr's code. */
	2813	int catchOnly; /* If 0, consider either loop or catch
	2814	* ExceptionRanges in search. Otherwise
	2815	* consider only catch ranges (and ignore
	2816	* any closer loop ranges). */
	2817	ByteCode* codePtr; /* Points to the ByteCode in which to search
	2818	* for the enclosing ExceptionRange. */
	2819	{
	2820	ExceptionRange *rangeArrayPtr;
	2821	int numRanges = codePtr->numExcRanges;
	2822	register ExceptionRange *rangePtr;
	2823	int codeOffset = (pc - codePtr->codeStart);
	2824	register int i, level;
	2825
	2826	if (numRanges == 0) {
	2827	return NULL;
	2828	}
	2829	rangeArrayPtr = codePtr->excRangeArrayPtr;
	2830
	2831	for (level = codePtr->maxExcRangeDepth; level >= 0; level--) {
	2832	for (i = 0; i < numRanges; i++) {
	2833	rangePtr = &(rangeArrayPtr[i]);
	2834	if (rangePtr->nestingLevel == level) {
	2835	int start = rangePtr->codeOffset;
	2836	int end = (start + rangePtr->numCodeBytes);
	2837	if ((start <= codeOffset) && (codeOffset < end)) {
	2838	if ((!catchOnly)
	2839	\|\| (rangePtr->type == CATCH_EXCEPTION_RANGE)) {
	2840	return rangePtr;
	2841	}
	2842	}
	2843	}
	2844	}
	2845	}
	2846	return NULL;
	2847	}
	2848
	2849
	2850	/*
	2851	*----------------------------------------------------------------------
	2852	*
	2853	* Math Functions --
	2854	*
	2855	* This page contains the procedures that implement all of the
	2856	* built-in math functions for expressions.
	2857	*
	2858	* Results:
	2859	* Each procedure returns TCL_OK if it succeeds and pushes an
	2860	* Tcl object holding the result. If it fails it returns TCL_ERROR
	2861	* and leaves an error message in the interpreter's result.
	2862	*
	2863	* Side effects:
	2864	* None.
	2865	*
	2866	*----------------------------------------------------------------------
	2867	*/
	2868
	2869	static int
	2870	ExprUnaryFunc(interp, eePtr, clientData)
	2871	Tcl_Interp interp; / The interpreter in which to execute the
	2872	* function. */
	2873	ExecEnv eePtr; / Points to the environment for executing
	2874	* the function. */
	2875	ClientData clientData; /* Contains the address of a procedure that
	2876	* takes one double argument and returns a
	2877	* double result. */
	2878	{
	2879	StackItem stackPtr; / Cached evaluation stack base pointer. */
	2880	register int stackTop; /* Cached top index of evaluation stack. */
	2881	register Tcl_Obj *valuePtr;
	2882	Tcl_ObjType *tPtr;
	2883	double d, dResult;
	2884	long i;
	2885	int result = TCL_OK;
	2886
	2887	double (*func) _ANSI_ARGS_((double)) =
	2888	(double (*)_ANSI_ARGS_((double))) clientData;
	2889
	2890	/*
	2891	* Set stackPtr and stackTop from eePtr.
	2892	*/
	2893
	2894	CACHE_STACK_INFO();
	2895
	2896	/*
	2897	* Pop the function's argument from the evaluation stack. Convert it
	2898	* to a double if necessary.
	2899	*/
	2900
	2901	valuePtr = POP_OBJECT();
	2902	tPtr = valuePtr->typePtr;
	2903
	2904	if (tPtr == &tclIntType) {
	2905	d = (double) valuePtr->internalRep.longValue;
	2906	} else if (tPtr == &tclDoubleType) {
	2907	d = valuePtr->internalRep.doubleValue;
	2908	} else { /* FAILS IF STRING REP HAS NULLS */
	2909	char s = Tcl_GetStringFromObj(valuePtr, (int ) NULL);
	2910
	2911	if (TclLooksLikeInt(s)) {
	2912	result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
	2913	d = (double) valuePtr->internalRep.longValue;
	2914	} else {
	2915	result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
	2916	}
	2917	if (result != TCL_OK) {
	2918	Tcl_ResetResult(interp);
	2919	Tcl_AppendToObj(Tcl_GetObjResult(interp),
	2920	"argument to math function didn't have numeric value", -1);
	2921	goto done;
	2922	}
	2923	}
	2924
	2925	errno = 0;
	2926	dResult = (*func)(d);
	2927	if ((errno != 0) \|\| IS_NAN(dResult) \|\| IS_INF(dResult)) {
	2928	TclExprFloatError(interp, dResult);
	2929	result = TCL_ERROR;
	2930	goto done;
	2931	}
	2932
	2933	/*
	2934	* Push a Tcl object holding the result.
	2935	*/
	2936
	2937	PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
	2938
	2939	/*
	2940	* Reflect the change to stackTop back in eePtr.
	2941	*/
	2942
	2943	done:
	2944	Tcl_DecrRefCount(valuePtr);
	2945	DECACHE_STACK_INFO();
	2946	return result;
	2947	}
	2948
	2949	static int
	2950	ExprBinaryFunc(interp, eePtr, clientData)
	2951	Tcl_Interp interp; / The interpreter in which to execute the
	2952	* function. */
	2953	ExecEnv eePtr; / Points to the environment for executing
	2954	* the function. */
	2955	ClientData clientData; /* Contains the address of a procedure that
	2956	* takes two double arguments and
	2957	* returns a double result. */
	2958	{
	2959	StackItem stackPtr; / Cached evaluation stack base pointer. */
	2960	register int stackTop; /* Cached top index of evaluation stack. */
	2961	register Tcl_Obj valuePtr, value2Ptr;
	2962	Tcl_ObjType *tPtr;
	2963	double d1, d2, dResult;
	2964	long i;
	2965	char *s;
	2966	int result = TCL_OK;
	2967
	2968	double (*func) _ANSI_ARGS_((double, double))
	2969	= (double (*)_ANSI_ARGS_((double, double))) clientData;
	2970
	2971	/*
	2972	* Set stackPtr and stackTop from eePtr.
	2973	*/
	2974
	2975	CACHE_STACK_INFO();
	2976
	2977	/*
	2978	* Pop the function's two arguments from the evaluation stack. Convert
	2979	* them to doubles if necessary.
	2980	*/
	2981
	2982	value2Ptr = POP_OBJECT();
	2983	valuePtr = POP_OBJECT();
	2984
	2985	tPtr = valuePtr->typePtr;
	2986	if (tPtr == &tclIntType) {
	2987	d1 = (double) valuePtr->internalRep.longValue;
	2988	} else if (tPtr == &tclDoubleType) {
	2989	d1 = valuePtr->internalRep.doubleValue;
	2990	} else { /* FAILS IF STRING REP HAS NULLS */
	2991	s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
	2992	if (TclLooksLikeInt(s)) {
	2993	result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
	2994	d1 = (double) valuePtr->internalRep.longValue;
	2995	} else {
	2996	result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d1);
	2997	}
	2998	if (result != TCL_OK) {
	2999	badArg:
	3000	Tcl_ResetResult(interp);
	3001	Tcl_AppendToObj(Tcl_GetObjResult(interp),
	3002	"argument to math function didn't have numeric value", -1);
	3003	goto done;
	3004	}
	3005	}
	3006
	3007	tPtr = value2Ptr->typePtr;
	3008	if (tPtr == &tclIntType) {
	3009	d2 = value2Ptr->internalRep.longValue;
	3010	} else if (tPtr == &tclDoubleType) {
	3011	d2 = value2Ptr->internalRep.doubleValue;
	3012	} else { /* FAILS IF STRING REP HAS NULLS */
	3013	s = Tcl_GetStringFromObj(value2Ptr, (int *) NULL);
	3014	if (TclLooksLikeInt(s)) {
	3015	result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, value2Ptr, &i);
	3016	d2 = (double) value2Ptr->internalRep.longValue;
	3017	} else {
	3018	result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, value2Ptr, &d2);
	3019	}
	3020	if (result != TCL_OK) {
	3021	goto badArg;
	3022	}
	3023	}
	3024
	3025	errno = 0;
	3026	dResult = (*func)(d1, d2);
	3027	if ((errno != 0) \|\| IS_NAN(dResult) \|\| IS_INF(dResult)) {
	3028	TclExprFloatError(interp, dResult);
	3029	result = TCL_ERROR;
	3030	goto done;
	3031	}
	3032
	3033	/*
	3034	* Push a Tcl object holding the result.
	3035	*/
	3036
	3037	PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
	3038
	3039	/*
	3040	* Reflect the change to stackTop back in eePtr.
	3041	*/
	3042
	3043	done:
	3044	Tcl_DecrRefCount(valuePtr);
	3045	Tcl_DecrRefCount(value2Ptr);
	3046	DECACHE_STACK_INFO();
	3047	return result;
	3048	}
	3049
	3050	static int
	3051	ExprAbsFunc(interp, eePtr, clientData)
	3052	Tcl_Interp interp; / The interpreter in which to execute the
	3053	* function. */
	3054	ExecEnv eePtr; / Points to the environment for executing
	3055	* the function. */
	3056	ClientData clientData; /* Ignored. */
	3057	{
	3058	StackItem stackPtr; / Cached evaluation stack base pointer. */
	3059	register int stackTop; /* Cached top index of evaluation stack. */
	3060	register Tcl_Obj *valuePtr;
	3061	Tcl_ObjType *tPtr;
	3062	long i, iResult;
	3063	double d, dResult;
	3064	int result = TCL_OK;
	3065
	3066	/*
	3067	* Set stackPtr and stackTop from eePtr.
	3068	*/
	3069
	3070	CACHE_STACK_INFO();
	3071
	3072	/*
	3073	* Pop the argument from the evaluation stack.
	3074	*/
	3075
	3076	valuePtr = POP_OBJECT();
	3077	tPtr = valuePtr->typePtr;
	3078
	3079	if (tPtr == &tclIntType) {
	3080	i = valuePtr->internalRep.longValue;
	3081	} else if (tPtr == &tclDoubleType) {
	3082	d = valuePtr->internalRep.doubleValue;
	3083	} else { /* FAILS IF STRING REP HAS NULLS */
	3084	char s = Tcl_GetStringFromObj(valuePtr, (int ) NULL);
	3085
	3086	if (TclLooksLikeInt(s)) {
	3087	result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
	3088	} else {
	3089	result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
	3090	}
	3091	if (result != TCL_OK) {
	3092	Tcl_ResetResult(interp);
	3093	Tcl_AppendToObj(Tcl_GetObjResult(interp),
	3094	"argument to math function didn't have numeric value", -1);
	3095	goto done;
	3096	}
	3097	tPtr = valuePtr->typePtr;
	3098	}
	3099
	3100	/*
	3101	* Push a Tcl object with the result.
	3102	*/
	3103
	3104	if (tPtr == &tclIntType) {
	3105	if (i < 0) {
	3106	iResult = -i;
	3107	if (iResult < 0) {
	3108	Tcl_ResetResult(interp);
	3109	Tcl_AppendToObj(Tcl_GetObjResult(interp),
	3110	"integer value too large to represent", -1);
	3111	Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
	3112	"integer value too large to represent", (char *) NULL);
	3113	result = TCL_ERROR;
	3114	goto done;
	3115	}
	3116	} else {
	3117	iResult = i;
	3118	}
	3119	PUSH_OBJECT(Tcl_NewLongObj(iResult));
	3120	} else {
	3121	if (d < 0.0) {
	3122	dResult = -d;
	3123	} else {
	3124	dResult = d;
	3125	}
	3126	if (IS_NAN(dResult) \|\| IS_INF(dResult)) {
	3127	TclExprFloatError(interp, dResult);
	3128	result = TCL_ERROR;
	3129	goto done;
	3130	}
	3131	PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
	3132	}
	3133
	3134	/*
	3135	* Reflect the change to stackTop back in eePtr.
	3136	*/
	3137
	3138	done:
	3139	Tcl_DecrRefCount(valuePtr);
	3140	DECACHE_STACK_INFO();
	3141	return result;
	3142	}
	3143
	3144	static int
	3145	ExprDoubleFunc(interp, eePtr, clientData)
	3146	Tcl_Interp interp; / The interpreter in which to execute the
	3147	* function. */
	3148	ExecEnv eePtr; / Points to the environment for executing
	3149	* the function. */
	3150	ClientData clientData; /* Ignored. */
	3151	{
	3152	StackItem stackPtr; / Cached evaluation stack base pointer. */
	3153	register int stackTop; /* Cached top index of evaluation stack. */
	3154	register Tcl_Obj *valuePtr;
	3155	double dResult;
	3156	long i;
	3157	int result = TCL_OK;
	3158
	3159	/*
	3160	* Set stackPtr and stackTop from eePtr.
	3161	*/
	3162
	3163	CACHE_STACK_INFO();
	3164
	3165	/*
	3166	* Pop the argument from the evaluation stack.
	3167	*/
	3168
	3169	valuePtr = POP_OBJECT();
	3170	if (valuePtr->typePtr == &tclIntType) {
	3171	dResult = (double) valuePtr->internalRep.longValue;
	3172	} else if (valuePtr->typePtr == &tclDoubleType) {
	3173	dResult = valuePtr->internalRep.doubleValue;
	3174	} else { /* FAILS IF STRING REP HAS NULLS */
	3175	char s = Tcl_GetStringFromObj(valuePtr, (int ) NULL);
	3176
	3177	if (TclLooksLikeInt(s)) {
	3178	result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
	3179	dResult = (double) valuePtr->internalRep.longValue;
	3180	} else {
	3181	result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr,
	3182	&dResult);
	3183	}
	3184	if (result != TCL_OK) {
	3185	Tcl_ResetResult(interp);
	3186	Tcl_AppendToObj(Tcl_GetObjResult(interp),
	3187	"argument to math function didn't have numeric value", -1);
	3188	goto done;
	3189	}
	3190	}
	3191
	3192	/*
	3193	* Push a Tcl object with the result.
	3194	*/
	3195
	3196	PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
	3197
	3198	/*
	3199	* Reflect the change to stackTop back in eePtr.
	3200	*/
	3201
	3202	done:
	3203	Tcl_DecrRefCount(valuePtr);
	3204	DECACHE_STACK_INFO();
	3205	return result;
	3206	}
	3207
	3208	static int
	3209	ExprIntFunc(interp, eePtr, clientData)
	3210	Tcl_Interp interp; / The interpreter in which to execute the
	3211	* function. */
	3212	ExecEnv eePtr; / Points to the environment for executing
	3213	* the function. */
	3214	ClientData clientData; /* Ignored. */
	3215	{
	3216	StackItem stackPtr; / Cached evaluation stack base pointer. */
	3217	register int stackTop; /* Cached top index of evaluation stack. */
	3218	register Tcl_Obj *valuePtr;
	3219	Tcl_ObjType *tPtr;
	3220	long i = 0; /* Initialized to avoid compiler warning. */
	3221	long iResult;
	3222	double d;
	3223	int result = TCL_OK;
	3224
	3225	/*
	3226	* Set stackPtr and stackTop from eePtr.
	3227	*/
	3228
	3229	CACHE_STACK_INFO();
	3230
	3231	/*
	3232	* Pop the argument from the evaluation stack.
	3233	*/
	3234
	3235	valuePtr = POP_OBJECT();
	3236	tPtr = valuePtr->typePtr;
	3237
	3238	if (tPtr == &tclIntType) {
	3239	i = valuePtr->internalRep.longValue;
	3240	} else if (tPtr == &tclDoubleType) {
	3241	d = valuePtr->internalRep.doubleValue;
	3242	} else { /* FAILS IF STRING REP HAS NULLS */
	3243	char s = Tcl_GetStringFromObj(valuePtr, (int ) NULL);
	3244
	3245	if (TclLooksLikeInt(s)) {
	3246	result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
	3247	} else {
	3248	result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
	3249	}
	3250	if (result != TCL_OK) {
	3251	Tcl_ResetResult(interp);
	3252	Tcl_AppendToObj(Tcl_GetObjResult(interp),
	3253	"argument to math function didn't have numeric value", -1);
	3254	goto done;
	3255	}
	3256	tPtr = valuePtr->typePtr;
	3257	}
	3258
	3259	/*
	3260	* Push a Tcl object with the result.
	3261	*/
	3262
	3263	if (tPtr == &tclIntType) {
	3264	iResult = i;
	3265	} else {
	3266	if (d < 0.0) {
	3267	if (d < (double) (long) LONG_MIN) {
	3268	tooLarge:
	3269	Tcl_ResetResult(interp);
	3270	Tcl_AppendToObj(Tcl_GetObjResult(interp),
	3271	"integer value too large to represent", -1);
	3272	Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
	3273	"integer value too large to represent", (char *) NULL);
	3274	result = TCL_ERROR;
	3275	goto done;
	3276	}
	3277	} else {
	3278	if (d > (double) LONG_MAX) {
	3279	goto tooLarge;
	3280	}
	3281	}
	3282	if (IS_NAN(d) \|\| IS_INF(d)) {
	3283	TclExprFloatError(interp, d);
	3284	result = TCL_ERROR;
	3285	goto done;
	3286	}
	3287	iResult = (long) d;
	3288	}
	3289	PUSH_OBJECT(Tcl_NewLongObj(iResult));
	3290
	3291	/*
	3292	* Reflect the change to stackTop back in eePtr.
	3293	*/
	3294
	3295	done:
	3296	Tcl_DecrRefCount(valuePtr);
	3297	DECACHE_STACK_INFO();
	3298	return result;
	3299	}
	3300
	3301	static int
	3302	ExprRoundFunc(interp, eePtr, clientData)
	3303	Tcl_Interp interp; / The interpreter in which to execute the
	3304	* function. */
	3305	ExecEnv eePtr; / Points to the environment for executing
	3306	* the function. */
	3307	ClientData clientData; /* Ignored. */
	3308	{
	3309	StackItem stackPtr; / Cached evaluation stack base pointer. */
	3310	register int stackTop; /* Cached top index of evaluation stack. */
	3311	Tcl_Obj *valuePtr;
	3312	Tcl_ObjType *tPtr;
	3313	long i = 0; /* Initialized to avoid compiler warning. */
	3314	long iResult;
	3315	double d, temp;
	3316	int result = TCL_OK;
	3317
	3318	/*
	3319	* Set stackPtr and stackTop from eePtr.
	3320	*/
	3321
	3322	CACHE_STACK_INFO();
	3323
	3324	/*
	3325	* Pop the argument from the evaluation stack.
	3326	*/
	3327
	3328	valuePtr = POP_OBJECT();
	3329	tPtr = valuePtr->typePtr;
	3330
	3331	if (tPtr == &tclIntType) {
	3332	i = valuePtr->internalRep.longValue;
	3333	} else if (tPtr == &tclDoubleType) {
	3334	d = valuePtr->internalRep.doubleValue;
	3335	} else { /* FAILS IF STRING REP HAS NULLS */
	3336	char s = Tcl_GetStringFromObj(valuePtr, (int ) NULL);
	3337
	3338	if (TclLooksLikeInt(s)) {
	3339	result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
	3340	} else {
	3341	result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
	3342	}
	3343	if (result != TCL_OK) {
	3344	Tcl_ResetResult(interp);
	3345	Tcl_AppendToObj(Tcl_GetObjResult(interp),
	3346	"argument to math function didn't have numeric value", -1);
	3347	goto done;
	3348	}
	3349	tPtr = valuePtr->typePtr;
	3350	}
	3351
	3352	/*
	3353	* Push a Tcl object with the result.
	3354	*/
	3355
	3356	if (tPtr == &tclIntType) {
	3357	iResult = i;
	3358	} else {
	3359	if (d < 0.0) {
	3360	if (d <= (((double) (long) LONG_MIN) - 0.5)) {
	3361	tooLarge:
	3362	Tcl_ResetResult(interp);
	3363	Tcl_AppendToObj(Tcl_GetObjResult(interp),
	3364	"integer value too large to represent", -1);
	3365	Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
	3366	"integer value too large to represent",
	3367	(char *) NULL);
	3368	result = TCL_ERROR;
	3369	goto done;
	3370	}
	3371	temp = (long) (d - 0.5);
	3372	} else {
	3373	if (d >= (((double) LONG_MAX + 0.5))) {
	3374	goto tooLarge;
	3375	}
	3376	temp = (long) (d + 0.5);
	3377	}
	3378	if (IS_NAN(temp) \|\| IS_INF(temp)) {
	3379	TclExprFloatError(interp, temp);
	3380	result = TCL_ERROR;
	3381	goto done;
	3382	}
	3383	iResult = (long) temp;
	3384	}
	3385	PUSH_OBJECT(Tcl_NewLongObj(iResult));
	3386
	3387	/*
	3388	* Reflect the change to stackTop back in eePtr.
	3389	*/
	3390
	3391	done:
	3392	Tcl_DecrRefCount(valuePtr);
	3393	DECACHE_STACK_INFO();
	3394	return result;
	3395	}
	3396
	3397	/*
	3398	*----------------------------------------------------------------------
	3399	*
	3400	* ExprCallMathFunc --
	3401	*
	3402	* This procedure is invoked to call a non-builtin math function
	3403	* during the execution of an expression.
	3404	*
	3405	* Results:
	3406	* TCL_OK is returned if all went well and the function's value
	3407	* was computed successfully. If an error occurred, TCL_ERROR
	3408	* is returned and an error message is left in the interpreter's
	3409	* result. After a successful return this procedure pushes a Tcl object
	3410	* holding the result.
	3411	*
	3412	* Side effects:
	3413	* None, unless the called math function has side effects.
	3414	*
	3415	*----------------------------------------------------------------------
	3416	*/
	3417
	3418	static int
	3419	ExprCallMathFunc(interp, eePtr, objc, objv)
	3420	Tcl_Interp interp; / The interpreter in which to execute the
	3421	* function. */
	3422	ExecEnv eePtr; / Points to the environment for executing
	3423	* the function. */
	3424	int objc; /* Number of arguments. The function name is
	3425	* the 0-th argument. */
	3426	Tcl_Obj *objv; / The array of arguments. The function name
	3427	* is objv[0]. */
	3428	{
	3429	Interp iPtr = (Interp ) interp;
	3430	StackItem stackPtr; / Cached evaluation stack base pointer. */
	3431	register int stackTop; /* Cached top index of evaluation stack. */
	3432	char *funcName;
	3433	Tcl_HashEntry *hPtr;
	3434	MathFunc mathFuncPtr; / Information about math function. */
	3435	Tcl_Value args[MAX_MATH_ARGS]; /* Arguments for function call. */
	3436	Tcl_Value funcResult; /* Result of function call as Tcl_Value. */
	3437	register Tcl_Obj *valuePtr;
	3438	Tcl_ObjType *tPtr;
	3439	long i;
	3440	double d;
	3441	int j, k, result;
	3442
	3443	Tcl_ResetResult(interp);
	3444
	3445	/*
	3446	* Set stackPtr and stackTop from eePtr.
	3447	*/
	3448
	3449	CACHE_STACK_INFO();
	3450
	3451	/*
	3452	* Look up the MathFunc record for the function.
	3453	* THIS FAILS IF THE OBJECT'S STRING REP CONTAINS NULLS.
	3454	*/
	3455
	3456	funcName = Tcl_GetStringFromObj(objv[0], (int *) NULL);
	3457	hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName);
	3458	if (hPtr == NULL) {
	3459	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
	3460	"unknown math function \"", funcName, "\"", (char *) NULL);
	3461	result = TCL_ERROR;
	3462	goto done;
	3463	}
	3464	mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
	3465	if (mathFuncPtr->numArgs != (objc-1)) {
	3466	panic("ExprCallMathFunc: expected number of args %d != actual number %d",
	3467	mathFuncPtr->numArgs, objc);
	3468	result = TCL_ERROR;
	3469	goto done;
	3470	}
	3471
	3472	/*
	3473	* Collect the arguments for the function, if there are any, into the
	3474	* array "args". Note that args[0] will have the Tcl_Value that
	3475	* corresponds to objv[1].
	3476	*/
	3477
	3478	for (j = 1, k = 0; j < objc; j++, k++) {
	3479	valuePtr = objv[j];
	3480	tPtr = valuePtr->typePtr;
	3481
	3482	if (tPtr == &tclIntType) {
	3483	i = valuePtr->internalRep.longValue;
	3484	} else if (tPtr == &tclDoubleType) {
	3485	d = valuePtr->internalRep.doubleValue;
	3486	} else {
	3487	/*
	3488	* Try to convert to int first then double.
	3489	* FAILS IF STRING REP HAS NULLS.
	3490	*/
	3491
	3492	char s = Tcl_GetStringFromObj(valuePtr, (int ) NULL);
	3493
	3494	if (TclLooksLikeInt(s)) {
	3495	result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
	3496	} else {
	3497	result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
	3498	valuePtr, &d);
	3499	}
	3500	if (result != TCL_OK) {
	3501	Tcl_AppendToObj(Tcl_GetObjResult(interp),
	3502	"argument to math function didn't have numeric value", -1);
	3503	goto done;
	3504	}
	3505	tPtr = valuePtr->typePtr;
	3506	}
	3507
	3508	/*
	3509	* Copy the object's numeric value to the argument record,
	3510	* converting it if necessary.
	3511	*/
	3512
	3513	if (tPtr == &tclIntType) {
	3514	if (mathFuncPtr->argTypes[k] == TCL_DOUBLE) {
	3515	args[k].type = TCL_DOUBLE;
	3516	args[k].doubleValue = i;
	3517	} else {
	3518	args[k].type = TCL_INT;
	3519	args[k].intValue = i;
	3520	}
	3521	} else {
	3522	if (mathFuncPtr->argTypes[k] == TCL_INT) {
	3523	args[k].type = TCL_INT;
	3524	args[k].intValue = (long) d;
	3525	} else {
	3526	args[k].type = TCL_DOUBLE;
	3527	args[k].doubleValue = d;
	3528	}
	3529	}
	3530	}
	3531
	3532	/*
	3533	* Invoke the function and copy its result back into valuePtr.
	3534	*/
	3535
	3536	tcl_MathInProgress++;
	3537	result = (*mathFuncPtr->proc)(mathFuncPtr->clientData, interp, args,
	3538	&funcResult);
	3539	tcl_MathInProgress--;
	3540	if (result != TCL_OK) {
	3541	goto done;
	3542	}
	3543
	3544	/*
	3545	* Pop the objc top stack elements and decrement their ref counts.
	3546	*/
	3547
	3548	i = (stackTop - (objc-1));
	3549	while (i <= stackTop) {
	3550	valuePtr = stackPtr[i].o;
	3551	Tcl_DecrRefCount(valuePtr);
	3552	i++;
	3553	}
	3554	stackTop -= objc;
	3555
	3556	/*
	3557	* Push the call's object result.
	3558	*/
	3559
	3560	if (funcResult.type == TCL_INT) {
	3561	PUSH_OBJECT(Tcl_NewLongObj(funcResult.intValue));
	3562	} else {
	3563	d = funcResult.doubleValue;
	3564	if (IS_NAN(d) \|\| IS_INF(d)) {
	3565	TclExprFloatError(interp, d);
	3566	result = TCL_ERROR;
	3567	goto done;
	3568	}
	3569	PUSH_OBJECT(Tcl_NewDoubleObj(d));
	3570	}
	3571
	3572	/*
	3573	* Reflect the change to stackTop back in eePtr.
	3574	*/
	3575
	3576	done:
	3577	DECACHE_STACK_INFO();
	3578	return result;
	3579	}
	3580
	3581
	3582	/*
	3583	*----------------------------------------------------------------------
	3584	*
	3585	* TclExprFloatError --
	3586	*
	3587	* This procedure is called when an error occurs during a
	3588	* floating-point operation. It reads errno and sets
	3589	* interp->objResultPtr accordingly.
	3590	*
	3591	* Results:
	3592	* interp->objResultPtr is set to hold an error message.
	3593	*
	3594	* Side effects:
	3595	* None.
	3596	*
	3597	*----------------------------------------------------------------------
	3598	*/
	3599
	3600	void
	3601	TclExprFloatError(interp, value)
	3602	Tcl_Interp interp; / Where to store error message. */
	3603	double value; /* Value returned after error; used to
	3604	* distinguish underflows from overflows. */
	3605	{
	3606	char *s;
	3607
	3608	Tcl_ResetResult(interp);
	3609	if ((errno == EDOM) \|\| (value != value)) {
	3610	s = "domain error: argument not in valid range";
	3611	Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
	3612	Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", s, (char *) NULL);
	3613	} else if ((errno == ERANGE) \|\| IS_INF(value)) {
	3614	if (value == 0.0) {
	3615	s = "floating-point value too small to represent";
	3616	Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
	3617	Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", s, (char *) NULL);
	3618	} else {
	3619	s = "floating-point value too large to represent";
	3620	Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
	3621	Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, (char *) NULL);
	3622	}
	3623	} else { /* FAILS IF STRING REP CONTAINS NULLS */
	3624	char msg[100];
	3625
	3626	sprintf(msg, "unknown floating-point error, errno = %d", errno);
	3627	Tcl_AppendToObj(Tcl_GetObjResult(interp), msg, -1);
	3628	Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN", msg, (char *) NULL);
	3629	}
	3630	}
	3631
	3632
	3633	/*
	3634	*----------------------------------------------------------------------
	3635	*
	3636	* Tcl_GetCommandFromObj --
	3637	*
	3638	* Returns the command specified by the name in a Tcl_Obj.
	3639	*
	3640	* Results:
	3641	* Returns a token for the command if it is found. Otherwise, if it
	3642	* can't be found or there is an error, returns NULL.
	3643	*
	3644	* Side effects:
	3645	* May update the internal representation for the object, caching
	3646	* the command reference so that the next time this procedure is
	3647	* called with the same object, the command can be found quickly.
	3648	*
	3649	*----------------------------------------------------------------------
	3650	*/
	3651
	3652	Tcl_Command
	3653	Tcl_GetCommandFromObj(interp, objPtr)
	3654	Tcl_Interp interp; / The interpreter in which to resolve the
	3655	* command and to report errors. */
	3656	register Tcl_Obj objPtr; / The object containing the command's
	3657	* name. If the name starts with "::", will
	3658	* be looked up in global namespace. Else,
	3659	* looked up first in the current namespace
	3660	* if contextNsPtr is NULL, then in global
	3661	* namespace. */
	3662	{
	3663	Interp iPtr = (Interp ) interp;
	3664	register ResolvedCmdName *resPtr;
	3665	register Command *cmdPtr;
	3666	Namespace *currNsPtr;
	3667	int result;
	3668
	3669	/*
	3670	* Get the internal representation, converting to a command type if
	3671	* needed. The internal representation is a ResolvedCmdName that points
	3672	* to the actual command.
	3673	*/
	3674
	3675	if (objPtr->typePtr != &tclCmdNameType) {
	3676	result = tclCmdNameType.setFromAnyProc(interp, objPtr);
	3677	if (result != TCL_OK) {
	3678	return (Tcl_Command) NULL;
	3679	}
	3680	}
	3681	resPtr = (ResolvedCmdName *) objPtr->internalRep.otherValuePtr;
	3682
	3683	/*
	3684	* Get the current namespace.
	3685	*/
	3686
	3687	if (iPtr->varFramePtr != NULL) {
	3688	currNsPtr = iPtr->varFramePtr->nsPtr;
	3689	} else {
	3690	currNsPtr = iPtr->globalNsPtr;
	3691	}
	3692
	3693	/*
	3694	* Check the context namespace and the namespace epoch of the resolved
	3695	* symbol to make sure that it is fresh. If not, then force another
	3696	* conversion to the command type, to discard the old rep and create a
	3697	* new one. Note that we verify that the namespace id of the context
	3698	* namespace is the same as the one we cached; this insures that the
	3699	* namespace wasn't deleted and a new one created at the same address
	3700	* with the same command epoch.
	3701	*/
	3702
	3703	cmdPtr = NULL;
	3704	if ((resPtr != NULL)
	3705	&& (resPtr->refNsPtr == currNsPtr)
	3706	&& (resPtr->refNsId == currNsPtr->nsId)
	3707	&& (resPtr->refNsCmdEpoch == currNsPtr->cmdRefEpoch)) {
	3708	cmdPtr = resPtr->cmdPtr;
	3709	if (cmdPtr->cmdEpoch != resPtr->cmdEpoch) {
	3710	cmdPtr = NULL;
	3711	}
	3712	}
	3713
	3714	if (cmdPtr == NULL) {
	3715	result = tclCmdNameType.setFromAnyProc(interp, objPtr);
	3716	if (result != TCL_OK) {
	3717	return (Tcl_Command) NULL;
	3718	}
	3719	resPtr = (ResolvedCmdName *) objPtr->internalRep.otherValuePtr;
	3720	if (resPtr != NULL) {
	3721	cmdPtr = resPtr->cmdPtr;
	3722	}
	3723	}
	3724
	3725	if (cmdPtr == NULL) {
	3726	return (Tcl_Command) NULL;
	3727	}
	3728	return (Tcl_Command) cmdPtr;
	3729	}
	3730
	3731
	3732	/*
	3733	*----------------------------------------------------------------------
	3734	*
	3735	* FreeCmdNameInternalRep --
	3736	*
	3737	* Frees the resources associated with a cmdName object's internal
	3738	* representation.
	3739	*
	3740	* Results:
	3741	* None.
	3742	*
	3743	* Side effects:
	3744	* Decrements the ref count of any cached ResolvedCmdName structure
	3745	* pointed to by the cmdName's internal representation. If this is
	3746	* the last use of the ResolvedCmdName, it is freed. This in turn
	3747	* decrements the ref count of the Command structure pointed to by
	3748	* the ResolvedSymbol, which may free the Command structure.
	3749	*
	3750	*----------------------------------------------------------------------
	3751	*/
	3752
	3753	static void
	3754	FreeCmdNameInternalRep(objPtr)
	3755	register Tcl_Obj objPtr; / CmdName object with internal
	3756	* representation to free. */
	3757	{
	3758	register ResolvedCmdName *resPtr =
	3759	(ResolvedCmdName *) objPtr->internalRep.otherValuePtr;
	3760
	3761	if (resPtr != NULL) {
	3762	/*
	3763	* Decrement the reference count of the ResolvedCmdName structure.
	3764	* If there are no more uses, free the ResolvedCmdName structure.
	3765	*/
	3766
	3767	resPtr->refCount--;
	3768	if (resPtr->refCount == 0) {
	3769	/*
	3770	* Now free the cached command, unless it is still in its
	3771	* hash table or if there are other references to it
	3772	* from other cmdName objects.
	3773	*/
	3774
	3775	Command *cmdPtr = resPtr->cmdPtr;
	3776	TclCleanupCommand(cmdPtr);
	3777	ckfree((char *) resPtr);
	3778	}
	3779	}
	3780	}
	3781
	3782
	3783	/*
	3784	*----------------------------------------------------------------------
	3785	*
	3786	* DupCmdNameInternalRep --
	3787	*
	3788	* Initialize the internal representation of an cmdName Tcl_Obj to a
	3789	* copy of the internal representation of an existing cmdName object.
	3790	*
	3791	* Results:
	3792	* None.
	3793	*
	3794	* Side effects:
	3795	* "copyPtr"s internal rep is set to point to the ResolvedCmdName
	3796	* structure corresponding to "srcPtr"s internal rep. Increments the
	3797	* ref count of the ResolvedCmdName structure pointed to by the
	3798	* cmdName's internal representation.
	3799	*
	3800	*----------------------------------------------------------------------
	3801	*/
	3802
	3803	static void
	3804	DupCmdNameInternalRep(srcPtr, copyPtr)
	3805	Tcl_Obj srcPtr; / Object with internal rep to copy. */
	3806	register Tcl_Obj copyPtr; / Object with internal rep to set. */
	3807	{
	3808	register ResolvedCmdName *resPtr =
	3809	(ResolvedCmdName *) srcPtr->internalRep.otherValuePtr;
	3810
	3811	copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
	3812	copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
	3813	if (resPtr != NULL) {
	3814	resPtr->refCount++;
	3815	}
	3816	copyPtr->typePtr = &tclCmdNameType;
	3817	}
	3818
	3819
	3820	/*
	3821	*----------------------------------------------------------------------
	3822	*
	3823	* SetCmdNameFromAny --
	3824	*
	3825	* Generate an cmdName internal form for the Tcl object "objPtr".
	3826	*
	3827	* Results:
	3828	* The return value is a standard Tcl result. The conversion always
	3829	* succeeds and TCL_OK is returned.
	3830	*
	3831	* Side effects:
	3832	* A pointer to a ResolvedCmdName structure that holds a cached pointer
	3833	* to the command with a name that matches objPtr's string rep is
	3834	* stored as objPtr's internal representation. This ResolvedCmdName
	3835	* pointer will be NULL if no matching command was found. The ref count
	3836	* of the cached Command's structure (if any) is also incremented.
	3837	*
	3838	*----------------------------------------------------------------------
	3839	*/
	3840
	3841	static int
	3842	SetCmdNameFromAny(interp, objPtr)
	3843	Tcl_Interp interp; / Used for error reporting if not NULL. */
	3844	register Tcl_Obj objPtr; / The object to convert. */
	3845	{
	3846	Interp iPtr = (Interp ) interp;
	3847	char *name;
	3848	Tcl_Command cmd;
	3849	register Command *cmdPtr;
	3850	Namespace *currNsPtr;
	3851	register ResolvedCmdName *resPtr;
	3852
	3853	/*
	3854	* Get "objPtr"s string representation. Make it up-to-date if necessary.
	3855	*/
	3856
	3857	name = objPtr->bytes;
	3858	if (name == NULL) {
	3859	name = Tcl_GetStringFromObj(objPtr, (int *) NULL);
	3860	}
	3861
	3862	/*
	3863	* Find the Command structure, if any, that describes the command called
	3864	* "name". Build a ResolvedCmdName that holds a cached pointer to this
	3865	* Command, and bump the reference count in the referenced Command
	3866	* structure. A Command structure will not be deleted as long as it is
	3867	* referenced from a CmdName object.
	3868	*/
	3869
	3870	cmd = Tcl_FindCommand(interp, name, (Tcl_Namespace *) NULL,
	3871	/flags/ 0);
	3872	cmdPtr = (Command *) cmd;
	3873	if (cmdPtr != NULL) {
	3874	/*
	3875	* Get the current namespace.
	3876	*/
	3877
	3878	if (iPtr->varFramePtr != NULL) {
	3879	currNsPtr = iPtr->varFramePtr->nsPtr;
	3880	} else {
	3881	currNsPtr = iPtr->globalNsPtr;
	3882	}
	3883
	3884	cmdPtr->refCount++;
	3885	resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
	3886	resPtr->cmdPtr = cmdPtr;
	3887	resPtr->refNsPtr = currNsPtr;
	3888	resPtr->refNsId = currNsPtr->nsId;
	3889	resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
	3890	resPtr->cmdEpoch = cmdPtr->cmdEpoch;
	3891	resPtr->refCount = 1;
	3892	} else {
	3893	resPtr = NULL; /* no command named "name" was found */
	3894	}
	3895
	3896	/*
	3897	* Free the old internalRep before setting the new one. We do this as
	3898	* late as possible to allow the conversion code, in particular
	3899	* GetStringFromObj, to use that old internalRep. If no Command
	3900	* structure was found, leave NULL as the cached value.
	3901	*/
	3902
	3903	if ((objPtr->typePtr != NULL)
	3904	&& (objPtr->typePtr->freeIntRepProc != NULL)) {
	3905	objPtr->typePtr->freeIntRepProc(objPtr);
	3906	}
	3907
	3908	objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
	3909	objPtr->internalRep.twoPtrValue.ptr2 = NULL;
	3910	objPtr->typePtr = &tclCmdNameType;
	3911	return TCL_OK;
	3912	}
	3913
	3914
	3915	/*
	3916	*----------------------------------------------------------------------
	3917	*
	3918	* UpdateStringOfCmdName --
	3919	*
	3920	* Update the string representation for an cmdName object.
	3921	*
	3922	* Results:
	3923	* None.
	3924	*
	3925	* Side effects:
	3926	* Generates a panic.
	3927	*
	3928	*----------------------------------------------------------------------
	3929	*/
	3930
	3931	static void
	3932	UpdateStringOfCmdName(objPtr)
	3933	Tcl_Obj objPtr; / CmdName obj to update string rep. */
	3934	{
	3935	/*
	3936	* This procedure is never invoked since the internal representation of
	3937	* a cmdName object is never modified.
	3938	*/
	3939
	3940	panic("UpdateStringOfCmdName should never be invoked");
	3941	}

Note: See TracBrowser for help on using the repository browser.

Download in other formats: