summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog100
-rw-r--r--generic/tclExecute.c4226
2 files changed, 2110 insertions, 2216 deletions
diff --git a/ChangeLog b/ChangeLog
index 00c06a4..7f10626 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,19 +1,18 @@
+2005-07-11 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclExecute.c: General style cleanup.
+
2005-07-08 Mo DeJong <mdejong@users.sourceforge.net>
- * generic/tclExecute.c (TclExecuteByteCode):
- Reimplement long and wide type integer division
- and modulus operations so that the smallest
- and largest integer values are handled properly.
- The divide operation is more efficient since
- it no longer does a modulus or negation and
- only checks for a remainder when the quotient
- will be a negative number. The modulus operation
- is now a bit more complex because of a number of
- special cases dealing with the smallest and
- largest integers.
- * tests/expr.test: Add test cases for division
- and modulus operations on the smallest and
- largest integer values for 32 and 64 bit types.
+ * generic/tclExecute.c (TclExecuteByteCode): Reimplement long and wide
+ type integer division and modulus operations so that the smallest and
+ largest integer values are handled properly. The divide operation is
+ more efficient since it no longer does a modulus or negation and only
+ checks for a remainder when the quotient will be a negative number.
+ The modulus operation is now a bit more complex because of a number of
+ special cases dealing with the smallest and largest integers.
+ * tests/expr.test: Add test cases for division and modulus operations
+ on the smallest and largest integer values for 32 and 64 bit types.
[Patch 1230205]
2005-07-06 Don Porter <dgp@users.sourceforge.net>
@@ -50,23 +49,22 @@
2005-06-28 Mo DeJong <mdejong@users.sourceforge.net>
- * generic/tclExecute.c (TclExecuteByteCode): When parsing an
- integer operand for a unary minus expression operator, check for a
- wide integer that is actually LONG_MIN. If found, convert it back
- to a long int type.
- * tests/expr.test: Add constraint for 32bit long int type and
- 64bit wide int type. Add tests that parse the smallest/largest
- long int and wide int values.
+ * generic/tclExecute.c (TclExecuteByteCode): When parsing an integer
+ operand for a unary minus expression operator, check for a wide
+ integer that is actually LONG_MIN. If found, convert it back to a long
+ int type.
+ * tests/expr.test: Add constraint for 32bit long int type and 64bit
+ wide int type. Add tests that parse the smallest/largest long int and
+ wide int values.
2004-06-24 Kevin Kenny <kennykb@acm.org>
* generic/tclEvent.c (Tcl_Finalize):
* generic/tclInt.h:
* generic/tclPreserve.c (TclFinalizePreserve): Changed the
- finalization logic so that Tcl_Preserve finalizes after exit
- handlers run; a lot of code called from Tk's exit handlers
- presumes tha Tcl_Preserve will still work even from an exit
- handler.
+ finalization logic so that Tcl_Preserve finalizes after exit handlers
+ run; a lot of code called from Tk's exit handlers presumes that
+ Tcl_Preserve will still work even from an exit handler.
2005-06-24 Don Porter <dgp@users.sourceforge.net>
@@ -75,10 +73,10 @@
2005-06-23 Kevin Kenny <kennykb@acm.org>
- * win/tclWinChan.c: More rewriting of __asm__ blocks that
- * win/tclWinFCmd.c: implement SEH in GCC, because mingw's
- gcc 3.4.2 is not as forgiving of violations committed by
- the old code and caused panics. [Bug #1225957]
+ * win/tclWinChan.c: More rewriting of __asm__ blocks that implement
+ * win/tclWinFCmd.c: SEH in GCC, because mingw's gcc 3.4.2 is not as
+ forgiving of violations committed by the old code and caused panics.
+ [Bug #1225957]
2005-06-23 Daniel Steffen <das@users.sourceforge.net>
@@ -97,27 +95,25 @@
* generic/tclIO.c (TclFinalizeIOSubsystem): shutdown of the pipe
* unix/tclUnixPipe.c (TclFinalizePipes): management until after
* win/tclWinPipe.c (TclFinalizePipes): all channels have been
- closed, in order to avoid a situation where the Windows
- PipeCloseProc2 would re-establish the exit handler after
- exit handlers had already run, corrupting the heap.
- [Bug #1225727]
+ closed, in order to avoid a situation where the Windows PipeCloseProc2
+ would re-establish the exit handler after exit handlers had already
+ run, corrupting the heap. [Bug #1225727]
Also corrected a potential read of uninitialized memory in
PipeClose2Proc [Bug #1225044]
2005-06-21 Andreas Kupries <andreask@activestate.com>
- * generic/tclInt.h: Followup to change made on 2005-06-18 by
- Daniel Steffen. There are compilers (*) who error out on the
- redefinition of WORDS_BIGENDIAN. We have to undef the previous
- definition (on the command line) first to make this
- acceptable. (*): AIX native.
+ * generic/tclInt.h: Followup to change made on 2005-06-18 by Daniel
+ Steffen. There are compilers (*) who error out on the redefinition of
+ WORDS_BIGENDIAN. We have to undef the previous definition (on the
+ command line) first to make this acceptable. (*): AIX native.
2005-06-21 Kevin B. Kenny <kennykb@acm.org>
- * generic/tclFileName.c: Changed [file split] and [file join]
- to treat Windows drive letters similarly to ~ syntax and make
- sure that they appear with "./" in front when they are in
- intermediate components of the path. [Bug 1194458]
+ * generic/tclFileName.c: Changed [file split] and [file join] to treat
+ Windows drive letters similarly to ~ syntax and make sure that they
+ appear with "./" in front when they are in intermediate components of
+ the path. [Bug 1194458]
* tests/fileName.test: Added test for the above bug.
2005-06-21 Don Porter <dgp@users.sourceforge.net>
@@ -130,10 +126,9 @@
2005-06-21 Donal K. Fellows <dkf@users.sf.net>
- * unix/tcl.m4 (SC_ENABLE_SYMBOLS): Only enable the 'compile'
- special debugging feature when requested in configure.in; removes
- irrelevant junk from the configure files of extensions that use
- Tcl's tcl.m4.
+ * unix/tcl.m4 (SC_ENABLE_SYMBOLS): Only enable the 'compile' special
+ debugging feature when requested in configure.in; removes irrelevant
+ junk from the configure files of extensions that use Tcl's tcl.m4.
2005-06-20 Donal K. Fellows <dkf@users.sf.net>
@@ -148,8 +143,8 @@
2005-06-20 Mo DeJong <mdejong@users.sourceforge.net>
* generic/tclCmdMZ.c (Tcl_SwitchObjCmd): Generate an error if a mode
- argument like -exact is passed more than once to the switch
- command. The previous implementation silently accepted invalid switch
+ argument like -exact is passed more than once to the switch command.
+ The previous implementation silently accepted invalid switch
invocations like [switch -exact -glob $str ...].
* tests/for.test: Check some error cases when invoking continue and
break inside a for loop next script.
@@ -265,12 +260,11 @@
2005-06-06 Kevin B. Kenny <kennykb@acm.org>
- * win/tclWin32Dll.c: Corrected another buglet in the assembly
- code for stack probing on Win32/gcc. [Bug #1213678]
+ * win/tclWin32Dll.c: Corrected another buglet in the assembly code for
+ stack probing on Win32/gcc. [Bug #1213678]
* generic/tclObj,c: Added missing 'static' on definition of
- UpdateStringOfBignum, and removed a 'switch' on a 'long long'
- operand (which HP-UX native 'cc' seems unable to handle).
- [Bug #1215775]
+ UpdateStringOfBignum, and removed a 'switch' on a 'long long' operand
+ (which HP-UX native 'cc' seems unable to handle). [Bug #1215775]
2005-06-04 Jeff Hobbs <jeffh@ActiveState.com>
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 90ee259..b9022bf 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -1,17 +1,16 @@
-/*
+/*
* tclExecute.c --
*
- * This file contains procedures that execute byte-compiled Tcl
- * commands.
+ * This file contains procedures that execute byte-compiled Tcl commands.
*
* Copyright (c) 1996-1997 Sun Microsystems, Inc.
* Copyright (c) 1998-2000 by Scriptics Corporation.
* Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclExecute.c,v 1.194 2005/07/09 00:27:32 mdejong Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.195 2005/07/11 15:04:11 dkf Exp $
*/
#include "tclInt.h"
@@ -21,10 +20,10 @@
#include <float.h>
/*
- * Hack to determine whether we may expect IEEE floating point.
- * The hack is formally incorrect in that non-IEEE platforms might
- * have the same precision and range, but VAX, IBM, and Cray do not;
- * are there any other floating point units that we might care about?
+ * Hack to determine whether we may expect IEEE floating point. The hack is
+ * formally incorrect in that non-IEEE platforms might have the same precision
+ * and range, but VAX, IBM, and Cray do not; are there any other floating
+ * point units that we might care about?
*/
#if ( FLT_RADIX == 2 ) && ( DBL_MANT_DIG == 53 ) && ( DBL_MAX_EXP == 1024 )
@@ -32,9 +31,8 @@
#endif
/*
- * The stuff below is a bit of a hack so that this file can be used
- * in environments that include no UNIX, i.e. no errno. Just define
- * errno here.
+ * The stuff below is a bit of a hack so that this file can be used in
+ * environments that include no UNIX, i.e. no errno. Just define errno here.
*/
#ifdef TCL_GENERIC_ONLY
@@ -62,17 +60,17 @@ int errno;
# define DBL_MAX MAXDOUBLE
# else /* !MAXDOUBLE */
/*
- * This value is from the Solaris headers, but doubles seem to be the
- * same size everywhere. Long doubles aren't, but we don't use those.
+ * This value is from the Solaris headers, but doubles seem to be the same
+ * size everywhere. Long doubles aren't, but we don't use those.
*/
# define DBL_MAX 1.79769313486231570e+308
# endif /* MAXDOUBLE */
#endif /* !DBL_MAX */
/*
- * A mask (should be 2**n-1) that is used to work out when the
- * bytecode engine should call Tcl_AsyncReady() to see whether there
- * is a signal that needs handling.
+ * A mask (should be 2**n-1) that is used to work out when the bytecode engine
+ * should call Tcl_AsyncReady() to see whether there is a signal that needs
+ * handling.
*/
#ifndef ASYNC_CHECK_COUNT_MASK
@@ -120,7 +118,7 @@ static CONST char *operatorStrings[] = {
/*
* Mapping from Tcl result codes to strings; used for error and debugging
- * messages.
+ * messages.
*/
#ifdef TCL_COMPILE_DEBUG
@@ -142,8 +140,8 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
/*
* Macros for testing floating-point values for certain special cases. Test
- * for not-a-number by comparing a value against itself; test for infinity
- * by comparing against the largest floating-point value.
+ * for not-a-number by comparing a value against itself; test for infinity by
+ * comparing against the largest floating-point value.
*/
#ifdef _MSC_VER
@@ -155,49 +153,48 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
#endif
/*
- * The new macro for ending an instruction; note that a
- * reasonable C-optimiser will resolve all branches
- * at compile time. (result) is always a constant; the macro
- * NEXT_INST_F handles constant (nCleanup), NEXT_INST_V is
- * resolved at runtime for variable (nCleanup).
+ * The new macro for ending an instruction; note that a reasonable C-optimiser
+ * will resolve all branches at compile time. (result) is always a constant;
+ * the macro NEXT_INST_F handles constant (nCleanup), NEXT_INST_V is resolved
+ * at runtime for variable (nCleanup).
*
* ARGUMENTS:
* pcAdjustment: how much to increment pc
* nCleanup: how many objects to remove from the stack
- * resultHandling: 0 indicates no object should be pushed on the
- * stack; otherwise, push objResultPtr. If (result < 0),
- * objResultPtr already has the correct reference count.
+ * resultHandling: 0 indicates no object should be pushed on the stack;
+ * otherwise, push objResultPtr. If (result < 0), objResultPtr already
+ * has the correct reference count.
*/
#define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling) \
- if (nCleanup == 0) {\
- if (resultHandling != 0) {\
- if ((resultHandling) > 0) {\
- PUSH_OBJECT(objResultPtr);\
- } else {\
- *(++tosPtr) = objResultPtr;\
- }\
- } \
- pc += (pcAdjustment);\
- goto cleanup0;\
- } else if (resultHandling != 0) {\
- if ((resultHandling) > 0) {\
- Tcl_IncrRefCount(objResultPtr);\
- }\
- pc += (pcAdjustment);\
- switch (nCleanup) {\
- case 1: goto cleanup1_pushObjResultPtr;\
- case 2: goto cleanup2_pushObjResultPtr;\
- default: Tcl_Panic("ERROR: bad usage of macro NEXT_INST_F");\
- }\
- } else {\
- pc += (pcAdjustment);\
- switch (nCleanup) {\
- case 1: goto cleanup1;\
- case 2: goto cleanup2;\
- default: Tcl_Panic("ERROR: bad usage of macro NEXT_INST_F");\
- }\
- }
+ if (nCleanup == 0) {\
+ if (resultHandling != 0) {\
+ if ((resultHandling) > 0) {\
+ PUSH_OBJECT(objResultPtr);\
+ } else {\
+ *(++tosPtr) = objResultPtr;\
+ }\
+ } \
+ pc += (pcAdjustment);\
+ goto cleanup0;\
+ } else if (resultHandling != 0) {\
+ if ((resultHandling) > 0) {\
+ Tcl_IncrRefCount(objResultPtr);\
+ }\
+ pc += (pcAdjustment);\
+ switch (nCleanup) {\
+ case 1: goto cleanup1_pushObjResultPtr;\
+ case 2: goto cleanup2_pushObjResultPtr;\
+ default: Tcl_Panic("ERROR: bad usage of macro NEXT_INST_F");\
+ }\
+ } else {\
+ pc += (pcAdjustment);\
+ switch (nCleanup) {\
+ case 1: goto cleanup1;\
+ case 2: goto cleanup2;\
+ default: Tcl_Panic("ERROR: bad usage of macro NEXT_INST_F");\
+ }\
+ }
#define NEXT_INST_V(pcAdjustment, nCleanup, resultHandling) \
pc += (pcAdjustment);\
@@ -232,36 +229,36 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
* Macros used to access items on the Tcl evaluation stack. PUSH_OBJECT
* increments the object's ref count since it makes the stack have another
* reference pointing to the object. However, POP_OBJECT does not decrement
- * the ref count. This is because the stack may hold the only reference to
- * the object, so the object would be destroyed if its ref count were
- * decremented before the caller had a chance to, e.g., store it in a
- * variable. It is the caller's responsibility to decrement the ref count
- * when it is finished with an object.
+ * the ref count. This is because the stack may hold the only reference to the
+ * object, so the object would be destroyed if its ref count were decremented
+ * before the caller had a chance to, e.g., store it in a variable. It is the
+ * caller's responsibility to decrement the ref count when it is finished with
+ * an object.
*
* WARNING! It is essential that objPtr only appear once in the PUSH_OBJECT
- * macro. The actual parameter might be an expression with side effects,
- * and this ensures that it will be executed only once.
+ * macro. The actual parameter might be an expression with side effects, and
+ * this ensures that it will be executed only once.
*/
-
+
#define PUSH_OBJECT(objPtr) \
Tcl_IncrRefCount(*(++tosPtr) = (objPtr))
-
+
#define POP_OBJECT() \
*(tosPtr--)
/*
* Macros used to trace instruction execution. The macros TRACE,
- * TRACE_WITH_OBJ, and O2S are only used inside TclExecuteByteCode.
- * O2S is only used in TRACE* calls to get a string from an object.
+ * TRACE_WITH_OBJ, and O2S are only used inside TclExecuteByteCode. O2S is
+ * only used in TRACE* calls to get a string from an object.
*/
#ifdef TCL_COMPILE_DEBUG
# define TRACE(a) \
if (traceInstructions) { \
- fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \
- (tosPtr - eePtr->stackPtr), \
- (unsigned int)(pc - codePtr->codeStart), \
- GetOpcodeName(pc)); \
+ fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \
+ (tosPtr - eePtr->stackPtr), \
+ (unsigned int)(pc - codePtr->codeStart), \
+ GetOpcodeName(pc)); \
printf a; \
}
# define TRACE_APPEND(a) \
@@ -270,29 +267,29 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
}
# define TRACE_WITH_OBJ(a, objPtr) \
if (traceInstructions) { \
- fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \
- (tosPtr - eePtr->stackPtr), \
- (unsigned int)(pc - codePtr->codeStart), \
- GetOpcodeName(pc)); \
+ fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \
+ (tosPtr - eePtr->stackPtr), \
+ (unsigned int)(pc - codePtr->codeStart), \
+ GetOpcodeName(pc)); \
printf a; \
- TclPrintObject(stdout, objPtr, 30); \
- fprintf(stdout, "\n"); \
+ TclPrintObject(stdout, objPtr, 30); \
+ fprintf(stdout, "\n"); \
}
# define O2S(objPtr) \
(objPtr ? TclGetString(objPtr) : "")
#else /* !TCL_COMPILE_DEBUG */
# define TRACE(a)
-# define TRACE_APPEND(a)
+# define TRACE_APPEND(a)
# define TRACE_WITH_OBJ(a, objPtr)
# define O2S(objPtr)
#endif /* TCL_COMPILE_DEBUG */
/*
- * Macro to read a string containing either a wide or an int and
- * decide which it is while decoding it at the same time. This
- * enforces the policy that integer constants between LONG_MIN and
- * LONG_MAX (inclusive) are represented by normal longs, and integer
- * constants outside that range are represented by wide ints.
+ * Macro to read a string containing either a wide or an int and decide which
+ * it is while decoding it at the same time. This enforces the policy that
+ * integer constants between LONG_MIN and LONG_MAX (inclusive) are represented
+ * by normal longs, and integer constants outside that range are represented
+ * by wide ints.
*
* GET_WIDE_OR_INT is the same as REQUIRE_WIDE_OR_INT except it never
* generates an error message.
@@ -315,8 +312,7 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
= Tcl_WideAsLong(wideVar); \
}
/*
- * Combined with REQUIRE_WIDE_OR_INT, this gets a long value from
- * an obj.
+ * Combined with REQUIRE_WIDE_OR_INT, this gets a long value from an obj.
*/
#define FORCE_LONG(objPtr, longVar, wideVar) \
if ((objPtr)->typePtr == &tclWideIntType) { \
@@ -361,8 +357,8 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
static int TclExecuteByteCode _ANSI_ARGS_((Tcl_Interp *interp,
ByteCode *codePtr));
#ifdef TCL_COMPILE_STATS
-static int EvalStatsCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int objc,
+static int EvalStatsCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
#endif /* TCL_COMPILE_STATS */
#ifdef TCL_COMPILE_DEBUG
@@ -371,7 +367,7 @@ static char * GetOpcodeName _ANSI_ARGS_((unsigned char *pc));
static ExceptionRange * GetExceptRangeForPc _ANSI_ARGS_((unsigned char *pc,
int catchOnly, ByteCode* codePtr));
static char * GetSrcInfoForPc _ANSI_ARGS_((unsigned char *pc,
- ByteCode* codePtr, int *lengthPtr));
+ ByteCode* codePtr, int *lengthPtr));
static void GrowEvaluationStack _ANSI_ARGS_((ExecEnv *eePtr));
static void IllegalExprOperandType _ANSI_ARGS_((
Tcl_Interp *interp, unsigned char *pc,
@@ -383,7 +379,7 @@ static void PrintByteCodeInfo _ANSI_ARGS_((ByteCode *codePtr));
static char * StringForResultCode _ANSI_ARGS_((int result));
static void ValidatePcAndStackTop _ANSI_ARGS_((
ByteCode *codePtr, unsigned char *pc,
- int stackTop, int stackLowerBound,
+ int stackTop, int stackLowerBound,
int checkStack));
#endif /* TCL_COMPILE_DEBUG */
static Tcl_WideInt ExponWide _ANSI_ARGS_((Tcl_WideInt w, Tcl_WideInt w2,
@@ -405,10 +401,10 @@ static long ExponLong _ANSI_ARGS_((long i, long i2,
*
* Side effects:
* This procedure initializes the array of instruction names. If
- * compiling with the TCL_COMPILE_STATS flag, it initializes the
- * array that counts the executions of each instruction and it
- * creates the "evalstats" command. It also establishes the link
- * between the Tcl "tcl_traceExec" and C "tclTraceExec" variables.
+ * compiling with the TCL_COMPILE_STATS flag, it initializes the array
+ * that counts the executions of each instruction and it creates the
+ * "evalstats" command. It also establishes the link between the Tcl
+ * "tcl_traceExec" and C "tclTraceExec" variables.
*
*----------------------------------------------------------------------
*/
@@ -421,11 +417,11 @@ InitByteCodeExecution(interp)
{
#ifdef TCL_COMPILE_DEBUG
if (Tcl_LinkVar(interp, "tcl_traceExec", (char *) &tclTraceExec,
- TCL_LINK_INT) != TCL_OK) {
+ TCL_LINK_INT) != TCL_OK) {
Tcl_Panic("InitByteCodeExecution: can't create link for tcl_traceExec variable");
}
#endif
-#ifdef TCL_COMPILE_STATS
+#ifdef TCL_COMPILE_STATS
Tcl_CreateObjCommand(interp, "evalstats", EvalStatsCmd,
(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
#endif /* TCL_COMPILE_STATS */
@@ -437,18 +433,18 @@ InitByteCodeExecution(interp)
* TclCreateExecEnv --
*
* This procedure creates a new execution environment for Tcl bytecode
- * execution. An ExecEnv points to a Tcl evaluation stack. An ExecEnv
- * is typically created once for each Tcl interpreter (Interp
- * structure) and recursively passed to TclExecuteByteCode to execute
- * ByteCode sequences for nested commands.
+ * execution. An ExecEnv points to a Tcl evaluation stack. An ExecEnv is
+ * typically created once for each Tcl interpreter (Interp structure) and
+ * recursively passed to TclExecuteByteCode to execute ByteCode sequences
+ * for nested commands.
*
* Results:
* A newly allocated ExecEnv is returned. This points to an empty
* evaluation stack of the standard initial size.
*
* Side effects:
- * The bytecode interpreter is also initialized here, as this
- * procedure will be called before any call to TclExecuteByteCode.
+ * The bytecode interpreter is also initialized here, as this procedure
+ * will be called before any call to TclExecuteByteCode.
*
*----------------------------------------------------------------------
*/
@@ -464,11 +460,11 @@ TclCreateExecEnv(interp)
Tcl_Obj **stackPtr;
stackPtr = (Tcl_Obj **)
- ckalloc((size_t) (TCL_STACK_INITIAL_SIZE * sizeof(Tcl_Obj *)));
+ ckalloc((size_t) (TCL_STACK_INITIAL_SIZE * sizeof(Tcl_Obj *)));
/*
- * Use the bottom pointer to keep a reference count; the
- * execution environment holds a reference.
+ * Use the bottom pointer to keep a reference count; the execution
+ * environment holds a reference.
*/
stackPtr++;
@@ -506,8 +502,8 @@ TclCreateExecEnv(interp)
* None.
*
* Side effects:
- * Storage for an ExecEnv and its contained storage (e.g. the
- * evaluation stack) is freed.
+ * Storage for an ExecEnv and its contained storage (e.g. the evaluation
+ * stack) is freed.
*
*----------------------------------------------------------------------
*/
@@ -531,15 +527,15 @@ TclDeleteExecEnv(eePtr)
*
* TclFinalizeExecution --
*
- * Finalizes the execution environment setup so that it can be
- * later reinitialized.
+ * Finalizes the execution environment setup so that it can be later
+ * reinitialized.
*
* Results:
* None.
*
* Side effects:
- * After this call, the next time TclCreateExecEnv will be called
- * it will call InitByteCodeExecution.
+ * After this call, the next time TclCreateExecEnv will be called it will
+ * call InitByteCodeExecution.
*
*----------------------------------------------------------------------
*/
@@ -571,12 +567,12 @@ TclFinalizeExecution()
static void
GrowEvaluationStack(eePtr)
- register ExecEnv *eePtr; /* Points to the ExecEnv with an evaluation
- * stack to enlarge. */
+ register ExecEnv *eePtr; /* Points to the ExecEnv with an evaluation
+ * stack to enlarge. */
{
/*
- * The current Tcl stack elements are stored from *(eePtr->stackPtr)
- * to *(eePtr->endPtr) (inclusive).
+ * The current Tcl stack elements are stored from *(eePtr->stackPtr) to
+ * *(eePtr->endPtr) (inclusive).
*/
int currElems = (eePtr->endPtr - eePtr->stackPtr + 1);
@@ -587,18 +583,18 @@ GrowEvaluationStack(eePtr)
Tcl_Obj **oldStackPtr = eePtr->stackPtr;
/*
- * We keep the stack reference count as a (char *), as that
- * works nicely as a portable pointer-sized counter.
+ * We keep the stack reference count as a (char *), as that works nicely
+ * as a portable pointer-sized counter.
*/
char *refCount = (char *) oldStackPtr[-1];
/*
* Copy the existing stack items to the new stack space, free the old
- * storage if appropriate, and record the refCount of the new stack
- * held by the environment.
+ * storage if appropriate, and record the refCount of the new stack held
+ * by the environment.
*/
-
+
newStackPtr++;
memcpy((VOID *) newStackPtr, (VOID *) oldStackPtr,
(size_t) currBytes);
@@ -607,17 +603,16 @@ GrowEvaluationStack(eePtr)
ckfree((VOID *) (oldStackPtr-1));
} else {
/*
- * Remove the reference corresponding to the
- * environment pointer.
+ * Remove the reference corresponding to the environment pointer.
*/
-
+
oldStackPtr[-1] = (Tcl_Obj *) (refCount-1);
}
eePtr->stackPtr = newStackPtr;
eePtr->endPtr = newStackPtr + (newElems - 2); /* index of last usable item */
eePtr->tosPtr += (newStackPtr - oldStackPtr);
- newStackPtr[-1] = (Tcl_Obj *) ((char *) 1);
+ newStackPtr[-1] = (Tcl_Obj *) ((char *) 1);
}
/*
@@ -629,8 +624,8 @@ GrowEvaluationStack(eePtr)
* with a call to TclStackFree
*
* Results:
- * A pointer to the first byte allocated, or panics if the allocation did
- * not succeed.
+ * A pointer to the first byte allocated, or panics if the allocation did
+ * not succeed.
*
* Side effects:
* The execution stack may be grown.
@@ -648,14 +643,14 @@ TclStackAlloc(interp, numBytes)
int numWords;
Tcl_Obj **tosPtr = eePtr->tosPtr;
char **stackRefCountPtr;
-
+
/*
* Add two words to store
* - a pointer to the used execution stack
* - the number of words reserved
- * These will be used later by TclStackFree.
+ * These will be used later by TclStackFree.
*/
-
+
numWords = (numBytes + 3*sizeof(void *) - 1)/sizeof(void *);
while ((tosPtr + numWords) > eePtr->endPtr) {
@@ -665,41 +660,39 @@ TclStackAlloc(interp, numBytes)
/*
* Increase the stack's reference count, to make sure it is not freed
- * prematurely.
- */
+ * prematurely.
+ */
stackRefCountPtr = (char **) (eePtr->stackPtr-1);
++*stackRefCountPtr;
-
+
/*
* Reserve the space in the exec stack, and store the data for freeing.
*/
-
+
eePtr->tosPtr += numWords;
*(eePtr->tosPtr-1) = (Tcl_Obj *) stackRefCountPtr;
*(eePtr->tosPtr) = (Tcl_Obj *) numWords;
- return (char *) (tosPtr+1);
+ return (char *) (tosPtr+1);
}
void
-TclStackFree(interp)
+TclStackFree(interp)
Tcl_Interp *interp;
{
Interp *iPtr = (Interp *) interp;
ExecEnv *eePtr = iPtr->execEnvPtr;
char **stackRefCountPtr;
-
stackRefCountPtr = (char **) *(eePtr->tosPtr-1);
eePtr->tosPtr -= (int) *(eePtr->tosPtr);
-
+
--*stackRefCountPtr;
if (*stackRefCountPtr == (char *) 0) {
ckfree((VOID *) stackRefCountPtr);
- }
+ }
}
-
/*
*--------------------------------------------------------------
@@ -709,18 +702,17 @@ TclStackFree(interp)
* Evaluate an expression in a Tcl_Obj.
*
* Results:
- * A standard Tcl object result. If the result is other than TCL_OK,
- * then the interpreter's result contains an error message. If the
- * result is TCL_OK, then a pointer to the expression's result value
- * object is stored in resultPtrPtr. In that case, the object's ref
- * count is incremented to reflect the reference returned to the
- * caller; the caller is then responsible for the resulting object
- * and must, for example, decrement the ref count when it is finished
- * with the object.
+ * A standard Tcl object result. If the result is other than TCL_OK, then
+ * the interpreter's result contains an error message. If the result is
+ * TCL_OK, then a pointer to the expression's result value object is
+ * stored in resultPtrPtr. In that case, the object's ref count is
+ * incremented to reflect the reference returned to the caller; the
+ * caller is then responsible for the resulting object and must, for
+ * example, decrement the ref count when it is finished with the object.
*
* Side effects:
- * Any side effects caused by subcommands in the expression, if any.
- * The interpreter result is not modified unless there is an error.
+ * Any side effects caused by subcommands in the expression, if any. The
+ * interpreter result is not modified unless there is an error.
*
*--------------------------------------------------------------
*/
@@ -729,18 +721,18 @@ int
Tcl_ExprObj(interp, objPtr, resultPtrPtr)
Tcl_Interp *interp; /* Context in which to evaluate the
* expression. */
- register Tcl_Obj *objPtr; /* Points to Tcl object containing
- * expression to evaluate. */
+ register Tcl_Obj *objPtr; /* Points to Tcl object containing expression
+ * to evaluate. */
Tcl_Obj **resultPtrPtr; /* Where the Tcl_Obj* that is the expression
* result is stored if no errors occur. */
{
Interp *iPtr = (Interp *) interp;
- CompileEnv compEnv; /* Compilation environment structure
- * allocated in frame. */
+ CompileEnv compEnv; /* Compilation environment structure allocated
+ * in frame. */
LiteralTable *localTablePtr = &(compEnv.localLitTable);
register ByteCode *codePtr = NULL;
- /* Tcl Internal type of bytecode.
- * Initialized to avoid compiler warning. */
+ /* Tcl Internal type of bytecode. Initialized
+ * to avoid compiler warning. */
AuxData *auxDataPtr;
LiteralEntry *entryPtr;
Tcl_Obj *saveObjPtr, *resultPtr;
@@ -780,15 +772,13 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr)
/*
* Get the ByteCode from the object. If it exists, make sure it hasn't
- * been invalidated by, e.g., someone redefining a command with a
- * compile procedure (this might make the compiled code wrong). If
- * necessary, convert the object to be a ByteCode object and compile it.
- * Also, if the code was compiled in/for a different interpreter, we
- * recompile it.
- *
- * Precompiled expressions, however, are immutable and therefore
- * they are not recompiled, even if the epoch has changed.
+ * been invalidated by, e.g., someone redefining a command with a compile
+ * procedure (this might make the compiled code wrong). If necessary,
+ * convert the object to be a ByteCode object and compile it. Also, if
+ * the code was compiled in/for a different interpreter, we recompile it.
*
+ * Precompiled expressions, however, are immutable and therefore they are
+ * not recompiled, even if the epoch has changed.
*/
if (objPtr->typePtr == &tclByteCodeType) {
@@ -811,14 +801,14 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr)
result = TclCompileExpr(interp, string, length, &compEnv);
/*
- * Free the compilation environment's literal table bucket array if
- * it was dynamically allocated.
+ * Free the compilation environment's literal table bucket array if it
+ * was dynamically allocated.
*/
if (localTablePtr->buckets != localTablePtr->staticBuckets) {
ckfree((char *) localTablePtr->buckets);
}
-
+
if (result != TCL_OK) {
/*
* Compilation errors. Free storage allocated for compilation.
@@ -848,10 +838,10 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr)
}
/*
- * Successful compilation. If the expression yielded no
- * instructions, push an zero object as the expression's result.
+ * Successful compilation. If the expression yielded no instructions,
+ * push an zero object as the expression's result.
*/
-
+
if (compEnv.codeNext == compEnv.codeStart) {
TclEmitPush(TclRegisterNewLiteral(&compEnv, "0", 1),
&compEnv);
@@ -859,8 +849,8 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr)
/*
* Add a "done" instruction as the last instruction and change the
- * object into a ByteCode object. Ownership of the literal objects
- * and aux data items is given to the ByteCode object.
+ * object into a ByteCode object. Ownership of the literal objects and
+ * aux data items is given to the ByteCode object.
*/
TclEmitOpcode(INST_DONE, &compEnv);
@@ -877,7 +867,7 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr)
/*
* Execute the expression after first saving the interpreter's result.
*/
-
+
saveObjPtr = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(saveObjPtr);
Tcl_ResetResult(interp);
@@ -886,7 +876,7 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr)
* Increment the code's ref count while it is being executed. If
* afterwards no references to it remain, free the code.
*/
-
+
codePtr->refCount++;
result = TclExecuteByteCode(interp, codePtr);
codePtr->refCount--;
@@ -895,20 +885,20 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr)
objPtr->typePtr = NULL;
objPtr->internalRep.otherValuePtr = NULL;
}
-
+
/*
- * If the expression evaluated successfully, store a pointer to its
- * value object in resultPtrPtr then restore the old interpreter result.
- * We increment the object's ref count to reflect the reference that we
- * are returning to the caller. We also decrement the ref count of the
- * interpreter's result object after calling Tcl_SetResult since we
- * next store into that field directly.
+ * If the expression evaluated successfully, store a pointer to its value
+ * object in resultPtrPtr then restore the old interpreter result. We
+ * increment the object's ref count to reflect the reference that we are
+ * returning to the caller. We also decrement the ref count of the
+ * interpreter's result object after calling Tcl_SetResult since we next
+ * store into that field directly.
*/
-
+
if (result == TCL_OK) {
*resultPtrPtr = iPtr->objResultPtr;
Tcl_IncrRefCount(iPtr->objResultPtr);
-
+
Tcl_SetObjResult(interp, saveObjPtr);
}
TclDecrRefCount(saveObjPtr);
@@ -920,14 +910,13 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr)
*
* TclCompEvalObj --
*
- * This procedure evaluates the script contained in a Tcl_Obj by
- * first compiling it and then passing it to TclExecuteByteCode.
+ * This procedure evaluates the script contained in a Tcl_Obj by first
+ * compiling it and then passing it to TclExecuteByteCode.
*
* Results:
- * The return value is one of the return codes defined in tcl.h
- * (such as TCL_OK), and interp->objResultPtr refers to a Tcl object
- * that either contains the result of executing the code or an
- * error message.
+ * The return value is one of the return codes defined in tcl.h (such as
+ * TCL_OK), and interp->objResultPtr refers to a Tcl object that either
+ * contains the result of executing the code or an error message.
*
* Side effects:
* Almost certainly, depending on the ByteCode's instructions.
@@ -961,16 +950,15 @@ TclCompEvalObj(interp, objPtr)
namespacePtr = iPtr->globalNsPtr;
}
- /*
- * If the object is not already of tclByteCodeType, compile it (and
- * reset the compilation flags in the interpreter; this should be
- * done after any compilation).
- * Otherwise, check that it is "fresh" enough.
+ /*
+ * If the object is not already of tclByteCodeType, compile it (and reset
+ * the compilation flags in the interpreter; this should be done after any
+ * compilation). Otherwise, check that it is "fresh" enough.
*/
if (objPtr->typePtr != &tclByteCodeType) {
- recompileObj:
- iPtr->errorLine = 1;
+ recompileObj:
+ iPtr->errorLine = 1;
result = tclByteCodeType.setFromAnyProc(interp, objPtr);
if (result != TCL_OK) {
iPtr->numLevels--;
@@ -979,21 +967,20 @@ TclCompEvalObj(interp, objPtr)
codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
} else {
/*
- * Make sure the Bytecode hasn't been invalidated by, e.g., someone
- * redefining a command with a compile procedure (this might make the
- * compiled code wrong).
- * The object needs to be recompiled if it was compiled in/for a
- * different interpreter, or for a different namespace, or for the
- * same namespace but with different name resolution rules.
- * Precompiled objects, however, are immutable and therefore
- * they are not recompiled, even if the epoch has changed.
+ * Make sure the Bytecode hasn't been invalidated by, e.g., someone
+ * redefining a command with a compile procedure (this might make the
+ * compiled code wrong). The object needs to be recompiled if it was
+ * compiled in/for a different interpreter, or for a different
+ * namespace, or for the same namespace but with different name
+ * resolution rules. Precompiled objects, however, are immutable and
+ * therefore they are not recompiled, even if the epoch has changed.
*
* To be pedantically correct, we should also check that the
* originating procPtr is the same as the current context procPtr
- * (assuming one exists at all - none for global level). This
- * code is #def'ed out because [info body] was changed to never
- * return a bytecode type object, which should obviate us from
- * the extra checks here.
+ * (assuming one exists at all - none for global level). This code is
+ * #def'ed out because [info body] was changed to never return a
+ * bytecode type object, which should obviate us from the extra checks
+ * here.
*/
codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
if (((Interp *) *codePtr->interpHandle != iPtr)
@@ -1039,14 +1026,13 @@ TclCompEvalObj(interp, objPtr)
*
* TclExecuteByteCode --
*
- * This procedure executes the instructions of a ByteCode structure.
- * It returns when a "done" instruction is executed or an error occurs.
+ * This procedure executes the instructions of a ByteCode structure. It
+ * returns when a "done" instruction is executed or an error occurs.
*
* Results:
- * The return value is one of the return codes defined in tcl.h
- * (such as TCL_OK), and interp->objResultPtr refers to a Tcl object
- * that either contains the result of executing the code or an
- * error message.
+ * The return value is one of the return codes defined in tcl.h (such as
+ * TCL_OK), and interp->objResultPtr refers to a Tcl object that either
+ * contains the result of executing the code or an error message.
*
* Side effects:
* Almost certainly, depending on the ByteCode's instructions.
@@ -1061,26 +1047,25 @@ TclExecuteByteCode(interp, codePtr)
{
/*
* Compiler cast directive - not a real variable.
- * Interp *iPtr = (Interp *) interp;
+ * Interp *iPtr = (Interp *) interp;
*/
#define iPtr ((Interp *) interp)
/*
- * Constants: variables that do not change during the execution,
- * used sporadically.
+ * Constants: variables that do not change during the execution, used
+ * sporadically.
*/
- ExecEnv *eePtr; /* Points to the execution environment. */
- int initStackTop; /* Stack top at start of execution. */
- int initCatchTop; /* Catch stack top at start of execution. */
+ ExecEnv *eePtr; /* Points to the execution environment. */
+ int initStackTop; /* Stack top at start of execution. */
+ int initCatchTop; /* Catch stack top at start of execution. */
Var *compiledLocals;
Namespace *namespacePtr;
/*
- * Globals: variables that store state, must remain valid at
- * all times.
+ * Globals: variables that store state, must remain valid at all times.
*/
-
+
int catchTop;
register Tcl_Obj **tosPtr; /* Cached pointer to top of evaluation stack. */
register unsigned char *pc = codePtr->codeStart;
@@ -1088,18 +1073,17 @@ TclExecuteByteCode(interp, codePtr)
int instructionCount = 0; /* Counter that is used to work out when to
* call Tcl_AsyncReady() */
Tcl_Obj *expandNestList = NULL;
- int checkInterp = 0; /* Indicates when a check of interp readyness
+ int checkInterp = 0; /* Indicates when a check of interp readyness
* is necessary. Set by DECACHE_STACK_INFO() */
-
+
/*
- * Transfer variables - needed only between opcodes, but not
- * while executing an instruction.
+ * Transfer variables - needed only between opcodes, but not while
+ * executing an instruction.
*/
register int cleanup;
Tcl_Obj *objResultPtr;
-
/*
* Result variable - needed only when going to checkForcatch or other
* error handlers; also used as local in some opcodes.
@@ -1108,8 +1092,8 @@ TclExecuteByteCode(interp, codePtr)
int result = TCL_OK; /* Return code returned after execution. */
/*
- * Locals - variables that are used within opcodes or bounded sections
- * of the file (jumps between opcodes within a family).
+ * Locals - variables that are used within opcodes or bounded sections of
+ * the file (jumps between opcodes within a family).
* NOTE: These are now defined locally where needed.
*/
@@ -1122,10 +1106,10 @@ TclExecuteByteCode(interp, codePtr)
* The execution uses a unified stack: first the catch stack, immediately
* above it the execution stack.
*
- * Make sure the catch stack is large enough to hold the maximum number
- * of catch commands that could ever be executing at the same time (this
- * will be no more than the exception range array's depth).
- * Make sure the execution stack is large enough to execute this ByteCode.
+ * Make sure the catch stack is large enough to hold the maximum number of
+ * catch commands that could ever be executing at the same time (this will
+ * be no more than the exception range array's depth). Make sure the
+ * execution stack is large enough to execute this ByteCode.
*/
eePtr = iPtr->execEnvPtr;
@@ -1134,7 +1118,7 @@ TclExecuteByteCode(interp, codePtr)
tosPtr = eePtr->tosPtr + codePtr->maxExceptDepth;
while ((tosPtr + codePtr->maxStackDepth) > eePtr->endPtr) {
- GrowEvaluationStack(eePtr);
+ GrowEvaluationStack(eePtr);
tosPtr = eePtr->tosPtr + codePtr->maxExceptDepth;
}
initStackTop = tosPtr - eePtr->stackPtr;
@@ -1146,103 +1130,102 @@ TclExecuteByteCode(interp, codePtr)
fflush(stdout);
}
#endif
-
+
#ifdef TCL_COMPILE_STATS
iPtr->stats.numExecutions++;
#endif
if (iPtr->varFramePtr != NULL) {
- namespacePtr = iPtr->varFramePtr->nsPtr;
+ namespacePtr = iPtr->varFramePtr->nsPtr;
compiledLocals = iPtr->varFramePtr->compiledLocals;
} else {
- namespacePtr = iPtr->globalNsPtr;
+ namespacePtr = iPtr->globalNsPtr;
compiledLocals = NULL;
}
/*
- * Loop executing instructions until a "done" instruction, a
- * TCL_RETURN, or some error.
+ * Loop executing instructions until a "done" instruction, a TCL_RETURN,
+ * or some error.
*/
goto cleanup0;
-
/*
- * Targets for standard instruction endings; unrolled
- * for speed in the most frequent cases (instructions that
- * consume up to two stack elements).
+ * Targets for standard instruction endings; unrolled for speed in the
+ * most frequent cases (instructions that consume up to two stack
+ * elements).
*
- * This used to be a "for(;;)" loop, with each instruction doing
- * its own cleanup.
+ * This used to be a "for(;;)" loop, with each instruction doing its own
+ * cleanup.
*/
-
+
{
Tcl_Obj *valuePtr;
-
- cleanupV_pushObjResultPtr:
+
+ cleanupV_pushObjResultPtr:
switch (cleanup) {
- case 0:
- *(++tosPtr) = (objResultPtr);
- goto cleanup0;
- default:
- cleanup -= 2;
- while (cleanup--) {
- valuePtr = POP_OBJECT();
- TclDecrRefCount(valuePtr);
- }
- case 2:
- cleanup2_pushObjResultPtr:
+ case 0:
+ *(++tosPtr) = (objResultPtr);
+ goto cleanup0;
+ default:
+ cleanup -= 2;
+ while (cleanup--) {
valuePtr = POP_OBJECT();
TclDecrRefCount(valuePtr);
- case 1:
- cleanup1_pushObjResultPtr:
- valuePtr = *tosPtr;
- TclDecrRefCount(valuePtr);
+ }
+ case 2:
+ cleanup2_pushObjResultPtr:
+ valuePtr = POP_OBJECT();
+ TclDecrRefCount(valuePtr);
+ case 1:
+ cleanup1_pushObjResultPtr:
+ valuePtr = *tosPtr;
+ TclDecrRefCount(valuePtr);
}
*tosPtr = objResultPtr;
goto cleanup0;
-
- cleanupV:
+
+ cleanupV:
switch (cleanup) {
- default:
- cleanup -= 2;
- while (cleanup--) {
- valuePtr = POP_OBJECT();
- TclDecrRefCount(valuePtr);
- }
- case 2:
- cleanup2:
- valuePtr = POP_OBJECT();
- TclDecrRefCount(valuePtr);
- case 1:
- cleanup1:
+ default:
+ cleanup -= 2;
+ while (cleanup--) {
valuePtr = POP_OBJECT();
TclDecrRefCount(valuePtr);
- case 0:
- /*
- * We really want to do nothing now, but this is needed
- * for some compilers (SunPro CC)
- */
- break;
+ }
+ case 2:
+ cleanup2:
+ valuePtr = POP_OBJECT();
+ TclDecrRefCount(valuePtr);
+ case 1:
+ cleanup1:
+ valuePtr = POP_OBJECT();
+ TclDecrRefCount(valuePtr);
+ case 0:
+ /*
+ * We really want to do nothing now, but this is needed for some
+ * compilers (SunPro CC)
+ */
+ break;
}
}
- cleanup0:
-
+ cleanup0:
+
#ifdef TCL_COMPILE_DEBUG
/*
* Skip the stack depth check if an expansion is in progress
*/
ValidatePcAndStackTop(codePtr, pc, (tosPtr - eePtr->stackPtr),
- initStackTop, /*checkStack*/ (expandNestList == NULL));
+ initStackTop, /*checkStack*/ (expandNestList == NULL));
if (traceInstructions) {
fprintf(stdout, "%2d: %2d ", iPtr->numLevels, (tosPtr - eePtr->stackPtr));
TclPrintInstruction(codePtr, pc);
fflush(stdout);
}
#endif /* TCL_COMPILE_DEBUG */
-
-#ifdef TCL_COMPILE_STATS
+
+#ifdef TCL_COMPILE_STATS
iPtr->stats.instructionCount[*pc]++;
#endif
@@ -1275,45 +1258,44 @@ TclExecuteByteCode(interp, codePtr)
}
switch (*pc) {
- case INST_RETURN:
- {
- int code = TclGetInt4AtPtr(pc+1);
- int level = TclGetUInt4AtPtr(pc+5);
- Tcl_Obj *returnOpts = POP_OBJECT();
+ case INST_RETURN: {
+ int code = TclGetInt4AtPtr(pc+1);
+ int level = TclGetUInt4AtPtr(pc+5);
+ Tcl_Obj *returnOpts = POP_OBJECT();
- result = TclProcessReturn(interp, code, level, returnOpts);
- Tcl_DecrRefCount(returnOpts);
- if (result != TCL_OK) {
- Tcl_SetObjResult(interp, *tosPtr);
- cleanup = 1;
- goto processExceptionReturn;
- }
- NEXT_INST_F(9, 0, 0);
+ result = TclProcessReturn(interp, code, level, returnOpts);
+ Tcl_DecrRefCount(returnOpts);
+ if (result != TCL_OK) {
+ Tcl_SetObjResult(interp, *tosPtr);
+ cleanup = 1;
+ goto processExceptionReturn;
}
+ NEXT_INST_F(9, 0, 0);
+ }
case INST_DONE:
if (tosPtr <= eePtr->stackPtr + initStackTop) {
tosPtr--;
goto abnormalReturn;
}
-
+
/*
- * Set the interpreter's object result to point to the
- * topmost object from the stack, and check for a possible
- * [catch]. The stackTop's level and refCount will be handled
- * by "processCatch" or "abnormalReturn".
+ * Set the interpreter's object result to point to the topmost object
+ * from the stack, and check for a possible [catch]. The stackTop's
+ * level and refCount will be handled by "processCatch" or
+ * "abnormalReturn".
*/
Tcl_SetObjResult(interp, *tosPtr);
-#ifdef TCL_COMPILE_DEBUG
+#ifdef TCL_COMPILE_DEBUG
TRACE_WITH_OBJ(("=> return code=%d, result=", result),
- iPtr->objResultPtr);
+ iPtr->objResultPtr);
if (traceInstructions) {
fprintf(stdout, "\n");
}
#endif
goto checkForCatch;
-
+
case INST_PUSH1:
#if !TCL_COMPILE_DEBUG
instPush1Peephole:
@@ -1323,9 +1305,9 @@ TclExecuteByteCode(interp, codePtr)
pc += 2;
#if !TCL_COMPILE_DEBUG
/*
- * Runtime peephole optimisation: check if we are pushing again.
+ * Runtime peephole optimisation: check if we are pushing again.
*/
-
+
if (*pc == INST_PUSH1) {
goto instPush1Peephole;
}
@@ -1337,40 +1319,37 @@ TclExecuteByteCode(interp, codePtr)
TRACE_WITH_OBJ(("%u => ", TclGetUInt4AtPtr(pc+1)), objResultPtr);
NEXT_INST_F(5, 0, 1);
- case INST_POP:
- {
- Tcl_Obj *valuePtr;
-
- TRACE_WITH_OBJ(("=> discarding "), *tosPtr);
- valuePtr = POP_OBJECT();
- TclDecrRefCount(valuePtr);
- }
+ case INST_POP: {
+ Tcl_Obj *valuePtr;
+
+ TRACE_WITH_OBJ(("=> discarding "), *tosPtr);
+ valuePtr = POP_OBJECT();
+ TclDecrRefCount(valuePtr);
/*
- * Runtime peephole optimisation: an INST_POP is scheduled
- * at the end of most commands. If the next instruction is an
- * INST_START_CMD, fall through to it.
+ * Runtime peephole optimisation: an INST_POP is scheduled at the end
+ * of most commands. If the next instruction is an INST_START_CMD,
+ * fall through to it.
*/
pc++;
-#if !TCL_COMPILE_DEBUG
- if (*pc == INST_START_CMD) {
+#if !TCL_COMPILE_DEBUG
+ if (*pc == INST_START_CMD) {
goto instStartCmdPeephole;
}
#endif
NEXT_INST_F(0, 0, 0);
+ }
-
case INST_START_CMD:
-#if !TCL_COMPILE_DEBUG
- instStartCmdPeephole:
+#if !TCL_COMPILE_DEBUG
+ instStartCmdPeephole:
#endif
/*
- * Remark that if the interpreter is marked for deletion
- * its compileEpoch is modified, so that the epoch
- * check also verifies that the interp is not deleted.
- * If no outside call has been made since the last check, it is safe
- * to omit the check.
+ * Remark that if the interpreter is marked for deletion its
+ * compileEpoch is modified, so that the epoch check also verifies
+ * that the interp is not deleted. If no outside call has been made
+ * since the last check, it is safe to omit the check.
*/
iPtr->cmdCount++;
@@ -1384,13 +1363,13 @@ TclExecuteByteCode(interp, codePtr)
* INST_START_CMD in a row. Many commands start by pushing a
* literal argument or command name; optimise that case too.
*/
-
+
while (*(pc += 5) == INST_START_CMD) {
iPtr->cmdCount++;
}
if (*pc == INST_PUSH1) {
goto instPush1Peephole;
- }
+ }
NEXT_INST_F(0, 0, 0);
#else
NEXT_INST_F(5, 0, 0);
@@ -1399,9 +1378,9 @@ TclExecuteByteCode(interp, codePtr)
char *bytes;
int length, opnd;
Tcl_Obj *newObjResultPtr;
-
+
bytes = GetSrcInfoForPc(pc, codePtr, &length);
- DECACHE_STACK_INFO();
+ DECACHE_STACK_INFO();
result = Tcl_EvalEx(interp, bytes, length, 0);
CACHE_STACK_INFO();
if (result != TCL_OK) {
@@ -1410,14 +1389,12 @@ TclExecuteByteCode(interp, codePtr)
}
opnd = TclGetUInt4AtPtr(pc+1);
objResultPtr = Tcl_GetObjResult(interp);
- {
- TclNewObj(newObjResultPtr);
- Tcl_IncrRefCount(newObjResultPtr);
- iPtr->objResultPtr = newObjResultPtr;
- }
+ TclNewObj(newObjResultPtr);
+ Tcl_IncrRefCount(newObjResultPtr);
+ iPtr->objResultPtr = newObjResultPtr;
NEXT_INST_V(opnd, 0, -1);
}
-
+
case INST_DUP:
objResultPtr = *tosPtr;
TRACE_WITH_OBJ(("=> "), objResultPtr);
@@ -1434,7 +1411,7 @@ TclExecuteByteCode(interp, codePtr)
case INST_CONCAT1: {
int opnd, length, appendLen = 0;
- char *bytes, *p;
+ char *bytes, *p;
Tcl_Obj **currPtr;
opnd = TclGetUInt1AtPtr(pc+1);
@@ -1487,7 +1464,7 @@ TclExecuteByteCode(interp, codePtr)
objResultPtr->length = length + appendLen;
currPtr = tosPtr - (opnd - 1);
#if !TCL_COMPILE_DEBUG
- }
+ }
#endif
/*
@@ -1531,7 +1508,7 @@ TclExecuteByteCode(interp, codePtr)
NEXT_INST_F(1, 0, 0);
}
- case INST_EXPAND_STKTOP: {
+ case INST_EXPAND_STKTOP: {
int objc, length, i;
Tcl_Obj **objv, *valuePtr, *objPtr;
@@ -1557,12 +1534,12 @@ TclExecuteByteCode(interp, codePtr)
* *and* process the rest of the command (at least up to the next
* argument expansion or command end). The operand is the current
* stack depth, as seen by the compiler.
- */
+ */
length = objc + codePtr->maxStackDepth - TclGetInt4AtPtr(pc+1);
while ((tosPtr + length) > eePtr->endPtr) {
DECACHE_STACK_INFO();
- GrowEvaluationStack(eePtr);
+ GrowEvaluationStack(eePtr);
CACHE_STACK_INFO();
}
@@ -1584,850 +1561,829 @@ TclExecuteByteCode(interp, codePtr)
int objc, pcAdjustment;
- case INST_INVOKE_EXPANDED:
- {
- Tcl_Obj *objPtr;
-
- objPtr = expandNestList;
- expandNestList = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr2;
- objc = tosPtr - eePtr->stackPtr
- - (ptrdiff_t) objPtr->internalRep.twoPtrValue.ptr1;
- TclDecrRefCount(objPtr);
- }
-
- if (objc == 0) {
- /*
- * Nothing was expanded, return {}.
- */
-
- TclNewObj(objResultPtr);
- NEXT_INST_F(1, 0, 1);
- }
-
- pcAdjustment = 1;
- goto doInvocation;
-
- case INST_INVOKE_STK4:
- objc = TclGetUInt4AtPtr(pc+1);
- pcAdjustment = 5;
- goto doInvocation;
-
- case INST_INVOKE_STK1:
- objc = TclGetUInt1AtPtr(pc+1);
- pcAdjustment = 2;
-
- doInvocation:
- {
- Tcl_Obj **objv = (tosPtr - (objc-1));
- int length;
- char *bytes;
-
- /*
- * We keep the stack reference count as a (char *), as that
- * works nicely as a portable pointer-sized counter.
- */
-
- char **preservedStackRefCountPtr;
-
+ case INST_INVOKE_EXPANDED:
+ {
+ Tcl_Obj *objPtr;
+
+ objPtr = expandNestList;
+ expandNestList = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr2;
+ objc = tosPtr - eePtr->stackPtr
+ - (ptrdiff_t) objPtr->internalRep.twoPtrValue.ptr1;
+ TclDecrRefCount(objPtr);
+ }
+
+ if (objc == 0) {
+ /*
+ * Nothing was expanded, return {}.
+ */
+
+ TclNewObj(objResultPtr);
+ NEXT_INST_F(1, 0, 1);
+ }
+
+ pcAdjustment = 1;
+ goto doInvocation;
+
+ case INST_INVOKE_STK4:
+ objc = TclGetUInt4AtPtr(pc+1);
+ pcAdjustment = 5;
+ goto doInvocation;
+
+ case INST_INVOKE_STK1:
+ objc = TclGetUInt1AtPtr(pc+1);
+ pcAdjustment = 2;
+
+ doInvocation:
+ {
+ Tcl_Obj **objv = (tosPtr - (objc-1));
+ int length;
+ char *bytes;
+
+ /*
+ * We keep the stack reference count as a (char *), as that works
+ * nicely as a portable pointer-sized counter.
+ */
+
+ char **preservedStackRefCountPtr;
+
#ifdef TCL_COMPILE_DEBUG
- if (tclTraceExec >= 2) {
- int i;
+ if (tclTraceExec >= 2) {
+ int i;
- if (traceInstructions) {
- strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
- TRACE(("%u => call ", objc));
- } else {
- fprintf(stdout, "%d: (%u) invoking ",
- iPtr->numLevels,
- (unsigned int)(pc - codePtr->codeStart));
- }
- for (i = 0; i < objc; i++) {
- TclPrintObject(stdout, objv[i], 15);
- fprintf(stdout, " ");
- }
- fprintf(stdout, "\n");
- fflush(stdout);
+ if (traceInstructions) {
+ strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
+ TRACE(("%u => call ", objc));
+ } else {
+ fprintf(stdout, "%d: (%u) invoking ", iPtr->numLevels,
+ (unsigned int)(pc - codePtr->codeStart));
+ }
+ for (i = 0; i < objc; i++) {
+ TclPrintObject(stdout, objv[i], 15);
+ fprintf(stdout, " ");
}
+ fprintf(stdout, "\n");
+ fflush(stdout);
+ }
#endif /*TCL_COMPILE_DEBUG*/
-
- /*
- * If trace procedures will be called, we need a
- * command string to pass to TclEvalObjvInternal; note
- * that a copy of the string will be made there to
- * include the ending \0.
- */
-
- bytes = NULL;
- length = 0;
- if (iPtr->tracePtr != NULL) {
- Trace *tracePtr, *nextTracePtr;
-
- for (tracePtr = iPtr->tracePtr; tracePtr != NULL;
- tracePtr = nextTracePtr) {
- nextTracePtr = tracePtr->nextPtr;
- if (tracePtr->level == 0 ||
- iPtr->numLevels <= tracePtr->level) {
- /*
- * Traces will be called: get command string
- */
-
- bytes = GetSrcInfoForPc(pc, codePtr, &length);
- break;
- }
- }
- } else {
- Command *cmdPtr;
- cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
- if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
+
+ /*
+ * If trace procedures will be called, we need a command string to
+ * pass to TclEvalObjvInternal; note that a copy of the string
+ * will be made there to include the ending \0.
+ */
+
+ bytes = NULL;
+ length = 0;
+ if (iPtr->tracePtr != NULL) {
+ Trace *tracePtr, *nextTracePtr;
+
+ for (tracePtr = iPtr->tracePtr; tracePtr != NULL;
+ tracePtr = nextTracePtr) {
+ nextTracePtr = tracePtr->nextPtr;
+ if (tracePtr->level == 0 ||
+ iPtr->numLevels <= tracePtr->level) {
+ /*
+ * Traces will be called: get command string
+ */
+
bytes = GetSrcInfoForPc(pc, codePtr, &length);
+ break;
}
- }
-
- /*
- * A reference to part of the stack vector itself
- * escapes our control: increase its refCount
- * to stop it from being deallocated by a recursive
- * call to ourselves. The extra variable is needed
- * because all others are liable to change due to the
- * trace procedures.
- */
-
- preservedStackRefCountPtr = (char **) (eePtr->stackPtr-1);
- ++*preservedStackRefCountPtr;
-
- /*
- * Reset the instructionCount variable, since we're about
- * to check for async stuff anyway while processing
- * TclEvalObjvInternal.
- */
-
- instructionCount = 1;
-
- /*
- * Finally, let TclEvalObjvInternal handle the command.
- */
-
- DECACHE_STACK_INFO();
- Tcl_ResetResult(interp);
- result = TclEvalObjvInternal(interp, objc, objv, bytes, length, 0);
- CACHE_STACK_INFO();
-
- /*
- * If the old stack is going to be released, it is
- * safe to do so now, since no references to objv are
- * going to be used from now on.
- */
-
- --*preservedStackRefCountPtr;
- if (*preservedStackRefCountPtr == (char *) 0) {
- ckfree((VOID *) preservedStackRefCountPtr);
- }
-
- if (result == TCL_OK) {
- /*
- * Push the call's object result and continue execution
- * with the next instruction.
- */
-
- TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
- objc, cmdNameBuf), Tcl_GetObjResult(interp));
-
- objResultPtr = Tcl_GetObjResult(interp);
-
- /*
- * Reset the interp's result to avoid possible duplications
- * of large objects [Bug 781585]. We do not call
- * Tcl_ResetResult() to avoid any side effects caused by
- * the resetting of errorInfo and errorCode [Bug 804681],
- * which are not needed here. We chose instead to manipulate
- * the interp's object result directly.
- *
- * Note that the result object is now in objResultPtr, it
- * keeps the refCount it had in its role of iPtr->objResultPtr.
- */
- {
- Tcl_Obj *objPtr;
-
- TclNewObj(objPtr);
- Tcl_IncrRefCount(objPtr);
- iPtr->objResultPtr = objPtr;
- }
-
- NEXT_INST_V(pcAdjustment, objc, -1);
- } else {
- cleanup = objc;
- goto processExceptionReturn;
+ }
+ } else {
+ Command *cmdPtr;
+
+ cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
+ if ((cmdPtr!=NULL) && (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
+ bytes = GetSrcInfoForPc(pc, codePtr, &length);
}
}
- }
-
- case INST_EVAL_STK:
- /*
- * Note to maintainers: it is important that INST_EVAL_STK
- * pop its argument from the stack before jumping to
- * checkForCatch! DO NOT OPTIMISE!
- */
+ /*
+ * A reference to part of the stack vector itself escapes our
+ * control: increase its refCount to stop it from being
+ * deallocated by a recursive call to ourselves. The extra
+ * variable is needed because all others are liable to change due
+ * to the trace procedures.
+ */
+
+ preservedStackRefCountPtr = (char **) (eePtr->stackPtr-1);
+ ++*preservedStackRefCountPtr;
+
+ /*
+ * Reset the instructionCount variable, since we're about to check
+ * for async stuff anyway while processing TclEvalObjvInternal.
+ */
+
+ instructionCount = 1;
+
+ /*
+ * Finally, let TclEvalObjvInternal handle the command.
+ */
- {
- Tcl_Obj *objPtr;
-
- objPtr = *tosPtr;
DECACHE_STACK_INFO();
- result = TclCompEvalObj(interp, objPtr);
+ Tcl_ResetResult(interp);
+ result = TclEvalObjvInternal(interp, objc, objv, bytes, length, 0);
CACHE_STACK_INFO();
+
+ /*
+ * If the old stack is going to be released, it is safe to do so
+ * now, since no references to objv are going to be used from now
+ * on.
+ */
+
+ --*preservedStackRefCountPtr;
+ if (*preservedStackRefCountPtr == (char *) 0) {
+ ckfree((VOID *) preservedStackRefCountPtr);
+ }
+
if (result == TCL_OK) {
+ Tcl_Obj *objPtr;
/*
- * Normal return; push the eval's object result.
+ * Push the call's object result and continue execution with
+ * the next instruction.
*/
-
+
+ TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
+ objc, cmdNameBuf), Tcl_GetObjResult(interp));
+
objResultPtr = Tcl_GetObjResult(interp);
- TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)),
- Tcl_GetObjResult(interp));
-
+
/*
- * Reset the interp's result to avoid possible duplications
- * of large objects [Bug 781585]. We do not call
- * Tcl_ResetResult() to avoid any side effects caused by
- * the resetting of errorInfo and errorCode [Bug 804681],
- * which are not needed here. We chose instead to manipulate
- * the interp's object result directly.
+ * Reset the interp's result to avoid possible duplications of
+ * large objects [Bug 781585]. We do not call Tcl_ResetResult
+ * to avoid any side effects caused by the resetting of
+ * errorInfo and errorCode [Bug 804681], which are not needed
+ * here. We chose instead to manipulate the interp's object
+ * result directly.
*
* Note that the result object is now in objResultPtr, it
- * keeps the refCount it had in its role of iPtr->objResultPtr.
+ * keeps the refCount it had in its role of
+ * iPtr->objResultPtr.
*/
TclNewObj(objPtr);
Tcl_IncrRefCount(objPtr);
iPtr->objResultPtr = objPtr;
- NEXT_INST_F(1, 1, -1);
+ NEXT_INST_V(pcAdjustment, objc, -1);
} else {
- cleanup = 1;
+ cleanup = objc;
goto processExceptionReturn;
}
}
+ }
- case INST_EXPR_STK:
- {
- Tcl_Obj *objPtr, *valuePtr;
-
- objPtr = *tosPtr;
- DECACHE_STACK_INFO();
- Tcl_ResetResult(interp);
- result = Tcl_ExprObj(interp, objPtr, &valuePtr);
- CACHE_STACK_INFO();
- if (result != TCL_OK) {
- TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(objPtr)),
- Tcl_GetObjResult(interp));
- goto checkForCatch;
- }
- objResultPtr = valuePtr;
- TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)), valuePtr);
- NEXT_INST_F(1, 1, -1); /* already has right refct */
+ case INST_EVAL_STK: {
+ /*
+ * Note to maintainers: it is important that INST_EVAL_STK pop its
+ * argument from the stack before jumping to checkForCatch! DO NOT
+ * OPTIMISE!
+ */
+
+ Tcl_Obj *objPtr;
+
+ objPtr = *tosPtr;
+ DECACHE_STACK_INFO();
+ result = TclCompEvalObj(interp, objPtr);
+ CACHE_STACK_INFO();
+ if (result == TCL_OK) {
+ /*
+ * Normal return; push the eval's object result.
+ */
+
+ objResultPtr = Tcl_GetObjResult(interp);
+ TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)),
+ Tcl_GetObjResult(interp));
+
+ /*
+ * Reset the interp's result to avoid possible duplications of
+ * large objects [Bug 781585]. We do not call Tcl_ResetResult to
+ * avoid any side effects caused by the resetting of errorInfo and
+ * errorCode [Bug 804681], which are not needed here. We chose
+ * instead to manipulate the interp's object result directly.
+ *
+ * Note that the result object is now in objResultPtr, it keeps
+ * the refCount it had in its role of iPtr->objResultPtr.
+ */
+
+ TclNewObj(objPtr);
+ Tcl_IncrRefCount(objPtr);
+ iPtr->objResultPtr = objPtr;
+ NEXT_INST_F(1, 1, -1);
+ } else {
+ cleanup = 1;
+ goto processExceptionReturn;
+ }
+ }
+
+ case INST_EXPR_STK: {
+ Tcl_Obj *objPtr, *valuePtr;
+
+ objPtr = *tosPtr;
+ DECACHE_STACK_INFO();
+ Tcl_ResetResult(interp);
+ result = Tcl_ExprObj(interp, objPtr, &valuePtr);
+ CACHE_STACK_INFO();
+ if (result != TCL_OK) {
+ TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(objPtr)),
+ Tcl_GetObjResult(interp));
+ goto checkForCatch;
}
+ objResultPtr = valuePtr;
+ TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)), valuePtr);
+ NEXT_INST_F(1, 1, -1); /* already has right refct */
+ }
/*
* ---------------------------------------------------------
- * Start of INST_LOAD instructions.
+ * Start of INST_LOAD instructions.
*
- * WARNING: more 'goto' here than your doctor recommended!
- * The different instructions set the value of some variables
- * and then jump to somme common execution code.
+ * WARNING: more 'goto' here than your doctor recommended! The different
+ * instructions set the value of some variables and then jump to somme
+ * common execution code.
*/
{
- int opnd, pcAdjustment;
+ int opnd, pcAdjustment;
char *part1, *part2;
Var *varPtr, *arrayPtr;
Tcl_Obj *objPtr;
- case INST_LOAD_SCALAR1:
- opnd = TclGetUInt1AtPtr(pc+1);
- varPtr = &(compiledLocals[opnd]);
- part1 = varPtr->name;
- while (TclIsVarLink(varPtr)) {
- varPtr = varPtr->value.linkPtr;
- }
- TRACE(("%u => ", opnd));
- if (TclIsVarDirectReadable(varPtr)) {
- /*
- * No errors, no traces: just get the value.
- */
- objResultPtr = varPtr->value.objPtr;
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
- NEXT_INST_F(2, 0, 1);
- }
- pcAdjustment = 2;
- cleanup = 0;
- arrayPtr = NULL;
- part2 = NULL;
- goto doCallPtrGetVar;
+ case INST_LOAD_SCALAR1:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ varPtr = &(compiledLocals[opnd]);
+ part1 = varPtr->name;
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+ TRACE(("%u => ", opnd));
+ if (TclIsVarDirectReadable(varPtr)) {
+ /*
+ * No errors, no traces: just get the value.
+ */
+ objResultPtr = varPtr->value.objPtr;
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_F(2, 0, 1);
+ }
+ pcAdjustment = 2;
+ cleanup = 0;
+ arrayPtr = NULL;
+ part2 = NULL;
+ goto doCallPtrGetVar;
- case INST_LOAD_SCALAR4:
- opnd = TclGetUInt4AtPtr(pc+1);
- varPtr = &(compiledLocals[opnd]);
- part1 = varPtr->name;
- while (TclIsVarLink(varPtr)) {
- varPtr = varPtr->value.linkPtr;
- }
- TRACE(("%u => ", opnd));
- if (TclIsVarDirectReadable(varPtr)) {
- /*
- * No errors, no traces: just get the value.
- */
- objResultPtr = varPtr->value.objPtr;
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
- NEXT_INST_F(5, 0, 1);
- }
- pcAdjustment = 5;
- cleanup = 0;
- arrayPtr = NULL;
- part2 = NULL;
- goto doCallPtrGetVar;
-
- case INST_LOAD_ARRAY_STK:
- cleanup = 2;
- part2 = Tcl_GetString(*tosPtr); /* element name */
- objPtr = *(tosPtr - 1); /* array name */
- TRACE(("\"%.30s(%.30s)\" => ", O2S(objPtr), part2));
- goto doLoadStk;
-
- case INST_LOAD_STK:
- case INST_LOAD_SCALAR_STK:
- cleanup = 1;
- part2 = NULL;
- objPtr = *tosPtr; /* variable name */
- TRACE(("\"%.30s\" => ", O2S(objPtr)));
-
- doLoadStk:
- part1 = TclGetString(objPtr);
- varPtr = TclObjLookupVar(interp, objPtr, part2,
- TCL_LEAVE_ERR_MSG, "read",
- /*createPart1*/ 0,
- /*createPart2*/ 1, &arrayPtr);
- if (varPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
- }
- if (TclIsVarDirectReadable(varPtr)
- && ((arrayPtr == NULL)
- || TclIsVarUntraced(arrayPtr))) {
- /*
- * No errors, no traces: just get the value.
- */
- objResultPtr = varPtr->value.objPtr;
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
- NEXT_INST_V(1, cleanup, 1);
- }
- pcAdjustment = 1;
- goto doCallPtrGetVar;
-
- case INST_LOAD_ARRAY4:
- opnd = TclGetUInt4AtPtr(pc+1);
- pcAdjustment = 5;
- goto doLoadArray;
-
- case INST_LOAD_ARRAY1:
- opnd = TclGetUInt1AtPtr(pc+1);
- pcAdjustment = 2;
-
- doLoadArray:
- part2 = TclGetString(*tosPtr);
- arrayPtr = &(compiledLocals[opnd]);
- part1 = arrayPtr->name;
- while (TclIsVarLink(arrayPtr)) {
- arrayPtr = arrayPtr->value.linkPtr;
- }
- TRACE(("%u \"%.30s\" => ", opnd, part2));
- varPtr = TclLookupArrayElement(interp, part1, part2,
- TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr);
- if (varPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
- }
- if (TclIsVarDirectReadable(varPtr)
- && ((arrayPtr == NULL)
- || TclIsVarUntraced(arrayPtr))) {
- /*
- * No errors, no traces: just get the value.
- */
- objResultPtr = varPtr->value.objPtr;
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
- NEXT_INST_F(pcAdjustment, 1, 1);
- }
- cleanup = 1;
- goto doCallPtrGetVar;
-
- doCallPtrGetVar:
+ case INST_LOAD_SCALAR4:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ varPtr = &(compiledLocals[opnd]);
+ part1 = varPtr->name;
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+ TRACE(("%u => ", opnd));
+ if (TclIsVarDirectReadable(varPtr)) {
/*
- * There are either errors or the variable is traced:
- * call TclPtrGetVar to process fully.
+ * No errors, no traces: just get the value.
*/
-
- DECACHE_STACK_INFO();
- objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1,
- part2, TCL_LEAVE_ERR_MSG);
- CACHE_STACK_INFO();
- if (objResultPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
- }
+ objResultPtr = varPtr->value.objPtr;
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
- NEXT_INST_V(pcAdjustment, cleanup, 1);
+ NEXT_INST_F(5, 0, 1);
+ }
+ pcAdjustment = 5;
+ cleanup = 0;
+ arrayPtr = NULL;
+ part2 = NULL;
+ goto doCallPtrGetVar;
+
+ case INST_LOAD_ARRAY_STK:
+ cleanup = 2;
+ part2 = Tcl_GetString(*tosPtr); /* element name */
+ objPtr = *(tosPtr - 1); /* array name */
+ TRACE(("\"%.30s(%.30s)\" => ", O2S(objPtr), part2));
+ goto doLoadStk;
+
+ case INST_LOAD_STK:
+ case INST_LOAD_SCALAR_STK:
+ cleanup = 1;
+ part2 = NULL;
+ objPtr = *tosPtr; /* variable name */
+ TRACE(("\"%.30s\" => ", O2S(objPtr)));
+
+ doLoadStk:
+ part1 = TclGetString(objPtr);
+ varPtr = TclObjLookupVar(interp, objPtr, part2, TCL_LEAVE_ERR_MSG,
+ "read", /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
+ if (varPtr == NULL) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ result = TCL_ERROR;
+ goto checkForCatch;
+ }
+ if (TclIsVarDirectReadable(varPtr)
+ && ((arrayPtr == NULL) || TclIsVarUntraced(arrayPtr))) {
+ /*
+ * No errors, no traces: just get the value.
+ */
+ objResultPtr = varPtr->value.objPtr;
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_V(1, cleanup, 1);
+ }
+ pcAdjustment = 1;
+ goto doCallPtrGetVar;
+
+ case INST_LOAD_ARRAY4:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ pcAdjustment = 5;
+ goto doLoadArray;
+
+ case INST_LOAD_ARRAY1:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ pcAdjustment = 2;
+
+ doLoadArray:
+ part2 = TclGetString(*tosPtr);
+ arrayPtr = &(compiledLocals[opnd]);
+ part1 = arrayPtr->name;
+ while (TclIsVarLink(arrayPtr)) {
+ arrayPtr = arrayPtr->value.linkPtr;
+ }
+ TRACE(("%u \"%.30s\" => ", opnd, part2));
+ varPtr = TclLookupArrayElement(interp, part1, part2,
+ TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr);
+ if (varPtr == NULL) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ result = TCL_ERROR;
+ goto checkForCatch;
+ }
+ if (TclIsVarDirectReadable(varPtr)
+ && ((arrayPtr == NULL) || TclIsVarUntraced(arrayPtr))) {
+ /*
+ * No errors, no traces: just get the value.
+ */
+ objResultPtr = varPtr->value.objPtr;
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_F(pcAdjustment, 1, 1);
+ }
+ cleanup = 1;
+ goto doCallPtrGetVar;
+
+ doCallPtrGetVar:
+ /*
+ * There are either errors or the variable is traced: call
+ * TclPtrGetVar to process fully.
+ */
+
+ DECACHE_STACK_INFO();
+ objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2,
+ TCL_LEAVE_ERR_MSG);
+ CACHE_STACK_INFO();
+ if (objResultPtr == NULL) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ result = TCL_ERROR;
+ goto checkForCatch;
+ }
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_V(pcAdjustment, cleanup, 1);
}
-
+
/*
- * End of INST_LOAD instructions.
+ * End of INST_LOAD instructions.
* ---------------------------------------------------------
*/
/*
* ---------------------------------------------------------
- * Start of INST_STORE and related instructions.
+ * Start of INST_STORE and related instructions.
*
- * WARNING: more 'goto' here than your doctor recommended!
- * The different instructions set the value of some variables
- * and then jump to somme common execution code.
+ * WARNING: more 'goto' here than your doctor recommended! The different
+ * instructions set the value of some variables and then jump to somme
+ * common execution code.
*/
{
- int opnd, pcAdjustment, storeFlags;
+ int opnd, pcAdjustment, storeFlags;
char *part1, *part2;
Var *varPtr, *arrayPtr;
Tcl_Obj *objPtr, *valuePtr;
- case INST_LAPPEND_STK:
- valuePtr = *tosPtr; /* value to append */
- part2 = NULL;
- storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
- | TCL_LIST_ELEMENT | TCL_TRACE_READS);
- goto doStoreStk;
-
- case INST_LAPPEND_ARRAY_STK:
- valuePtr = *tosPtr; /* value to append */
- part2 = TclGetString(*(tosPtr - 1));
- storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
- | TCL_LIST_ELEMENT | TCL_TRACE_READS);
- goto doStoreStk;
-
- case INST_APPEND_STK:
- valuePtr = *tosPtr; /* value to append */
- part2 = NULL;
- storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
- goto doStoreStk;
-
- case INST_APPEND_ARRAY_STK:
- valuePtr = *tosPtr; /* value to append */
- part2 = TclGetString(*(tosPtr - 1));
- storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
- goto doStoreStk;
-
- case INST_STORE_ARRAY_STK:
- valuePtr = *tosPtr;
- part2 = TclGetString(*(tosPtr - 1));
- storeFlags = TCL_LEAVE_ERR_MSG;
- goto doStoreStk;
+ case INST_LAPPEND_STK:
+ valuePtr = *tosPtr; /* value to append */
+ part2 = NULL;
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
+ | TCL_LIST_ELEMENT | TCL_TRACE_READS);
+ goto doStoreStk;
+
+ case INST_LAPPEND_ARRAY_STK:
+ valuePtr = *tosPtr; /* value to append */
+ part2 = TclGetString(*(tosPtr - 1));
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
+ | TCL_LIST_ELEMENT | TCL_TRACE_READS);
+ goto doStoreStk;
+
+ case INST_APPEND_STK:
+ valuePtr = *tosPtr; /* value to append */
+ part2 = NULL;
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
+ goto doStoreStk;
+
+ case INST_APPEND_ARRAY_STK:
+ valuePtr = *tosPtr; /* value to append */
+ part2 = TclGetString(*(tosPtr - 1));
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
+ goto doStoreStk;
+
+ case INST_STORE_ARRAY_STK:
+ valuePtr = *tosPtr;
+ part2 = TclGetString(*(tosPtr - 1));
+ storeFlags = TCL_LEAVE_ERR_MSG;
+ goto doStoreStk;
- case INST_STORE_STK:
- case INST_STORE_SCALAR_STK:
- valuePtr = *tosPtr;
- part2 = NULL;
- storeFlags = TCL_LEAVE_ERR_MSG;
-
- doStoreStk:
- objPtr = *(tosPtr - 1 - (part2 != NULL)); /* variable name */
- part1 = TclGetString(objPtr);
+ case INST_STORE_STK:
+ case INST_STORE_SCALAR_STK:
+ valuePtr = *tosPtr;
+ part2 = NULL;
+ storeFlags = TCL_LEAVE_ERR_MSG;
+
+ doStoreStk:
+ objPtr = *(tosPtr - 1 - (part2 != NULL)); /* variable name */
+ part1 = TclGetString(objPtr);
#ifdef TCL_COMPILE_DEBUG
- if (part2 == NULL) {
- TRACE(("\"%.30s\" <- \"%.30s\" =>",
- part1, O2S(valuePtr)));
- } else {
- TRACE(("\"%.30s(%.30s)\" <- \"%.30s\" => ",
- part1, part2, O2S(valuePtr)));
- }
-#endif
- varPtr = TclObjLookupVar(interp, objPtr, part2,
- TCL_LEAVE_ERR_MSG, "set",
- /*createPart1*/ 1,
- /*createPart2*/ 1, &arrayPtr);
- if (varPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
- }
- cleanup = ((part2 == NULL)? 2 : 3);
- pcAdjustment = 1;
- goto doCallPtrSetVar;
-
- case INST_LAPPEND_ARRAY4:
- opnd = TclGetUInt4AtPtr(pc+1);
- pcAdjustment = 5;
- storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
- | TCL_LIST_ELEMENT | TCL_TRACE_READS);
- goto doStoreArray;
-
- case INST_LAPPEND_ARRAY1:
- opnd = TclGetUInt1AtPtr(pc+1);
- pcAdjustment = 2;
- storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
- | TCL_LIST_ELEMENT | TCL_TRACE_READS);
- goto doStoreArray;
-
- case INST_APPEND_ARRAY4:
- opnd = TclGetUInt4AtPtr(pc+1);
- pcAdjustment = 5;
- storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
- goto doStoreArray;
-
- case INST_APPEND_ARRAY1:
- opnd = TclGetUInt1AtPtr(pc+1);
- pcAdjustment = 2;
- storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
- goto doStoreArray;
-
- case INST_STORE_ARRAY4:
- opnd = TclGetUInt4AtPtr(pc+1);
- pcAdjustment = 5;
- storeFlags = TCL_LEAVE_ERR_MSG;
- goto doStoreArray;
-
- case INST_STORE_ARRAY1:
- opnd = TclGetUInt1AtPtr(pc+1);
- pcAdjustment = 2;
- storeFlags = TCL_LEAVE_ERR_MSG;
-
- doStoreArray:
- valuePtr = *tosPtr;
- part2 = TclGetString(*(tosPtr - 1));
- arrayPtr = &(compiledLocals[opnd]);
- part1 = arrayPtr->name;
- TRACE(("%u \"%.30s\" <- \"%.30s\" => ",
- opnd, part2, O2S(valuePtr)));
- while (TclIsVarLink(arrayPtr)) {
- arrayPtr = arrayPtr->value.linkPtr;
- }
- varPtr = TclLookupArrayElement(interp, part1, part2,
- TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr);
- if (varPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
- }
- cleanup = 2;
- goto doCallPtrSetVar;
-
- case INST_LAPPEND_SCALAR4:
- opnd = TclGetUInt4AtPtr(pc+1);
- pcAdjustment = 5;
- storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
- | TCL_LIST_ELEMENT | TCL_TRACE_READS);
- goto doStoreScalar;
-
- case INST_LAPPEND_SCALAR1:
- opnd = TclGetUInt1AtPtr(pc+1);
- pcAdjustment = 2;
- storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
- | TCL_LIST_ELEMENT | TCL_TRACE_READS);
- goto doStoreScalar;
-
- case INST_APPEND_SCALAR4:
- opnd = TclGetUInt4AtPtr(pc+1);
- pcAdjustment = 5;
- storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
- goto doStoreScalar;
-
- case INST_APPEND_SCALAR1:
- opnd = TclGetUInt1AtPtr(pc+1);
- pcAdjustment = 2;
- storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
- goto doStoreScalar;
-
- case INST_STORE_SCALAR4:
- opnd = TclGetUInt4AtPtr(pc+1);
- pcAdjustment = 5;
- storeFlags = TCL_LEAVE_ERR_MSG;
- goto doStoreScalar;
-
- case INST_STORE_SCALAR1:
- opnd = TclGetUInt1AtPtr(pc+1);
- pcAdjustment = 2;
- storeFlags = TCL_LEAVE_ERR_MSG;
-
- doStoreScalar:
- valuePtr = *tosPtr;
- varPtr = &(compiledLocals[opnd]);
- part1 = varPtr->name;
- TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr)));
- while (TclIsVarLink(varPtr)) {
- varPtr = varPtr->value.linkPtr;
- }
- cleanup = 1;
- arrayPtr = NULL;
- part2 = NULL;
-
- doCallPtrSetVar:
- if ((storeFlags == TCL_LEAVE_ERR_MSG)
- && TclIsVarDirectWritable(varPtr)
- && ((arrayPtr == NULL)
- || TclIsVarUntraced(arrayPtr))) {
- /*
- * No traces, no errors, plain 'set': we can safely inline.
- * The value *will* be set to what's requested, so that
- * the stack top remains pointing to the same Tcl_Obj.
- */
- valuePtr = varPtr->value.objPtr;
- objResultPtr = *tosPtr;
- if (valuePtr != objResultPtr) {
- if (valuePtr != NULL) {
- TclDecrRefCount(valuePtr);
- } else {
- TclSetVarScalar(varPtr);
- TclClearVarUndefined(varPtr);
- }
- varPtr->value.objPtr = objResultPtr;
- Tcl_IncrRefCount(objResultPtr);
- }
-#ifndef TCL_COMPILE_DEBUG
- if (*(pc+pcAdjustment) == INST_POP) {
- NEXT_INST_V((pcAdjustment+1), cleanup, 0);
- }
-#else
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ if (part2 == NULL) {
+ TRACE(("\"%.30s\" <- \"%.30s\" =>", part1, O2S(valuePtr)));
+ } else {
+ TRACE(("\"%.30s(%.30s)\" <- \"%.30s\" => ",
+ part1, part2, O2S(valuePtr)));
+ }
#endif
- NEXT_INST_V(pcAdjustment, cleanup, 1);
- } else {
- DECACHE_STACK_INFO();
- objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr,
- part1, part2, valuePtr, storeFlags);
- CACHE_STACK_INFO();
- if (objResultPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
+ varPtr = TclObjLookupVar(interp, objPtr, part2, TCL_LEAVE_ERR_MSG,
+ "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
+ if (varPtr == NULL) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ result = TCL_ERROR;
+ goto checkForCatch;
+ }
+ cleanup = ((part2 == NULL)? 2 : 3);
+ pcAdjustment = 1;
+ goto doCallPtrSetVar;
+
+ case INST_LAPPEND_ARRAY4:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ pcAdjustment = 5;
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
+ | TCL_LIST_ELEMENT | TCL_TRACE_READS);
+ goto doStoreArray;
+
+ case INST_LAPPEND_ARRAY1:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ pcAdjustment = 2;
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
+ | TCL_LIST_ELEMENT | TCL_TRACE_READS);
+ goto doStoreArray;
+
+ case INST_APPEND_ARRAY4:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ pcAdjustment = 5;
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
+ goto doStoreArray;
+
+ case INST_APPEND_ARRAY1:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ pcAdjustment = 2;
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
+ goto doStoreArray;
+
+ case INST_STORE_ARRAY4:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ pcAdjustment = 5;
+ storeFlags = TCL_LEAVE_ERR_MSG;
+ goto doStoreArray;
+
+ case INST_STORE_ARRAY1:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ pcAdjustment = 2;
+ storeFlags = TCL_LEAVE_ERR_MSG;
+
+ doStoreArray:
+ valuePtr = *tosPtr;
+ part2 = TclGetString(*(tosPtr - 1));
+ arrayPtr = &(compiledLocals[opnd]);
+ part1 = arrayPtr->name;
+ TRACE(("%u \"%.30s\" <- \"%.30s\" => ", opnd, part2, O2S(valuePtr)));
+ while (TclIsVarLink(arrayPtr)) {
+ arrayPtr = arrayPtr->value.linkPtr;
+ }
+ varPtr = TclLookupArrayElement(interp, part1, part2,
+ TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr);
+ if (varPtr == NULL) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ result = TCL_ERROR;
+ goto checkForCatch;
+ }
+ cleanup = 2;
+ goto doCallPtrSetVar;
+
+ case INST_LAPPEND_SCALAR4:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ pcAdjustment = 5;
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
+ | TCL_LIST_ELEMENT | TCL_TRACE_READS);
+ goto doStoreScalar;
+
+ case INST_LAPPEND_SCALAR1:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ pcAdjustment = 2;
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
+ | TCL_LIST_ELEMENT | TCL_TRACE_READS);
+ goto doStoreScalar;
+
+ case INST_APPEND_SCALAR4:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ pcAdjustment = 5;
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
+ goto doStoreScalar;
+
+ case INST_APPEND_SCALAR1:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ pcAdjustment = 2;
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
+ goto doStoreScalar;
+
+ case INST_STORE_SCALAR4:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ pcAdjustment = 5;
+ storeFlags = TCL_LEAVE_ERR_MSG;
+ goto doStoreScalar;
+
+ case INST_STORE_SCALAR1:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ pcAdjustment = 2;
+ storeFlags = TCL_LEAVE_ERR_MSG;
+
+ doStoreScalar:
+ valuePtr = *tosPtr;
+ varPtr = &(compiledLocals[opnd]);
+ part1 = varPtr->name;
+ TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr)));
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+ cleanup = 1;
+ arrayPtr = NULL;
+ part2 = NULL;
+
+ doCallPtrSetVar:
+ if ((storeFlags == TCL_LEAVE_ERR_MSG)
+ && TclIsVarDirectWritable(varPtr)
+ && ((arrayPtr == NULL) || TclIsVarUntraced(arrayPtr))) {
+ /*
+ * No traces, no errors, plain 'set': we can safely inline. The
+ * value *will* be set to what's requested, so that the stack top
+ * remains pointing to the same Tcl_Obj.
+ */
+ valuePtr = varPtr->value.objPtr;
+ objResultPtr = *tosPtr;
+ if (valuePtr != objResultPtr) {
+ if (valuePtr != NULL) {
+ TclDecrRefCount(valuePtr);
+ } else {
+ TclSetVarScalar(varPtr);
+ TclClearVarUndefined(varPtr);
}
+ varPtr->value.objPtr = objResultPtr;
+ Tcl_IncrRefCount(objResultPtr);
}
#ifndef TCL_COMPILE_DEBUG
if (*(pc+pcAdjustment) == INST_POP) {
NEXT_INST_V((pcAdjustment+1), cleanup, 0);
}
-#endif
+#else
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+#endif
NEXT_INST_V(pcAdjustment, cleanup, 1);
+ } else {
+ DECACHE_STACK_INFO();
+ objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr,
+ part1, part2, valuePtr, storeFlags);
+ CACHE_STACK_INFO();
+ if (objResultPtr == NULL) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ result = TCL_ERROR;
+ goto checkForCatch;
+ }
+ }
+#ifndef TCL_COMPILE_DEBUG
+ if (*(pc+pcAdjustment) == INST_POP) {
+ NEXT_INST_V((pcAdjustment+1), cleanup, 0);
+ }
+#endif
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_V(pcAdjustment, cleanup, 1);
}
/*
- * End of INST_STORE and related instructions.
+ * End of INST_STORE and related instructions.
* ---------------------------------------------------------
*/
/*
* ---------------------------------------------------------
- * Start of INST_INCR instructions.
+ * Start of INST_INCR instructions.
*
- * WARNING: more 'goto' here than your doctor recommended!
- * The different instructions set the value of some variables
- * and then jump to somme common execution code.
+ * WARNING: more 'goto' here than your doctor recommended! The different
+ * instructions set the value of some variables and then jump to somme
+ * common execution code.
*/
- {
- Tcl_Obj *objPtr;
- int opnd, pcAdjustment, isWide;
- long i;
- Tcl_WideInt w;
- char *part1, *part2;
- Var *varPtr, *arrayPtr;
-
- case INST_INCR_SCALAR1:
- case INST_INCR_ARRAY1:
- case INST_INCR_ARRAY_STK:
- case INST_INCR_SCALAR_STK:
- case INST_INCR_STK:
- opnd = TclGetUInt1AtPtr(pc+1);
- objPtr = *tosPtr;
- if (objPtr->typePtr == &tclIntType) {
- i = objPtr->internalRep.longValue;
- isWide = 0;
- } else if (objPtr->typePtr == &tclWideIntType) {
- i = 0; /* lint */
- w = objPtr->internalRep.wideValue;
- isWide = 1;
- } else {
- i = 0; /* lint */
- REQUIRE_WIDE_OR_INT(result, objPtr, i, w);
- if (result != TCL_OK) {
- TRACE_WITH_OBJ(("%u (by %s) => ERROR converting increment amount to int: ",
- opnd, O2S(objPtr)), Tcl_GetObjResult(interp));
- Tcl_AddErrorInfo(interp, "\n (reading increment)");
- goto checkForCatch;
- }
- isWide = (objPtr->typePtr == &tclWideIntType);
- }
- tosPtr--;
- TclDecrRefCount(objPtr);
- switch (*pc) {
- case INST_INCR_SCALAR1:
- pcAdjustment = 2;
- goto doIncrScalar;
- case INST_INCR_ARRAY1:
- pcAdjustment = 2;
- goto doIncrArray;
- default:
- pcAdjustment = 1;
- goto doIncrStk;
- }
-
- case INST_INCR_ARRAY_STK_IMM:
- case INST_INCR_SCALAR_STK_IMM:
- case INST_INCR_STK_IMM:
- i = TclGetInt1AtPtr(pc+1);
- isWide = 0;
- pcAdjustment = 2;
-
- doIncrStk:
- if ((*pc == INST_INCR_ARRAY_STK_IMM)
- || (*pc == INST_INCR_ARRAY_STK)) {
- part2 = TclGetString(*tosPtr);
- objPtr = *(tosPtr - 1);
- TRACE(("\"%.30s(%.30s)\" (by %ld) => ",
- O2S(objPtr), part2, i));
- } else {
- part2 = NULL;
- objPtr = *tosPtr;
- TRACE(("\"%.30s\" (by %ld) => ", O2S(objPtr), i));
- }
- part1 = TclGetString(objPtr);
-
- varPtr = TclObjLookupVar(interp, objPtr, part2,
- TCL_LEAVE_ERR_MSG, "read", 0, 1, &arrayPtr);
- if (varPtr == NULL) {
- Tcl_AddObjErrorInfo(interp,
- "\n (reading value of variable to increment)", -1);
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
- }
- cleanup = ((part2 == NULL)? 1 : 2);
- goto doIncrVar;
-
- case INST_INCR_ARRAY1_IMM:
- opnd = TclGetUInt1AtPtr(pc+1);
- i = TclGetInt1AtPtr(pc+2);
- isWide = 0;
- pcAdjustment = 3;
-
- doIncrArray:
- part2 = TclGetString(*tosPtr);
- arrayPtr = &(compiledLocals[opnd]);
- part1 = arrayPtr->name;
- while (TclIsVarLink(arrayPtr)) {
- arrayPtr = arrayPtr->value.linkPtr;
- }
- TRACE(("%u \"%.30s\" (by %ld) => ",
- opnd, part2, i));
- varPtr = TclLookupArrayElement(interp, part1, part2,
- TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr);
- if (varPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
- }
- cleanup = 1;
- goto doIncrVar;
-
- case INST_INCR_SCALAR1_IMM:
- opnd = TclGetUInt1AtPtr(pc+1);
- i = TclGetInt1AtPtr(pc+2);
- isWide = 0;
- pcAdjustment = 3;
-
- doIncrScalar:
- varPtr = &(compiledLocals[opnd]);
- part1 = varPtr->name;
- while (TclIsVarLink(varPtr)) {
- varPtr = varPtr->value.linkPtr;
- }
- arrayPtr = NULL;
- part2 = NULL;
- cleanup = 0;
- TRACE(("%u %ld => ", opnd, i));
-
-
- doIncrVar:
- objPtr = varPtr->value.objPtr;
- if (TclIsVarDirectReadable(varPtr)
- && ((arrayPtr == NULL)
- || TclIsVarUntraced(arrayPtr))) {
- if (objPtr->typePtr == &tclIntType && !isWide) {
- /*
- * No errors, no traces, the variable already has an
- * integer value: inline processing.
- */
-
- i += objPtr->internalRep.longValue;
- if (Tcl_IsShared(objPtr)) {
- objPtr->refCount--; /* we know it is shared */
- TclNewLongObj(objResultPtr, i);
- Tcl_IncrRefCount(objResultPtr);
- varPtr->value.objPtr = objResultPtr;
- } else {
- TclSetLongObj(objPtr, i);
- objResultPtr = objPtr;
- }
- goto doneIncr;
- } else if (objPtr->typePtr == &tclWideIntType && isWide) {
- /*
- * No errors, no traces, the variable already has a
- * wide integer value: inline processing.
- */
-
- w += objPtr->internalRep.wideValue;
- if (Tcl_IsShared(objPtr)) {
- objPtr->refCount--; /* we know it is shared */
- TclNewWideIntObj(objResultPtr, w);
- Tcl_IncrRefCount(objResultPtr);
- varPtr->value.objPtr = objResultPtr;
- } else {
- TclSetWideIntObj(objPtr, w);
- objResultPtr = objPtr;
- }
- goto doneIncr;
- }
- }
- DECACHE_STACK_INFO();
- if (isWide) {
- objResultPtr = TclPtrIncrWideVar(interp, varPtr, arrayPtr, part1,
- part2, w, TCL_LEAVE_ERR_MSG);
- } else {
- objResultPtr = TclPtrIncrVar(interp, varPtr, arrayPtr, part1,
- part2, i, TCL_LEAVE_ERR_MSG);
- }
- CACHE_STACK_INFO();
- if (objResultPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
- }
- doneIncr:
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ {
+ Tcl_Obj *objPtr;
+ int opnd, pcAdjustment, isWide;
+ long i;
+ Tcl_WideInt w;
+ char *part1, *part2;
+ Var *varPtr, *arrayPtr;
+
+ case INST_INCR_SCALAR1:
+ case INST_INCR_ARRAY1:
+ case INST_INCR_ARRAY_STK:
+ case INST_INCR_SCALAR_STK:
+ case INST_INCR_STK:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ objPtr = *tosPtr;
+ if (objPtr->typePtr == &tclIntType) {
+ i = objPtr->internalRep.longValue;
+ isWide = 0;
+ } else if (objPtr->typePtr == &tclWideIntType) {
+ i = 0; /* lint */
+ w = objPtr->internalRep.wideValue;
+ isWide = 1;
+ } else {
+ i = 0; /* lint */
+ REQUIRE_WIDE_OR_INT(result, objPtr, i, w);
+ if (result != TCL_OK) {
+ TRACE_WITH_OBJ(("%u (by %s) => ERROR converting increment amount to int: ",
+ opnd, O2S(objPtr)), Tcl_GetObjResult(interp));
+ Tcl_AddErrorInfo(interp, "\n (reading increment)");
+ goto checkForCatch;
+ }
+ isWide = (objPtr->typePtr == &tclWideIntType);
+ }
+ tosPtr--;
+ TclDecrRefCount(objPtr);
+ switch (*pc) {
+ case INST_INCR_SCALAR1:
+ pcAdjustment = 2;
+ goto doIncrScalar;
+ case INST_INCR_ARRAY1:
+ pcAdjustment = 2;
+ goto doIncrArray;
+ default:
+ pcAdjustment = 1;
+ goto doIncrStk;
+ }
+
+ case INST_INCR_ARRAY_STK_IMM:
+ case INST_INCR_SCALAR_STK_IMM:
+ case INST_INCR_STK_IMM:
+ i = TclGetInt1AtPtr(pc+1);
+ isWide = 0;
+ pcAdjustment = 2;
+
+ doIncrStk:
+ if ((*pc == INST_INCR_ARRAY_STK_IMM)
+ || (*pc == INST_INCR_ARRAY_STK)) {
+ part2 = TclGetString(*tosPtr);
+ objPtr = *(tosPtr - 1);
+ TRACE(("\"%.30s(%.30s)\" (by %ld) => ",
+ O2S(objPtr), part2, i));
+ } else {
+ part2 = NULL;
+ objPtr = *tosPtr;
+ TRACE(("\"%.30s\" (by %ld) => ", O2S(objPtr), i));
+ }
+ part1 = TclGetString(objPtr);
+
+ varPtr = TclObjLookupVar(interp, objPtr, part2,
+ TCL_LEAVE_ERR_MSG, "read", 0, 1, &arrayPtr);
+ if (varPtr == NULL) {
+ Tcl_AddObjErrorInfo(interp,
+ "\n (reading value of variable to increment)", -1);
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ result = TCL_ERROR;
+ goto checkForCatch;
+ }
+ cleanup = ((part2 == NULL)? 1 : 2);
+ goto doIncrVar;
+
+ case INST_INCR_ARRAY1_IMM:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ i = TclGetInt1AtPtr(pc+2);
+ isWide = 0;
+ pcAdjustment = 3;
+
+ doIncrArray:
+ part2 = TclGetString(*tosPtr);
+ arrayPtr = &(compiledLocals[opnd]);
+ part1 = arrayPtr->name;
+ while (TclIsVarLink(arrayPtr)) {
+ arrayPtr = arrayPtr->value.linkPtr;
+ }
+ TRACE(("%u \"%.30s\" (by %ld) => ", opnd, part2, i));
+ varPtr = TclLookupArrayElement(interp, part1, part2,
+ TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr);
+ if (varPtr == NULL) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ result = TCL_ERROR;
+ goto checkForCatch;
+ }
+ cleanup = 1;
+ goto doIncrVar;
+
+ case INST_INCR_SCALAR1_IMM:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ i = TclGetInt1AtPtr(pc+2);
+ isWide = 0;
+ pcAdjustment = 3;
+
+ doIncrScalar:
+ varPtr = &(compiledLocals[opnd]);
+ part1 = varPtr->name;
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+ arrayPtr = NULL;
+ part2 = NULL;
+ cleanup = 0;
+ TRACE(("%u %ld => ", opnd, i));
+
+ doIncrVar:
+ objPtr = varPtr->value.objPtr;
+ if (TclIsVarDirectReadable(varPtr)
+ && ((arrayPtr == NULL) || TclIsVarUntraced(arrayPtr))) {
+ if (objPtr->typePtr == &tclIntType && !isWide) {
+ /*
+ * No errors, no traces, the variable already has an integer
+ * value: inline processing.
+ */
+
+ i += objPtr->internalRep.longValue;
+ if (Tcl_IsShared(objPtr)) {
+ objPtr->refCount--; /* we know it is shared */
+ TclNewLongObj(objResultPtr, i);
+ Tcl_IncrRefCount(objResultPtr);
+ varPtr->value.objPtr = objResultPtr;
+ } else {
+ TclSetLongObj(objPtr, i);
+ objResultPtr = objPtr;
+ }
+ goto doneIncr;
+ } else if (objPtr->typePtr == &tclWideIntType && isWide) {
+ /*
+ * No errors, no traces, the variable already has a wide
+ * integer value: inline processing.
+ */
+
+ w += objPtr->internalRep.wideValue;
+ if (Tcl_IsShared(objPtr)) {
+ objPtr->refCount--; /* we know it is shared */
+ TclNewWideIntObj(objResultPtr, w);
+ Tcl_IncrRefCount(objResultPtr);
+ varPtr->value.objPtr = objResultPtr;
+ } else {
+ TclSetWideIntObj(objPtr, w);
+ objResultPtr = objPtr;
+ }
+ goto doneIncr;
+ }
+ }
+ DECACHE_STACK_INFO();
+ if (isWide) {
+ objResultPtr = TclPtrIncrWideVar(interp, varPtr, arrayPtr, part1,
+ part2, w, TCL_LEAVE_ERR_MSG);
+ } else {
+ objResultPtr = TclPtrIncrVar(interp, varPtr, arrayPtr, part1,
+ part2, i, TCL_LEAVE_ERR_MSG);
+ }
+ CACHE_STACK_INFO();
+ if (objResultPtr == NULL) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ result = TCL_ERROR;
+ goto checkForCatch;
+ }
+ doneIncr:
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
#ifndef TCL_COMPILE_DEBUG
- if (*(pc+pcAdjustment) == INST_POP) {
- NEXT_INST_V((pcAdjustment+1), cleanup, 0);
- }
+ if (*(pc+pcAdjustment) == INST_POP) {
+ NEXT_INST_V((pcAdjustment+1), cleanup, 0);
+ }
#endif
- NEXT_INST_V(pcAdjustment, cleanup, 1);
- }
+ NEXT_INST_V(pcAdjustment, cleanup, 1);
+ }
/*
- * End of INST_INCR instructions.
+ * End of INST_INCR instructions.
* ---------------------------------------------------------
*/
case INST_JUMP1:
- {
+ {
int opnd;
-
+
opnd = TclGetInt1AtPtr(pc+1);
TRACE(("%d => new pc %u\n", opnd,
(unsigned int)(pc + opnd - codePtr->codeStart)));
@@ -2435,111 +2391,111 @@ TclExecuteByteCode(interp, codePtr)
}
case INST_JUMP4:
- {
+ {
int opnd;
-
+
opnd = TclGetInt4AtPtr(pc+1);
TRACE(("%d => new pc %u\n", opnd,
(unsigned int)(pc + opnd - codePtr->codeStart)));
NEXT_INST_F(opnd, 0, 0);
- }
+ }
{
int jmpOffset[2];
int b;
Tcl_Obj *valuePtr;
-
- case INST_JUMP_FALSE4:
- jmpOffset[0] = TclGetInt4AtPtr(pc+1); /* FALSE offset */
- jmpOffset[1] = 5; /* TRUE offset*/
- goto doCondJump;
-
- case INST_JUMP_TRUE4:
- jmpOffset[0] = 5;
- jmpOffset[1] = TclGetInt4AtPtr(pc+1);
- goto doCondJump;
-
- case INST_JUMP_FALSE1:
- jmpOffset[0] = TclGetInt1AtPtr(pc+1);
- jmpOffset[1] = 2;
- goto doCondJump;
- case INST_JUMP_TRUE1:
- jmpOffset[0] = 2;
- jmpOffset[1] = TclGetInt1AtPtr(pc+1);
-
- doCondJump:
- valuePtr = *tosPtr;
-
- if (valuePtr->typePtr == &tclIntType) {
- b = (valuePtr->internalRep.longValue != 0);
- } else if (valuePtr->typePtr == &tclDoubleType) {
- b = (valuePtr->internalRep.doubleValue != 0.0);
- } else if (valuePtr->typePtr == &tclWideIntType) {
- Tcl_WideInt w;
-
- TclGetWide(w,valuePtr);
- b = (w != W0);
- } else {
- /*
- * Taking b's address impedes it being a register
- * variable (in gcc at least), so we avoid doing it.
-
- */
- int b1;
- result = Tcl_GetBooleanFromObj(interp, valuePtr, &b1);
- if (result != TCL_OK) {
- if ((*pc == INST_JUMP_FALSE1) || (*pc == INST_JUMP_FALSE4)) {
- jmpOffset[1] = jmpOffset[0];
- }
- TRACE_WITH_OBJ(("%d => ERROR: ", jmpOffset[1]), Tcl_GetObjResult(interp));
- goto checkForCatch;
+ case INST_JUMP_FALSE4:
+ jmpOffset[0] = TclGetInt4AtPtr(pc+1); /* FALSE offset */
+ jmpOffset[1] = 5; /* TRUE offset*/
+ goto doCondJump;
+
+ case INST_JUMP_TRUE4:
+ jmpOffset[0] = 5;
+ jmpOffset[1] = TclGetInt4AtPtr(pc+1);
+ goto doCondJump;
+
+ case INST_JUMP_FALSE1:
+ jmpOffset[0] = TclGetInt1AtPtr(pc+1);
+ jmpOffset[1] = 2;
+ goto doCondJump;
+
+ case INST_JUMP_TRUE1:
+ jmpOffset[0] = 2;
+ jmpOffset[1] = TclGetInt1AtPtr(pc+1);
+
+ doCondJump:
+ valuePtr = *tosPtr;
+
+ if (valuePtr->typePtr == &tclIntType) {
+ b = (valuePtr->internalRep.longValue != 0);
+ } else if (valuePtr->typePtr == &tclDoubleType) {
+ b = (valuePtr->internalRep.doubleValue != 0.0);
+ } else if (valuePtr->typePtr == &tclWideIntType) {
+ Tcl_WideInt w;
+
+ TclGetWide(w,valuePtr);
+ b = (w != W0);
+ } else {
+ /*
+ * Taking b's address impedes it being a register variable (in gcc
+ * at least), so we avoid doing it.
+ */
+ int b1;
+ result = Tcl_GetBooleanFromObj(interp, valuePtr, &b1);
+ if (result != TCL_OK) {
+ if ((*pc == INST_JUMP_FALSE1) || (*pc == INST_JUMP_FALSE4)) {
+ jmpOffset[1] = jmpOffset[0];
}
- b = b1;
+ TRACE_WITH_OBJ(("%d => ERROR: ", jmpOffset[1]),
+ Tcl_GetObjResult(interp));
+ goto checkForCatch;
}
+ b = b1;
+ }
#ifndef TCL_COMPILE_DEBUG
- NEXT_INST_F(jmpOffset[b], 1, 0);
+ NEXT_INST_F(jmpOffset[b], 1, 0);
#else
- if (b) {
- if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) {
- TRACE(("%d => %.20s true, new pc %u\n", jmpOffset[1], O2S(valuePtr),
- (unsigned int)(pc+jmpOffset[1] - codePtr->codeStart)));
- } else {
- TRACE(("%d => %.20s true\n", jmpOffset[0], O2S(valuePtr)));
- }
- NEXT_INST_F(jmpOffset[1], 1, 0);
+ if (b) {
+ if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) {
+ TRACE(("%d => %.20s true, new pc %u\n", jmpOffset[1], O2S(valuePtr),
+ (unsigned int)(pc+jmpOffset[1] - codePtr->codeStart)));
} else {
- if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) {
- TRACE(("%d => %.20s false\n", jmpOffset[0], O2S(valuePtr)));
- } else {
- TRACE(("%d => %.20s false, new pc %u\n", jmpOffset[0], O2S(valuePtr),
- (unsigned int)(pc + jmpOffset[1] - codePtr->codeStart)));
- }
- NEXT_INST_F(jmpOffset[0], 1, 0);
+ TRACE(("%d => %.20s true\n", jmpOffset[0], O2S(valuePtr)));
+ }
+ NEXT_INST_F(jmpOffset[1], 1, 0);
+ } else {
+ if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) {
+ TRACE(("%d => %.20s false\n", jmpOffset[0], O2S(valuePtr)));
+ } else {
+ TRACE(("%d => %.20s false, new pc %u\n", jmpOffset[0], O2S(valuePtr),
+ (unsigned int)(pc + jmpOffset[1] - codePtr->codeStart)));
}
+ NEXT_INST_F(jmpOffset[0], 1, 0);
+ }
#endif
}
-
+
/*
- * These two instructions are now redundant: the complete logic of the
- * LOR and LAND is now handled by the expression compiler.
+ * These two instructions are now redundant: the complete logic of the LOR
+ * and LAND is now handled by the expression compiler.
*/
case INST_LOR:
case INST_LAND:
{
/*
- * Operands must be boolean or numeric. No int->double
- * conversions are performed.
+ * Operands must be boolean or numeric. No int->double conversions are
+ * performed.
*/
-
+
int i1, i2, length;
int iResult;
char *s;
Tcl_ObjType *t1Ptr, *t2Ptr;
Tcl_Obj *valuePtr, *value2Ptr;
Tcl_WideInt w;
-
+
value2Ptr = *tosPtr;
valuePtr = *(tosPtr - 1);
t1Ptr = valuePtr->typePtr;
@@ -2556,7 +2512,7 @@ TclExecuteByteCode(interp, codePtr)
s = Tcl_GetStringFromObj(valuePtr, &length);
if (TclLooksLikeInt(s, length)) {
long i = 0;
-
+
GET_WIDE_OR_INT(result, valuePtr, i, w);
if (valuePtr->typePtr == &tclIntType) {
i1 = (i != 0);
@@ -2568,12 +2524,12 @@ TclExecuteByteCode(interp, codePtr)
}
if (result != TCL_OK) {
TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
- (t1Ptr? t1Ptr->name : "null")));
+ (t1Ptr? t1Ptr->name : "null")));
IllegalExprOperandType(interp, pc, valuePtr);
goto checkForCatch;
}
}
-
+
if (t2Ptr == &tclIntType) {
i2 = (value2Ptr->internalRep.longValue != 0);
} else if (t2Ptr == &tclWideIntType) {
@@ -2585,7 +2541,7 @@ TclExecuteByteCode(interp, codePtr)
s = Tcl_GetStringFromObj(value2Ptr, &length);
if (TclLooksLikeInt(s, length)) {
long i = 0;
-
+
GET_WIDE_OR_INT(result, value2Ptr, i, w);
if (value2Ptr->typePtr == &tclIntType) {
i2 = (i != 0);
@@ -2597,7 +2553,7 @@ TclExecuteByteCode(interp, codePtr)
}
if (result != TCL_OK) {
TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr),
- (t2Ptr? t2Ptr->name : "null")));
+ (t2Ptr? t2Ptr->name : "null")));
IllegalExprOperandType(interp, pc, value2Ptr);
goto checkForCatch;
}
@@ -2606,7 +2562,7 @@ TclExecuteByteCode(interp, codePtr)
/*
* Reuse the valuePtr object already on stack if possible.
*/
-
+
if (*pc == INST_LOR) {
iResult = (i1 || i2);
} else {
@@ -2625,89 +2581,92 @@ TclExecuteByteCode(interp, codePtr)
/*
* ---------------------------------------------------------
- * Start of INST_LIST and related instructions.
+ * Start of INST_LIST and related instructions.
*/
- case INST_LIST:
- {
- /*
- * Pop the opnd (objc) top stack elements into a new list obj
- * and then decrement their ref counts.
- */
- int opnd;
-
- opnd = TclGetUInt4AtPtr(pc+1);
- objResultPtr = Tcl_NewListObj(opnd, (tosPtr - (opnd-1)));
- TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
- NEXT_INST_V(5, opnd, 1);
- }
+ case INST_LIST: {
+ /*
+ * Pop the opnd (objc) top stack elements into a new list obj and then
+ * decrement their ref counts.
+ */
- case INST_LIST_LENGTH:
- {
- Tcl_Obj *valuePtr;
- int length;
-
- valuePtr = *tosPtr;
+ int opnd;
- result = Tcl_ListObjLength(interp, valuePtr, &length);
- if (result != TCL_OK) {
- TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
- Tcl_GetObjResult(interp));
- goto checkForCatch;
- }
- TclNewIntObj(objResultPtr, length);
- TRACE(("%.20s => %d\n", O2S(valuePtr), length));
- NEXT_INST_F(1, 1, 1);
+ opnd = TclGetUInt4AtPtr(pc+1);
+ objResultPtr = Tcl_NewListObj(opnd, (tosPtr - (opnd-1)));
+ TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
+ NEXT_INST_V(5, opnd, 1);
+ }
+
+ case INST_LIST_LENGTH: {
+ Tcl_Obj *valuePtr;
+ int length;
+
+ valuePtr = *tosPtr;
+
+ result = Tcl_ListObjLength(interp, valuePtr, &length);
+ if (result != TCL_OK) {
+ TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
+ Tcl_GetObjResult(interp));
+ goto checkForCatch;
}
-
- case INST_LIST_INDEX:
- {
- /*** lindex with objc == 3 ***/
+ TclNewIntObj(objResultPtr, length);
+ TRACE(("%.20s => %d\n", O2S(valuePtr), length));
+ NEXT_INST_F(1, 1, 1);
+ }
- Tcl_Obj *valuePtr, *value2Ptr;
-
- /*
- * Pop the two operands
- */
- value2Ptr = *tosPtr;
- valuePtr = *(tosPtr - 1);
-
- /*
- * Extract the desired list element
- */
- objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);
- if (objResultPtr == NULL) {
- TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ", O2S(valuePtr), O2S(value2Ptr)),
- Tcl_GetObjResult(interp));
- result = TCL_ERROR;
- goto checkForCatch;
- }
-
- /*
- * Stash the list element on the stack
- */
- TRACE(("%.20s %.20s => %s\n",
- O2S(valuePtr), O2S(value2Ptr), O2S(objResultPtr)));
- NEXT_INST_F(1, 2, -1); /* already has the correct refCount */
+ case INST_LIST_INDEX: {
+ /*** lindex with objc == 3 ***/
+
+ Tcl_Obj *valuePtr, *value2Ptr;
+
+ /*
+ * Pop the two operands
+ */
+
+ value2Ptr = *tosPtr;
+ valuePtr = *(tosPtr - 1);
+
+ /*
+ * Extract the desired list element
+ */
+
+ objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);
+ if (objResultPtr == NULL) {
+ TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ", O2S(valuePtr), O2S(value2Ptr)),
+ Tcl_GetObjResult(interp));
+ result = TCL_ERROR;
+ goto checkForCatch;
}
+ /*
+ * Stash the list element on the stack
+ */
+
+ TRACE(("%.20s %.20s => %s\n",
+ O2S(valuePtr), O2S(value2Ptr), O2S(objResultPtr)));
+ NEXT_INST_F(1, 2, -1); /* already has the correct refCount */
+ }
+
case INST_LIST_INDEX_IMM: {
/*** lindex with objc==3 and index in bytecode stream ***/
int listc, idx, opnd;
Tcl_Obj **listv;
Tcl_Obj *valuePtr;
-
+
/*
* Pop the list and get the index
*/
+
valuePtr = *tosPtr;
opnd = TclGetInt4AtPtr(pc+1);
/*
- * Get the contents of the list, making sure that it
- * really is a list in the process.
+ * Get the contents of the list, making sure that it really is a list
+ * in the process.
*/
+
result = Tcl_ListObjGetElements(interp, valuePtr, &listc, &listv);
if (result != TCL_OK) {
TRACE_WITH_OBJ(("\"%.30s\" %d => ERROR: ", O2S(valuePtr), opnd),
@@ -2716,9 +2675,10 @@ TclExecuteByteCode(interp, codePtr)
}
/*
- * Select the list item based on the index. Negative
- * operand == end-based indexing.
+ * Select the list item based on the index. Negative operand means
+ * end-based indexing.
*/
+
if (opnd < -1) {
idx = opnd+1 + listc;
} else {
@@ -2734,8 +2694,7 @@ TclExecuteByteCode(interp, codePtr)
NEXT_INST_F(5, 1, 1);
}
- case INST_LIST_INDEX_MULTI:
- {
+ case INST_LIST_INDEX_MULTI: {
/*
* 'lindex' with multiple index args:
*
@@ -2750,8 +2709,9 @@ TclExecuteByteCode(interp, codePtr)
/*
* Do the 'lindex' operation.
*/
+
objResultPtr = TclLindexFlat(interp, *(tosPtr - numIdx),
- numIdx, tosPtr - numIdx + 1);
+ numIdx, tosPtr - numIdx + 1);
/*
* Check for errors
@@ -2769,11 +2729,9 @@ TclExecuteByteCode(interp, codePtr)
NEXT_INST_V(5, opnd, -1);
}
- case INST_LSET_FLAT:
- {
+ case INST_LSET_FLAT: {
/*
- * Lset with 3, 5, or more args. Get the number
- * of index args.
+ * Lset with 3, 5, or more args. Get the number of index args.
*/
int numIdx,opnd;
Tcl_Obj *valuePtr, *value2Ptr;
@@ -2782,9 +2740,9 @@ TclExecuteByteCode(interp, codePtr)
numIdx = opnd - 2;
/*
- * Get the old value of variable, and remove the stack ref.
- * This is safe because the variable still references the
- * object; the ref count will never go zero here.
+ * Get the old value of variable, and remove the stack ref. This is
+ * safe because the variable still references the object; the ref
+ * count will never go zero here.
*/
value2Ptr = POP_OBJECT();
TclDecrRefCount(value2Ptr); /* This one should be done here */
@@ -2798,7 +2756,7 @@ TclExecuteByteCode(interp, codePtr)
* Compute the new variable value
*/
objResultPtr = TclLsetFlat(interp, value2Ptr, numIdx,
- tosPtr - numIdx, valuePtr);
+ tosPtr - numIdx, valuePtr);
/*
* Check for errors
@@ -2816,28 +2774,27 @@ TclExecuteByteCode(interp, codePtr)
NEXT_INST_V(5, (numIdx+1), -1);
}
- case INST_LSET_LIST:
- {
+ case INST_LSET_LIST: {
/*
* 'lset' with 4 args.
*/
Tcl_Obj *objPtr, *valuePtr, *value2Ptr;
-
+
/*
- * Get the old value of variable, and remove the stack ref.
- * This is safe because the variable still references the
- * object; the ref count will never go zero here.
+ * Get the old value of variable, and remove the stack ref. This is
+ * safe because the variable still references the object; the ref
+ * count will never go zero here.
*/
- objPtr = POP_OBJECT();
+ objPtr = POP_OBJECT();
TclDecrRefCount(objPtr); /* This one should be done here */
-
+
/*
* Get the new element value, and the index list
*/
valuePtr = *tosPtr;
value2Ptr = *(tosPtr - 1);
-
+
/*
* Compute the new variable value
*/
@@ -2848,7 +2805,7 @@ TclExecuteByteCode(interp, codePtr)
*/
if (objResultPtr == NULL) {
TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(value2Ptr)),
- Tcl_GetObjResult(interp));
+ Tcl_GetObjResult(interp));
result = TCL_ERROR;
goto checkForCatch;
}
@@ -2859,15 +2816,14 @@ TclExecuteByteCode(interp, codePtr)
TRACE(("=> %s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, -1);
}
-
- case INST_LIST_RANGE_IMM:
- {
+
+ case INST_LIST_RANGE_IMM: {
/*** lrange with objc==4 and both indices in bytecode stream ***/
int listc, fromIdx, toIdx;
Tcl_Obj **listv;
Tcl_Obj *valuePtr;
-
+
/*
* Pop the list and get the indices
*/
@@ -2876,8 +2832,8 @@ TclExecuteByteCode(interp, codePtr)
toIdx = TclGetInt4AtPtr(pc+5);
/*
- * Get the contents of the list, making sure that it
- * really is a list in the process.
+ * Get the contents of the list, making sure that it really is a list
+ * in the process.
*/
result = Tcl_ListObjGetElements(interp, valuePtr, &listc, &listv);
if (result != TCL_OK) {
@@ -2887,8 +2843,8 @@ TclExecuteByteCode(interp, codePtr)
}
/*
- * Skip a lot of work if we're about to throw the result away
- * (common with uses of [lassign].)
+ * Skip a lot of work if we're about to throw the result away (common
+ * with uses of [lassign].)
*/
#ifndef TCL_COMPILE_DEBUG
if (*(pc+9) == INST_POP) {
@@ -2917,8 +2873,8 @@ TclExecuteByteCode(interp, codePtr)
}
/*
- * Check if we are referring to a valid, non-empty list range,
- * and if so, build the list of elements in that range.
+ * Check if we are referring to a valid, non-empty list range, and if
+ * so, build the list of elements in that range.
*/
if (fromIdx<=toIdx && fromIdx<listc && toIdx>=0) {
if (fromIdx<0) {
@@ -2981,8 +2937,7 @@ TclExecuteByteCode(interp, codePtr)
TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), found));
/*
- * Peep-hole optimisation: if you're about to jump, do jump
- * from here.
+ * Peep-hole optimisation: if you're about to jump, do jump from here.
*/
pc++;
@@ -3003,13 +2958,12 @@ TclExecuteByteCode(interp, codePtr)
}
/*
- * End of INST_LIST and related instructions.
+ * End of INST_LIST and related instructions.
* ---------------------------------------------------------
*/
case INST_STR_EQ:
- case INST_STR_NEQ:
- {
+ case INST_STR_NEQ: {
/*
* String (in)equality check
*/
@@ -3021,8 +2975,8 @@ TclExecuteByteCode(interp, codePtr)
if (valuePtr == value2Ptr) {
/*
- * On the off-chance that the objects are the same,
- * we don't really have to think hard about equality.
+ * On the off-chance that the objects are the same, we don't
+ * really have to think hard about equality.
*/
iResult = (*pc == INST_STR_EQ);
} else {
@@ -3033,8 +2987,8 @@ TclExecuteByteCode(interp, codePtr)
s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
if (s1len == s2len) {
/*
- * We only need to check (in)equality when
- * we have equal length strings.
+ * We only need to check (in)equality when we have equal
+ * length strings.
*/
if (*pc == INST_STR_NEQ) {
iResult = (strcmp(s1, s2) != 0);
@@ -3050,57 +3004,55 @@ TclExecuteByteCode(interp, codePtr)
TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), iResult));
/*
- * Peep-hole optimisation: if you're about to jump, do jump
- * from here.
+ * Peep-hole optimisation: if you're about to jump, do jump from here.
*/
pc++;
#ifndef TCL_COMPILE_DEBUG
switch (*pc) {
- case INST_JUMP_FALSE1:
- NEXT_INST_F((iResult? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
- case INST_JUMP_TRUE1:
- NEXT_INST_F((iResult? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
- case INST_JUMP_FALSE4:
- NEXT_INST_F((iResult? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
- case INST_JUMP_TRUE4:
- NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
+ case INST_JUMP_FALSE1:
+ NEXT_INST_F((iResult? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
+ case INST_JUMP_TRUE1:
+ NEXT_INST_F((iResult? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
+ case INST_JUMP_FALSE4:
+ NEXT_INST_F((iResult? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
+ case INST_JUMP_TRUE4:
+ NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
}
#endif
objResultPtr = eePtr->constants[iResult];
NEXT_INST_F(0, 2, 1);
}
- case INST_STR_CMP:
- {
+ case INST_STR_CMP: {
/*
* String compare
*/
CONST char *s1, *s2;
int s1len, s2len, iResult;
Tcl_Obj *valuePtr, *value2Ptr;
-
+
value2Ptr = *tosPtr;
valuePtr = *(tosPtr - 1);
/*
- * The comparison function should compare up to the
- * minimum byte length only.
+ * The comparison function should compare up to the minimum byte
+ * length only.
*/
if (valuePtr == value2Ptr) {
/*
- * In the pure equality case, set lengths too for
- * the checks below (or we could goto beyond it).
+ * In the pure equality case, set lengths too for the checks below
+ * (or we could goto beyond it).
*/
iResult = s1len = s2len = 0;
} else if ((valuePtr->typePtr == &tclByteArrayType)
- && (value2Ptr->typePtr == &tclByteArrayType)) {
+ && (value2Ptr->typePtr == &tclByteArrayType)) {
s1 = (char *) Tcl_GetByteArrayFromObj(valuePtr, &s1len);
s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
- iResult = memcmp(s1, s2,
- (size_t) ((s1len < s2len) ? s1len : s2len));
+ iResult = memcmp(s1, s2,
+ (size_t) ((s1len < s2len) ? s1len : s2len));
} else if (((valuePtr->typePtr == &tclStringType)
- && (value2Ptr->typePtr == &tclStringType))) {
+ && (value2Ptr->typePtr == &tclStringType))) {
/*
* Do a unicode-specific comparison if both of the args are of
* String type. If the char length == byte length, we can do a
@@ -3120,13 +3072,13 @@ TclExecuteByteCode(interp, codePtr)
}
} else {
/*
- * We can't do a simple memcmp in order to handle the
- * special Tcl \xC0\x80 null encoding for utf-8.
+ * We can't do a simple memcmp in order to handle the special Tcl
+ * \xC0\x80 null encoding for utf-8.
*/
s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
iResult = TclpUtfNcmp2(s1, s2,
- (size_t) ((s1len < s2len) ? s1len : s2len));
+ (size_t) ((s1len < s2len) ? s1len : s2len));
}
/*
@@ -3146,11 +3098,10 @@ TclExecuteByteCode(interp, codePtr)
NEXT_INST_F(1, 2, 1);
}
- case INST_STR_LEN:
- {
+ case INST_STR_LEN: {
int length;
Tcl_Obj *valuePtr;
-
+
valuePtr = *tosPtr;
if (valuePtr->typePtr == &tclByteArrayType) {
@@ -3162,25 +3113,23 @@ TclExecuteByteCode(interp, codePtr)
TRACE(("%.20s => %d\n", O2S(valuePtr), length));
NEXT_INST_F(1, 1, 1);
}
-
- case INST_STR_INDEX:
- {
+
+ case INST_STR_INDEX: {
/*
* String compare
*/
int index, length;
char *bytes;
Tcl_Obj *valuePtr, *value2Ptr;
-
+
bytes = NULL; /* lint */
value2Ptr = *tosPtr;
valuePtr = *(tosPtr - 1);
/*
- * If we have a ByteArray object, avoid indexing in the
- * Utf string since the byte array contains one byte per
- * character. Otherwise, use the Unicode string rep to
- * get the index'th char.
+ * If we have a ByteArray object, avoid indexing in the Utf string
+ * since the byte array contains one byte per character. Otherwise,
+ * use the Unicode string rep to get the index'th char.
*/
if (valuePtr->typePtr == &tclByteArrayType) {
@@ -3200,20 +3149,19 @@ TclExecuteByteCode(interp, codePtr)
if ((index >= 0) && (index < length)) {
if (valuePtr->typePtr == &tclByteArrayType) {
objResultPtr = Tcl_NewByteArrayObj((unsigned char *)
- (&bytes[index]), 1);
+ (&bytes[index]), 1);
} else if (valuePtr->bytes && length == valuePtr->length) {
objResultPtr = Tcl_NewStringObj((CONST char *)
- (&valuePtr->bytes[index]), 1);
+ (&valuePtr->bytes[index]), 1);
} else {
char buf[TCL_UTF_MAX];
Tcl_UniChar ch;
ch = Tcl_GetUniChar(valuePtr, index);
/*
- * This could be:
- * Tcl_NewUnicodeObj((CONST Tcl_UniChar *)&ch, 1)
- * but creating the object as a string seems to be
- * faster in practical use.
+ * This could be: Tcl_NewUnicodeObj((CONST Tcl_UniChar *)&ch,
+ * 1) but creating the object as a string seems to be faster
+ * in practical use.
*/
length = Tcl_UniCharToUtf(ch, buf);
objResultPtr = Tcl_NewStringObj(buf, length);
@@ -3222,27 +3170,26 @@ TclExecuteByteCode(interp, codePtr)
TclNewObj(objResultPtr);
}
- TRACE(("%.20s %.20s => %s\n", O2S(valuePtr), O2S(value2Ptr),
- O2S(objResultPtr)));
+ TRACE(("%.20s %.20s => %s\n", O2S(valuePtr), O2S(value2Ptr),
+ O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
}
- case INST_STR_MATCH:
- {
+ case INST_STR_MATCH: {
int nocase, match;
Tcl_Obj *valuePtr, *value2Ptr;
nocase = TclGetInt1AtPtr(pc+1);
- valuePtr = *tosPtr; /* String */
+ valuePtr = *tosPtr; /* String */
value2Ptr = *(tosPtr - 1); /* Pattern */
/*
- * Check that at least one of the objects is Unicode before
- * promoting both.
+ * Check that at least one of the objects is Unicode before promoting
+ * both.
*/
if ((valuePtr->typePtr == &tclStringType)
- || (value2Ptr->typePtr == &tclStringType)) {
+ || (value2Ptr->typePtr == &tclStringType)) {
Tcl_UniChar *ustring1, *ustring2;
int length1, length2;
@@ -3256,8 +3203,8 @@ TclExecuteByteCode(interp, codePtr)
}
/*
- * Reuse value2Ptr object already on stack if possible.
- * Adjustment is 2 due to the nocase byte
+ * Reuse value2Ptr object already on stack if possible. Adjustment is
+ * 2 due to the nocase byte
*/
TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));
@@ -3270,11 +3217,10 @@ TclExecuteByteCode(interp, codePtr)
case INST_LT:
case INST_GT:
case INST_LE:
- case INST_GE:
- {
+ case INST_GE: {
/*
- * Any type is allowed but the two operands must have the
- * same type. We will compute value op value2.
+ * Any type is allowed but the two operands must have the same type.
+ * We will compute value op value2.
*/
Tcl_ObjType *t1Ptr, *t2Ptr;
@@ -3288,30 +3234,29 @@ TclExecuteByteCode(interp, codePtr)
int length;
Tcl_WideInt w;
long i;
-
+
value2Ptr = *tosPtr;
valuePtr = *(tosPtr - 1);
/*
- * Be careful in the equal-object case; 'NaN' isn't supposed
- * to be equal to even itself. [Bug 761471]
+ * Be careful in the equal-object case; 'NaN' isn't supposed to be
+ * equal to even itself. [Bug 761471]
*/
t1Ptr = valuePtr->typePtr;
if (valuePtr == value2Ptr) {
/*
- * If we are numeric already, or a dictionary (which is
- * never like a single-element list), we can proceed to
- * the main equality check right now. Otherwise, we need
- * to try to coerce to a numeric type so we can see if
- * we've got a NaN but haven't parsed it as numeric.
+ * If we are numeric already, or a dictionary (which is never like
+ * a single-element list), we can proceed to the main equality
+ * check right now. Otherwise, we need to try to coerce to a
+ * numeric type so we can see if we've got a NaN but haven't
+ * parsed it as numeric.
*/
if (!IS_NUMERIC_TYPE(t1Ptr) && (t1Ptr != &tclDictType)) {
if (t1Ptr == &tclListType) {
int length;
/*
- * Only a list of length 1 can be NaN or such
- * things.
+ * Only a list of length 1 can be NaN or such things.
*/
(void) Tcl_ListObjLength(NULL, valuePtr, &length);
if (length == 1) {
@@ -3319,8 +3264,8 @@ TclExecuteByteCode(interp, codePtr)
}
} else {
/*
- * Too bad, we'll have to compute the string and
- * try the conversion
+ * Too bad, we'll have to compute the string and try the
+ * conversion
*/
mustConvertForNaNCheck:
@@ -3357,21 +3302,21 @@ TclExecuteByteCode(interp, codePtr)
t2Ptr = value2Ptr->typePtr;
/*
- * We only want to coerce numeric validation if neither type
- * is NULL. A NULL type means the arg is essentially an empty
- * object ("", {} or [list]).
+ * We only want to coerce numeric validation if neither type is NULL.
+ * A NULL type means the arg is essentially an empty object ("", {} or
+ * [list]).
*/
- if (!( (!t1Ptr && !valuePtr->bytes)
- || (valuePtr->bytes && !valuePtr->length)
- || (!t2Ptr && !value2Ptr->bytes)
- || (value2Ptr->bytes && !value2Ptr->length))) {
+ if (!( (!t1Ptr && !valuePtr->bytes)
+ || (valuePtr->bytes && !valuePtr->length)
+ || (!t2Ptr && !value2Ptr->bytes)
+ || (value2Ptr->bytes && !value2Ptr->length))) {
if (!IS_NUMERIC_TYPE(t1Ptr)) {
s1 = Tcl_GetStringFromObj(valuePtr, &length);
if (TclLooksLikeInt(s1, length)) {
GET_WIDE_OR_INT(iResult, valuePtr, i, w);
} else {
- (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
- valuePtr, &d1);
+ (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
+ valuePtr, &d1);
}
t1Ptr = valuePtr->typePtr;
}
@@ -3381,51 +3326,49 @@ TclExecuteByteCode(interp, codePtr)
GET_WIDE_OR_INT(iResult, value2Ptr, i2, w);
} else {
(void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
- value2Ptr, &d2);
+ value2Ptr, &d2);
}
t2Ptr = value2Ptr->typePtr;
}
}
if (!IS_NUMERIC_TYPE(t1Ptr) || !IS_NUMERIC_TYPE(t2Ptr)) {
/*
- * One operand is not numeric. Compare as strings. NOTE:
- * strcmp is not correct for \x00 < \x01, but that is
- * unlikely to occur here. We could use the TclUtfNCmp2
- * to handle this.
+ * One operand is not numeric. Compare as strings. NOTE: strcmp
+ * is not correct for \x00 < \x01, but that is unlikely to occur
+ * here. We could use the TclUtfNCmp2 to handle this.
*/
int s1len, s2len;
s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
switch (*pc) {
- case INST_EQ:
- if (s1len == s2len) {
- iResult = (strcmp(s1, s2) == 0);
- } else {
- iResult = 0;
- }
- break;
- case INST_NEQ:
- if (s1len == s2len) {
- iResult = (strcmp(s1, s2) != 0);
- } else {
- iResult = 1;
- }
- break;
- case INST_LT:
- iResult = (strcmp(s1, s2) < 0);
- break;
- case INST_GT:
- iResult = (strcmp(s1, s2) > 0);
- break;
- case INST_LE:
- iResult = (strcmp(s1, s2) <= 0);
- break;
- case INST_GE:
- iResult = (strcmp(s1, s2) >= 0);
- break;
+ case INST_EQ:
+ if (s1len == s2len) {
+ iResult = (strcmp(s1, s2) == 0);
+ } else {
+ iResult = 0;
+ }
+ break;
+ case INST_NEQ:
+ if (s1len == s2len) {
+ iResult = (strcmp(s1, s2) != 0);
+ } else {
+ iResult = 1;
+ }
+ break;
+ case INST_LT:
+ iResult = (strcmp(s1, s2) < 0);
+ break;
+ case INST_GT:
+ iResult = (strcmp(s1, s2) > 0);
+ break;
+ case INST_LE:
+ iResult = (strcmp(s1, s2) <= 0);
+ break;
+ case INST_GE:
+ iResult = (strcmp(s1, s2) >= 0);
+ break;
}
- } else if ((t1Ptr == &tclDoubleType)
- || (t2Ptr == &tclDoubleType)) {
+ } else if ((t1Ptr == &tclDoubleType) || (t2Ptr == &tclDoubleType)) {
/*
* Compare as doubles.
*/
@@ -3437,27 +3380,26 @@ TclExecuteByteCode(interp, codePtr)
d2 = value2Ptr->internalRep.doubleValue;
}
switch (*pc) {
- case INST_EQ:
- iResult = d1 == d2;
- break;
- case INST_NEQ:
- iResult = d1 != d2;
- break;
- case INST_LT:
- iResult = d1 < d2;
- break;
- case INST_GT:
- iResult = d1 > d2;
- break;
- case INST_LE:
- iResult = d1 <= d2;
- break;
- case INST_GE:
- iResult = d1 >= d2;
- break;
+ case INST_EQ:
+ iResult = d1 == d2;
+ break;
+ case INST_NEQ:
+ iResult = d1 != d2;
+ break;
+ case INST_LT:
+ iResult = d1 < d2;
+ break;
+ case INST_GT:
+ iResult = d1 > d2;
+ break;
+ case INST_LE:
+ iResult = d1 <= d2;
+ break;
+ case INST_GE:
+ iResult = d1 >= d2;
+ break;
}
- } else if ((t1Ptr == &tclWideIntType)
- || (t2Ptr == &tclWideIntType)) {
+ } else if ((t1Ptr == &tclWideIntType) || (t2Ptr == &tclWideIntType)) {
Tcl_WideInt w2;
/*
* Compare as wide ints (neither are doubles)
@@ -3473,24 +3415,24 @@ TclExecuteByteCode(interp, codePtr)
TclGetWide(w2,value2Ptr);
}
switch (*pc) {
- case INST_EQ:
- iResult = w == w2;
- break;
- case INST_NEQ:
- iResult = w != w2;
- break;
- case INST_LT:
- iResult = w < w2;
- break;
- case INST_GT:
- iResult = w > w2;
- break;
- case INST_LE:
- iResult = w <= w2;
- break;
- case INST_GE:
- iResult = w >= w2;
- break;
+ case INST_EQ:
+ iResult = w == w2;
+ break;
+ case INST_NEQ:
+ iResult = w != w2;
+ break;
+ case INST_LT:
+ iResult = w < w2;
+ break;
+ case INST_GT:
+ iResult = w > w2;
+ break;
+ case INST_LE:
+ iResult = w <= w2;
+ break;
+ case INST_GE:
+ iResult = w >= w2;
+ break;
}
} else {
/*
@@ -3499,46 +3441,45 @@ TclExecuteByteCode(interp, codePtr)
i = valuePtr->internalRep.longValue;
i2 = value2Ptr->internalRep.longValue;
switch (*pc) {
- case INST_EQ:
- iResult = i == i2;
- break;
- case INST_NEQ:
- iResult = i != i2;
- break;
- case INST_LT:
- iResult = i < i2;
- break;
- case INST_GT:
- iResult = i > i2;
- break;
- case INST_LE:
- iResult = i <= i2;
- break;
- case INST_GE:
- iResult = i >= i2;
- break;
+ case INST_EQ:
+ iResult = i == i2;
+ break;
+ case INST_NEQ:
+ iResult = i != i2;
+ break;
+ case INST_LT:
+ iResult = i < i2;
+ break;
+ case INST_GT:
+ iResult = i > i2;
+ break;
+ case INST_LE:
+ iResult = i <= i2;
+ break;
+ case INST_GE:
+ iResult = i >= i2;
+ break;
}
}
TRACE(("%.20s %.20s => %ld\n", O2S(valuePtr), O2S(value2Ptr), iResult));
/*
- * Peep-hole optimisation: if you're about to jump, do jump
- * from here.
+ * Peep-hole optimisation: if you're about to jump, do jump from here.
*/
- foundResult:
+ foundResult:
pc++;
#ifndef TCL_COMPILE_DEBUG
switch (*pc) {
- case INST_JUMP_FALSE1:
- NEXT_INST_F((iResult? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
- case INST_JUMP_TRUE1:
- NEXT_INST_F((iResult? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
- case INST_JUMP_FALSE4:
- NEXT_INST_F((iResult? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
- case INST_JUMP_TRUE4:
- NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
+ case INST_JUMP_FALSE1:
+ NEXT_INST_F((iResult? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
+ case INST_JUMP_TRUE1:
+ NEXT_INST_F((iResult? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
+ case INST_JUMP_FALSE4:
+ NEXT_INST_F((iResult? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
+ case INST_JUMP_TRUE4:
+ NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
}
#endif
objResultPtr = eePtr->constants[iResult];
@@ -3550,8 +3491,7 @@ TclExecuteByteCode(interp, codePtr)
case INST_RSHIFT:
case INST_BITOR:
case INST_BITXOR:
- case INST_BITAND:
- {
+ case INST_BITAND: {
/*
* Only integers are allowed. We compute value op value2.
*/
@@ -3561,9 +3501,9 @@ TclExecuteByteCode(interp, codePtr)
Tcl_WideInt w, w2, wResult = W0;
int doWide = 0;
Tcl_Obj *valuePtr, *value2Ptr;
-
+
value2Ptr = *tosPtr;
- valuePtr = *(tosPtr - 1);
+ valuePtr = *(tosPtr - 1);
if (valuePtr->typePtr == &tclIntType) {
i = valuePtr->internalRep.longValue;
} else if (valuePtr->typePtr == &tclWideIntType) {
@@ -3572,9 +3512,9 @@ TclExecuteByteCode(interp, codePtr)
REQUIRE_WIDE_OR_INT(result, valuePtr, i, w);
if (result != TCL_OK) {
TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n",
- O2S(valuePtr), O2S(value2Ptr),
- (valuePtr->typePtr?
- valuePtr->typePtr->name : "null")));
+ O2S(valuePtr), O2S(value2Ptr),
+ (valuePtr->typePtr?
+ valuePtr->typePtr->name : "null")));
IllegalExprOperandType(interp, pc, valuePtr);
goto checkForCatch;
}
@@ -3587,8 +3527,8 @@ TclExecuteByteCode(interp, codePtr)
REQUIRE_WIDE_OR_INT(result, value2Ptr, i2, w2);
if (result != TCL_OK) {
TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n",
- O2S(valuePtr), O2S(value2Ptr),
- (value2Ptr->typePtr?
+ O2S(valuePtr), O2S(value2Ptr),
+ (value2Ptr->typePtr?
value2Ptr->typePtr->name : "null")));
IllegalExprOperandType(interp, pc, value2Ptr);
goto checkForCatch;
@@ -3598,11 +3538,10 @@ TclExecuteByteCode(interp, codePtr)
switch (*pc) {
case INST_MOD:
/*
- * This code is tricky: C doesn't guarantee much about
- * the quotient or remainder, and results with a negative
- * divisor are not specified. Tcl guarantees that the
- * remainder will have the same sign as the divisor and
- * a smaller absolute value.
+ * This code is tricky: C doesn't guarantee much about the
+ * quotient or remainder, and results with a negative divisor are
+ * not specified. Tcl guarantees that the remainder will have the
+ * same sign as the divisor and a smaller absolute value.
*/
if (value2Ptr->typePtr == &tclWideIntType && w2 == W0) {
if (valuePtr->typePtr == &tclIntType) {
@@ -3621,7 +3560,7 @@ TclExecuteByteCode(interp, codePtr)
goto divideByZero;
}
if (valuePtr->typePtr == &tclWideIntType
- || value2Ptr->typePtr == &tclWideIntType) {
+ || value2Ptr->typePtr == &tclWideIntType) {
Tcl_WideInt wRemainder;
/*
* Promote to wide
@@ -3632,49 +3571,47 @@ TclExecuteByteCode(interp, codePtr)
w2 = Tcl_LongAsWide(i2);
}
if ( w == LLONG_MIN && w2 == -1 ) {
- /* Integer overflow could happen with
- * (LLONG_MIN % -1) even though it
- * is not possible in the code below. */
+ /* Integer overflow could happen with (LLONG_MIN % -1)
+ * even though it is not possible in the code below. */
wRemainder = 0;
} else if ( w == LLONG_MIN && w2 == LLONG_MAX ) {
wRemainder = LLONG_MAX - 1;
} else if ( w2 == LLONG_MIN ) {
- /* In C, a modulus operation is not well
- * defined when the divisor is a negative
- * number. So w % LLONG_MIN is not well
- * defined in the code below because
- * -LLONG_MIN is still a negative number.
+ /*
+ * In C, a modulus operation is not well defined when the
+ * divisor is a negative number. So w % LLONG_MIN is not
+ * well defined in the code below because -LLONG_MIN is
+ * still a negative number.
*/
if (w == 0 || w == LLONG_MIN) {
- wRemainder = 0;
+ wRemainder = 0;
} else if (w < 0) {
- wRemainder = w;
+ wRemainder = w;
} else {
- wRemainder = LLONG_MIN + w;
+ wRemainder = LLONG_MIN + w;
}
neg_divisor = 1;
} else {
if (w2 < 0) {
- w2 = -w2;
- w = -w; /* Note: -LLONG_MIN == LLONG_MIN */
- neg_divisor = 1;
+ w2 = -w2;
+ w = -w; /* Note: -LLONG_MIN == LLONG_MIN */
+ neg_divisor = 1;
}
wRemainder = w % w2;
/*
- * remainder is (remainder + divisor) when the
- * remainder is negative. Watch out for the
- * special case of a LLONG_MIN dividend and
- * a negative divisor. Don't add the divisor
- * in that case because the remainder should
+ * remainder is (remainder + divisor) when the remainder
+ * is negative. Watch out for the special case of a
+ * LLONG_MIN dividend and a negative divisor. Don't add
+ * the divisor in that case because the remainder should
* not be negative.
*/
if (wRemainder < 0 && !(neg_divisor && (w == LLONG_MIN))) {
- wRemainder += w2;
+ wRemainder += w2;
}
}
if ((neg_divisor && (wRemainder > 0)) ||
- (!neg_divisor && (wRemainder < 0))) {
+ (!neg_divisor && (wRemainder < 0))) {
wRemainder = -wRemainder;
}
wResult = wRemainder;
@@ -3683,18 +3620,19 @@ TclExecuteByteCode(interp, codePtr)
}
if ( i == LONG_MIN && i2 == -1 ) {
- /* Integer overflow could happen with
- * (LONG_MIN % -1) even though it
- * is not possible in the code below. */
+ /*
+ * Integer overflow could happen with (LONG_MIN % -1) even
+ * though it is not possible in the code below.
+ */
rem = 0;
} else if ( i == LONG_MIN && i2 == LONG_MAX ) {
rem = LONG_MAX - 1;
} else if ( i2 == LONG_MIN ) {
- /* In C, a modulus operation is not well
- * defined when the divisor is a negative
- * number. So i % LONG_MIN is not well
- * defined in the code below because
- * -LONG_MIN is still a negative number.
+ /*
+ * In C, a modulus operation is not well defined when the
+ * divisor is a negative number. So i % LONG_MIN is not well
+ * defined in the code below because -LONG_MIN is still a
+ * negative number.
*/
if (i == 0 || i == LONG_MIN) {
rem = 0;
@@ -3713,12 +3651,10 @@ TclExecuteByteCode(interp, codePtr)
rem = i % i2;
/*
- * remainder is (remainder + divisor) when the
- * remainder is negative. Watch out for the
- * special case of a LONG_MIN dividend and
- * a negative divisor. Don't add the divisor
- * in that case because the remainder should
- * not be negative.
+ * remainder is (remainder + divisor) when the remainder is
+ * negative. Watch out for the special case of a LONG_MIN
+ * dividend and a negative divisor. Don't add the divisor in
+ * that case because the remainder should not be negative.
*/
if (rem < 0 && !(neg_divisor && (i == LONG_MIN))) {
rem += i2;
@@ -3761,8 +3697,8 @@ TclExecuteByteCode(interp, codePtr)
break;
}
/*
- * Shift in steps when the shift gets large to prevent
- * annoying compiler/processor bugs. [Bug 868467]
+ * Shift in steps when the shift gets large to prevent annoying
+ * compiler/processor bugs. [Bug 868467]
*/
if (i2 >= 64) {
iResult = 0;
@@ -3779,9 +3715,9 @@ TclExecuteByteCode(interp, codePtr)
break;
case INST_RSHIFT:
/*
- * The following code is a bit tricky: it ensures that
- * right shifts propagate the sign bit even on machines
- * where ">>" won't do it by default.
+ * The following code is a bit tricky: it ensures that right
+ * shifts propagate the sign bit even on machines where ">>" won't
+ * do it by default.
*/
/*
* Shifts are never usefully 64-bits wide!
@@ -3824,8 +3760,8 @@ TclExecuteByteCode(interp, codePtr)
iResult = i;
}
/*
- * Shift in steps when the shift gets large to prevent
- * annoying compiler/processor bugs. [Bug 868467]
+ * Shift in steps when the shift gets large to prevent annoying
+ * compiler/processor bugs. [Bug 868467]
*/
if (i2 >= 64) {
iResult = 0;
@@ -3845,7 +3781,7 @@ TclExecuteByteCode(interp, codePtr)
break;
case INST_BITOR:
if (valuePtr->typePtr == &tclWideIntType
- || value2Ptr->typePtr == &tclWideIntType) {
+ || value2Ptr->typePtr == &tclWideIntType) {
/*
* Promote to wide
*/
@@ -3862,7 +3798,7 @@ TclExecuteByteCode(interp, codePtr)
break;
case INST_BITXOR:
if (valuePtr->typePtr == &tclWideIntType
- || value2Ptr->typePtr == &tclWideIntType) {
+ || value2Ptr->typePtr == &tclWideIntType) {
/*
* Promote to wide
*/
@@ -3879,7 +3815,7 @@ TclExecuteByteCode(interp, codePtr)
break;
case INST_BITAND:
if (valuePtr->typePtr == &tclWideIntType
- || value2Ptr->typePtr == &tclWideIntType) {
+ || value2Ptr->typePtr == &tclWideIntType) {
/*
* Promote to wide
*/
@@ -3899,7 +3835,7 @@ TclExecuteByteCode(interp, codePtr)
/*
* Reuse the valuePtr object already on stack if possible.
*/
-
+
if (Tcl_IsShared(valuePtr)) {
if (doWide) {
TclNewWideIntObj(objResultPtr, wResult);
@@ -3925,40 +3861,38 @@ TclExecuteByteCode(interp, codePtr)
case INST_SUB:
case INST_MULT:
case INST_DIV:
- case INST_EXPON:
- {
+ case INST_EXPON: {
/*
- * Operands must be numeric and ints get converted to floats
- * if necessary. We compute value op value2.
+ * Operands must be numeric and ints get converted to floats if
+ * necessary. We compute value op value2.
*/
Tcl_ObjType *t1Ptr, *t2Ptr;
long i = 0, i2 = 0, quot; /* Init. avoids compiler warning. */
double d1, d2;
- long iResult = 0; /* Init. avoids compiler warning. */
- double dResult = 0.0; /* Init. avoids compiler warning. */
- int doDouble = 0; /* 1 if doing floating arithmetic */
+ long iResult = 0; /* Init. avoids compiler warning. */
+ double dResult = 0.0; /* Init. avoids compiler warning. */
+ int doDouble = 0; /* 1 if doing floating arithmetic */
Tcl_WideInt w, w2, wquot;
- Tcl_WideInt wResult = W0; /* Init. avoids compiler warning. */
- int doWide = 0; /* 1 if doing wide arithmetic. */
+ Tcl_WideInt wResult = W0; /* Init. avoids compiler warning. */
+ int doWide = 0; /* 1 if doing wide arithmetic. */
Tcl_Obj *valuePtr,*value2Ptr;
int length;
-
+
value2Ptr = *tosPtr;
valuePtr = *(tosPtr - 1);
t1Ptr = valuePtr->typePtr;
t2Ptr = value2Ptr->typePtr;
-
+
if (t1Ptr == &tclIntType) {
i = valuePtr->internalRep.longValue;
} else if (t1Ptr == &tclWideIntType) {
TclGetWide(w,valuePtr);
- } else if ((t1Ptr == &tclDoubleType)
- && (valuePtr->bytes == NULL)) {
+ } else if ((t1Ptr == &tclDoubleType) && (valuePtr->bytes == NULL)) {
/*
- * We can only use the internal rep directly if there is
- * no string rep. Otherwise the string rep might actually
- * look like an integer, which is preferred.
+ * We can only use the internal rep directly if there is no string
+ * rep. Otherwise the string rep might actually look like an
+ * integer, which is preferred.
*/
d1 = valuePtr->internalRep.doubleValue;
@@ -3968,13 +3902,12 @@ TclExecuteByteCode(interp, codePtr)
GET_WIDE_OR_INT(result, valuePtr, i, w);
} else {
result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
- valuePtr, &d1);
+ valuePtr, &d1);
}
if (result != TCL_OK) {
TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n",
- s, O2S(valuePtr),
- (valuePtr->typePtr?
- valuePtr->typePtr->name : "null")));
+ s, O2S(valuePtr),
+ (valuePtr->typePtr? valuePtr->typePtr->name: "null")));
IllegalExprOperandType(interp, pc, valuePtr);
goto checkForCatch;
}
@@ -3985,12 +3918,11 @@ TclExecuteByteCode(interp, codePtr)
i2 = value2Ptr->internalRep.longValue;
} else if (t2Ptr == &tclWideIntType) {
TclGetWide(w2,value2Ptr);
- } else if ((t2Ptr == &tclDoubleType)
- && (value2Ptr->bytes == NULL)) {
+ } else if ((t2Ptr == &tclDoubleType) && (value2Ptr->bytes == NULL)) {
/*
- * We can only use the internal rep directly if there is
- * no string rep. Otherwise the string rep might actually
- * look like an integer, which is preferred.
+ * We can only use the internal rep directly if there is no string
+ * rep. Otherwise the string rep might actually look like an
+ * integer, which is preferred.
*/
d2 = value2Ptr->internalRep.doubleValue;
@@ -4000,12 +3932,12 @@ TclExecuteByteCode(interp, codePtr)
GET_WIDE_OR_INT(result, value2Ptr, i2, w2);
} else {
result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
- value2Ptr, &d2);
+ value2Ptr, &d2);
}
if (result != TCL_OK) {
TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n",
- O2S(value2Ptr), s,
- (value2Ptr->typePtr?
+ O2S(value2Ptr), s,
+ (value2Ptr->typePtr?
value2Ptr->typePtr->name : "null")));
IllegalExprOperandType(interp, pc, value2Ptr);
goto checkForCatch;
@@ -4019,61 +3951,59 @@ TclExecuteByteCode(interp, codePtr)
*/
doDouble = 1;
if (t1Ptr == &tclIntType) {
- d1 = i; /* promote value 1 to double */
+ d1 = i; /* promote value 1 to double */
} else if (t2Ptr == &tclIntType) {
- d2 = i2; /* promote value 2 to double */
+ d2 = i2; /* promote value 2 to double */
} else if (t1Ptr == &tclWideIntType) {
d1 = Tcl_WideAsDouble(w);
} else if (t2Ptr == &tclWideIntType) {
d2 = Tcl_WideAsDouble(w2);
}
switch (*pc) {
- case INST_ADD:
- dResult = d1 + d2;
- break;
- case INST_SUB:
- dResult = d1 - d2;
- break;
- case INST_MULT:
- dResult = d1 * d2;
- break;
- case INST_DIV:
+ case INST_ADD:
+ dResult = d1 + d2;
+ break;
+ case INST_SUB:
+ dResult = d1 - d2;
+ break;
+ case INST_MULT:
+ dResult = d1 * d2;
+ break;
+ case INST_DIV:
#ifndef IEEE_FLOATING_POINT
- if (d2 == 0.0) {
- TRACE(("%.6g %.6g => DIVIDE BY ZERO\n", d1, d2));
- goto divideByZero;
- }
+ if (d2 == 0.0) {
+ TRACE(("%.6g %.6g => DIVIDE BY ZERO\n", d1, d2));
+ goto divideByZero;
+ }
#endif
- /*
- * We presume that we are running with zero-divide
- * unmasked if we're on an IEEE box. Otherwise,
- * this statement might cause demons to fly out
- * our noses.
- */
- dResult = d1 / d2;
- break;
- case INST_EXPON:
- if (d1==0.0 && d2<0.0) {
- TRACE(("%.6g %.6g => EXPONENT OF ZERO\n", d1, d2));
- goto exponOfZero;
- }
- dResult = pow(d1, d2);
- break;
+ /*
+ * We presume that we are running with zero-divide unmasked if
+ * we're on an IEEE box. Otherwise, this statement might cause
+ * demons to fly out our noses.
+ */
+ dResult = d1 / d2;
+ break;
+ case INST_EXPON:
+ if (d1==0.0 && d2<0.0) {
+ TRACE(("%.6g %.6g => EXPONENT OF ZERO\n", d1, d2));
+ goto exponOfZero;
+ }
+ dResult = pow(d1, d2);
+ break;
}
-
+
/*
* Check now for IEEE floating-point error.
*/
-
+
if (IS_NAN(dResult)) {
TRACE(("%.20s %.20s => IEEE FLOATING PT ERROR\n",
- O2S(valuePtr), O2S(value2Ptr)));
+ O2S(valuePtr), O2S(value2Ptr)));
TclExprFloatError(interp, dResult);
result = TCL_ERROR;
goto checkForCatch;
}
- } else if ((t1Ptr == &tclWideIntType)
- || (t2Ptr == &tclWideIntType)) {
+ } else if ((t1Ptr == &tclWideIntType) || (t2Ptr == &tclWideIntType)) {
/*
* Do wide integer arithmetic.
*/
@@ -4084,123 +4014,117 @@ TclExecuteByteCode(interp, codePtr)
w2 = Tcl_LongAsWide(i2);
}
switch (*pc) {
- case INST_ADD:
- wResult = w + w2;
- break;
- case INST_SUB:
- wResult = w - w2;
- break;
- case INST_MULT:
- wResult = w * w2;
- break;
- case INST_DIV:
+ case INST_ADD:
+ wResult = w + w2;
+ break;
+ case INST_SUB:
+ wResult = w - w2;
+ break;
+ case INST_MULT:
+ wResult = w * w2;
+ break;
+ case INST_DIV:
+ /*
+ * When performing integer division, protect against integer
+ * overflow. Round towards zero when the quotient is positive,
+ * otherwise round towards -Infinity.
+ */
+ if (w2 == W0) {
+ TRACE((LLD" "LLD" => DIVIDE BY ZERO\n", w, w2));
+ goto divideByZero;
+ }
+ if (w == LLONG_MIN && w2 == -1) {
+ /* Avoid integer overflow on (LLONG_MIN / -1) */
+ wquot = LLONG_MIN;
+ } else {
+ wquot = w / w2;
/*
- * When performing integer division, protect
- * against integer overflow. Round towards zero
- * when the quotient is positive, otherwise
- * round towards -Infinity.
+ * Round down to a smaller negative number if there is a
+ * remainder and the quotient is negative or zero and the
+ * signs don't match. Note that we don't use a modulus to
+ * find the remainder since it is not well defined in C
+ * when the divisor is negative.
*/
- if (w2 == W0) {
- TRACE((LLD" "LLD" => DIVIDE BY ZERO\n", w, w2));
- goto divideByZero;
+ if (((wquot < 0) || ((wquot == 0) &&
+ ((w < 0 && w2 > 0) || (w > 0 && w2 < 0)))) &&
+ ((wquot * w2) != w)) {
+ wquot -= 1;
}
- if (w == LLONG_MIN && w2 == -1) {
- /* Avoid integer overflow on (LLONG_MIN / -1) */
- wquot = LLONG_MIN;
- } else {
- wquot = w / w2;
- /* Round down to a smaller negative number if
- * there is a remainder and the quotient is
- * negative or zero and the signs don't match.
- * Note that we don't use a modulus to find the
- * remainder since it is not well defined in C
- * when the divisor is negative.
- */
- if (((wquot < 0) ||
- ((wquot == 0) &&
- (((w < 0) && (w2 > 0)) ||
- ((w > 0) && (w2 < 0))))) &&
- ((wquot * w2) != w)) {
- wquot -= 1;
- }
- }
- wResult = wquot;
- break;
- case INST_EXPON: {
- int errExpon;
-
- wResult = ExponWide(w, w2, &errExpon);
- if (errExpon) {
- TRACE((LLD" "LLD" => EXPONENT OF ZERO\n", w, w2));
- goto exponOfZero;
- }
- break;
}
+ wResult = wquot;
+ break;
+ case INST_EXPON: {
+ int errExpon;
+
+ wResult = ExponWide(w, w2, &errExpon);
+ if (errExpon) {
+ TRACE((LLD" "LLD" => EXPONENT OF ZERO\n", w, w2));
+ goto exponOfZero;
+ }
+ break;
+ }
}
} else {
/*
* Do integer arithmetic.
*/
switch (*pc) {
- case INST_ADD:
- iResult = i + i2;
- break;
- case INST_SUB:
- iResult = i - i2;
- break;
- case INST_MULT:
- iResult = i * i2;
- break;
- case INST_DIV:
+ case INST_ADD:
+ iResult = i + i2;
+ break;
+ case INST_SUB:
+ iResult = i - i2;
+ break;
+ case INST_MULT:
+ iResult = i * i2;
+ break;
+ case INST_DIV:
+ /*
+ * When performing integer division, protect against integer
+ * overflow. Round towards zero when the quotient is positive,
+ * otherwise round towards -Infinity.
+ */
+ if (i2 == 0) {
+ TRACE(("%ld %ld => DIVIDE BY ZERO\n", i, i2));
+ goto divideByZero;
+ }
+ if (i == LONG_MIN && i2 == -1) {
+ /* Avoid integer overflow on (LONG_MIN / -1) */
+ quot = LONG_MIN;
+ } else {
+ quot = i / i2;
/*
- * When performing integer division, protect
- * against integer overflow. Round towards zero
- * when the quotient is positive, otherwise
- * round towards -Infinity.
+ * Round down to a smaller negative number if there is a
+ * remainder and the quotient is negative or zero and the
+ * signs don't match. Note that we don't use a modulus to
+ * find the remainder since it is not well defined in C
+ * when the divisor is negative.
*/
- if (i2 == 0) {
- TRACE(("%ld %ld => DIVIDE BY ZERO\n", i, i2));
- goto divideByZero;
+ if (((quot < 0) || ((quot == 0) &&
+ ((i<0 && i2>0) || (i>0 && i2<0)))) &&
+ ((quot * i2) != i)) {
+ quot -= 1;
}
- if (i == LONG_MIN && i2 == -1) {
- /* Avoid integer overflow on (LONG_MIN / -1) */
- quot = LONG_MIN;
- } else {
- quot = i / i2;
- /* Round down to a smaller negative number if
- * there is a remainder and the quotient is
- * negative or zero and the signs don't match.
- * Note that we don't use a modulus to find the
- * remainder since it is not well defined in C
- * when the divisor is negative.
- */
- if (((quot < 0) ||
- ((quot == 0) &&
- (((i < 0) && (i2 > 0)) ||
- ((i > 0) && (i2 < 0))))) &&
- ((quot * i2) != i)) {
- quot -= 1;
- }
- }
- iResult = quot;
- break;
- case INST_EXPON: {
- int errExpon;
-
- iResult = ExponLong(i, i2, &errExpon);
- if (errExpon) {
- TRACE(("%ld %ld => EXPONENT OF ZERO\n", i, i2));
- goto exponOfZero;
- }
- break;
}
+ iResult = quot;
+ break;
+ case INST_EXPON: {
+ int errExpon;
+
+ iResult = ExponLong(i, i2, &errExpon);
+ if (errExpon) {
+ TRACE(("%ld %ld => EXPONENT OF ZERO\n", i, i2));
+ goto exponOfZero;
+ }
+ break;
+ }
}
}
/*
* Reuse the valuePtr object already on stack if possible.
*/
-
+
if (Tcl_IsShared(valuePtr)) {
if (doDouble) {
TclNewDoubleObj(objResultPtr, dResult);
@@ -4211,7 +4135,7 @@ TclExecuteByteCode(interp, codePtr)
} else {
TclNewLongObj(objResultPtr, iResult);
TRACE(("%ld %ld => %ld\n", i, i2, iResult));
- }
+ }
NEXT_INST_F(1, 2, 1);
} else { /* reuse the valuePtr object */
if (doDouble) { /* NB: stack top is off by 1 */
@@ -4228,8 +4152,7 @@ TclExecuteByteCode(interp, codePtr)
}
}
- case INST_UPLUS:
- {
+ case INST_UPLUS: {
/*
* Operand must be numeric.
*/
@@ -4237,24 +4160,24 @@ TclExecuteByteCode(interp, codePtr)
double d;
Tcl_ObjType *tPtr;
Tcl_Obj *valuePtr;
-
+
valuePtr = *tosPtr;
tPtr = valuePtr->typePtr;
- if (IS_INTEGER_TYPE(tPtr)
+ if (IS_INTEGER_TYPE(tPtr)
|| ((tPtr == &tclDoubleType) && (valuePtr->bytes == NULL))) {
/*
- * We already have a numeric internal rep, either some kind
- * of integer, or a "pure" double. (Need "pure" so that we
- * know the string rep of the double would not prefer to be
- * interpreted as an integer.)
+ * We already have a numeric internal rep, either some kind of
+ * integer, or a "pure" double. (Need "pure" so that we know the
+ * string rep of the double would not prefer to be interpreted as
+ * an integer.)
*/
} else {
/*
- * Otherwise, we need to generate a numeric internal rep.
- * from the string rep.
+ * Otherwise, we need to generate a numeric internal rep. from
+ * the string rep.
*/
int length;
- long i; /* Set but never used, needed in GET_WIDE_OR_INT */
+ long i; /* Set but never used, needed in GET_WIDE_OR_INT */
Tcl_WideInt w;
char *s = Tcl_GetStringFromObj(valuePtr, &length);
@@ -4263,9 +4186,9 @@ TclExecuteByteCode(interp, codePtr)
} else {
result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
}
- if (result != TCL_OK) {
+ if (result != TCL_OK) {
TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n",
- s, (tPtr? tPtr->name : "null")));
+ s, (tPtr? tPtr->name : "null")));
IllegalExprOperandType(interp, pc, valuePtr);
goto checkForCatch;
}
@@ -4273,12 +4196,11 @@ TclExecuteByteCode(interp, codePtr)
}
/*
- * Ensure that the operand's string rep is the same as the
- * formatted version of its internal rep. This makes sure
- * that "expr +000123" yields "83", not "000123". We
- * implement this by _discarding_ the string rep since we
- * know it will be regenerated, if needed later, by
- * formatting the internal rep's value.
+ * Ensure that the operand's string rep is the same as the formatted
+ * version of its internal rep. This makes sure that "expr +000123"
+ * yields "83", not "000123". We implement this by _discarding_ the
+ * string rep since we know it will be regenerated, if needed later,
+ * by formatting the internal rep's value.
*/
if (Tcl_IsShared(valuePtr)) {
@@ -4300,16 +4222,14 @@ TclExecuteByteCode(interp, codePtr)
NEXT_INST_F(1, 0, 0);
}
}
-
+
case INST_UMINUS:
- case INST_LNOT:
- {
+ case INST_LNOT: {
/*
- * The operand must be numeric or a boolean string as
- * accepted by Tcl_GetBooleanFromObj(). If the operand
- * object is unshared modify it directly, otherwise
- * create a copy to modify: this is "copy on write".
- * Free any old string representation since it is now
+ * The operand must be numeric or a boolean string as accepted by
+ * Tcl_GetBooleanFromObj(). If the operand object is unshared modify
+ * it directly, otherwise create a copy to modify: this is "copy on
+ * write". Free any old string representation since it is now
* invalid.
*/
@@ -4323,18 +4243,18 @@ TclExecuteByteCode(interp, codePtr)
valuePtr = *tosPtr;
tPtr = valuePtr->typePtr;
- if (IS_INTEGER_TYPE(tPtr)
+ if (IS_INTEGER_TYPE(tPtr)
|| ((tPtr == &tclDoubleType) && (valuePtr->bytes == NULL))) {
/*
- * We already have a numeric internal rep, either some kind
- * of integer, or a "pure" double. (Need "pure" so that we
- * know the string rep of the double would not prefer to be
- * interpreted as an integer.)
+ * We already have a numeric internal rep, either some kind of
+ * integer, or a "pure" double. (Need "pure" so that we know the
+ * string rep of the double would not prefer to be interpreted as
+ * an integer.)
*/
} else {
/*
- * Otherwise, we need to generate a numeric internal rep.
- * from the string rep.
+ * Otherwise, we need to generate a numeric internal rep. from
+ * the string rep.
*/
int length;
char *s = Tcl_GetStringFromObj(valuePtr, &length);
@@ -4342,17 +4262,16 @@ TclExecuteByteCode(interp, codePtr)
GET_WIDE_OR_INT(result, valuePtr, i, w);
/*
- * An integer was parsed. If parsing a literal that
- * is the smallest long value, then it would have
- * been promoted to a wide since it would not fit in
- * a long type without the leading '-'. Convert
- * back to the smallest possible long.
+ * An integer was parsed. If parsing a literal that is the
+ * smallest long value, then it would have been promoted to a
+ * wide since it would not fit in a long type without the
+ * leading '-'. Convert back to the smallest possible long.
*/
if ((result == TCL_OK) &&
- (*pc == INST_UMINUS) &&
- (valuePtr->typePtr == &tclWideIntType) &&
- (w == -Tcl_LongAsWide(LONG_MIN))) {
+ (*pc == INST_UMINUS) &&
+ (valuePtr->typePtr == &tclWideIntType) &&
+ (w == -Tcl_LongAsWide(LONG_MIN))) {
valuePtr->typePtr = &tclIntType;
valuePtr->internalRep.longValue = LONG_MIN;
negate_value = 0;
@@ -4381,10 +4300,10 @@ TclExecuteByteCode(interp, codePtr)
if (tPtr == &tclIntType) {
i = valuePtr->internalRep.longValue;
if (negate_value) {
- i = -i;
+ i = -i;
}
TclNewLongObj(objResultPtr, i);
- TRACE_WITH_OBJ(("%ld => ", i), objResultPtr);
+ TRACE_WITH_OBJ(("%ld => ", i), objResultPtr);
} else if (tPtr == &tclWideIntType) {
TclGetWide(w,valuePtr);
TclNewWideIntObj(objResultPtr, -w);
@@ -4402,7 +4321,7 @@ TclExecuteByteCode(interp, codePtr)
if (tPtr == &tclIntType) {
i = valuePtr->internalRep.longValue;
if (negate_value) {
- i = -i;
+ i = -i;
}
TclSetLongObj(valuePtr, i);
TRACE_WITH_OBJ(("%ld => ", i), valuePtr);
@@ -4434,15 +4353,13 @@ TclExecuteByteCode(interp, codePtr)
}
}
- case INST_BITNOT:
- {
+ case INST_BITNOT: {
/*
- * The operand must be an integer. If the operand object is
- * unshared modify it directly, otherwise modify a copy.
- * Free any old string representation since it is now
- * invalid.
+ * The operand must be an integer. If the operand object is unshared
+ * modify it directly, otherwise modify a copy. Free any old string
+ * representation since it is now invalid.
*/
-
+
Tcl_ObjType *tPtr;
Tcl_Obj *valuePtr;
Tcl_WideInt w;
@@ -4454,12 +4371,12 @@ TclExecuteByteCode(interp, codePtr)
REQUIRE_WIDE_OR_INT(result, valuePtr, i, w);
if (result != TCL_OK) { /* try to convert to double */
TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n",
- O2S(valuePtr), (tPtr? tPtr->name : "null")));
+ O2S(valuePtr), (tPtr? tPtr->name : "null")));
IllegalExprOperandType(interp, pc, valuePtr);
goto checkForCatch;
}
}
-
+
if (valuePtr->typePtr == &tclWideIntType) {
TclGetWide(w,valuePtr);
if (Tcl_IsShared(valuePtr)) {
@@ -4491,25 +4408,22 @@ TclExecuteByteCode(interp, codePtr)
}
}
- case INST_CALL_BUILTIN_FUNC1:
- {
- Tcl_Panic("TclExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found");
- }
-
- case INST_CALL_FUNC1:
- {
- Tcl_Panic("TclExecuteByteCode: obsolete INST_CALL_FUNC1 found");
- }
+ case INST_CALL_BUILTIN_FUNC1: {
+ Tcl_Panic("TclExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found");
+ }
- case INST_TRY_CVT_TO_NUMERIC:
- {
+ case INST_CALL_FUNC1: {
+ Tcl_Panic("TclExecuteByteCode: obsolete INST_CALL_FUNC1 found");
+ }
+
+ case INST_TRY_CVT_TO_NUMERIC: {
/*
- * Try to convert the topmost stack object to an int or
- * double object. This is done in order to support Tcl's
- * policy of interpreting operands if at all possible as
- * first integers, else floating-point numbers.
+ * Try to convert the topmost stack object to an int or double object.
+ * This is done in order to support Tcl's policy of interpreting
+ * operands if at all possible as first integers, else floating-point
+ * numbers.
*/
-
+
double d;
char *s;
Tcl_ObjType *tPtr;
@@ -4517,22 +4431,22 @@ TclExecuteByteCode(interp, codePtr)
Tcl_Obj *valuePtr;
long i;
Tcl_WideInt w;
-
+
valuePtr = *tosPtr;
tPtr = valuePtr->typePtr;
converted = 0;
- if (IS_INTEGER_TYPE(tPtr)
+ if (IS_INTEGER_TYPE(tPtr)
|| ((tPtr == &tclDoubleType) && (valuePtr->bytes == NULL))) {
/*
- * We already have a numeric internal rep, either some kind
- * of integer, or a "pure" double. (Need "pure" so that we
- * know the string rep of the double would not prefer to be
- * interpreted as an integer.)
+ * We already have a numeric internal rep, either some kind of
+ * integer, or a "pure" double. (Need "pure" so that we know the
+ * string rep of the double would not prefer to be interpreted as
+ * an integer.)
*/
} else {
/*
- * Otherwise, we need to generate a numeric internal rep.
- * from the string rep.
+ * Otherwise, we need to generate a numeric internal rep. from
+ * the string rep.
*/
s = Tcl_GetStringFromObj(valuePtr, &length);
if (TclLooksLikeInt(s, length)) {
@@ -4548,24 +4462,23 @@ TclExecuteByteCode(interp, codePtr)
}
/*
- * Ensure that the topmost stack object, if numeric, has a
- * string rep the same as the formatted version of its
- * internal rep. This is used, e.g., to make sure that "expr
- * {0001}" yields "1", not "0001". We implement this by
- * _discarding_ the string rep since we know it will be
- * regenerated, if needed later, by formatting the internal
- * rep's value. Also check if there has been an IEEE
- * floating point error.
+ * Ensure that the topmost stack object, if numeric, has a string rep
+ * the same as the formatted version of its internal rep. This is
+ * used, e.g., to make sure that "expr {0001}" yields "1", not
+ * "0001". We implement this by _discarding_ the string rep since we
+ * know it will be regenerated, if needed later, by formatting the
+ * internal rep's value. Also check if there has been an IEEE floating
+ * point error.
*/
-
+
objResultPtr = valuePtr;
needNew = 0;
if (IS_NUMERIC_TYPE(tPtr)) {
if (Tcl_IsShared(valuePtr)) {
if (valuePtr->bytes != NULL) {
/*
- * We only need to make a copy of the object
- * when it already had a string rep
+ * We only need to make a copy of the object when it
+ * already had a string rep
*/
needNew = 1;
if (tPtr == &tclIntType) {
@@ -4583,12 +4496,12 @@ TclExecuteByteCode(interp, codePtr)
} else {
Tcl_InvalidateStringRep(valuePtr);
}
-
+
if (tPtr == &tclDoubleType) {
d = objResultPtr->internalRep.doubleValue;
if (IS_NAN(d)) {
TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n",
- O2S(objResultPtr)));
+ O2S(objResultPtr)));
TclExprFloatError(interp, d);
result = TCL_ERROR;
goto checkForCatch;
@@ -4596,7 +4509,7 @@ TclExecuteByteCode(interp, codePtr)
}
converted = converted; /* lint, converted not used. */
TRACE(("\"%.20s\" => numeric, %s, %s\n", O2S(valuePtr),
- (converted? "converted" : "not converted"),
+ (converted? "converted" : "not converted"),
(needNew? "new Tcl_Obj" : "same Tcl_Obj")));
} else {
TRACE(("\"%.20s\" => not numeric\n", O2S(valuePtr)));
@@ -4607,7 +4520,7 @@ TclExecuteByteCode(interp, codePtr)
NEXT_INST_F(1, 0, 0);
}
}
-
+
case INST_BREAK:
DECACHE_STACK_INFO();
Tcl_ResetResult(interp);
@@ -4624,203 +4537,198 @@ TclExecuteByteCode(interp, codePtr)
cleanup = 0;
goto processExceptionReturn;
- case INST_FOREACH_START4:
- {
- /*
- * Initialize the temporary local var that holds the count
- * of the number of iterations of the loop body to -1.
- */
+ case INST_FOREACH_START4: {
+ /*
+ * Initialize the temporary local var that holds the count of the
+ * number of iterations of the loop body to -1.
+ */
- int opnd;
- ForeachInfo *infoPtr;
- int iterTmpIndex;
- Var *iterVarPtr;
- Tcl_Obj *oldValuePtr;
+ int opnd;
+ ForeachInfo *infoPtr;
+ int iterTmpIndex;
+ Var *iterVarPtr;
+ Tcl_Obj *oldValuePtr;
- opnd = TclGetUInt4AtPtr(pc+1);
- infoPtr = (ForeachInfo *)
- codePtr->auxDataArrayPtr[opnd].clientData;
- iterTmpIndex = infoPtr->loopCtTemp;
- iterVarPtr = &(compiledLocals[iterTmpIndex]);
- oldValuePtr = iterVarPtr->value.objPtr;
-
- if (oldValuePtr == NULL) {
- TclNewLongObj(iterVarPtr->value.objPtr, -1);
- Tcl_IncrRefCount(iterVarPtr->value.objPtr);
- } else {
- TclSetLongObj(oldValuePtr, -1);
- }
- TclSetVarScalar(iterVarPtr);
- TclClearVarUndefined(iterVarPtr);
- TRACE(("%u => loop iter count temp %d\n",
- opnd, iterTmpIndex));
+ opnd = TclGetUInt4AtPtr(pc+1);
+ infoPtr = (ForeachInfo *) codePtr->auxDataArrayPtr[opnd].clientData;
+ iterTmpIndex = infoPtr->loopCtTemp;
+ iterVarPtr = &(compiledLocals[iterTmpIndex]);
+ oldValuePtr = iterVarPtr->value.objPtr;
+
+ if (oldValuePtr == NULL) {
+ TclNewLongObj(iterVarPtr->value.objPtr, -1);
+ Tcl_IncrRefCount(iterVarPtr->value.objPtr);
+ } else {
+ TclSetLongObj(oldValuePtr, -1);
}
-
+ TclSetVarScalar(iterVarPtr);
+ TclClearVarUndefined(iterVarPtr);
+ TRACE(("%u => loop iter count temp %d\n", opnd, iterTmpIndex));
+
#ifndef TCL_COMPILE_DEBUG
- /*
- * Remark that the compiler ALWAYS sets INST_FOREACH_STEP4
- * immediately after INST_FOREACH_START4 - let us just fall
- * through instead of jumping back to the top.
+ /*
+ * Remark that the compiler ALWAYS sets INST_FOREACH_STEP4 immediately
+ * after INST_FOREACH_START4 - let us just fall through instead of
+ * jumping back to the top.
*/
pc += 5;
#else
NEXT_INST_F(5, 0, 0);
-#endif
- case INST_FOREACH_STEP4:
- {
- /*
- * "Step" a foreach loop (i.e., begin its next iteration) by
- * assigning the next value list element to each loop var.
- */
+#endif
+ }
- int opnd;
- ForeachInfo *infoPtr;
- ForeachVarList *varListPtr;
- int numLists;
- Tcl_Obj *listPtr,*valuePtr, *value2Ptr;
- Tcl_Obj **elements;
- Var *iterVarPtr, *listVarPtr;
- int iterNum, listTmpIndex, listLen, numVars;
- int varIndex, valIndex, continueLoop, j;
- long i;
- Var *varPtr;
- char *part1;
+ case INST_FOREACH_STEP4: {
+ /*
+ * "Step" a foreach loop (i.e., begin its next iteration) by assigning
+ * the next value list element to each loop var.
+ */
- opnd = TclGetUInt4AtPtr(pc+1);
- infoPtr = (ForeachInfo *)
- codePtr->auxDataArrayPtr[opnd].clientData;
- numLists = infoPtr->numLists;
+ int opnd;
+ ForeachInfo *infoPtr;
+ ForeachVarList *varListPtr;
+ int numLists;
+ Tcl_Obj *listPtr,*valuePtr, *value2Ptr;
+ Tcl_Obj **elements;
+ Var *iterVarPtr, *listVarPtr;
+ int iterNum, listTmpIndex, listLen, numVars;
+ int varIndex, valIndex, continueLoop, j;
+ long i;
+ Var *varPtr;
+ char *part1;
- /*
- * Increment the temp holding the loop iteration number.
- */
+ opnd = TclGetUInt4AtPtr(pc+1);
+ infoPtr = (ForeachInfo *) codePtr->auxDataArrayPtr[opnd].clientData;
+ numLists = infoPtr->numLists;
- iterVarPtr = &(compiledLocals[infoPtr->loopCtTemp]);
- valuePtr = iterVarPtr->value.objPtr;
- iterNum = (valuePtr->internalRep.longValue + 1);
- TclSetLongObj(valuePtr, iterNum);
-
- /*
- * Check whether all value lists are exhausted and we should
- * stop the loop.
- */
+ /*
+ * Increment the temp holding the loop iteration number.
+ */
- continueLoop = 0;
+ iterVarPtr = &(compiledLocals[infoPtr->loopCtTemp]);
+ valuePtr = iterVarPtr->value.objPtr;
+ iterNum = (valuePtr->internalRep.longValue + 1);
+ TclSetLongObj(valuePtr, iterNum);
+
+ /*
+ * Check whether all value lists are exhausted and we should stop the
+ * loop.
+ */
+
+ continueLoop = 0;
+ listTmpIndex = infoPtr->firstValueTemp;
+ for (i = 0; i < numLists; i++) {
+ varListPtr = infoPtr->varLists[i];
+ numVars = varListPtr->numVars;
+
+ listVarPtr = &(compiledLocals[listTmpIndex]);
+ listPtr = listVarPtr->value.objPtr;
+ result = Tcl_ListObjLength(interp, listPtr, &listLen);
+ if (result != TCL_OK) {
+ TRACE_WITH_OBJ(("%u => ERROR converting list %ld, \"%s\": ",
+ opnd, i, O2S(listPtr)), Tcl_GetObjResult(interp));
+ goto checkForCatch;
+ }
+ if (listLen > (iterNum * numVars)) {
+ continueLoop = 1;
+ }
+ listTmpIndex++;
+ }
+
+ /*
+ * If some var in some var list still has a remaining list element
+ * iterate one more time. Assign to var the next element from its
+ * value list. We already checked above that each list temp holds a
+ * valid list object (by calling Tcl_ListObjLength), but cannot rely
+ * on that check remaining valid: one list could have been shimmered
+ * as a side effect of setting a traced variable.
+ */
+
+ if (continueLoop) {
listTmpIndex = infoPtr->firstValueTemp;
for (i = 0; i < numLists; i++) {
varListPtr = infoPtr->varLists[i];
numVars = varListPtr->numVars;
-
+
listVarPtr = &(compiledLocals[listTmpIndex]);
listPtr = listVarPtr->value.objPtr;
- result = Tcl_ListObjLength(interp, listPtr, &listLen);
- if (result != TCL_OK) {
- TRACE_WITH_OBJ(("%u => ERROR converting list %ld, \"%s\": ",
- opnd, i, O2S(listPtr)), Tcl_GetObjResult(interp));
- goto checkForCatch;
- }
- if (listLen > (iterNum * numVars)) {
- continueLoop = 1;
- }
- listTmpIndex++;
- }
+ Tcl_ListObjGetElements(interp, listPtr, &listLen, &elements);
+
+ valIndex = (iterNum * numVars);
+ for (j = 0; j < numVars; j++) {
+ int setEmptyStr = 0;
+ if (valIndex >= listLen) {
+ setEmptyStr = 1;
+ TclNewObj(valuePtr);
+ } else {
+ valuePtr = elements[valIndex];
+ }
- /*
- * If some var in some var list still has a remaining list
- * element iterate one more time. Assign to var the next
- * element from its value list. We already checked above
- * that each list temp holds a valid list object (by calling
- * Tcl_ListObjLength), but cannot rely on that check remaining
- * valid: one list could have been shimmered as a side effect of
- * setting a traced variable.
- */
-
- if (continueLoop) {
- listTmpIndex = infoPtr->firstValueTemp;
- for (i = 0; i < numLists; i++) {
- varListPtr = infoPtr->varLists[i];
- numVars = varListPtr->numVars;
-
- listVarPtr = &(compiledLocals[listTmpIndex]);
- listPtr = listVarPtr->value.objPtr;
- Tcl_ListObjGetElements(interp, listPtr, &listLen, &elements);
-
- valIndex = (iterNum * numVars);
- for (j = 0; j < numVars; j++) {
- int setEmptyStr = 0;
- if (valIndex >= listLen) {
- setEmptyStr = 1;
- TclNewObj(valuePtr);
- } else {
- valuePtr = elements[valIndex];
- }
-
- varIndex = varListPtr->varIndexes[j];
- varPtr = &(compiledLocals[varIndex]);
- part1 = varPtr->name;
- while (TclIsVarLink(varPtr)) {
- varPtr = varPtr->value.linkPtr;
- }
- if (TclIsVarDirectWritable(varPtr)) {
- value2Ptr = varPtr->value.objPtr;
- if (valuePtr != value2Ptr) {
- if (value2Ptr != NULL) {
- TclDecrRefCount(value2Ptr);
- } else {
- TclSetVarScalar(varPtr);
- TclClearVarUndefined(varPtr);
- }
- varPtr->value.objPtr = valuePtr;
- Tcl_IncrRefCount(valuePtr);
+ varIndex = varListPtr->varIndexes[j];
+ varPtr = &(compiledLocals[varIndex]);
+ part1 = varPtr->name;
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+ if (TclIsVarDirectWritable(varPtr)) {
+ value2Ptr = varPtr->value.objPtr;
+ if (valuePtr != value2Ptr) {
+ if (value2Ptr != NULL) {
+ TclDecrRefCount(value2Ptr);
+ } else {
+ TclSetVarScalar(varPtr);
+ TclClearVarUndefined(varPtr);
}
- } else {
- DECACHE_STACK_INFO();
- value2Ptr = TclPtrSetVar(interp, varPtr, NULL, part1,
- NULL, valuePtr, TCL_LEAVE_ERR_MSG);
- CACHE_STACK_INFO();
- if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(("%u => ERROR init. index temp %d: ",
- opnd, varIndex),
- Tcl_GetObjResult(interp));
- if (setEmptyStr) {
- TclDecrRefCount(valuePtr);
- }
- result = TCL_ERROR;
- goto checkForCatch;
+ varPtr->value.objPtr = valuePtr;
+ Tcl_IncrRefCount(valuePtr);
+ }
+ } else {
+ DECACHE_STACK_INFO();
+ value2Ptr = TclPtrSetVar(interp, varPtr, NULL, part1,
+ NULL, valuePtr, TCL_LEAVE_ERR_MSG);
+ CACHE_STACK_INFO();
+ if (value2Ptr == NULL) {
+ TRACE_WITH_OBJ(("%u => ERROR init. index temp %d: ",
+ opnd, varIndex), Tcl_GetObjResult(interp));
+ if (setEmptyStr) {
+ TclDecrRefCount(valuePtr);
}
+ result = TCL_ERROR;
+ goto checkForCatch;
}
- valIndex++;
}
- listTmpIndex++;
+ valIndex++;
}
+ listTmpIndex++;
}
- TRACE(("%u => %d lists, iter %d, %s loop\n", opnd, numLists,
- iterNum, (continueLoop? "continue" : "exit")));
+ }
+ TRACE(("%u => %d lists, iter %d, %s loop\n", opnd, numLists,
+ iterNum, (continueLoop? "continue" : "exit")));
- /*
- * Run-time peep-hole optimisation: the compiler ALWAYS follows
- * INST_FOREACH_STEP4 with an INST_JUMP_FALSE. We just skip that
- * instruction and jump direct from here.
- */
+ /*
+ * Run-time peep-hole optimisation: the compiler ALWAYS follows
+ * INST_FOREACH_STEP4 with an INST_JUMP_FALSE. We just skip that
+ * instruction and jump direct from here.
+ */
- pc += 5;
- if (*pc == INST_JUMP_FALSE1) {
- NEXT_INST_F((continueLoop? 2 : TclGetInt1AtPtr(pc+1)), 0, 0);
- } else {
- NEXT_INST_F((continueLoop? 5 : TclGetInt4AtPtr(pc+1)), 0, 0);
- }
+ pc += 5;
+ if (*pc == INST_JUMP_FALSE1) {
+ NEXT_INST_F((continueLoop? 2 : TclGetInt1AtPtr(pc+1)), 0, 0);
+ } else {
+ NEXT_INST_F((continueLoop? 5 : TclGetInt4AtPtr(pc+1)), 0, 0);
}
+ }
case INST_BEGIN_CATCH4:
/*
- * Record start of the catch command with exception range index
- * equal to the operand. Push the current stack depth onto the
- * special catch stack.
+ * Record start of the catch command with exception range index equal
+ * to the operand. Push the current stack depth onto the special catch
+ * stack.
*/
eePtr->stackPtr[++catchTop] = (Tcl_Obj *) (tosPtr - eePtr->stackPtr);
TRACE(("%u => catchTop=%d, stackTop=%d\n",
- TclGetUInt4AtPtr(pc+1), (catchTop - initCatchTop - 1), tosPtr - eePtr->stackPtr));
+ TclGetUInt4AtPtr(pc+1), (catchTop - initCatchTop - 1),
+ tosPtr - eePtr->stackPtr));
NEXT_INST_F(5, 0, 0);
case INST_END_CATCH:
@@ -4828,7 +4736,7 @@ TclExecuteByteCode(interp, codePtr)
result = TCL_OK;
TRACE(("=> catchTop=%d\n", (catchTop - initCatchTop - 1)));
NEXT_INST_F(1, 0, 0);
-
+
case INST_PUSH_RESULT:
objResultPtr = Tcl_GetObjResult(interp);
TRACE_WITH_OBJ(("=> "), objResultPtr);
@@ -4860,21 +4768,21 @@ TclExecuteByteCode(interp, codePtr)
} /* end of switch on opCode */
/*
- * Division by zero in an expression. Control only reaches this
- * point by "goto divideByZero".
+ * Division by zero in an expression. Control only reaches this point by
+ * "goto divideByZero".
*/
-
+
divideByZero:
Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1));
Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero",
- (char *) NULL);
+ (char *) NULL);
result = TCL_ERROR;
goto checkForCatch;
/*
- * Exponentiation of zero by negative number in an expression.
- * Control only reaches this point by "goto exponOfZero".
+ * Exponentiation of zero by negative number in an expression. Control
+ * only reaches this point by "goto exponOfZero".
*/
exponOfZero:
@@ -4888,14 +4796,13 @@ TclExecuteByteCode(interp, codePtr)
/*
* Block for variables needed to process exception returns
*/
-
- {
+ {
ExceptionRange *rangePtr; /* Points to closest loop or catch
* exception range enclosing the pc. Used
* by various instructions and processCatch
* to process break, continue, and
- * errors. */
+ * errors. */
Tcl_Obj *valuePtr;
char *bytes;
int length;
@@ -4903,42 +4810,42 @@ TclExecuteByteCode(interp, codePtr)
int opnd;
#endif
- /*
- * An external evaluation (INST_INVOKE or INST_EVAL) returned
- * something different from TCL_OK, or else INST_BREAK or
+ /*
+ * An external evaluation (INST_INVOKE or INST_EVAL) returned
+ * something different from TCL_OK, or else INST_BREAK or
* INST_CONTINUE were called.
*/
- processExceptionReturn:
-#if TCL_COMPILE_DEBUG
+ processExceptionReturn:
+#if TCL_COMPILE_DEBUG
switch (*pc) {
- case INST_INVOKE_STK1:
- opnd = TclGetUInt1AtPtr(pc+1);
- TRACE(("%u => ... after \"%.20s\": ", opnd, cmdNameBuf));
- break;
- case INST_INVOKE_STK4:
- opnd = TclGetUInt4AtPtr(pc+1);
- TRACE(("%u => ... after \"%.20s\": ", opnd, cmdNameBuf));
- break;
- case INST_EVAL_STK:
- /*
- * Note that the object at stacktop has to be used
- * before doing the cleanup.
- */
+ case INST_INVOKE_STK1:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ TRACE(("%u => ... after \"%.20s\": ", opnd, cmdNameBuf));
+ break;
+ case INST_INVOKE_STK4:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ TRACE(("%u => ... after \"%.20s\": ", opnd, cmdNameBuf));
+ break;
+ case INST_EVAL_STK:
+ /*
+ * Note that the object at stacktop has to be used before doing
+ * the cleanup.
+ */
- TRACE(("\"%.30s\" => ", O2S(*tosPtr)));
- break;
- default:
- TRACE(("=> "));
- }
-#endif
+ TRACE(("\"%.30s\" => ", O2S(*tosPtr)));
+ break;
+ default:
+ TRACE(("=> "));
+ }
+#endif
if ((result == TCL_CONTINUE) || (result == TCL_BREAK)) {
rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0, codePtr);
if (rangePtr == NULL) {
TRACE_APPEND(("no encl. loop or catch, returning %s\n",
- StringForResultCode(result)));
+ StringForResultCode(result)));
goto abnormalReturn;
- }
+ }
if (rangePtr->type == CATCH_EXCEPTION_RANGE) {
TRACE_APPEND(("%s ...\n", StringForResultCode(result)));
goto processCatch;
@@ -4951,44 +4858,44 @@ TclExecuteByteCode(interp, codePtr)
result = TCL_OK;
pc = (codePtr->codeStart + rangePtr->breakOffset);
TRACE_APPEND(("%s, range at %d, new pc %d\n",
- StringForResultCode(result),
- rangePtr->codeOffset, rangePtr->breakOffset));
+ StringForResultCode(result),
+ rangePtr->codeOffset, rangePtr->breakOffset));
NEXT_INST_F(0, 0, 0);
} else {
if (rangePtr->continueOffset == -1) {
TRACE_APPEND(("%s, loop w/o continue, checking for catch\n",
- StringForResultCode(result)));
+ StringForResultCode(result)));
goto checkForCatch;
- }
+ }
result = TCL_OK;
pc = (codePtr->codeStart + rangePtr->continueOffset);
TRACE_APPEND(("%s, range at %d, new pc %d\n",
- StringForResultCode(result),
- rangePtr->codeOffset, rangePtr->continueOffset));
+ StringForResultCode(result),
+ rangePtr->codeOffset, rangePtr->continueOffset));
NEXT_INST_F(0, 0, 0);
}
-#if TCL_COMPILE_DEBUG
+#if TCL_COMPILE_DEBUG
} else if (traceInstructions) {
if ((result != TCL_ERROR) && (result != TCL_RETURN)) {
Tcl_Obj *objPtr = Tcl_GetObjResult(interp);
- TRACE_APPEND(("OTHER RETURN CODE %d, result= \"%s\"\n ",
+ TRACE_APPEND(("OTHER RETURN CODE %d, result= \"%s\"\n ",
result, O2S(objPtr)));
} else {
Tcl_Obj *objPtr = Tcl_GetObjResult(interp);
- TRACE_APPEND(("%s, result= \"%s\"\n",
+ TRACE_APPEND(("%s, result= \"%s\"\n",
StringForResultCode(result), O2S(objPtr)));
}
#endif
}
-
+
/*
* Execution has generated an "exception" such as TCL_ERROR. If the
* exception is an error, record information about what was being
- * executed when the error occurred. Find the closest enclosing
- * catch range, if any. If no enclosing catch range is found, stop
- * execution and return the "exception" code.
+ * executed when the error occurred. Find the closest enclosing catch
+ * range, if any. If no enclosing catch range is found, stop execution
+ * and return the "exception" code.
*/
-
+
checkForCatch:
if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
bytes = GetSrcInfoForPc(pc, codePtr, &length);
@@ -5000,7 +4907,7 @@ TclExecuteByteCode(interp, codePtr)
/*
* Clear all expansions that may have started after the last
- * INST_BEGIN_CATCH.
+ * INST_BEGIN_CATCH.
*/
while ((expandNestList != NULL) && ((catchTop == initCatchTop) ||
@@ -5012,9 +4919,9 @@ TclExecuteByteCode(interp, codePtr)
}
/*
- * We must not catch an exceeded limit. Instead, it blows
- * outwards until we either hit another interpreter (presumably
- * where the limit is not exceeded) or we get to the top-level.
+ * We must not catch an exceeded limit. Instead, it blows outwards
+ * until we either hit another interpreter (presumably where the limit
+ * is not exceeded) or we get to the top-level.
*/
if (Tcl_LimitExceeded(interp)) {
#ifdef TCL_COMPILE_DEBUG
@@ -5038,7 +4945,7 @@ TclExecuteByteCode(interp, codePtr)
if (rangePtr == NULL) {
/*
* This is only possible when compiling a [catch] that sends its
- * script to INST_EVAL. Cannot correct the compiler without
+ * script to INST_EVAL. Cannot correct the compiler without
* breakingcompat with previous .tbc compiled scripts.
*/
#ifdef TCL_COMPILE_DEBUG
@@ -5049,14 +4956,13 @@ TclExecuteByteCode(interp, codePtr)
#endif
goto abnormalReturn;
}
-
+
/*
* A catch exception range (rangePtr) was found to handle an
- * "exception". It was found either by checkForCatch just above or
- * by an instruction during break, continue, or error processing.
- * Jump to its catchOffset after unwinding the operand stack to
- * the depth it had when starting to execute the range's catch
- * command.
+ * "exception". It was found either by checkForCatch just above or by
+ * an instruction during break, continue, or error processing. Jump
+ * to its catchOffset after unwinding the operand stack to the depth
+ * it had when starting to execute the range's catch command.
*/
processCatch:
@@ -5067,23 +4973,24 @@ TclExecuteByteCode(interp, codePtr)
#ifdef TCL_COMPILE_DEBUG
if (traceInstructions) {
fprintf(stdout, " ... found catch at %d, catchTop=%d, unwound to %d, new pc %u\n",
- rangePtr->codeOffset, (catchTop - initCatchTop - 1),
+ rangePtr->codeOffset, (catchTop - initCatchTop - 1),
(int) eePtr->stackPtr[catchTop],
(unsigned int)(rangePtr->catchOffset));
}
-#endif
+#endif
pc = (codePtr->codeStart + rangePtr->catchOffset);
NEXT_INST_F(0, 0, 0); /* restart the execution loop at pc */
-
- /*
+
+ /*
* end of infinite loop dispatching on instructions.
*/
-
+
/*
- * Abnormal return code. Restore the stack to state it had when starting
- * to execute the ByteCode. Panic if the stack is below the initial level.
+ * Abnormal return code. Restore the stack to state it had when
+ * starting to execute the ByteCode. Panic if the stack is below the
+ * initial level.
*/
-
+
abnormalReturn:
{
Tcl_Obj **initTosPtr = eePtr->stackPtr + initStackTop;
@@ -5093,9 +5000,9 @@ TclExecuteByteCode(interp, codePtr)
}
/*
- * Clear all expansions.
+ * Clear all expansions.
*/
-
+
while (expandNestList) {
Tcl_Obj *objPtr = expandNestList->internalRep.twoPtrValue.ptr2;
TclDecrRefCount(expandNestList);
@@ -5121,9 +5028,9 @@ TclExecuteByteCode(interp, codePtr)
*
* PrintByteCodeInfo --
*
- * This procedure prints a summary about a bytecode object to stdout.
- * It is called by TclExecuteByteCode when starting to execute the
- * bytecode object if tclTraceExec has the value 2 or more.
+ * This procedure prints a summary about a bytecode object to stdout. It
+ * is called by TclExecuteByteCode when starting to execute the bytecode
+ * object if tclTraceExec has the value 2 or more.
*
* Results:
* None.
@@ -5136,8 +5043,8 @@ TclExecuteByteCode(interp, codePtr)
static void
PrintByteCodeInfo(codePtr)
- register ByteCode *codePtr; /* The bytecode whose summary is printed
- * to stdout. */
+ register ByteCode *codePtr; /* The bytecode whose summary is printed to
+ * stdout. */
{
Proc *procPtr = codePtr->procPtr;
Interp *iPtr = (Interp *) *codePtr->interpHandle;
@@ -5146,20 +5053,20 @@ PrintByteCodeInfo(codePtr)
(unsigned int) codePtr, codePtr->refCount,
codePtr->compileEpoch, (unsigned int) iPtr,
iPtr->compileEpoch);
-
+
fprintf(stdout, " Source: ");
TclPrintSource(stdout, codePtr->source, 60);
fprintf(stdout, "\n Cmds %d, src %d, inst %u, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
- codePtr->numCommands, codePtr->numSrcBytes,
+ codePtr->numCommands, codePtr->numSrcBytes,
codePtr->numCodeBytes, codePtr->numLitObjects,
codePtr->numAuxDataItems, codePtr->maxStackDepth,
#ifdef TCL_COMPILE_STATS
- (codePtr->numSrcBytes?
- ((float)codePtr->structureSize)/((float)codePtr->numSrcBytes) : 0.0));
-#else
- 0.0);
+ codePtr->numSrcBytes?
+ ((float)codePtr->structureSize)/codePtr->numSrcBytes :
#endif
+ 0.0);
+
#ifdef TCL_COMPILE_STATS
fprintf(stdout, " Code %d = header %d+inst %d+litObj %d+exc %d+aux %d+cmdMap %d\n",
codePtr->structureSize,
@@ -5192,8 +5099,8 @@ PrintByteCodeInfo(codePtr)
* None.
*
* Side effects:
- * Prints a message to stderr and panics if either the pc or stack
- * top are invalid.
+ * Prints a message to stderr and panics if either the pc or stack top
+ * are invalid.
*
*----------------------------------------------------------------------
*/
@@ -5201,19 +5108,19 @@ PrintByteCodeInfo(codePtr)
#ifdef TCL_COMPILE_DEBUG
static void
ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound, checkStack)
- register ByteCode *codePtr; /* The bytecode whose summary is printed
- * to stdout. */
+ register ByteCode *codePtr; /* The bytecode whose summary is printed to
+ * stdout. */
unsigned char *pc; /* Points to first byte of a bytecode
* instruction. The program counter. */
int stackTop; /* Current stack top. Must be between
* stackLowerBound and stackUpperBound
* (inclusive). */
int stackLowerBound; /* Smallest legal value for stackTop. */
- int checkStack; /* 0 if the stack depth check should be
+ int checkStack; /* 0 if the stack depth check should be
* skipped. */
{
- int stackUpperBound = stackLowerBound + codePtr->maxStackDepth;
- /* Greatest legal value for stackTop. */
+ int stackUpperBound = stackLowerBound + codePtr->maxStackDepth;
+ /* Greatest legal value for stackTop. */
unsigned int relativePc = (unsigned int) (pc - codePtr->codeStart);
unsigned int codeStart = (unsigned int) codePtr->codeStart;
unsigned int codeEnd = (unsigned int)
@@ -5228,13 +5135,13 @@ ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound, checkStack)
if ((unsigned int) opCode > LAST_INST_OPCODE) {
fprintf(stderr, "\nBad opcode %d at pc %u in TclExecuteByteCode\n",
(unsigned int) opCode, relativePc);
- Tcl_Panic("TclExecuteByteCode execution failure: bad opcode");
+ Tcl_Panic("TclExecuteByteCode execution failure: bad opcode");
}
- if (checkStack &&
- ((stackTop < stackLowerBound) || (stackTop > stackUpperBound))) {
+ if (checkStack &&
+ ((stackTop < stackLowerBound) || (stackTop > stackUpperBound))) {
int numChars;
char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars);
-
+
fprintf(stderr, "\nBad stack top %d at pc %u in TclExecuteByteCode (min %i, max %i)",
stackTop, relativePc, stackLowerBound, stackUpperBound);
if (cmd != NULL) {
@@ -5256,10 +5163,9 @@ ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound, checkStack)
*
* IllegalExprOperandType --
*
- * Used by TclExecuteByteCode to append an error message to
- * the interp result when an illegal operand type is detected by an
- * expression instruction. The argument opndPtr holds the operand
- * object in error.
+ * Used by TclExecuteByteCode to append an error message to the interp
+ * result when an illegal operand type is detected by an expression
+ * instruction. The argument opndPtr holds the operand object in error.
*
* Results:
* None.
@@ -5285,7 +5191,7 @@ IllegalExprOperandType(interp, pc, opndPtr)
operator = "**";
}
- Tcl_SetObjResult(interp, Tcl_NewObj());
+ Tcl_SetObjResult(interp, Tcl_NewObj());
if ((opndPtr->bytes == NULL) || (opndPtr->length == 0)) {
Tcl_AppendResult(interp, "can't use empty string as operand of \"",
operator, "\"", (char *) NULL);
@@ -5298,8 +5204,8 @@ IllegalExprOperandType(interp, pc, opndPtr)
s = Tcl_GetStringFromObj(opndPtr, &length);
p = s;
/*
- * strtod() isn't at all consistent about detecting Inf and
- * NaN between platforms.
+ * strtod() isn't at all consistent about detecting Inf and NaN
+ * between platforms.
*/
if (length == 3) {
if ((s[0]=='n' || s[0]=='N') && (s[1]=='a' || s[1]=='A') &&
@@ -5315,10 +5221,10 @@ IllegalExprOperandType(interp, pc, opndPtr)
}
/*
- * We cannot use TclLooksLikeInt here because it passes strings
- * like "10;" [Bug 587140]. We'll accept as "looking like ints"
- * for the present purposes any string that looks formally like
- * a (decimal|octal|hex) integer.
+ * We cannot use TclLooksLikeInt here because it passes strings like
+ * "10;" [Bug 587140]. We'll accept as "looking like ints" for the
+ * present purposes any string that looks formally like a
+ * (decimal|octal|hex) integer.
*/
while (length && isspace(UCHAR(*p))) {
@@ -5361,9 +5267,9 @@ IllegalExprOperandType(interp, pc, opndPtr)
}
if (looksLikeInt) {
/*
- * If something that looks like an integer could not be
- * converted, then it *must* be a bad octal or too large
- * to represent [Bug 542588].
+ * If something that looks like an integer could not be converted,
+ * then it *must* be a bad octal or too large to represent [Bug
+ * 542588].
*/
if (TclCheckBadOctal(NULL, s)) {
@@ -5375,8 +5281,8 @@ IllegalExprOperandType(interp, pc, opndPtr)
}
} else {
/*
- * See if the operand can be interpreted as a double in
- * order to improve the error message.
+ * See if the operand can be interpreted as a double in order to
+ * improve the error message.
*/
double d;
@@ -5385,7 +5291,7 @@ IllegalExprOperandType(interp, pc, opndPtr)
msg = "floating-point value";
}
}
- makeErrorMessage:
+ makeErrorMessage:
Tcl_AppendResult(interp, "can't use ", msg, " as operand of \"",
operator, "\"", (char *) NULL);
}
@@ -5404,10 +5310,10 @@ IllegalExprOperandType(interp, pc, opndPtr)
* Results:
* If a command is found that encloses the program counter value, a
* pointer to the command's source is returned and the length of the
- * source is stored at *lengthPtr. If multiple commands resulted in
- * code at pc, information about the closest enclosing command is
- * returned. If no matching command is found, NULL is returned and
- * *lengthPtr is unchanged.
+ * source is stored at *lengthPtr. If multiple commands resulted in code
+ * at pc, information about the closest enclosing command is returned. If
+ * no matching command is found, NULL is returned and *lengthPtr is
+ * unchanged.
*
* Side effects:
* None.
@@ -5419,13 +5325,13 @@ static char *
GetSrcInfoForPc(pc, codePtr, lengthPtr)
unsigned char *pc; /* The program counter value for which to
* return the closest command's source info.
- * This points to a bytecode instruction
- * in codePtr's code. */
- ByteCode *codePtr; /* The bytecode sequence in which to look
- * up the command source for the pc. */
- int *lengthPtr; /* If non-NULL, the location where the
- * length of the command's source should be
- * stored. If NULL, no length is stored. */
+ * This points to a bytecode instruction in
+ * codePtr's code. */
+ ByteCode *codePtr; /* The bytecode sequence in which to look up
+ * the command source for the pc. */
+ int *lengthPtr; /* If non-NULL, the location where the length
+ * of the command's source should be stored.
+ * If NULL, no length is stored. */
{
register int pcOffset = (pc - codePtr->codeStart);
int numCmds = codePtr->numCommands;
@@ -5490,8 +5396,8 @@ GetSrcInfoForPc(pc, codePtr, lengthPtr)
srcLen = TclGetInt1AtPtr(srcLengthNext);
srcLengthNext++;
}
-
- if (codeOffset > pcOffset) { /* best cmd already found */
+
+ if (codeOffset > pcOffset) { /* best cmd already found */
break;
} else if (pcOffset <= codeEnd) { /* this cmd's code encloses pc */
int dist = (pcOffset - codeOffset);
@@ -5506,7 +5412,7 @@ GetSrcInfoForPc(pc, codePtr, lengthPtr)
if (bestDist == INT_MAX) {
return NULL;
}
-
+
if (lengthPtr != NULL) {
*lengthPtr = bestSrcLength;
}
@@ -5522,15 +5428,14 @@ GetSrcInfoForPc(pc, codePtr, lengthPtr)
* ExceptionRange.
*
* Results:
- * In the normal case, catchOnly is 0 (false) and this procedure
- * returns a pointer to the most closely enclosing ExceptionRange
- * structure regardless of whether it is a loop or catch exception
- * range. This is appropriate when processing a TCL_BREAK or
- * TCL_CONTINUE, which will be "handled" either by a loop exception
- * range or a closer catch range. If catchOnly is nonzero, this
- * procedure ignores loop exception ranges and returns a pointer to the
- * closest catch range. If no matching ExceptionRange is found that
- * encloses pc, a NULL is returned.
+ * In the normal case, catchOnly is 0 (false) and this procedure returns
+ * a pointer to the most closely enclosing ExceptionRange structure
+ * regardless of whether it is a loop or catch exception range. This is
+ * appropriate when processing a TCL_BREAK or TCL_CONTINUE, which will be
+ * "handled" either by a loop exception range or a closer catch range. If
+ * catchOnly is nonzero, this procedure ignores loop exception ranges and
+ * returns a pointer to the closest catch range. If no matching
+ * ExceptionRange is found that encloses pc, a NULL is returned.
*
* Side effects:
* None.
@@ -5546,8 +5451,8 @@ GetExceptRangeForPc(pc, catchOnly, codePtr)
* instruction in codePtr's code. */
int catchOnly; /* If 0, consider either loop or catch
* ExceptionRanges in search. If nonzero
- * consider only catch ranges (and ignore
- * any closer loop ranges). */
+ * consider only catch ranges (and ignore any
+ * closer loop ranges). */
ByteCode* codePtr; /* Points to the ByteCode in which to search
* for the enclosing ExceptionRange. */
{
@@ -5561,11 +5466,10 @@ GetExceptRangeForPc(pc, catchOnly, codePtr)
return NULL;
}
- /*
- * This exploits peculiarities of our compiler: nested ranges
- * are always *after* their containing ranges, so that by scanning
- * backwards we are sure that the first matching range is indeed
- * the deepest.
+ /*
+ * This exploits peculiarities of our compiler: nested ranges are always
+ * *after* their containing ranges, so that by scanning backwards we are
+ * sure that the first matching range is indeed the deepest.
*/
rangeArrayPtr = codePtr->exceptArrayPtr;
@@ -5573,7 +5477,7 @@ GetExceptRangeForPc(pc, catchOnly, codePtr)
while (--rangePtr >= rangeArrayPtr) {
start = rangePtr->codeOffset;
if ((start <= pcOffset) &&
- (pcOffset < (start + rangePtr->numCodeBytes))) {
+ (pcOffset < (start + rangePtr->numCodeBytes))) {
if ((!catchOnly)
|| (rangePtr->type == CATCH_EXCEPTION_RANGE)) {
return rangePtr;
@@ -5588,9 +5492,9 @@ GetExceptRangeForPc(pc, catchOnly, codePtr)
*
* GetOpcodeName --
*
- * This procedure is called by the TRACE and TRACE_WITH_OBJ macros
- * used in TclExecuteByteCode when debugging. It returns the name of
- * the bytecode instruction at a specified instruction pc.
+ * This procedure is called by the TRACE and TRACE_WITH_OBJ macros used
+ * in TclExecuteByteCode when debugging. It returns the name of the
+ * bytecode instruction at a specified instruction pc.
*
* Results:
* A character string for the instruction.
@@ -5604,11 +5508,11 @@ GetExceptRangeForPc(pc, catchOnly, codePtr)
#ifdef TCL_COMPILE_DEBUG
static char *
GetOpcodeName(pc)
- unsigned char *pc; /* Points to the instruction whose name
- * should be returned. */
+ unsigned char *pc; /* Points to the instruction whose name should
+ * be returned. */
{
unsigned char opCode = *pc;
-
+
return tclInstructionTable[opCode].name;
}
#endif /* TCL_COMPILE_DEBUG */
@@ -5618,9 +5522,8 @@ GetOpcodeName(pc)
*
* TclExprFloatError --
*
- * This procedure is called when an error occurs during a
- * floating-point operation. It reads errno and sets
- * interp->objResultPtr accordingly.
+ * This procedure is called when an error occurs during a floating-point
+ * operation. It reads errno and sets interp->objResultPtr accordingly.
*
* Results:
* interp->objResultPtr is set to hold an error message.
@@ -5634,7 +5537,7 @@ GetOpcodeName(pc)
void
TclExprFloatError(interp, value)
Tcl_Interp *interp; /* Where to store error message. */
- double value; /* Value returned after error; used to
+ double value; /* Value returned after error; used to
* distinguish underflows from overflows. */
{
CONST char *s;
@@ -5655,7 +5558,7 @@ TclExprFloatError(interp, value)
}
} else {
char msg[64 + TCL_INTEGER_SPACE];
-
+
sprintf(msg, "unknown floating-point error, errno = %d", errno);
Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN", msg, (char *) NULL);
@@ -5672,8 +5575,8 @@ TclExprFloatError(interp, value)
* the log base 2 of an integer.
*
* Results:
- * Returns the log base 2 of the operand. If the argument is less
- * than or equal to zero, a zero is returned.
+ * Returns the log base 2 of the operand. If the argument is less than or
+ * equal to zero, a zero is returned.
*
* Side effects:
* None.
@@ -5683,8 +5586,8 @@ TclExprFloatError(interp, value)
int
TclLog2(value)
- register int value; /* The integer for which to compute the
- * log base 2. */
+ register int value; /* The integer for which to compute the log
+ * base 2. */
{
register int n = value;
register int result = 0;
@@ -5737,9 +5640,9 @@ EvalStatsCmd(unused, interp, objc, objv)
numInstructions = 0.0;
for (i = 0; i < 256; i++) {
- if (statsPtr->instructionCount[i] != 0) {
- numInstructions += statsPtr->instructionCount[i];
- }
+ if (statsPtr->instructionCount[i] != 0) {
+ numInstructions += statsPtr->instructionCount[i];
+ }
}
totalLiteralBytes = sizeof(LiteralTable)
@@ -5760,7 +5663,7 @@ EvalStatsCmd(unused, interp, objc, objv)
+ iPtr->literalTable.numEntries * sizeof(Tcl_Obj)
+ statsPtr->currentLitStringBytes;
currentCodeBytes = statsPtr->currentByteCodeBytes + currentLiteralBytes;
-
+
/*
* Summary statistics, total and current source and ByteCode sizes.
*/
@@ -5776,7 +5679,7 @@ EvalStatsCmd(unused, interp, objc, objv)
statsPtr->numCompilations);
fprintf(stdout, " Mean executions/compile %.1f\n",
((float)statsPtr->numExecutions) / ((float)statsPtr->numCompilations));
-
+
fprintf(stdout, "\nInstructions executed %.0f\n",
numInstructions);
fprintf(stdout, " Mean inst/compile %.0f\n",
@@ -5830,9 +5733,8 @@ EvalStatsCmd(unused, interp, objc, objv)
/*
* Tcl_IsShared statistics check
*
- * This gives the refcount of each obj as Tcl_IsShared was called
- * for it. Shared objects must be duplicated before they can be
- * modified.
+ * This gives the refcount of each obj as Tcl_IsShared was called for it.
+ * Shared objects must be duplicated before they can be modified.
*/
numSharedMultX = 0;
@@ -5864,7 +5766,7 @@ EvalStatsCmd(unused, interp, objc, objv)
strBytesSharedOnce = 0.0;
for (i = 0; i < globalTablePtr->numBuckets; i++) {
for (entryPtr = globalTablePtr->buckets[i]; entryPtr != NULL;
- entryPtr = entryPtr->nextPtr) {
+ entryPtr = entryPtr->nextPtr) {
if (entryPtr->objPtr->typePtr == &tclByteCodeType) {
numByteCodeLits++;
}
@@ -5933,7 +5835,7 @@ EvalStatsCmd(unused, interp, objc, objv)
/*
* Breakdown of current ByteCode space requirements.
*/
-
+
fprintf(stdout, "\nBreakdown of current ByteCode requirements:\n");
fprintf(stdout, " Bytes Pct of Avg per\n");
fprintf(stdout, " total ByteCode\n");
@@ -5968,27 +5870,27 @@ EvalStatsCmd(unused, interp, objc, objv)
/*
* Detailed literal statistics.
*/
-
+
fprintf(stdout, "\nLiteral string sizes:\n");
fprintf(stdout, " Up to length Percentage\n");
maxSizeDecade = 0;
for (i = 31; i >= 0; i--) {
- if (statsPtr->literalCount[i] > 0) {
- maxSizeDecade = i;
+ if (statsPtr->literalCount[i] > 0) {
+ maxSizeDecade = i;
break;
- }
+ }
}
sum = 0;
for (i = 0; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
sum += statsPtr->literalCount[i];
- fprintf(stdout, " %10d %8.0f%%\n",
+ fprintf(stdout, " %10d %8.0f%%\n",
decadeHigh, (sum * 100.0) / statsPtr->numLiteralsCreated);
}
litTableStats = TclLiteralStats(globalTablePtr);
fprintf(stdout, "\nCurrent literal table statistics:\n%s\n",
- litTableStats);
+ litTableStats);
ckfree((char *) litTableStats);
/*
@@ -5999,22 +5901,22 @@ EvalStatsCmd(unused, interp, objc, objv)
fprintf(stdout, " Up to size Percentage\n");
minSizeDecade = maxSizeDecade = 0;
for (i = 0; i < 31; i++) {
- if (statsPtr->srcCount[i] > 0) {
+ if (statsPtr->srcCount[i] > 0) {
minSizeDecade = i;
break;
- }
+ }
}
for (i = 31; i >= 0; i--) {
- if (statsPtr->srcCount[i] > 0) {
- maxSizeDecade = i;
+ if (statsPtr->srcCount[i] > 0) {
+ maxSizeDecade = i;
break;
- }
+ }
}
sum = 0;
for (i = minSizeDecade; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
sum += statsPtr->srcCount[i];
- fprintf(stdout, " %10d %8.0f%%\n",
+ fprintf(stdout, " %10d %8.0f%%\n",
decadeHigh, (sum * 100.0) / statsPtr->numCompilations);
}
@@ -6022,22 +5924,22 @@ EvalStatsCmd(unused, interp, objc, objv)
fprintf(stdout, " Up to size Percentage\n");
minSizeDecade = maxSizeDecade = 0;
for (i = 0; i < 31; i++) {
- if (statsPtr->byteCodeCount[i] > 0) {
+ if (statsPtr->byteCodeCount[i] > 0) {
minSizeDecade = i;
break;
- }
+ }
}
for (i = 31; i >= 0; i--) {
- if (statsPtr->byteCodeCount[i] > 0) {
- maxSizeDecade = i;
+ if (statsPtr->byteCodeCount[i] > 0) {
+ maxSizeDecade = i;
break;
- }
+ }
}
sum = 0;
for (i = minSizeDecade; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
sum += statsPtr->byteCodeCount[i];
- fprintf(stdout, " %10d %8.0f%%\n",
+ fprintf(stdout, " %10d %8.0f%%\n",
decadeHigh, (sum * 100.0) / statsPtr->numCompilations);
}
@@ -6045,22 +5947,22 @@ EvalStatsCmd(unused, interp, objc, objv)
fprintf(stdout, " Up to ms Percentage\n");
minSizeDecade = maxSizeDecade = 0;
for (i = 0; i < 31; i++) {
- if (statsPtr->lifetimeCount[i] > 0) {
+ if (statsPtr->lifetimeCount[i] > 0) {
minSizeDecade = i;
break;
- }
+ }
}
for (i = 31; i >= 0; i--) {
- if (statsPtr->lifetimeCount[i] > 0) {
- maxSizeDecade = i;
+ if (statsPtr->lifetimeCount[i] > 0) {
+ maxSizeDecade = i;
break;
- }
+ }
}
sum = 0;
for (i = minSizeDecade; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
sum += statsPtr->lifetimeCount[i];
- fprintf(stdout, " %12.3f %8.0f%%\n",
+ fprintf(stdout, " %12.3f %8.0f%%\n",
decadeHigh / 1000.0,
(sum * 100.0) / statsPtr->numByteCodesFreed);
}
@@ -6071,19 +5973,19 @@ EvalStatsCmd(unused, interp, objc, objv)
fprintf(stdout, "\nInstruction counts:\n");
for (i = 0; i <= LAST_INST_OPCODE; i++) {
- if (statsPtr->instructionCount[i]) {
- fprintf(stdout, "%20s %8ld %6.1f%%\n",
+ if (statsPtr->instructionCount[i]) {
+ fprintf(stdout, "%20s %8ld %6.1f%%\n",
tclInstructionTable[i].name,
statsPtr->instructionCount[i],
(statsPtr->instructionCount[i]*100.0) / numInstructions);
- }
+ }
}
fprintf(stdout, "\nInstructions NEVER executed:\n");
for (i = 0; i <= LAST_INST_OPCODE; i++) {
- if (statsPtr->instructionCount[i] == 0) {
- fprintf(stdout, "%20s\n", tclInstructionTable[i].name);
- }
+ if (statsPtr->instructionCount[i] == 0) {
+ fprintf(stdout, "%20s\n", tclInstructionTable[i].name);
+ }
}
#ifdef TCL_MEM_DEBUG
@@ -6101,15 +6003,15 @@ EvalStatsCmd(unused, interp, objc, objv)
*
* StringForResultCode --
*
- * Procedure that returns a human-readable string representing a
- * Tcl result code such as TCL_ERROR.
+ * Procedure that returns a human-readable string representing a Tcl
+ * result code such as TCL_ERROR.
*
* Results:
- * If the result code is one of the standard Tcl return codes, the
- * result is a string representing that code such as "TCL_ERROR".
- * Otherwise, the result string is that code formatted as a
- * sequence of decimal digit characters. Note that the resulting
- * string must not be modified by the caller.
+ * If the result code is one of the standard Tcl return codes, the result
+ * is a string representing that code such as "TCL_ERROR". Otherwise,
+ * the result string is that code formatted as a sequence of decimal
+ * digit characters. Note that the resulting string must not be modified
+ * by the caller.
*
* Side effects:
* None.
@@ -6119,11 +6021,11 @@ EvalStatsCmd(unused, interp, objc, objv)
static char *
StringForResultCode(result)
- int result; /* The Tcl result code for which to
- * generate a string. */
+ int result; /* The Tcl result code for which to generate a
+ * string. */
{
static char buf[TCL_INTEGER_SPACE];
-
+
if ((result >= TCL_OK) && (result <= TCL_CONTINUE)) {
return resultStrings[result];
}
@@ -6140,9 +6042,8 @@ StringForResultCode(result)
* Procedure to return w**w2 as wide integer
*
* Results:
- * Return value is w to the power w2, unless the computation
- * makes no sense mathematically. In that case *errExpon is
- * set to 1.
+ * Return value is w to the power w2, unless the computation makes no
+ * sense mathematically. In that case *errExpon is set to 1.
*
* Side effects:
* None.
@@ -6187,7 +6088,7 @@ ExponWide(w, w2, errExpon)
}
/*
- * The general case.
+ * The general case.
*/
result = Tcl_LongAsWide(1);
@@ -6204,15 +6105,14 @@ ExponWide(w, w2, errExpon)
*
* ExponLong --
*
- * Procedure to return i**i2 as long integer
+ * Procedure to return i**i2 as long integer
*
* Results:
- * Return value is i to the power i2, unless the computation
- * makes no sense mathematically. In that case *errExpon is
- * set to 1.
+ * Return value is i to the power i2, unless the computation makes no
+ * sense mathematically. In that case *errExpon is set to 1.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
@@ -6232,28 +6132,28 @@ ExponLong(i, i2, errExpon)
*/
if (i == 0) {
- if (i2 < 0) {
- *errExpon = 1;
- return 0L;
- } else if (i2 > 0) {
- return 0L;
- }
+ if (i2 < 0) {
+ *errExpon = 1;
+ return 0L;
+ } else if (i2 > 0) {
+ return 0L;
+ }
/*
* By definition and analysis, 0**0 is 1.
*/
return 1L;
} else if (i < -1) {
- if (i2 < 0) {
- return 0L;
- } else if (i2 == 0) {
+ if (i2 < 0) {
+ return 0L;
+ } else if (i2 == 0) {
return 1L;
- }
+ }
} else if (i == -1) {
- return (i2&1) ? -1L : 1L;
+ return (i2&1) ? -1L : 1L;
} else if ((i == 1) || (i2 == 0)) {
- return 1L;
+ return 1L;
} else if (i > 1 && i2 < 0) {
- return 0L;
+ return 0L;
}
/*