summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog73
-rw-r--r--generic/tclCompile.c34
-rw-r--r--generic/tclExecute.c846
3 files changed, 609 insertions, 344 deletions
diff --git a/ChangeLog b/ChangeLog
index 13f809a..f31c7ee 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2007-04-01 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCompile.c (TclCompileScript, TclPrintInstruction):
+ * generic/tclExecute.c (TclExecuteByteCode): Changed the definition of
+ INST_START_CMD so that it knows how many commands start at the current
+ location. This makes the interpreter command counter correct without
+ requiring a large number of instructions to be issued. (See my change
+ from 2007-01-19 for what triggered this.)
+
2007-03-30 Don Porter <dgp@users.sourceforge.net>
* generic/tclCompile.c:
@@ -14,26 +23,25 @@
2007-03-30 Miguel Sofer <msofer@users.sf.net>
* generic/tclExecute.c: optimise the lookup of elements of indexed
- arrays.
-
+ arrays.
+
2007-03-29 Miguel Sofer <msofer@users.sf.net>
* generic/tclProc.c (Tcl_ApplyObjCmd):
* tests/apply.test (9.3): Fixed Tcl_Obj leak on error return; an
- unneeded ref to lambdaPtr was being set and not released on an
- error return path.
+ unneeded ref to lambdaPtr was being set and not released on an error
+ return path.
2007-03-28 Don Porter <dgp@users.sourceforge.net>
- * generic/tclCmdMZ.c (STR_REVERSE): Implement the actual
- [string reverse] command in terms of the new TclStringObjReverse()
- routine.
+ * generic/tclCmdMZ.c (STR_REVERSE): Implement the actual [string
+ reverse] command in terms of the new TclStringObjReverse() routine.
* generic/tclInt.h (TclStringObjReverse): New internal routine
* generic/tclStringObj.c (TclStringObjReverse): that implements the
[string reverse] operation, making use of knowledge/surgery of the
- String intrep to minimize the number of allocs and copies needed to
- do the job.
+ String intrep to minimize the number of allocs and copies needed to do
+ the job.
2007-03-27 Don Porter <dgp@users.sourceforge.net>
@@ -42,32 +50,31 @@
2007-03-24 Zoran Vasiljevic <vasiljevic@users.sourceforge.net>
- * win/tclWinThrd.c: Thread exit handler marks the current
- thread as un-initialized. This allows exit handlers that
- are registered later to re-initialize this subsystem in
- case they need to use some sync primitives (cond variables)
- from this file again.
+ * win/tclWinThrd.c: Thread exit handler marks the current thread as
+ un-initialized. This allows exit handlers that are registered later to
+ re-initialize this subsystem in case they need to use some sync
+ primitives (cond variables) from this file again.
2007-03-23 Miguel Sofer <msofer@users.sf.net>
- * generic/tclBasic.c (DeleteInterpProc): pop the root frame
- pointer before deleting the global namespace [Bug 1658572]
+ * generic/tclBasic.c (DeleteInterpProc): pop the root frame pointer
+ before deleting the global namespace [Bug 1658572]
2007-03-23 Kevin B. Kenny <kennykb@acm.org>
- * win/Makefile.in: Added code to keep a Cygwin path name from
- leaking into LIBRARY_DIR when doing 'make test' or 'make runtest'.
-
+ * win/Makefile.in: Added code to keep a Cygwin path name from leaking
+ into LIBRARY_DIR when doing 'make test' or 'make runtest'.
+
2007-03-22 Don Porter <dgp@users.sourceforge.net>
- * generic/tclCmdAH.c (Tcl_ForeachObjCmd): Replaced arrays
- on the C stack and ckalloc calls with TclStackAlloc calls to use
- memory on Tcl's evaluation stack.
+ * generic/tclCmdAH.c (Tcl_ForeachObjCmd): Replaced arrays on the
+ C stack and ckalloc calls with TclStackAlloc calls to use memory on
+ Tcl's evaluation stack.
- * generic/tclExecute.c: Revised GrowEvaluationStack to take an
- argument specifying the growth required by the caller, so that
- a single reallocation / copy is the most that will ever be needed
- even when required growth is large.
+ * generic/tclExecute.c: Revised GrowEvaluationStack to take an
+ argument specifying the growth required by the caller, so that a
+ single reallocation / copy is the most that will ever be needed even
+ when required growth is large.
2007-03-21 Don Porter <dgp@users.sourceforge.net>
@@ -87,9 +94,9 @@
2007-03-20 Kevin B. Kenny <kennykb@acm.org>
* generic/tclDate.c: Rebuilt, despite Donal Fellows's comment when
- committing it that no rebuild was required.
- * generic/tclGetDate.y: According to Donal Fellows, "Introduce
- modern formatting standards; no need for rebuild of tclDate.c."
+ committing it that no rebuild was required.
+ * generic/tclGetDate.y: According to Donal Fellows, "Introduce modern
+ formatting standards; no need for rebuild of tclDate.c."
* library/tzdata/America/Cambridge_Bay:
* library/tzdata/America/Havana:
@@ -110,15 +117,15 @@
* library/tzdata/Europe/Istanbul: Upgraded to Olson's tzdata2007d.
* generic/tclListObj.c (TclLsetList, TclLsetFlat):
- * tests/lset.test: Changes to deal with shared internal
- representation for lists passed to the [lset] command. Thanks to
- Don Porter for fixing this issue. [Bug 1677512]
+ * tests/lset.test: Changes to deal with shared internal representation
+ for lists passed to the [lset] command. Thanks to Don Porter for
+ fixing this issue. [Bug 1677512]
2007-03-19 Don Porter <dgp@users.sourceforge.net>
* generic/tclCompile.c: Revise the various expansion routines for
CompileEnv fields to use ckrealloc() where appropriate.
-
+
* generic/tclBinary.c (Tcl_SetByteArrayLength): Replaced ckalloc() /
memcpy() sequence with ckrealloc() call.
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 0965afa..dbd8db2 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompile.c,v 1.110 2007/03/30 18:24:54 dgp Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.111 2007/04/01 00:32:26 dkf Exp $
*/
#include "tclInt.h"
@@ -299,8 +299,9 @@ InstructionDesc tclInstructionTable[] = {
/* List Index: push (lindex stktop op4) */
{"listRangeImm", 9, 0, 2, {OPERAND_IDX4, OPERAND_IDX4}},
/* List Range: push (lrange stktop op4 op4) */
- {"startCommand", 5, 0, 1, {OPERAND_UINT4}},
- /* Start of bytecoded command: op is the length of the cmd's code */
+ {"startCommand", 9, 0, 1, {OPERAND_INT4,OPERAND_UINT4}},
+ /* Start of bytecoded command: op is the length of the cmd's code, op2
+ * is number of commands here */
{"listIn", 1, -1, 0, {OPERAND_NONE}},
/* List containment: push [lsearch stktop stknext]>=0) */
@@ -1485,9 +1486,24 @@ TclCompileScript(
* (savedCodeNext == 0)
*/
- if (savedCodeNext != 0 && !envPtr->atCmdStart) {
- TclEmitInstInt4(INST_START_CMD, 0, envPtr);
- update = 1;
+ if (savedCodeNext != 0) {
+ if (envPtr->atCmdStart) {
+ /*
+ * Increase the number of commands being
+ * started at the current point. Note that
+ * this depends on the exact layout of the
+ * INST_START_CMD's operands, so be careful!
+ */
+
+ unsigned char *fixPtr = envPtr->codeNext - 4;
+
+ TclStoreInt4AtPtr(TclGetUInt4AtPtr(fixPtr)+1,
+ fixPtr);
+ } else {
+ TclEmitInstInt4(INST_START_CMD, 0, envPtr);
+ TclEmitInt4(1, envPtr);
+ update = 1;
+ }
}
code = (cmdPtr->compileProc)(interp, &parse, envPtr);
@@ -3658,6 +3674,8 @@ TclPrintInstruction(
if (opCode == INST_JUMP4 || opCode == INST_JUMP_TRUE4
|| opCode == INST_JUMP_FALSE4) {
sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
+ } else if (opCode == INST_START_CMD) {
+ sprintf(suffixBuffer, "next cmd at pc %u", pcOffset+opnd);
}
fprintf(stdout, "%+d ", opnd);
break;
@@ -3673,8 +3691,8 @@ TclPrintInstruction(
opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
if (opCode == INST_PUSH4) {
suffixObj = codePtr->objArrayPtr[opnd];
- } else if (opCode == INST_START_CMD) {
- sprintf(suffixBuffer, "next cmd at pc %u", pcOffset+opnd);
+ } else if (opCode == INST_START_CMD && opnd != 1) {
+ sprintf(suffixBuffer, ", %u cmds start here", opnd);
}
fprintf(stdout, "%u ", (unsigned int) opnd);
if (instDesc->opTypes[i] == OPERAND_AUX4) {
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 2ed4e7d..fd3fb34 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -7,12 +7,12 @@
* Copyright (c) 1998-2000 by Scriptics Corporation.
* Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
* Copyright (c) 2002-2005 by Miguel Sofer.
- * Copyright (c) 2005 by Donal K. Fellows.
+ * Copyright (c) 2005-2007 by Donal K. Fellows.
*
* 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.265 2007/03/30 14:22:30 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.266 2007/04/01 00:32:27 dkf Exp $
*/
#include "tclInt.h"
@@ -29,7 +29,7 @@
* point units that we might care about?
*/
-#if ( FLT_RADIX == 2 ) && ( DBL_MANT_DIG == 53 ) && ( DBL_MAX_EXP == 1024 )
+#if (FLT_RADIX == 2) && (DBL_MANT_DIG == 53) && (DBL_MAX_EXP == 1024)
#define IEEE_FLOATING_POINT
#endif
@@ -59,7 +59,6 @@
# define ASYNC_CHECK_COUNT_MASK 63
#endif /* !ASYNC_CHECK_COUNT_MASK */
-
/*
* Boolean flag indicating whether the Tcl bytecode interpreter has been
* initialized.
@@ -115,7 +114,7 @@ static char *resultStrings[] = {
#ifdef TCL_COMPILE_STATS
long tclObjsAlloced = 0;
-long tclObjsFreed = 0;
+long tclObjsFreed = 0;
#define TCL_MAX_SHARED_OBJ_STATS 5
long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
#endif /* TCL_COMPILE_STATS */
@@ -176,7 +175,6 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
goto cleanupV;\
}
-
/*
* Macros used to cache often-referenced Tcl evaluation stack information
* in local variables. Note that a DECACHE_STACK_INFO()-CACHE_STACK_INFO()
@@ -192,7 +190,6 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
eePtr->tosPtr = tosPtr;\
checkInterp = 1
-
/*
* 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
@@ -216,7 +213,7 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
/*
* Macros used to trace instruction execution. The macros TRACE,
- * TRACE_WITH_OBJ, and O2S are only used inside TclExecuteByteCode. O2S is
+ * TRACE_WITH_OBJ, and O2S are only used inside TclExecuteByteCode. O2S is
* only used in TRACE* calls to get a string from an object.
*/
@@ -304,7 +301,7 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
/*
* Macro used in this file to save a function call for common uses of
- * Tcl_GetBooleanFromObj(). The ANSI C "prototype" is:
+ * Tcl_GetBooleanFromObj(). The ANSI C "prototype" is:
*
* MODULE_SCOPE int TclGetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
* int *boolPtr);
@@ -318,7 +315,7 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
/*
* Macro used in this file to save a function call for common uses of
- * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is:
+ * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is:
*
* MODULE_SCOPE int TclGetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
* Tcl_WideInt *wideIntPtr);
@@ -357,10 +354,10 @@ static int EvalStatsCmd(ClientData clientData,
#ifdef TCL_COMPILE_DEBUG
static char * GetOpcodeName(unsigned char *pc);
#endif /* TCL_COMPILE_DEBUG */
-static ExceptionRange * GetExceptRangeForPc(unsigned char *pc,
- int catchOnly, ByteCode* codePtr);
-static const char * GetSrcInfoForPc(unsigned char *pc,
- ByteCode* codePtr, int *lengthPtr);
+static ExceptionRange * GetExceptRangeForPc(unsigned char *pc, int catchOnly,
+ ByteCode *codePtr);
+static const char * GetSrcInfoForPc(unsigned char *pc, ByteCode *codePtr,
+ int *lengthPtr);
static void GrowEvaluationStack(ExecEnv *eePtr, int growth);
static void IllegalExprOperandType(Tcl_Interp *interp,
unsigned char *pc, Tcl_Obj *opndPtr);
@@ -598,7 +595,7 @@ GrowEvaluationStack(
}
eePtr->stackPtr = newStackPtr;
- eePtr->endPtr = newStackPtr + (newElems - 2); /* index of last usable item */
+ eePtr->endPtr = newStackPtr + (newElems-2); /* index of last usable item */
eePtr->tosPtr = newStackPtr + (eePtr->tosPtr - oldStackPtr);
}
@@ -652,7 +649,7 @@ TclStackAlloc(
eePtr->tosPtr += numWords;
*(eePtr->tosPtr-1) = (Tcl_Obj *) stackRefCountPtr;
- *(eePtr->tosPtr) = (Tcl_Obj *) INT2PTR(numWords);
+ *(eePtr->tosPtr) = (Tcl_Obj *) INT2PTR(numWords);
return (char *) (tosPtr+1);
}
@@ -754,8 +751,8 @@ Tcl_ExprObj(
* 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.
+ * 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.
@@ -777,7 +774,10 @@ Tcl_ExprObj(
}
}
if (objPtr->typePtr != &tclByteCodeType) {
- /* TIP #280 : No invoker (yet) - Expression compilation */
+ /*
+ * TIP #280: No invoker (yet) - Expression compilation
+ */
+
TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0);
result = TclCompileExpr(interp, string, length, &compEnv);
@@ -909,11 +909,11 @@ int
TclCompEvalObj(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
- const CmdFrame* invoker,
- int word)
+ const CmdFrame *invoker,
+ int word)
{
register Interp *iPtr = (Interp *) interp;
- register ByteCode* codePtr; /* Tcl Internal type of bytecode. */
+ register ByteCode *codePtr; /* Tcl Internal type of bytecode. */
int result;
Namespace *namespacePtr;
@@ -943,7 +943,8 @@ TclCompEvalObj(
recompileObj:
iPtr->errorLine = 1;
- /* TIP #280. Remember the invoker for a moment in the interpreter
+ /*
+ * TIP #280. Remember the invoker for a moment in the interpreter
* structures so that the byte code compiler can pick it up when
* initializing the compilation environment, i.e. the extended
* location information.
@@ -1064,9 +1065,13 @@ TclIncrObj(
long augend = *((const long *)ptr1);
long addend = *((const long *)ptr2);
long sum = augend + addend;
- /* Test for overflow */
+
+ /*
+ * Test for overflow.
+ */
+
if ((augend >= 0 || addend >= 0 || sum < 0)
- && (sum >= 0 || addend < 0 || augend < 0)) {
+ && (sum >= 0 || addend < 0 || augend < 0)) {
TclSetLongObj(valuePtr, sum);
return TCL_OK;
}
@@ -1074,8 +1079,12 @@ TclIncrObj(
{
Tcl_WideInt w1 = (Tcl_WideInt)augend;
Tcl_WideInt w2 = (Tcl_WideInt)addend;
- /* We know the sum value is outside the long range,
- * so we use the macro form that doesn't range test again */
+
+ /*
+ * We know the sum value is outside the long range, so we use the
+ * macro form that doesn't range test again.
+ */
+
TclSetWideIntObj(valuePtr, w1 + w2);
return TCL_OK;
}
@@ -1156,13 +1165,15 @@ TclExecuteByteCode(
int initCatchTop; /* Catch stack top at start of execution. */
Var *compiledLocals;
Namespace *namespacePtr;
+ CmdFrame bcFrame; /* TIP #280: Structure for tracking lines. */
/*
* 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 Tcl_Obj **tosPtr; /* Cached pointer to top of evaluation
+ * stack. */
register unsigned char *pc = codePtr->codeStart;
/* The current program counter. */
int instructionCount = 0; /* Counter that is used to work out when to
@@ -1186,9 +1197,6 @@ TclExecuteByteCode(
int result = TCL_OK; /* Return code returned after execution. */
- /* TIP #280 : Structures for tracking lines */
- CmdFrame bcFrame;
-
/*
* Locals - variables that are used within opcodes or bounded sections of
* the file (jumps between opcodes within a family).
@@ -1220,23 +1228,22 @@ TclExecuteByteCode(
initStackTop = tosPtr - eePtr->stackPtr;
- /* TIP #280 : Initialize the frame. Do not push it yet. */
+ /*
+ * TIP #280: Initialize the frame. Do not push it yet.
+ */
- bcFrame.type = ((codePtr->flags & TCL_BYTECODE_PRECOMPILED)
- ? TCL_LOCATION_PREBC
- : TCL_LOCATION_BC);
- bcFrame.level = (iPtr->cmdFramePtr == NULL ?
- 1 :
- iPtr->cmdFramePtr->level + 1);
- bcFrame.framePtr = iPtr->framePtr;
- bcFrame.nextPtr = iPtr->cmdFramePtr;
- bcFrame.nline = 0;
- bcFrame.line = NULL;
+ bcFrame.type = ((codePtr->flags & TCL_BYTECODE_PRECOMPILED)
+ ? TCL_LOCATION_PREBC : TCL_LOCATION_BC);
+ bcFrame.level = (iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level+1 : 1);
+ bcFrame.framePtr = iPtr->framePtr;
+ bcFrame.nextPtr = iPtr->cmdFramePtr;
+ bcFrame.nline = 0;
+ bcFrame.line = NULL;
- bcFrame.data.tebc.codePtr = codePtr;
- bcFrame.data.tebc.pc = NULL;
- bcFrame.cmd.str.cmd = NULL;
- bcFrame.cmd.str.len = 0;
+ bcFrame.data.tebc.codePtr = codePtr;
+ bcFrame.data.tebc.pc = NULL;
+ bcFrame.cmd.str.cmd = NULL;
+ bcFrame.cmd.str.len = 0;
#ifdef TCL_COMPILE_DEBUG
if (tclTraceExec >= 2) {
@@ -1483,11 +1490,11 @@ TclExecuteByteCode(
/*
* 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
+ * 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++;
+ iPtr->cmdCount += TclGetUInt4AtPtr(pc+5);
if (!checkInterp ||
(((codePtr->compileEpoch == iPtr->compileEpoch)
&& (codePtr->nsEpoch == namespacePtr->resolverEpoch))
@@ -1497,17 +1504,20 @@ TclExecuteByteCode(
* Peephole optimisations: check if there are several
* INST_START_CMD in a row. Many commands start by pushing a
* literal argument or command name; optimise that case too.
+ *
+ * TODO: Compiler no longer generates sequences of INST_START_CMD,
+ * so maybe take some of this peephole out.
*/
- while (*(pc += 5) == INST_START_CMD) {
- iPtr->cmdCount++;
+ while (*(pc += 9) == INST_START_CMD) {
+ iPtr->cmdCount += TclGetUInt4AtPtr(pc+5);
}
if (*pc == INST_PUSH1) {
goto instPush1Peephole;
}
NEXT_INST_F(0, 0, 0);
#else
- NEXT_INST_F(5, 0, 0);
+ NEXT_INST_F(9, 0, 0);
#endif
} else {
const char *bytes;
@@ -1609,7 +1619,7 @@ TclExecuteByteCode(
for (; currPtr <= tosPtr; currPtr++) {
bytes = Tcl_GetStringFromObj(*currPtr, &length);
if (bytes != NULL) {
- memcpy((VOID *) p, (VOID *) bytes, (size_t) length);
+ memcpy(p, bytes, (size_t) length);
p += length;
}
}
@@ -1667,7 +1677,7 @@ TclExecuteByteCode(
/*
* Make sure there is enough room in the stack to expand this list
* *and* process the rest of the command (at least up to the next
- * argument expansion or command end). The operand is the current
+ * argument expansion or command end). The operand is the current
* stack depth, as seen by the compiler.
*/
@@ -1696,9 +1706,8 @@ TclExecuteByteCode(
case INST_INVOKE_EXPANDED:
{
- Tcl_Obj *objPtr;
+ Tcl_Obj *objPtr = expandNestList;
- objPtr = expandNestList;
expandNestList = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr2;
objc = tosPtr - eePtr->stackPtr
- (ptrdiff_t) objPtr->internalRep.twoPtrValue.ptr1;
@@ -1795,7 +1804,7 @@ TclExecuteByteCode(
/*
* 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
+ * deallocated by a recursive call to ourselves. The extra
* variable is needed because all others are liable to change due
* to the trace procedures.
*/
@@ -1813,11 +1822,11 @@ TclExecuteByteCode(
/*
* Finally, let TclEvalObjvInternal handle the command.
*
- * TIP #280 : Record the last piece of info needed by
+ * TIP #280: Record the last piece of info needed by
* 'TclGetSrcInfoForPc', and push the frame.
*/
- bcFrame.data.tebc.pc = (char*)pc;
+ bcFrame.data.tebc.pc = (char *) pc;
iPtr->cmdFramePtr = &bcFrame;
DECACHE_STACK_INFO();
/*Tcl_ResetResult(interp);*/
@@ -1838,6 +1847,7 @@ TclExecuteByteCode(
if (result == TCL_OK) {
Tcl_Obj *objPtr;
+
/*
* Push the call's object result and continue execution with
* the next instruction.
@@ -1879,12 +1889,12 @@ TclExecuteByteCode(
* OPTIMISE!
*/
- Tcl_Obj *objPtr;
+ Tcl_Obj *objPtr = *tosPtr;
- objPtr = *tosPtr;
DECACHE_STACK_INFO();
- /* TIP #280: The invoking context is left NULL for a dynamically
+ /*
+ * TIP #280: The invoking context is left NULL for a dynamically
* constructed command. We cannot match its lines to the outer
* context.
*/
@@ -1943,7 +1953,7 @@ TclExecuteByteCode(
* ---------------------------------------------------------
* Start of INST_LOAD instructions.
*
- * WARNING: more 'goto' here than your doctor recommended! The different
+ * 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.
*/
@@ -1965,6 +1975,7 @@ TclExecuteByteCode(
/*
* No errors, no traces: just get the value.
*/
+
objResultPtr = varPtr->value.objPtr;
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
NEXT_INST_F(2, 0, 1);
@@ -1987,6 +1998,7 @@ TclExecuteByteCode(
/*
* No errors, no traces: just get the value.
*/
+
objResultPtr = varPtr->value.objPtr;
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
NEXT_INST_F(5, 0, 1);
@@ -2075,6 +2087,7 @@ TclExecuteByteCode(
/*
* No errors, no traces: just get the value.
*/
+
objResultPtr = varPtr->value.objPtr;
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
NEXT_INST_F(pcAdjustment, 1, 1);
@@ -2110,7 +2123,7 @@ TclExecuteByteCode(
* ---------------------------------------------------------
* Start of INST_STORE and related instructions.
*
- * WARNING: more 'goto' here than your doctor recommended! The different
+ * 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.
*/
@@ -2359,12 +2372,12 @@ TclExecuteByteCode(
* ---------------------------------------------------------
* Start of INST_INCR instructions.
*
- * WARNING: more 'goto' here than your doctor recommended! The different
+ * 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.
*/
-/*TODO: Consider more untangling here; merge with LOAD and STORE ? */
+/*TODO: Consider more untangling here; merge with LOAD and STORE ? */
{
Tcl_Obj *objPtr, *incrPtr;
@@ -2418,8 +2431,8 @@ TclExecuteByteCode(
}
part1 = TclGetString(objPtr);
- varPtr = TclObjLookupVar(interp, objPtr, part2,
- TCL_LEAVE_ERR_MSG, "read", 1, 1, &arrayPtr);
+ varPtr = TclObjLookupVar(interp, objPtr, part2, TCL_LEAVE_ERR_MSG,
+ "read", 1, 1, &arrayPtr);
if (varPtr == NULL) {
Tcl_AddObjErrorInfo(interp,
"\n (reading value of variable to increment)", -1);
@@ -2476,8 +2489,12 @@ TclExecuteByteCode(
if (type == TCL_NUMBER_LONG) {
long augend = *((const long *)ptr);
long sum = augend + i;
- /* Test for overflow */
- /* TODO: faster checking with known limits on i ? */
+
+ /*
+ * Test for overflow.
+ * TODO: faster checking with known limits on i?
+ */
+
if ((augend >= 0 || i >= 0 || sum < 0)
&& (sum >= 0 || i < 0 || augend < 0)) {
@@ -2505,8 +2522,13 @@ TclExecuteByteCode(
varPtr->value.objPtr = objResultPtr;
} else {
objResultPtr = objPtr;
- /* We know the sum value is outside the long range;
- * use macro form that doesn't range test again */
+
+ /*
+ * We know the sum value is outside the long
+ * range; use macro form that doesn't range test
+ * again.
+ */
+
TclSetWideIntObj(objPtr, w+i);
}
goto doneIncr;
@@ -2519,7 +2541,10 @@ TclExecuteByteCode(
w = *((const Tcl_WideInt *)ptr);
sum = w + i;
- /* Check for overflow */
+ /*
+ * Check for overflow.
+ */
+
if ((w >= 0 || i >= 0 || sum < 0)
&& (w < 0 || i < 0 || sum >= 0)) {
TRACE(("%u %ld => ", opnd, i));
@@ -2530,9 +2555,13 @@ TclExecuteByteCode(
varPtr->value.objPtr = objResultPtr;
} else {
objResultPtr = objPtr;
- /* We *do not* know the sum value is outside
- * the long range (wide + long can yield long);
- * use the function call that checks range. */
+
+ /*
+ * We *do not* know the sum value is outside the
+ * long range (wide + long can yield long); use
+ * the function call that checks range.
+ */
+
Tcl_SetWideIntObj(objPtr, sum);
}
goto doneIncr;
@@ -2541,7 +2570,7 @@ TclExecuteByteCode(
#endif
}
if (Tcl_IsShared(objPtr)) {
- objPtr->refCount--; /* we know it's shared */
+ objPtr->refCount--; /* We know it's shared */
objResultPtr = Tcl_DuplicateObj(objPtr);
Tcl_IncrRefCount(objResultPtr);
varPtr->value.objPtr = objResultPtr;
@@ -2552,12 +2581,17 @@ TclExecuteByteCode(
result = TclIncrObj(interp, objResultPtr, incrPtr);
Tcl_DecrRefCount(incrPtr);
if (result != TCL_OK) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TRACE_APPEND(("ERROR: %.30s\n",
+ O2S(Tcl_GetObjResult(interp))));
goto checkForCatch;
}
goto doneIncr;
}
- /* All other cases, flow through to generic handling */
+
+ /*
+ * All other cases, flow through to generic handling.
+ */
+
TclNewLongObj(incrPtr, i);
Tcl_IncrRefCount(incrPtr);
@@ -2574,10 +2608,10 @@ TclExecuteByteCode(
doIncrVar:
if (TclIsVarDirectReadable(varPtr)
- && ((arrayPtr == NULL) || TclIsVarUntraced(arrayPtr))) {
+ && ((arrayPtr == NULL) || TclIsVarUntraced(arrayPtr))) {
objPtr = varPtr->value.objPtr;
if (Tcl_IsShared(objPtr)) {
- objPtr->refCount--; /* we know it's shared */
+ objPtr->refCount--; /* We know it's shared */
objResultPtr = Tcl_DuplicateObj(objPtr);
Tcl_IncrRefCount(objResultPtr);
varPtr->value.objPtr = objResultPtr;
@@ -2636,15 +2670,14 @@ TclExecuteByteCode(
}
{
- int jmpOffset[2];
- int b;
+ int jmpOffset[2], b;
Tcl_Obj *valuePtr;
-/* TODO: consider rewrite so we don't compute the offset we're
- * not going to take. */
+ /* TODO: consider rewrite so we don't compute the offset we're not
+ * going to take. */
case INST_JUMP_FALSE4:
jmpOffset[0] = TclGetInt4AtPtr(pc+1); /* FALSE offset */
- jmpOffset[1] = 5; /* TRUE offset*/
+ jmpOffset[1] = 5; /* TRUE offset*/
goto doCondJump;
case INST_JUMP_TRUE4:
@@ -2726,8 +2759,7 @@ TclExecuteByteCode(
*/
case INST_LOR:
- case INST_LAND:
- {
+ case INST_LAND: {
/*
* Operands must be boolean or numeric. No int->double conversions are
* performed.
@@ -2735,7 +2767,7 @@ TclExecuteByteCode(
int i1, i2, iResult;
Tcl_Obj *value2Ptr = *tosPtr;
- Tcl_Obj *valuePtr = *(tosPtr - 1);
+ Tcl_Obj *valuePtr = *(tosPtr - 1);
result = TclGetBooleanFromObj(NULL, valuePtr, &i1);
if (result != TCL_OK) {
@@ -2809,7 +2841,7 @@ TclExecuteByteCode(
*/
value2Ptr = *tosPtr;
- valuePtr = *(tosPtr - 1);
+ valuePtr = *(tosPtr - 1);
/*
* Extract the desired list element
@@ -2817,8 +2849,8 @@ TclExecuteByteCode(
objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);
if (objResultPtr == NULL) {
- TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ", O2S(valuePtr), O2S(value2Ptr)),
- Tcl_GetObjResult(interp));
+ TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ", O2S(valuePtr),
+ O2S(value2Ptr)), Tcl_GetObjResult(interp));
result = TCL_ERROR;
goto checkForCatch;
}
@@ -2859,7 +2891,7 @@ TclExecuteByteCode(
}
/*
- * Select the list item based on the index. Negative operand means
+ * Select the list item based on the index. Negative operand means
* end-based indexing.
*/
@@ -2874,7 +2906,8 @@ TclExecuteByteCode(
TclNewObj(objResultPtr);
}
- TRACE_WITH_OBJ(("\"%.30s\" %d => ", O2S(valuePtr), opnd), objResultPtr);
+ TRACE_WITH_OBJ(("\"%.30s\" %d => ", O2S(valuePtr), opnd),
+ objResultPtr);
NEXT_INST_F(5, 1, 1);
}
@@ -2900,6 +2933,7 @@ TclExecuteByteCode(
/*
* Check for errors
*/
+
if (objResultPtr == NULL) {
TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
result = TCL_ERROR;
@@ -2915,8 +2949,9 @@ TclExecuteByteCode(
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;
@@ -2924,27 +2959,31 @@ TclExecuteByteCode(
numIdx = opnd - 2;
/*
- * Get the old value of variable, and remove the stack ref. This is
+ * 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 */
/*
* Get the new element value.
*/
+
valuePtr = *tosPtr;
/*
* Compute the new variable value
*/
+
objResultPtr = TclLsetFlat(interp, value2Ptr, numIdx,
tosPtr - numIdx, valuePtr);
/*
* Check for errors
*/
+
if (objResultPtr == NULL) {
TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
result = TCL_ERROR;
@@ -2954,6 +2993,7 @@ TclExecuteByteCode(
/*
* Set result
*/
+
TRACE(("%d => %s\n", opnd, O2S(objResultPtr)));
NEXT_INST_V(5, (numIdx+1), -1);
}
@@ -2966,27 +3006,31 @@ TclExecuteByteCode(
Tcl_Obj *objPtr, *valuePtr, *value2Ptr;
/*
- * Get the old value of variable, and remove the stack ref. This is
+ * 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();
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
*/
+
objResultPtr = TclLsetList(interp, objPtr, value2Ptr, valuePtr);
/*
* Check for errors
*/
+
if (objResultPtr == NULL) {
TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(value2Ptr)),
Tcl_GetObjResult(interp));
@@ -2997,6 +3041,7 @@ TclExecuteByteCode(
/*
* Set result
*/
+
TRACE(("=> %s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, -1);
}
@@ -3005,12 +3050,12 @@ TclExecuteByteCode(
/*** lrange with objc==4 and both indices in bytecode stream ***/
int listc, fromIdx, toIdx;
- Tcl_Obj **listv;
- Tcl_Obj *valuePtr;
+ Tcl_Obj **listv, *valuePtr;
/*
* Pop the list and get the indices
*/
+
valuePtr = *tosPtr;
fromIdx = TclGetInt4AtPtr(pc+1);
toIdx = TclGetInt4AtPtr(pc+5);
@@ -3019,6 +3064,7 @@ TclExecuteByteCode(
* 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 %d => ERROR: ", O2S(valuePtr),
@@ -3030,6 +3076,7 @@ TclExecuteByteCode(
* 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) {
NEXT_INST_F(10, 1, 0);
@@ -3039,6 +3086,7 @@ TclExecuteByteCode(
/*
* Adjust the indices for end-based handling.
*/
+
if (fromIdx < -1) {
fromIdx += 1+listc;
if (fromIdx < -1) {
@@ -3060,6 +3108,7 @@ TclExecuteByteCode(
* 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) {
fromIdx = 0;
@@ -3101,7 +3150,10 @@ TclExecuteByteCode(
}
found = 0;
if (llen > 0) {
- /* An empty list doesn't match anything */
+ /*
+ * An empty list doesn't match anything.
+ */
+
i = 0;
do {
Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
@@ -3272,6 +3324,7 @@ TclExecuteByteCode(
* 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,
@@ -3282,12 +3335,16 @@ TclExecuteByteCode(
* Make sure only -1,0,1 is returned
* TODO: consider peephole opt.
*/
+
if (iResult == 0) {
iResult = s1len - s2len;
}
if (*pc != INST_STR_CMP) {
- /* Take care of the opcodes that goto'ed into here */
+ /*
+ * Take care of the opcodes that goto'ed into here.
+ */
+
switch (*pc) {
case INST_EQ:
iResult = (iResult == 0);
@@ -3351,7 +3408,7 @@ TclExecuteByteCode(
/*
* If we have a ByteArray object, avoid indexing in the Utf string
- * since the byte array contains one byte per character. Otherwise,
+ * since the byte array contains one byte per character. Otherwise,
* use the Unicode string rep to get the index'th char.
*/
@@ -3361,6 +3418,7 @@ TclExecuteByteCode(
/*
* Get Unicode char length to calulate what 'end' means.
*/
+
length = Tcl_GetCharLength(valuePtr);
}
@@ -3404,8 +3462,8 @@ TclExecuteByteCode(
int nocase, match;
Tcl_Obj *valuePtr, *value2Ptr;
- nocase = TclGetInt1AtPtr(pc+1);
- valuePtr = *tosPtr; /* String */
+ nocase = TclGetInt1AtPtr(pc+1);
+ valuePtr = *tosPtr; /* String */
value2Ptr = *(tosPtr - 1); /* Pattern */
/*
@@ -3456,11 +3514,17 @@ TclExecuteByteCode(
#endif
if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) {
- /* At least one non-numeric argument - compare as strings */
+ /*
+ * At least one non-numeric argument - compare as strings.
+ */
+
goto stringCompare;
}
if (type1 == TCL_NUMBER_NAN) {
- /* NaN first arg: NaN != to everything, other compares are false */
+ /*
+ * NaN first arg: NaN != to everything, other compares are false.
+ */
+
iResult = (*pc == INST_NEQ);
goto foundResult;
}
@@ -3469,11 +3533,17 @@ TclExecuteByteCode(
goto convertComparison;
}
if (GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK) {
- /* At least one non-numeric argument - compare as strings */
+ /*
+ * At least one non-numeric argument - compare as strings.
+ */
+
goto stringCompare;
}
if (type2 == TCL_NUMBER_NAN) {
- /* NaN 2nd arg: NaN != to everything, other compares are false */
+ /*
+ * NaN 2nd arg: NaN != to everything, other compares are false.
+ */
+
iResult = (*pc == INST_NEQ);
goto foundResult;
}
@@ -3502,8 +3572,9 @@ TclExecuteByteCode(
* as doubles.
*/
- if ((DBL_MANT_DIG > CHAR_BIT*sizeof(long))
- || (l1 == (long) d1) || (modf(d2, &tmp) != 0.0)) {
+ if (DBL_MANT_DIG > CHAR_BIT*sizeof(long)
+ || l1 == (long) d1
+ || modf(d2, &tmp) != 0.0) {
goto doubleCompare;
}
@@ -3515,7 +3586,7 @@ TclExecuteByteCode(
* expr 20000000000000003 < 20000000000000004.0
* right. Converting the first argument to double will yield
* two double values that are equivalent within double
- * precision. Converting the double to an integer gets done
+ * precision. Converting the double to an integer gets done
* exactly, then integer comparison can tell the difference.
*/
@@ -3556,8 +3627,9 @@ TclExecuteByteCode(
case TCL_NUMBER_DOUBLE:
d2 = *((const double *)ptr2);
d1 = (double) w1;
- if ((DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt))
- || (w1 == (Tcl_WideInt) d1) || (modf(d2, &tmp) != 0.0)) {
+ if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)
+ || w1 == (Tcl_WideInt) d1
+ || modf(d2, &tmp) != 0.0) {
goto doubleCompare;
}
if (d2 < (double)LLONG_MIN) {
@@ -3593,9 +3665,9 @@ TclExecuteByteCode(
case TCL_NUMBER_LONG:
l2 = *((const long *)ptr2);
d2 = (double) l2;
-
- if ((DBL_MANT_DIG > CHAR_BIT*sizeof(long))
- || (l2 == (long) d2) || (modf(d1, &tmp) != 0.0)) {
+ if (DBL_MANT_DIG > CHAR_BIT*sizeof(long)
+ || l2 == (long) d2
+ || modf(d1, &tmp) != 0.0) {
goto doubleCompare;
}
if (d1 < (double)LONG_MIN) {
@@ -3612,8 +3684,9 @@ TclExecuteByteCode(
case TCL_NUMBER_WIDE:
w2 = *((const Tcl_WideInt *)ptr2);
d2 = (double) w2;
- if ((DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt))
- || (w2 == (Tcl_WideInt) d2) || (modf(d1, &tmp) != 0.0)) {
+ if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)
+ || w2 == (Tcl_WideInt) d2
+ || modf(d1, &tmp) != 0.0) {
goto doubleCompare;
}
if (d1 < (double)LLONG_MIN) {
@@ -3642,8 +3715,8 @@ TclExecuteByteCode(
mp_clear(&big2);
break;
}
- if ((DBL_MANT_DIG > CHAR_BIT*sizeof(long))
- && (modf(d1, &tmp) != 0.0)) {
+ if (DBL_MANT_DIG > CHAR_BIT*sizeof(long)
+ && modf(d1, &tmp) != 0.0) {
d2 = TclBignumToDouble(&big2);
mp_clear(&big2);
goto doubleCompare;
@@ -3675,8 +3748,8 @@ TclExecuteByteCode(
mp_clear(&big1);
break;
}
- if ((DBL_MANT_DIG > CHAR_BIT*sizeof(long))
- && (modf(d2, &tmp) != 0.0)) {
+ if (DBL_MANT_DIG > CHAR_BIT*sizeof(long)
+ && modf(d2, &tmp) != 0.0) {
d1 = TclBignumToDouble(&big1);
mp_clear(&big1);
goto doubleCompare;
@@ -3692,7 +3765,9 @@ TclExecuteByteCode(
}
}
- /* Turn comparison outcome into appropriate result for opcode */
+ /*
+ * Turn comparison outcome into appropriate result for opcode.
+ */
convertComparison:
switch (*pc) {
@@ -3742,7 +3817,7 @@ TclExecuteByteCode(
case INST_LSHIFT:
case INST_RSHIFT: {
Tcl_Obj *value2Ptr = *tosPtr;
- Tcl_Obj *valuePtr = *(tosPtr - 1);
+ Tcl_Obj *valuePtr = *(tosPtr - 1);
ClientData ptr1, ptr2;
int invalid, shift, type1, type2;
long l1;
@@ -3772,8 +3847,8 @@ TclExecuteByteCode(
if (*pc == INST_MOD) {
/* TODO: Attempts to re-use unshared operands on stack */
- long l2 = 0; /* silence gcc warning */
-
+ long l2 = 0; /* silence gcc warning */
+
if (type2 == TCL_NUMBER_LONG) {
l2 = *((const long *)ptr2);
if (l2 == 0) {
@@ -3782,7 +3857,10 @@ TclExecuteByteCode(
goto divideByZero;
}
if ((l2 == 1) || (l2 == -1)) {
- /* Div. by |1| always yields remainder of 0 */
+ /*
+ * Div. by |1| always yields remainder of 0
+ */
+
objResultPtr = eePtr->constants[0];
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
@@ -3791,20 +3869,30 @@ TclExecuteByteCode(
if (type1 == TCL_NUMBER_LONG) {
l1 = *((const long *)ptr1);
if (l1 == 0) {
- /* 0 % (non-zero) always yields remainder of 0 */
+ /*
+ * 0 % (non-zero) always yields remainder of 0
+ */
+
objResultPtr = eePtr->constants[0];
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
}
if (type2 == TCL_NUMBER_LONG) {
- /* Both operands are long; do native calculation */
+ /*
+ * Both operands are long; do native calculation.
+ */
+
long lRemainder, lQuotient = l1 / l2;
- /* Force Tcl's integer division rules */
- /* TODO: examine for logic simplification */
- if (((lQuotient < 0) || ((lQuotient == 0) &&
+ /*
+ * Force Tcl's integer division rules.
+ *
+ * TODO: examine for logic simplification
+ */
+
+ if ((lQuotient < 0 || (lQuotient == 0 &&
((l1 < 0 && l2 > 0) || (l1 > 0 && l2 < 0)))) &&
- ((lQuotient * l2) != l1)) {
+ (lQuotient * l2 != l1)) {
lQuotient -= 1;
}
lRemainder = l1 - l2*lQuotient;
@@ -3812,41 +3900,59 @@ TclExecuteByteCode(
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
}
+
/*
- * first operand fits in long; second does not, so the second
- * has greater magnitude than first. No need to divide to
+ * First operand fits in long; second does not, so the second
+ * has greater magnitude than first. No need to divide to
* determine the remainder.
*/
+
#ifndef NO_WIDE_TYPE
if (type2 == TCL_NUMBER_WIDE) {
Tcl_WideInt w2 = *((const Tcl_WideInt *)ptr2);
if ((l1 > 0) ^ (w2 > (Tcl_WideInt)0)) {
- /* Arguments are opposite sign; remainder is sum */
+ /*
+ * Arguments are opposite sign; remainder is sum.
+ */
+
objResultPtr = Tcl_NewWideIntObj(w2+(Tcl_WideInt)l1);
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
}
- /* Arguments are same sign; remainder is first operand */
+
+ /*
+ * Arguments are same sign; remainder is first operand.
+ */
+
TRACE(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 1, 0);
}
#endif
{
mp_int big2;
+
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
/* TODO: internals intrusion */
if ((l1 > 0) ^ (big2.sign == MP_ZPOS)) {
- /* Arguments are opposite sign; remainder is sum */
+ /*
+ * Arguments are opposite sign; remainder is sum.
+ */
+
mp_int big1;
+
TclBNInitBignumFromLong(&big1, l1);
mp_add(&big2, &big1, &big2);
objResultPtr = Tcl_NewBignumObj(&big2);
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
}
- /* Arguments are same sign; remainder is first operand */
+
+ /*
+ * Arguments are same sign; remainder is first operand.
+ */
+
TRACE(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 1, 0);
}
@@ -3854,21 +3960,24 @@ TclExecuteByteCode(
#ifndef NO_WIDE_TYPE
if (type1 == TCL_NUMBER_WIDE) {
Tcl_WideInt w1 = *((const Tcl_WideInt *)ptr1);
+
if (type2 != TCL_NUMBER_BIG) {
Tcl_WideInt w2, wQuotient, wRemainder;
Tcl_GetWideIntFromObj(NULL, value2Ptr, &w2);
wQuotient = w1 / w2;
- /* Force Tcl's integer division rules */
- /* TODO: examine for logic simplification */
- if (((wQuotient < ((Tcl_WideInt) 0))
- || ((wQuotient == ((Tcl_WideInt) 0))
- && ((w1 < ((Tcl_WideInt) 0)
- && w2 > ((Tcl_WideInt) 0))
- || (w1 > ((Tcl_WideInt) 0)
- && w2 < ((Tcl_WideInt) 0))))) &&
- ((wQuotient * w2) != w1)) {
+ /*
+ * Force Tcl's integer division rules.
+ *
+ * TODO: examine for logic simplification
+ */
+
+ if (((wQuotient < (Tcl_WideInt) 0)
+ || ((wQuotient == (Tcl_WideInt) 0)
+ && ((w1 < (Tcl_WideInt)0 && w2 > (Tcl_WideInt)0)
+ || (w1 > (Tcl_WideInt)0 && w2 < (Tcl_WideInt)0))))
+ && (wQuotient * w2 != w1)) {
wQuotient -= (Tcl_WideInt) 1;
}
wRemainder = w1 - w2*wQuotient;
@@ -3882,15 +3991,23 @@ TclExecuteByteCode(
/* TODO: internals intrusion */
if ((w1 > ((Tcl_WideInt) 0)) ^ (big2.sign == MP_ZPOS)) {
- /* Arguments are opposite sign; remainder is sum */
+ /*
+ * Arguments are opposite sign; remainder is sum.
+ */
+
mp_int big1;
+
TclBNInitBignumFromWideInt(&big1, w1);
mp_add(&big2, &big1, &big2);
objResultPtr = Tcl_NewBignumObj(&big2);
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
}
- /* Arguments are same sign; remainder is first operand */
+
+ /*
+ * Arguments are same sign; remainder is first operand.
+ */
+
TRACE(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 1, 0);
}
@@ -3906,7 +4023,10 @@ TclExecuteByteCode(
mp_div(&big1, &big2, &bigResult, &bigRemainder);
if (!mp_iszero(&bigRemainder)
&& (bigRemainder.sign != big2.sign)) {
- /* Convert to Tcl's integer division rules */
+ /*
+ * Convert to Tcl's integer division rules.
+ */
+
mp_sub_d(&bigResult, 1, &bigResult);
mp_add(&bigRemainder, &big2, &bigRemainder);
}
@@ -3926,7 +4046,10 @@ TclExecuteByteCode(
}
}
- /* reject negative shift argument */
+ /*
+ * Reject negative shift argument.
+ */
+
switch (type2) {
case TCL_NUMBER_LONG:
invalid = (*((const long *)ptr2) < (long)0);
@@ -3937,7 +4060,7 @@ TclExecuteByteCode(
break;
#endif
case TCL_NUMBER_BIG:
- /* TODO: const correctness ? */
+ /* TODO: const correctness? */
invalid = (mp_cmp_d((mp_int *)ptr2, 0) == MP_LT);
break;
default:
@@ -3951,7 +4074,10 @@ TclExecuteByteCode(
goto checkForCatch;
}
- /* Zero shifted any number of bits is still zero */
+ /*
+ * Zero shifted any number of bits is still zero.
+ */
+
if ((type1 == TCL_NUMBER_LONG) && (*((const long *)ptr1) == (long)0)) {
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
objResultPtr = eePtr->constants[0];
@@ -3960,12 +4086,14 @@ TclExecuteByteCode(
}
if (*pc == INST_LSHIFT) {
- /* Large left shifts create integer overflow */
- /* BEWARE! Can't use Tcl_GetIntFromObj() here because
- * that converts values in the (unsigned int) range to
- * their signed int counterparts, leading to incorrect
- * results.
+ /*
+ * Large left shifts create integer overflow.
+ *
+ * BEWARE! Can't use Tcl_GetIntFromObj() here because that
+ * converts values in the (unsigned int) range to their signed int
+ * counterparts, leading to incorrect results.
*/
+
if ((type2 != TCL_NUMBER_LONG)
|| (*((const long *)ptr2) > (long) INT_MAX)) {
/*
@@ -3982,38 +4110,47 @@ TclExecuteByteCode(
}
shift = (int)(*((const long *)ptr2));
+ /*
+ * Handle shifts within the native long range.
+ */
- /* Handle shifts within the native long range */
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
- if ((type1 == TCL_NUMBER_LONG) && ((size_t)shift < CHAR_BIT*sizeof(long))
- && (l1 = *((const long *)ptr1))
- && !(((l1>0) ? l1 : ~l1)
- & -(1L<<(CHAR_BIT*sizeof(long)-1-shift)))) {
+ if ((type1 == TCL_NUMBER_LONG)
+ && (size_t) shift < CHAR_BIT*sizeof(long)
+ && l1 == *(const long *)ptr1
+ && !((l1>0 ? l1 : ~l1)
+ & -(1L<<(CHAR_BIT*sizeof(long) - 1 - shift)))) {
TclNewLongObj(objResultPtr, (l1<<shift));
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
}
- /* Handle shifts within the native wide range */
+ /*
+ * Handle shifts within the native wide range.
+ */
+
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
if ((type1 != TCL_NUMBER_BIG)
&& ((size_t)shift < CHAR_BIT*sizeof(Tcl_WideInt))) {
Tcl_WideInt w;
TclGetWideIntFromObj(NULL, valuePtr, &w);
- if (!(((w>0) ? w : ~w)
+ if (!((w>0 ? w : ~w)
& -(((Tcl_WideInt)1)
- <<(CHAR_BIT*sizeof(Tcl_WideInt)-1-shift)))) {
+ << (CHAR_BIT*sizeof(Tcl_WideInt) - 1 - shift)))) {
objResultPtr = Tcl_NewWideIntObj(w<<shift);
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
}
}
} else {
- /* Quickly force large right shifts to 0 or -1 */
+ /*
+ * Quickly force large right shifts to 0 or -1
+ */
+
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
if ((type2 != TCL_NUMBER_LONG)
- || (*((const long *)ptr2) > INT_MAX)) {
+ || (*(const long *)ptr2 > INT_MAX)) {
/*
* Again, technically, the value to be shifted could be an
* mp_int so huge that a right shift by (INT_MAX+1) bits could
@@ -4026,11 +4163,11 @@ TclExecuteByteCode(
switch (type1) {
case TCL_NUMBER_LONG:
- zero = (*((const long *)ptr1) > (long)0);
+ zero = (*(const long *)ptr1 > 0L);
break;
#ifndef NO_WIDE_TYPE
case TCL_NUMBER_WIDE:
- zero = (*((const Tcl_WideInt *)ptr1) > (Tcl_WideInt)0);
+ zero = (*(const Tcl_WideInt *)ptr1 > (Tcl_WideInt)0);
break;
#endif
case TCL_NUMBER_BIG:
@@ -4049,8 +4186,12 @@ TclExecuteByteCode(
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
}
- shift = (int)(*((const long *)ptr2));
- /* Handle shifts within the native long range */
+ shift = (int)(*(const long *)ptr2);
+
+ /*
+ * Handle shifts within the native long range.
+ */
+
if (type1 == TCL_NUMBER_LONG) {
l1 = *((const long *)ptr1);
if ((size_t)shift >= CHAR_BIT*sizeof(long)) {
@@ -4065,10 +4206,15 @@ TclExecuteByteCode(
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
}
+
#ifndef NO_WIDE_TYPE
- /* Handle shifts within the native wide range */
+ /*
+ * Handle shifts within the native wide range.
+ */
+
if (type1 == TCL_NUMBER_WIDE) {
- Tcl_WideInt w = *((const Tcl_WideInt *)ptr1);
+ Tcl_WideInt w = *(const Tcl_WideInt *)ptr1;
+
if ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideInt)) {
if (w >= (Tcl_WideInt)0) {
objResultPtr = eePtr->constants[0];
@@ -4096,7 +4242,10 @@ TclExecuteByteCode(
mp_init(&bigRemainder);
mp_div_2d(&big, shift, &bigResult, &bigRemainder);
if (mp_cmp_d(&bigRemainder, 0) == MP_LT) {
- /* Convert to Tcl's integer division rules */
+ /*
+ * Convert to Tcl's integer division rules.
+ */
+
mp_sub_d(&bigResult, 1, &bigResult);
}
mp_clear(&bigRemainder);
@@ -4144,8 +4293,7 @@ TclExecuteByteCode(
}
if ((type1 == TCL_NUMBER_BIG) || (type2 == TCL_NUMBER_BIG)) {
- mp_int big1, big2, bigResult;
- mp_int *First, *Second;
+ mp_int big1, big2, bigResult, *First, *Second;
int numPos;
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
@@ -4158,10 +4306,10 @@ TclExecuteByteCode(
if (mp_cmp_d(&big1, 0) != MP_LT) {
numPos = 1 + (mp_cmp_d(&big2, 0) != MP_LT);
- First = &big1;
+ First = &big1;
Second = &big2;
} else {
- First = &big2;
+ First = &big2;
Second = &big1;
numPos = (mp_cmp_d(First, 0) != MP_LT);
}
@@ -4171,20 +4319,29 @@ TclExecuteByteCode(
case INST_BITAND:
switch (numPos) {
case 2:
- /* Both arguments positive, base case */
+ /*
+ * Both arguments positive, base case.
+ */
+
mp_and(First, Second, &bigResult);
break;
case 1:
- /* First is positive; Second negative
- * P & N = P & ~~N = P&~(-N-1) = P & (P ^ (-N-1)) */
+ /*
+ * First is positive; second negative:
+ * P & N = P & ~~N = P&~(-N-1) = P & (P ^ (-N-1))
+ */
+
mp_neg(Second, Second);
mp_sub_d(Second, 1, Second);
mp_xor(First, Second, &bigResult);
mp_and(First, &bigResult, &bigResult);
break;
case 0:
- /* Both arguments negative
- * a & b = ~ (~a | ~b) = -(-a-1|-b-1)-1 */
+ /*
+ * Both arguments negative:
+ * a & b = ~ (~a | ~b) = -(-a-1|-b-1)-1
+ */
+
mp_neg(First, First);
mp_sub_d(First, 1, First);
mp_neg(Second, Second);
@@ -4199,12 +4356,18 @@ TclExecuteByteCode(
case INST_BITOR:
switch (numPos) {
case 2:
- /* Both arguments positive, base case */
+ /*
+ * Both arguments positive, base case.
+ */
+
mp_or(First, Second, &bigResult);
break;
case 1:
- /* First is positive; Second negative
- * N|P = ~(~N&~P) = ~((-N-1)&~P) = -((-N-1)&((-N-1)^P))-1 */
+ /*
+ * First is positive; second negative:
+ * N|P = ~(~N&~P) = ~((-N-1)&~P) = -((-N-1)&((-N-1)^P))-1
+ */
+
mp_neg(Second, Second);
mp_sub_d(Second, 1, Second);
mp_xor(First, Second, &bigResult);
@@ -4213,8 +4376,11 @@ TclExecuteByteCode(
mp_sub_d(&bigResult, 1, &bigResult);
break;
case 0:
- /* Both arguments negative
- * a | b = ~ (~a & ~b) = -(-a-1&-b-1)-1 */
+ /*
+ * Both arguments negative:
+ * a | b = ~ (~a & ~b) = -(-a-1&-b-1)-1
+ */
+
mp_neg(First, First);
mp_sub_d(First, 1, First);
mp_neg(Second, Second);
@@ -4229,13 +4395,18 @@ TclExecuteByteCode(
case INST_BITXOR:
switch (numPos) {
case 2:
- /* Both arguments positive, base case */
+ /*
+ * Both arguments positive, base case.
+ */
+
mp_xor(First, Second, &bigResult);
break;
case 1:
- /* First is positive; Second negative
+ /*
+ * First is positive; second negative:
* P^N = ~(P^~N) = -(P^(-N-1))-1
*/
+
mp_neg(Second, Second);
mp_sub_d(Second, 1, Second);
mp_xor(First, Second, &bigResult);
@@ -4243,8 +4414,11 @@ TclExecuteByteCode(
mp_sub_d(&bigResult, 1, &bigResult);
break;
case 0:
- /* Both arguments negative
- * a ^ b = (~a ^ ~b) = (-a-1^-b-1) */
+ /*
+ * Both arguments negative:
+ * a ^ b = (~a ^ ~b) = (-a-1^-b-1)
+ */
+
mp_neg(First, First);
mp_sub_d(First, 1, First);
mp_neg(Second, Second);
@@ -4271,6 +4445,7 @@ TclExecuteByteCode(
#ifndef NO_WIDE_TYPE
if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) {
Tcl_WideInt wResult, w1, w2;
+
TclGetWideIntFromObj(NULL, valuePtr, &w1);
TclGetWideIntFromObj(NULL, value2Ptr, &w2);
@@ -4334,7 +4509,7 @@ TclExecuteByteCode(
#if 0
/*
* 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
+ * 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.
@@ -4354,8 +4529,7 @@ TclExecuteByteCode(
* For tracing that uses wide values.
*/
#define LLD "%" TCL_LL_MODIFIER "d"
- case INST_MOD:
- {
+ case INST_MOD: {
/*
* Only integers are allowed. We compute value op value2.
*/
@@ -4367,7 +4541,7 @@ TclExecuteByteCode(
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) {
@@ -4426,9 +4600,11 @@ TclExecuteByteCode(
if (valuePtr->typePtr == &tclWideIntType
|| value2Ptr->typePtr == &tclWideIntType) {
Tcl_WideInt wRemainder;
+
/*
* Promote to wide
*/
+
if (valuePtr->typePtr == &tclIntType) {
w = Tcl_LongAsWide(i);
} else if (value2Ptr->typePtr == &tclIntType) {
@@ -4522,7 +4698,7 @@ TclExecuteByteCode(
rem = i % i2;
/*
- * remainder is (remainder + divisor) when the remainder is
+ * 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.
@@ -4592,7 +4768,10 @@ TclExecuteByteCode(
#ifdef ACCEPT_NAN
if (type1 == TCL_NUMBER_NAN) {
- /* NaN first argument -> result is also NaN */
+ /*
+ * NaN first argument -> result is also NaN.
+ */
+
NEXT_INST_F(1, 1, 0);
}
#endif
@@ -4613,16 +4792,23 @@ TclExecuteByteCode(
#ifdef ACCEPT_NAN
if (type2 == TCL_NUMBER_NAN) {
- /* NaN second argument -> result is also NaN */
+ /*
+ * NaN second argument -> result is also NaN.
+ */
+
objResultPtr = value2Ptr;
NEXT_INST_F(1, 2, 1);
}
#endif
if ((type1 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_DOUBLE)) {
- /* At least one of the values is floating-point, so perform
- * floating point calculations */
+ /*
+ * At least one of the values is floating-point, so perform
+ * floating point calculations.
+ */
+
double d1, d2, dResult;
+
Tcl_GetDoubleFromObj(NULL, valuePtr, &d1);
Tcl_GetDoubleFromObj(NULL, value2Ptr, &d2);
@@ -4691,6 +4877,7 @@ TclExecuteByteCode(
&& (type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
long l1 = *((const long *)ptr1);
long l2 = *((const long *)ptr2);
+
if ((l1 <= INT_MAX) && (l1 >= INT_MIN)
&& (l2 <= INT_MAX) && (l2 >= INT_MIN)) {
long lResult = l1 * l2;
@@ -4730,10 +4917,14 @@ TclExecuteByteCode(
if (*pc == INST_EXPON) {
long l1, l2 = 0;
int oddExponent = 0, negativeExponent = 0;
+
if (type2 == TCL_NUMBER_LONG) {
l2 = *((const long *)ptr2);
if (l2 == 0) {
- /* Anything to the zero power is 1 */
+ /*
+ * Anything to the zero power is 1.
+ */
+
objResultPtr = eePtr->constants[1];
NEXT_INST_F(1, 2, 1);
}
@@ -4747,6 +4938,7 @@ TclExecuteByteCode(
#ifndef NO_WIDE_TYPE
case TCL_NUMBER_WIDE: {
Tcl_WideInt w2 = *((const Tcl_WideInt *)ptr2);
+
negativeExponent = (w2 < 0);
oddExponent = (int) (w2 & (Tcl_WideInt)1);
break;
@@ -4754,6 +4946,7 @@ TclExecuteByteCode(
#endif
case TCL_NUMBER_BIG: {
mp_int big2;
+
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
negativeExponent = (mp_cmp_d(&big2, 0) == MP_LT);
mp_mod_2d(&big2, 1, &big2);
@@ -4768,9 +4961,12 @@ TclExecuteByteCode(
l1 = *((const long *)ptr1);
switch (l1) {
case 0:
- /* zero to a negative power is div by zero error */
+ /*
+ * Zero to a negative power is div by zero error.
+ */
+
TRACE(("%s %s => EXPONENT OF ZERO\n", O2S(valuePtr),
- O2S(value2Ptr)));
+ O2S(value2Ptr)));
goto exponOfZero;
case -1:
if (oddExponent) {
@@ -4780,13 +4976,20 @@ TclExecuteByteCode(
}
NEXT_INST_F(1, 2, 1);
case 1:
- /* 1 to any power is 1 */
+ /*
+ * 1 to any power is 1.
+ */
+
objResultPtr = eePtr->constants[1];
NEXT_INST_F(1, 2, 1);
}
}
- /* Integers with magnitude greater than 1 raise to a negative
- * power yield the answer zero (see TIP 123) */
+
+ /*
+ * Integers with magnitude greater than 1 raise to a negative
+ * power yield the answer zero (see TIP 123).
+ */
+
objResultPtr = eePtr->constants[0];
NEXT_INST_F(1, 2, 1);
}
@@ -4795,11 +4998,17 @@ TclExecuteByteCode(
l1 = *((const long *)ptr1);
switch (l1) {
case 0:
- /* zero to a positive power is zero */
+ /*
+ * Zero to a positive power is zero.
+ */
+
objResultPtr = eePtr->constants[0];
NEXT_INST_F(1, 2, 1);
case 1:
- /* 1 to any power is 1 */
+ /*
+ * 1 to any power is 1.
+ */
+
objResultPtr = eePtr->constants[1];
NEXT_INST_F(1, 2, 1);
case -1:
@@ -4834,7 +5043,10 @@ TclExecuteByteCode(
if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
#endif
{
- /* Check for overflow */
+ /*
+ * Check for overflow.
+ */
+
if (((w1 < 0) && (w2 < 0) && (wResult >= 0))
|| ((w1 > 0) && (w2 > 0) && (wResult < 0))) {
goto overflow;
@@ -4848,7 +5060,10 @@ TclExecuteByteCode(
if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
#endif
{
- /* Must check for overflow */
+ /*
+ * Must check for overflow.
+ */
+
if (((w1 < 0) && (w2 > 0) && (wResult > 0))
|| ((w1 >= 0) && (w2 < 0) && (wResult < 0))) {
goto overflow;
@@ -4863,14 +5078,20 @@ TclExecuteByteCode(
goto divideByZero;
}
- /* Need a bignum to represent (LLONG_MIN / -1) */
+ /*
+ * Need a bignum to represent (LLONG_MIN / -1)
+ */
+
if ((w1 == LLONG_MIN) && (w2 == -1)) {
goto overflow;
}
wResult = w1 / w2;
- /* Force Tcl's integer division rules */
- /* TODO: examine for logic simplification */
+ /*
+ * Force Tcl's integer division rules.
+ * TODO: examine for logic simplification
+ */
+
if (((wResult < 0) || ((wResult == 0) &&
((w1 < 0 && w2 > 0) || (w1 > 0 && w2 < 0)))) &&
((wResult * w2) != w1)) {
@@ -4878,7 +5099,10 @@ TclExecuteByteCode(
}
break;
default:
- /* Unused, here to silence compiler warning. */
+ /*
+ * Unused, here to silence compiler warning.
+ */
+
wResult = 0;
}
@@ -4896,6 +5120,7 @@ TclExecuteByteCode(
overflow:
{
mp_int big1, big2, bigResult, bigRemainder;
+
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
@@ -4923,7 +5148,10 @@ TclExecuteByteCode(
/* TODO: internals intrusion */
if (!mp_iszero(&bigRemainder)
&& (bigRemainder.sign != big2.sign)) {
- /* Convert to Tcl's integer division rules */
+ /*
+ * Convert to Tcl's integer division rules.
+ */
+
mp_sub_d(&bigResult, 1, &bigResult);
mp_add(&bigRemainder, &big2, &bigRemainder);
}
@@ -4981,7 +5209,10 @@ TclExecuteByteCode(
result = GetNumberFromObj(NULL, valuePtr, &ptr, &type);
if ((result != TCL_OK)
|| (type == TCL_NUMBER_NAN) || (type == TCL_NUMBER_DOUBLE)) {
- /* ... ~$NonInteger => raise an error */
+ /*
+ * ... ~$NonInteger => raise an error.
+ */
+
result = TCL_ERROR;
TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
(valuePtr->typePtr? valuePtr->typePtr->name : "null")));
@@ -4990,6 +5221,7 @@ TclExecuteByteCode(
}
if (type == TCL_NUMBER_LONG) {
long l = *((const long *)ptr);
+
if (Tcl_IsShared(valuePtr)) {
TclNewLongObj(objResultPtr, ~l);
NEXT_INST_F(1, 1, 1);
@@ -5064,6 +5296,7 @@ TclExecuteByteCode(
#ifndef NO_WIDE_TYPE
case TCL_NUMBER_WIDE: {
Tcl_WideInt w;
+
if (type == TCL_NUMBER_LONG) {
w = (Tcl_WideInt)(*((const long *)ptr));
} else {
@@ -5082,14 +5315,15 @@ TclExecuteByteCode(
#endif
case TCL_NUMBER_BIG: {
mp_int big;
+
switch (type) {
#ifdef NO_WIDE_TYPE
case TCL_NUMBER_LONG:
- TclBNInitBignumFromLong(&big, *((const long *)ptr));
+ TclBNInitBignumFromLong(&big, *(const long *) ptr);
break;
#else
case TCL_NUMBER_WIDE:
- TclBNInitBignumFromWideInt(&big, *((const Tcl_WideInt*)ptr));
+ TclBNInitBignumFromWideInt(&big, *(const Tcl_WideInt *) ptr);
break;
#endif
case TCL_NUMBER_BIG:
@@ -5162,24 +5396,27 @@ TclExecuteByteCode(
#endif
/*
- * Ensure that the numeric value has a string rep the same as
- * the formatted version of its internal rep. This is used, e.g.,
- * to make sure that "expr {0001}" yields "1", not "0001".
- * We implement this by _discarding_ the string rep since we
- * know it will be regenerated, if needed later, by formatting
- * the internal rep's value.
+ * Ensure that the numeric value has a string rep the same as the
+ * formatted version of its internal rep. This is used, e.g., to make
+ * sure that "expr {0001}" yields "1", not "0001". We implement this
+ * by _discarding_ the string rep since we know it will be
+ * regenerated, if needed later, by formatting the internal rep's
+ * value.
*/
+
if (valuePtr->bytes == NULL) {
TRACE(("\"%.20s\" => numeric, same Tcl_Obj\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
}
if (Tcl_IsShared(valuePtr)) {
/*
- * Here we do some surgery within the Tcl_Obj internals.
- * We want to copy the intrep, but not the string, so we
- * temporarily hide the string so we do not copy it.
+ * Here we do some surgery within the Tcl_Obj internals. We want
+ * to copy the intrep, but not the string, so we temporarily hide
+ * the string so we do not copy it.
*/
+
char *savedString = valuePtr->bytes;
+
valuePtr->bytes = NULL;
objResultPtr = Tcl_DuplicateObj(valuePtr);
valuePtr->bytes = savedString;
@@ -5217,9 +5454,8 @@ TclExecuteByteCode(
* number of iterations of the loop body to -1.
*/
- int opnd;
+ int opnd, iterTmpIndex;
ForeachInfo *infoPtr;
- int iterTmpIndex;
Var *iterVarPtr;
Tcl_Obj *oldValuePtr;
@@ -5258,17 +5494,14 @@ TclExecuteByteCode(
* the next value list element to each loop var.
*/
- int opnd;
+ int opnd, numLists;
ForeachInfo *infoPtr;
ForeachVarList *varListPtr;
- int numLists;
- Tcl_Obj *listPtr,*valuePtr, *value2Ptr;
- Tcl_Obj **elements;
- Var *iterVarPtr, *listVarPtr;
+ Tcl_Obj *listPtr,*valuePtr, *value2Ptr, **elements;
+ Var *iterVarPtr, *listVarPtr, *varPtr;
int iterNum, listTmpIndex, listLen, numVars;
int varIndex, valIndex, continueLoop, j;
long i;
- Var *varPtr;
char *part1;
opnd = TclGetUInt4AtPtr(pc+1);
@@ -5418,6 +5651,7 @@ TclExecuteByteCode(
*/
{
Tcl_Obj *newObjResultPtr;
+
TclNewObj(newObjResultPtr);
Tcl_IncrRefCount(newObjResultPtr);
iPtr->objResultPtr = newObjResultPtr;
@@ -5463,7 +5697,7 @@ TclExecuteByteCode(
if (result != TCL_OK) {
TRACE_WITH_OBJ((
"%u => ERROR reading leaf dictionary key \"%s\": ",
- opnd, O2S(dictPtr)), Tcl_GetObjResult(interp));
+ opnd, O2S(dictPtr)), Tcl_GetObjResult(interp));
cleanup = opnd + 1;
goto checkForCatch;
}
@@ -5769,7 +6003,7 @@ TclExecuteByteCode(
TRACE_APPEND(("\"%.30s\" \"%.30s\" %d",
O2S(*(tosPtr-1)), O2S(*tosPtr), done));
objResultPtr = eePtr->constants[done];
- /*TODO: consider opt like INST_FOREACH_STEP4 */
+ /* TODO: consider opt like INST_FOREACH_STEP4 */
NEXT_INST_F(5, 0, 1);
case INST_DICT_DONE:
@@ -5962,7 +6196,7 @@ TclExecuteByteCode(
goto checkForCatch;
/*
- * Exponentiation of zero by negative number in an expression. Control
+ * Exponentiation of zero by negative number in an expression. Control
* only reaches this point by "goto exponOfZero".
*/
@@ -5979,11 +6213,11 @@ TclExecuteByteCode(
*/
{
- 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. */
+ 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. */
Tcl_Obj *valuePtr;
const char *bytes;
int length;
@@ -6057,7 +6291,7 @@ TclExecuteByteCode(
}
#if TCL_COMPILE_DEBUG
} else if (traceInstructions) {
- if ((result != TCL_ERROR) && (result != TCL_RETURN)) {
+ if ((result != TCL_ERROR) && (result != TCL_RETURN)) {
Tcl_Obj *objPtr = Tcl_GetObjResult(interp);
TRACE_APPEND(("OTHER RETURN CODE %d, result= \"%s\"\n ",
result, O2S(objPtr)));
@@ -6100,10 +6334,11 @@ TclExecuteByteCode(
}
/*
- * We must not catch an exceeded limit. Instead, it blows outwards
+ * 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
if (traceInstructions) {
@@ -6141,9 +6376,9 @@ TclExecuteByteCode(
/*
* 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.
+ * 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:
@@ -6300,7 +6535,7 @@ ValidatePcAndStackTop(
int checkStack) /* 0 if the stack depth check should be
* skipped. */
{
- int stackUpperBound = stackLowerBound + codePtr->maxStackDepth;
+ 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;
@@ -6390,7 +6625,7 @@ IllegalExprOperandType(
} else if (type == TCL_NUMBER_DOUBLE) {
description = "floating-point value";
} else {
- /* TODO: No caller needs this. Eliminate? */
+ /* TODO: No caller needs this. Eliminate? */
description = "(big) integer";
}
@@ -6424,55 +6659,58 @@ IllegalExprOperandType(
void
TclGetSrcInfoForPc (cfPtr)
- CmdFrame* cfPtr;
+ CmdFrame *cfPtr;
{
- ByteCode* codePtr = (ByteCode*) cfPtr->data.tebc.codePtr;
+ ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
if (cfPtr->cmd.str.cmd == NULL) {
- cfPtr->cmd.str.cmd = GetSrcInfoForPc((unsigned char*) cfPtr->data.tebc.pc,
- codePtr,
- &cfPtr->cmd.str.len);
+ cfPtr->cmd.str.cmd = GetSrcInfoForPc(
+ (unsigned char *) cfPtr->data.tebc.pc, codePtr,
+ &cfPtr->cmd.str.len);
}
if (cfPtr->cmd.str.cmd != NULL) {
- /* We now have the command. We can get the srcOffset back and
- * from there find the list of word locations for this command
+ /*
+ * We now have the command. We can get the srcOffset back and from
+ * there find the list of word locations for this command.
*/
- ExtCmdLoc* eclPtr;
- ECL* locPtr = NULL;
- int srcOffset;
+ ExtCmdLoc *eclPtr;
+ ECL *locPtr = NULL;
+ int srcOffset, i;
+ Interp *iPtr = (Interp *) *codePtr->interpHandle;
+ Tcl_HashEntry *hePtr =
+ Tcl_FindHashEntry(iPtr->lineBCPtr, (char *) codePtr);
- Interp* iPtr = (Interp*) *codePtr->interpHandle;
- Tcl_HashEntry* hePtr = Tcl_FindHashEntry (iPtr->lineBCPtr, (char *) codePtr);
-
- if (!hePtr) return;
+ if (!hePtr) {
+ return;
+ }
srcOffset = cfPtr->cmd.str.cmd - codePtr->source;
- eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hePtr);
+ eclPtr = (ExtCmdLoc *) Tcl_GetHashValue (hePtr);
- {
- int i;
- for (i=0; i < eclPtr->nuloc; i++) {
- if (eclPtr->loc [i].srcOffset == srcOffset) {
- locPtr = &(eclPtr->loc [i]);
- break;
- }
+ for (i=0; i < eclPtr->nuloc; i++) {
+ if (eclPtr->loc[i].srcOffset == srcOffset) {
+ locPtr = eclPtr->loc+i;
+ break;
}
}
+ if (locPtr == NULL) {
+ Tcl_Panic("LocSearch failure");
+ }
- if (locPtr == NULL) {Tcl_Panic ("LocSearch failure");}
-
- cfPtr->line = locPtr->line;
- cfPtr->nline = locPtr->nline;
- cfPtr->type = eclPtr->type;
+ cfPtr->line = locPtr->line;
+ cfPtr->nline = locPtr->nline;
+ cfPtr->type = eclPtr->type;
if (eclPtr->type == TCL_LOCATION_SOURCE) {
cfPtr->data.eval.path = eclPtr->path;
- Tcl_IncrRefCount (cfPtr->data.eval.path);
+ Tcl_IncrRefCount(cfPtr->data.eval.path);
}
- /* Do not set cfPtr->data.eval.path NULL for non-SOURCE
- * Needed for cfPtr->data.tebc.codePtr.
+
+ /*
+ * Do not set cfPtr->data.eval.path NULL for non-SOURCE. Needed for
+ * cfPtr->data.tebc.codePtr.
*/
}
}
@@ -6510,7 +6748,7 @@ GetSrcInfoForPc(
codeDeltaNext = codePtr->codeDeltaStart;
codeLengthNext = codePtr->codeLengthStart;
- srcDeltaNext = codePtr->srcDeltaStart;
+ srcDeltaNext = codePtr->srcDeltaStart;
srcLengthNext = codePtr->srcLengthStart;
codeOffset = srcOffset = 0;
for (i = 0; i < numCmds; i++) {
@@ -6553,10 +6791,12 @@ GetSrcInfoForPc(
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 */
+ }
+ if (pcOffset <= codeEnd) { /* This cmd's code encloses pc */
int dist = (pcOffset - codeOffset);
+
if (dist <= bestDist) {
bestDist = dist;
bestSrcOffset = srcOffset;
@@ -6609,7 +6849,7 @@ GetExceptRangeForPc(
* ExceptionRanges in search. If nonzero
* consider only catch ranges (and ignore any
* closer loop ranges). */
- ByteCode* codePtr) /* Points to the ByteCode in which to search
+ ByteCode *codePtr) /* Points to the ByteCode in which to search
* for the enclosing ExceptionRange. */
{
ExceptionRange *rangeArrayPtr;
@@ -6780,8 +7020,8 @@ EvalStatsCmd(
Tcl_Obj *const objv[]) /* The argument strings. */
{
Interp *iPtr = (Interp *) interp;
- LiteralTable *globalTablePtr = &(iPtr->literalTable);
- ByteCodeStats *statsPtr = &(iPtr->stats);
+ LiteralTable *globalTablePtr = &iPtr->literalTable;
+ ByteCodeStats *statsPtr = &iPtr->stats;
double totalCodeBytes, currentCodeBytes;
double totalLiteralBytes, currentLiteralBytes;
double objBytesIfUnshared, strBytesIfUnshared, sharingBytesSaved;
@@ -6834,7 +7074,7 @@ EvalStatsCmd(
fprintf(stdout, "Number ByteCodes compiled %ld\n",
statsPtr->numCompilations);
fprintf(stdout, " Mean executions/compile %.1f\n",
- ((float)statsPtr->numExecutions) / ((float)statsPtr->numCompilations));
+ ((float)statsPtr->numExecutions) / statsPtr->numCompilations);
fprintf(stdout, "\nInstructions executed %.0f\n",
numInstructions);
@@ -6915,11 +7155,11 @@ EvalStatsCmd(
numByteCodeLits = 0;
refCountSum = 0;
numSharedMultX = 0;
- numSharedOnce = 0;
- objBytesIfUnshared = 0.0;
- strBytesIfUnshared = 0.0;
+ numSharedOnce = 0;
+ objBytesIfUnshared = 0.0;
+ strBytesIfUnshared = 0.0;
strBytesSharedMultX = 0.0;
- strBytesSharedOnce = 0.0;
+ strBytesSharedOnce = 0.0;
for (i = 0; i < globalTablePtr->numBuckets; i++) {
for (entryPtr = globalTablePtr->buckets[i]; entryPtr != NULL;
entryPtr = entryPtr->nextPtr) {
@@ -7000,27 +7240,27 @@ EvalStatsCmd(
statsPtr->currentByteCodeBytes / numCurrentByteCodes);
fprintf(stdout, "Header %12.6g %8.1f%% %8.1f\n",
currentHeaderBytes,
- ((currentHeaderBytes * 100.0) / statsPtr->currentByteCodeBytes),
+ (currentHeaderBytes * 100.0) / statsPtr->currentByteCodeBytes,
currentHeaderBytes / numCurrentByteCodes);
fprintf(stdout, "Instructions %12.6g %8.1f%% %8.1f\n",
statsPtr->currentInstBytes,
- ((statsPtr->currentInstBytes * 100.0) / statsPtr->currentByteCodeBytes),
+ (statsPtr->currentInstBytes*100.0)/statsPtr->currentByteCodeBytes,
statsPtr->currentInstBytes / numCurrentByteCodes);
fprintf(stdout, "Literal ptr array %12.6g %8.1f%% %8.1f\n",
statsPtr->currentLitBytes,
- ((statsPtr->currentLitBytes * 100.0) / statsPtr->currentByteCodeBytes),
+ (statsPtr->currentLitBytes*100.0)/statsPtr->currentByteCodeBytes,
statsPtr->currentLitBytes / numCurrentByteCodes);
fprintf(stdout, "Exception table %12.6g %8.1f%% %8.1f\n",
statsPtr->currentExceptBytes,
- ((statsPtr->currentExceptBytes * 100.0) / statsPtr->currentByteCodeBytes),
+ (statsPtr->currentExceptBytes*100.0)/statsPtr->currentByteCodeBytes,
statsPtr->currentExceptBytes / numCurrentByteCodes);
fprintf(stdout, "Auxiliary data %12.6g %8.1f%% %8.1f\n",
statsPtr->currentAuxBytes,
- ((statsPtr->currentAuxBytes * 100.0) / statsPtr->currentByteCodeBytes),
+ (statsPtr->currentAuxBytes*100.0)/statsPtr->currentByteCodeBytes,
statsPtr->currentAuxBytes / numCurrentByteCodes);
fprintf(stdout, "Command map %12.6g %8.1f%% %8.1f\n",
statsPtr->currentCmdMapBytes,
- ((statsPtr->currentCmdMapBytes * 100.0) / statsPtr->currentByteCodeBytes),
+ (statsPtr->currentCmdMapBytes*100.0)/statsPtr->currentByteCodeBytes,
statsPtr->currentCmdMapBytes / numCurrentByteCodes);
/*
@@ -7164,10 +7404,10 @@ EvalStatsCmd(
*
* 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.
+ * 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.