summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2005-06-20 21:27:03 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2005-06-20 21:27:03 (GMT)
commit0274a89c20d0e377adddaee757e45facd7247d87 (patch)
treea39aeb7142a3410949583a9ba25510d6ed50ef34 /generic
parent534bef21225845450d07b9de68a8f6add62561f3 (diff)
downloadtcl-0274a89c20d0e377adddaee757e45facd7247d87.zip
tcl-0274a89c20d0e377adddaee757e45facd7247d87.tar.gz
tcl-0274a89c20d0e377adddaee757e45facd7247d87.tar.bz2
Add compilation for TIP#90-style [catch] requiring a new opcode [Bug1219112]
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCompCmds.c98
-rw-r--r--generic/tclCompile.c51
-rw-r--r--generic/tclCompile.h579
-rw-r--r--generic/tclExecute.c302
4 files changed, 536 insertions, 494 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index be74f2a..aefd8e3 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompCmds.c,v 1.73 2005/06/20 10:01:47 dkf Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.74 2005/06/20 21:27:09 dkf Exp $
*/
#include "tclInt.h"
@@ -264,50 +264,65 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
CompileEnv *envPtr; /* Holds resulting instructions. */
{
JumpFixup jumpFixup;
- Tcl_Token *cmdTokenPtr, *nameTokenPtr;
+ Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
CONST char *name;
- int localIndex, nameChars, range, startOffset;
+ int resultIndex, optsIndex, nameChars, range, startOffset;
int savedStackDepth = envPtr->currStackDepth;
/*
* If syntax does not match what we expect for [catch], do not compile.
* Let runtime checks determine if syntax has changed.
*/
- if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
+ if ((parsePtr->numWords < 2) && (parsePtr->numWords > 4)) {
return TCL_ERROR;
}
/*
- * If a variable was specified and the catch command is at global level
+ * If variables were specified and the catch command is at global level
* (not in a procedure), don't compile it inline: the payoff is too small.
*/
- if ((parsePtr->numWords == 3) && (envPtr->procPtr == NULL)) {
+ if ((parsePtr->numWords >= 3) && (envPtr->procPtr == NULL)) {
return TCL_ERROR;
}
/*
- * Make sure the variable name, if any, has no substitutions and just
- * refers to a local scaler.
+ * Make sure the variable names, if any, have no substitutions and just
+ * refer to local scalars.
*/
- localIndex = -1;
+ resultIndex = optsIndex = -1;
cmdTokenPtr = TokenAfter(parsePtr->tokenPtr);
- if (parsePtr->numWords == 3) {
- nameTokenPtr = TokenAfter(cmdTokenPtr);
+ if (parsePtr->numWords >= 3) {
+ resultNameTokenPtr = TokenAfter(cmdTokenPtr);
/* DGP */
- if (nameTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- name = nameTokenPtr[1].start;
- nameChars = nameTokenPtr[1].size;
+ if (resultNameTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ name = resultNameTokenPtr[1].start;
+ nameChars = resultNameTokenPtr[1].size;
if (!TclIsLocalScalar(name, nameChars)) {
return TCL_ERROR;
}
- localIndex = TclFindCompiledLocal(nameTokenPtr[1].start,
- nameTokenPtr[1].size, /*create*/ 1, VAR_SCALAR,
+ resultIndex = TclFindCompiledLocal(resultNameTokenPtr[1].start,
+ resultNameTokenPtr[1].size, /*create*/ 1, VAR_SCALAR,
envPtr->procPtr);
} else {
return TCL_ERROR;
}
+ /* DKF */
+ if (parsePtr->numWords == 4) {
+ optsNameTokenPtr = TokenAfter(resultNameTokenPtr);
+ if (optsNameTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ return TCL_ERROR;
+ }
+ name = optsNameTokenPtr[1].start;
+ nameChars = optsNameTokenPtr[1].size;
+ if (!TclIsLocalScalar(name, nameChars)) {
+ return TCL_ERROR;
+ }
+ optsIndex = TclFindCompiledLocal(optsNameTokenPtr[1].start,
+ optsNameTokenPtr[1].size, /*create*/ 1, VAR_SCALAR,
+ envPtr->procPtr);
+ }
}
/*
@@ -346,14 +361,31 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
/*
* The "no errors" epilogue code: store the body's result into the
* variable (if any), push "0" (TCL_OK) as the catch's "no error" result,
- * and jump around the "error case" code.
+ * and jump around the "error case" code. Note that we issue the push of
+ * the return options first so that if alterations happen to the current
+ * interpreter state during the writing of the variable, we won't see
+ * them; this results in a slightly complex instruction issuing flow
+ * (can't exchange, only duplicate and pop).
*/
- if (localIndex != -1) {
- if (localIndex <= 255) {
- TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
+ if (resultIndex != -1) {
+ if (optsIndex != -1) {
+ TclEmitOpcode(INST_PUSH_RETURN_OPTIONS, envPtr);
+ TclEmitInstInt4(INST_OVER, 1, envPtr);
+ }
+ if (resultIndex <= 255) {
+ TclEmitInstInt1(INST_STORE_SCALAR1, resultIndex, envPtr);
} else {
- TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
+ TclEmitInstInt4(INST_STORE_SCALAR4, resultIndex, envPtr);
+ }
+ if (optsIndex != -1) {
+ TclEmitOpcode(INST_POP, envPtr);
+ if (optsIndex <= 255) {
+ TclEmitInstInt1(INST_STORE_SCALAR1, optsIndex, envPtr);
+ } else {
+ TclEmitInstInt4(INST_STORE_SCALAR4, optsIndex, envPtr);
+ }
+ TclEmitOpcode(INST_POP, envPtr);
}
}
TclEmitOpcode(INST_POP, envPtr);
@@ -363,23 +395,35 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
/*
* The "error case" code: store the body's result into the variable (if
* any), then push the error result code. The initial PC offset here is
- * the catch's error target.
+ * the catch's error target. Note that if we are saving the return
+ * options, we do that first so the preservation cannot get affected by
+ * any intermediate result handling.
*/
envPtr->currStackDepth = savedStackDepth;
envPtr->exceptArrayPtr[range].catchOffset = CurrentOffset(envPtr);
- if (localIndex != -1) {
+ if (resultIndex != -1) {
+ if (optsIndex != -1) {
+ TclEmitOpcode(INST_PUSH_RETURN_OPTIONS, envPtr);
+ }
TclEmitOpcode(INST_PUSH_RESULT, envPtr);
- if (localIndex <= 255) {
- TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
+ if (resultIndex <= 255) {
+ TclEmitInstInt1(INST_STORE_SCALAR1, resultIndex, envPtr);
} else {
- TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
+ TclEmitInstInt4(INST_STORE_SCALAR4, resultIndex, envPtr);
}
TclEmitOpcode(INST_POP, envPtr);
+ if (optsIndex != -1) {
+ if (optsIndex <= 255) {
+ TclEmitInstInt1(INST_STORE_SCALAR1, optsIndex, envPtr);
+ } else {
+ TclEmitInstInt4(INST_STORE_SCALAR4, optsIndex, envPtr);
+ }
+ TclEmitOpcode(INST_POP, envPtr);
+ }
}
TclEmitOpcode(INST_PUSH_RETURN_CODE, envPtr);
-
/*
* Update the target of the jump after the "no errors" code, then emit an
* endCatch instruction at the end of the catch command.
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index f67fea6..6a7234d 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.85 2005/05/10 18:34:11 kennykb Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.86 2005/06/20 21:27:10 dkf Exp $
*/
#include "tclInt.h"
@@ -213,6 +213,7 @@ InstructionDesc tclInstructionTable[] = {
{"pushReturnCode", 1, +1, 0, {OPERAND_NONE}},
/* Push interpreter's return code (e.g. TCL_OK or TCL_ERROR) as
* a new object onto the stack. */
+
{"streq", 1, -1, 0, {OPERAND_NONE}},
/* Str Equal: push (stknext eq stktop) */
{"strneq", 1, -1, 0, {OPERAND_NONE}},
@@ -225,12 +226,14 @@ InstructionDesc tclInstructionTable[] = {
/* Str Index: push (strindex stknext stktop) */
{"strmatch", 2, -1, 1, {OPERAND_INT1}},
/* Str Match: push (strmatch stknext stktop) opnd == nocase */
+
{"list", 5, INT_MIN, 1, {OPERAND_UINT4}},
/* List: push (stk1 stk2 ... stktop) */
{"listIndex", 1, -1, 0, {OPERAND_NONE}},
/* List Index: push (listindex stknext stktop) */
{"listLength", 1, 0, 0, {OPERAND_NONE}},
/* List Len: push (listlength stktop) */
+
{"appendScalar1", 2, 0, 1, {OPERAND_UINT1}},
/* Append scalar variable at op1<=255 in frame; value is stktop */
{"appendScalar4", 5, 0, 1, {OPERAND_UINT4}},
@@ -255,10 +258,11 @@ InstructionDesc tclInstructionTable[] = {
/* Lappend array element; value is stktop, then elem, array names */
{"lappendStk", 1, -1, 0, {OPERAND_NONE}},
/* Lappend general variable; value is stktop, then unparsed name */
+
{"lindexMulti", 5, INT_MIN, 1, {OPERAND_UINT4}},
- /* Lindex with generalized args, operand is number of stacked objs
- * used: (operand-1) entries from stktop are the indices; then list
- * to process. */
+ /* Lindex with generalized args, operand is number of stacked objs
+ * used: (operand-1) entries from stktop are the indices; then list to
+ * process. */
{"over", 5, +1, 1, {OPERAND_UINT4}},
/* Duplicate the arg-th element from top of stack (TOS=0) */
{"lsetList", 1, -2, 0, {OPERAND_NONE}},
@@ -269,37 +273,44 @@ InstructionDesc tclInstructionTable[] = {
* stacked objs: stktop is old value, next is new element value, next
* come (operand-2) indices; pushes the new value.
*/
+
{"return", 9, -1, 2, {OPERAND_INT4, OPERAND_UINT4}},
/* Compiled [return], code, level are operands; options and result
* are on the stack. */
+
{"expon", 1, -1, 0, {OPERAND_NONE}},
/* Binary exponentiation operator: push (stknext ** stktop) */
- /*
- * NOTE: the stack effects of expandStkTop and invokeExpanded
- * are wrong - but it cannot be done right at compile time, the stack
- * effect is only known at run time. The value for invokeExpanded
- * is estimated better at compile time.
- * See the comments further down in this file, where INST_INVOKE_EXPANDED
- * is emitted.
- */
- {"expandStart", 1, 0, 0, {OPERAND_NONE}},
- /* Start of command with {expand}ed arguments */
- {"expandStkTop", 5, 0, 1, {OPERAND_INT4}},
- /* Expand the list at stacktop: push its elements on the stack */
- {"invokeExpanded", 1, 0, 0, {OPERAND_NONE}},
- /* Invoke the command marked by the last 'expandStart' */
+
+ /*
+ * NOTE: the stack effects of expandStkTop and invokeExpanded
+ * are wrong - but it cannot be done right at compile time, the stack
+ * effect is only known at run time. The value for invokeExpanded
+ * is estimated better at compile time.
+ * See the comments further down in this file, where INST_INVOKE_EXPANDED
+ * is emitted.
+ */
+ {"expandStart", 1, 0, 0, {OPERAND_NONE}},
+ /* Start of command with {expand}ed arguments */
+ {"expandStkTop", 5, 0, 1, {OPERAND_INT4}},
+ /* Expand the list at stacktop: push its elements on the stack */
+ {"invokeExpanded", 1, 0, 0, {OPERAND_NONE}},
+ /* Invoke the command marked by the last 'expandStart' */
+
{"listIndexImm", 5, 0, 1, {OPERAND_IDX4}},
/* 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}},
+ {"startCommand", 5, 0, 1, {OPERAND_UINT4}},
/* Start of bytecoded command: op is the length of the cmd's code */
{"listIn", 1, -1, 0, {OPERAND_NONE}},
/* List containment: push [lsearch stktop stknext]>=0) */
{"listNotIn", 1, -1, 0, {OPERAND_NONE}},
/* List negated containment: push [lsearch stktop stknext]<0) */
+
+ {"pushReturnOpts", 1, +1, 0, {OPERAND_NONE}}
+ /* Push the interpreter's return option dictionary as an object on the
+ * stack. */
{0}
};
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index ab34f81..74c2091 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -8,7 +8,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.h,v 1.55 2005/05/10 18:34:27 kennykb Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.56 2005/06/20 21:27:12 dkf Exp $
*/
#ifndef _TCLCOMPILATION
@@ -34,9 +34,7 @@
*/
MODULE_SCOPE int tclTraceCompile;
-#endif
-#ifdef TCL_COMPILE_DEBUG
/*
* Variable that controls whether execution tracing is enabled and, if so,
* what level of tracing is desired:
@@ -49,7 +47,7 @@ MODULE_SCOPE int tclTraceCompile;
MODULE_SCOPE int tclTraceExec;
#endif
-
+
/*
*------------------------------------------------------------------------
* Data structures related to compilation.
@@ -57,54 +55,55 @@ MODULE_SCOPE int tclTraceExec;
*/
/*
- * The structure used to implement Tcl "exceptions" (exceptional returns):
- * for example, those generated in loops by the break and continue commands,
- * and those generated by scripts and caught by the catch command. This
- * ExceptionRange structure describes a range of code (e.g., a loop body),
- * the kind of exceptions (e.g., a break or continue) that might occur, and
- * the PC offsets to jump to if a matching exception does occur. Exception
- * ranges can nest so this structure includes a nesting level that is used
- * at runtime to find the closest exception range surrounding a PC. For
- * example, when a break command is executed, the ExceptionRange structure
- * for the most deeply nested loop, if any, is found and used. These
- * structures are also generated for the "next" subcommands of for loops
- * since a break there terminates the for command. This means a for command
- * actually generates two LoopInfo structures.
+ * The structure used to implement Tcl "exceptions" (exceptional returns): for
+ * example, those generated in loops by the break and continue commands, and
+ * those generated by scripts and caught by the catch command. This
+ * ExceptionRange structure describes a range of code (e.g., a loop body), the
+ * kind of exceptions (e.g., a break or continue) that might occur, and the PC
+ * offsets to jump to if a matching exception does occur. Exception ranges can
+ * nest so this structure includes a nesting level that is used at runtime to
+ * find the closest exception range surrounding a PC. For example, when a
+ * break command is executed, the ExceptionRange structure for the most deeply
+ * nested loop, if any, is found and used. These structures are also generated
+ * for the "next" subcommands of for loops since a break there terminates the
+ * for command. This means a for command actually generates two LoopInfo
+ * structures.
*/
typedef enum {
- LOOP_EXCEPTION_RANGE, /* Exception's range is part of a loop.
- * Break and continue "exceptions" cause
- * jumps to appropriate PC offsets. */
- CATCH_EXCEPTION_RANGE /* Exception's range is controlled by a
- * catch command. Errors in the range cause
- * a jump to a catch PC offset. */
+ LOOP_EXCEPTION_RANGE, /* Exception's range is part of a loop. Break
+ * and continue "exceptions" cause jumps to
+ * appropriate PC offsets. */
+ CATCH_EXCEPTION_RANGE /* Exception's range is controlled by a catch
+ * command. Errors in the range cause a jump
+ * to a catch PC offset. */
} ExceptionRangeType;
typedef struct ExceptionRange {
ExceptionRangeType type; /* The kind of ExceptionRange. */
- int nestingLevel; /* Static depth of the exception range.
- * Used to find the most deeply-nested
- * range surrounding a PC at runtime. */
- int codeOffset; /* Offset of the first instruction byte of
- * the code range. */
+ int nestingLevel; /* Static depth of the exception range. Used
+ * to find the most deeply-nested range
+ * surrounding a PC at runtime. */
+ int codeOffset; /* Offset of the first instruction byte of the
+ * code range. */
int numCodeBytes; /* Number of bytes in the code range. */
int breakOffset; /* If LOOP_EXCEPTION_RANGE, the target PC
* offset for a break command in the range. */
int continueOffset; /* If LOOP_EXCEPTION_RANGE and not -1, the
* target PC offset for a continue command in
- * the code range. Otherwise, ignore this range
- * when processing a continue command. */
+ * the code range. Otherwise, ignore this
+ * range when processing a continue
+ * command. */
int catchOffset; /* If a CATCH_EXCEPTION_RANGE, the target PC
* offset for any "exception" in range. */
} ExceptionRange;
/*
* Structure used to map between instruction pc and source locations. It
- * defines for each compiled Tcl command its code's starting offset and
- * its source's starting offset and length. Note that the code offset
- * increases monotonically: that is, the table is sorted in code offset
- * order. The source offset is not monotonic.
+ * defines for each compiled Tcl command its code's starting offset and its
+ * source's starting offset and length. Note that the code offset increases
+ * monotonically: that is, the table is sorted in code offset order. The
+ * source offset is not monotonic.
*/
typedef struct CmdLocation {
@@ -115,19 +114,18 @@ typedef struct CmdLocation {
} CmdLocation;
/*
- * CompileProcs need the ability to record information during compilation
- * that can be used by bytecode instructions during execution. The AuxData
- * structure provides this "auxiliary data" mechanism. An arbitrary number
- * of these structures can be stored in the ByteCode record (during
- * compilation they are stored in a CompileEnv structure). Each AuxData
- * record holds one word of client-specified data (often a pointer) and is
- * given an index that instructions can later use to look up the structure
- * and its data.
+ * CompileProcs need the ability to record information during compilation that
+ * can be used by bytecode instructions during execution. The AuxData
+ * structure provides this "auxiliary data" mechanism. An arbitrary number of
+ * these structures can be stored in the ByteCode record (during compilation
+ * they are stored in a CompileEnv structure). Each AuxData record holds one
+ * word of client-specified data (often a pointer) and is given an index that
+ * instructions can later use to look up the structure and its data.
*
* The following definitions declare the types of procedures that are called
* to duplicate or free this auxiliary data when the containing ByteCode
- * objects are duplicated and freed. Pointers to these procedures are kept
- * in the AuxData structure.
+ * objects are duplicated and freed. Pointers to these procedures are kept in
+ * the AuxData structure.
*/
typedef ClientData (AuxDataDupProc) _ANSI_ARGS_((ClientData clientData));
@@ -136,22 +134,22 @@ typedef void (AuxDataFreeProc) _ANSI_ARGS_((ClientData clientData));
/*
* We define a separate AuxDataType struct to hold type-related information
* for the AuxData structure. This separation makes it possible for clients
- * outside of the TCL core to manipulate (in a limited fashion!) AuxData;
- * for example, it makes it possible to pickle and unpickle AuxData structs.
+ * outside of the TCL core to manipulate (in a limited fashion!) AuxData; for
+ * example, it makes it possible to pickle and unpickle AuxData structs.
*/
typedef struct AuxDataType {
char *name; /* the name of the type. Types can be
* registered and found by name */
- AuxDataDupProc *dupProc; /* Callback procedure to invoke when the
- * aux data is duplicated (e.g., when the
- * ByteCode structure containing the aux
- * data is duplicated). NULL means just
- * copy the source clientData bits; no
- * proc need be called. */
- AuxDataFreeProc *freeProc; /* Callback procedure to invoke when the
- * aux data is freed. NULL means no
- * proc need be called. */
+ AuxDataDupProc *dupProc; /* Callback procedure to invoke when the aux
+ * data is duplicated (e.g., when the ByteCode
+ * structure containing the aux data is
+ * duplicated). NULL means just copy the
+ * source clientData bits; no proc need be
+ * called. */
+ AuxDataFreeProc *freeProc; /* Callback procedure to invoke when the aux
+ * data is freed. NULL means no proc need be
+ * called. */
} AuxDataType;
/*
@@ -180,70 +178,68 @@ typedef struct AuxData {
typedef struct CompileEnv {
Interp *iPtr; /* Interpreter containing the code being
- * compiled. Commands and their compile
- * procs are specific to an interpreter so
- * the code emitted will depend on the
- * interpreter. */
+ * compiled. Commands and their compile procs
+ * are specific to an interpreter so the code
+ * emitted will depend on the interpreter. */
char *source; /* The source string being compiled by
* SetByteCodeFromAny. This pointer is not
* owned by the CompileEnv and must not be
* freed or changed by it. */
int numSrcBytes; /* Number of bytes in source. */
- Proc *procPtr; /* If a procedure is being compiled, a
- * pointer to its Proc structure; otherwise
- * NULL. Used to compile local variables.
- * Set from information provided by
- * ObjInterpProc in tclProc.c. */
+ Proc *procPtr; /* If a procedure is being compiled, a pointer
+ * to its Proc structure; otherwise NULL. Used
+ * to compile local variables. Set from
+ * information provided by ObjInterpProc in
+ * tclProc.c. */
int numCommands; /* Number of commands compiled. */
- int exceptDepth; /* Current exception range nesting level;
- * -1 if not in any range currently. */
- int maxExceptDepth; /* Max nesting level of exception ranges;
- * -1 if no ranges have been compiled. */
- int maxStackDepth; /* Maximum number of stack elements needed
- * to execute the code. Set by compilation
+ int exceptDepth; /* Current exception range nesting level; -1
+ * if not in any range currently. */
+ int maxExceptDepth; /* Max nesting level of exception ranges; -1
+ * if no ranges have been compiled. */
+ int maxStackDepth; /* Maximum number of stack elements needed to
+ * execute the code. Set by compilation
* procedures before returning. */
int currStackDepth; /* Current stack depth. */
- LiteralTable localLitTable; /* Contains LiteralEntry's describing
- * all Tcl objects referenced by this
- * compiled code. Indexed by the string
- * representations of the literals. Used to
- * avoid creating duplicate objects. */
+ LiteralTable localLitTable; /* Contains LiteralEntry's describing all Tcl
+ * objects referenced by this compiled code.
+ * Indexed by the string representations of
+ * the literals. Used to avoid creating
+ * duplicate objects. */
unsigned char *codeStart; /* Points to the first byte of the code. */
unsigned char *codeNext; /* Points to next code array byte to use. */
- unsigned char *codeEnd; /* Points just after the last allocated
- * code array byte. */
- int mallocedCodeArray; /* Set 1 if code array was expanded
- * and codeStart points into the heap.*/
+ unsigned char *codeEnd; /* Points just after the last allocated code
+ * array byte. */
+ int mallocedCodeArray; /* Set 1 if code array was expanded and
+ * codeStart points into the heap.*/
LiteralEntry *literalArrayPtr;
/* Points to start of LiteralEntry array. */
int literalArrayNext; /* Index of next free object array entry. */
int literalArrayEnd; /* Index just after last obj array entry. */
- int mallocedLiteralArray; /* 1 if object array was expanded and
- * objArray points into the heap, else 0. */
+ int mallocedLiteralArray; /* 1 if object array was expanded and objArray
+ * points into the heap, else 0. */
ExceptionRange *exceptArrayPtr;
/* Points to start of the ExceptionRange
* array. */
int exceptArrayNext; /* Next free ExceptionRange array index.
- * exceptArrayNext is the number of ranges
- * and (exceptArrayNext-1) is the index of
- * the current range's array entry. */
- int exceptArrayEnd; /* Index after the last ExceptionRange
- * array entry. */
- int mallocedExceptArray; /* 1 if ExceptionRange array was expanded
- * and exceptArrayPtr points in heap,
- * else 0. */
+ * exceptArrayNext is the number of ranges and
+ * (exceptArrayNext-1) is the index of the
+ * current range's array entry. */
+ int exceptArrayEnd; /* Index after the last ExceptionRange array
+ * entry. */
+ int mallocedExceptArray; /* 1 if ExceptionRange array was expanded and
+ * exceptArrayPtr points in heap, else 0. */
CmdLocation *cmdMapPtr; /* Points to start of CmdLocation array.
- * numCommands is the index of the next
- * entry to use; (numCommands-1) is the
- * entry index for the last command. */
+ * numCommands is the index of the next entry
+ * to use; (numCommands-1) is the entry index
+ * for the last command. */
int cmdMapEnd; /* Index after last CmdLocation entry. */
int mallocedCmdMap; /* 1 if command map array was expanded and
* cmdMapPtr points in the heap, else 0. */
AuxData *auxDataArrayPtr; /* Points to auxiliary data array start. */
int auxDataArrayNext; /* Next free compile aux data array index.
- * auxDataArrayNext is the number of aux
- * data items and (auxDataArrayNext-1) is
- * index of current aux data array entry. */
+ * auxDataArrayNext is the number of aux data
+ * items and (auxDataArrayNext-1) is index of
+ * current aux data array entry. */
int auxDataArrayEnd; /* Index after last aux data array entry. */
int mallocedAuxDataArray; /* 1 if aux data array was expanded and
* auxDataArrayPtr points in heap else 0. */
@@ -260,11 +256,11 @@ typedef struct CompileEnv {
} CompileEnv;
/*
- * The structure defining the bytecode instructions resulting from compiling
- * a Tcl script. Note that this structure is variable length: a single heap
- * object is allocated to hold the ByteCode structure immediately followed
- * by the code bytes, the literal object array, the ExceptionRange array,
- * the CmdLocation map, and the compilation AuxData array.
+ * The structure defining the bytecode instructions resulting from compiling a
+ * Tcl script. Note that this structure is variable length: a single heap
+ * object is allocated to hold the ByteCode structure immediately followed by
+ * the code bytes, the literal object array, the ExceptionRange array, the
+ * CmdLocation map, and the compilation AuxData array.
*/
/*
@@ -273,13 +269,12 @@ typedef struct CompileEnv {
*/
#define TCL_BYTECODE_PRECOMPILED 0x0001
-
/*
* When a bytecode is compiled, interp or namespace resolvers have not been
* applied yet: this is indicated by the TCL_BYTECODE_RESOLVE_VARS flag.
*/
-#define TCL_BYTECODE_RESOLVE_VARS 0x0002
+#define TCL_BYTECODE_RESOLVE_VARS 0x0002
typedef struct ByteCode {
TclHandle interpHandle; /* Handle for interpreter containing the
@@ -291,25 +286,25 @@ typedef struct ByteCode {
* ByteCode was compiled. Used to invalidate
* code when, e.g., commands with compile
* procs are redefined. */
- Namespace *nsPtr; /* Namespace context in which this code
- * was compiled. If the code is executed
- * if a different namespace, it must be
+ Namespace *nsPtr; /* Namespace context in which this code was
+ * compiled. If the code is executed if a
+ * different namespace, it must be
* recompiled. */
int nsEpoch; /* Value of nsPtr->resolverEpoch when this
* ByteCode was compiled. Used to invalidate
* code when new namespace resolution rules
* are put into effect. */
- int refCount; /* Reference count: set 1 when created
- * plus 1 for each execution of the code
- * currently active. This structure can be
- * freed when refCount becomes zero. */
+ int refCount; /* Reference count: set 1 when created plus 1
+ * for each execution of the code currently
+ * active. This structure can be freed when
+ * refCount becomes zero. */
unsigned int flags; /* flags describing state for the codebyte.
* this variable holds ORed values from the
* TCL_BYTECODE_ masks defined above */
- char *source; /* The source string from which this
- * ByteCode was compiled. Note that this
- * pointer is not owned by the ByteCode and
- * must not be freed or modified by it. */
+ char *source; /* The source string from which this ByteCode
+ * was compiled. Note that this pointer is not
+ * owned by the ByteCode and must not be freed
+ * or modified by it. */
Proc *procPtr; /* If the ByteCode was compiled from a
* procedure body, this is a pointer to its
* Proc structure; otherwise NULL. This
@@ -325,71 +320,69 @@ typedef struct ByteCode {
int numLitObjects; /* Number of objects in literal array. */
int numExceptRanges; /* Number of ExceptionRange array elems. */
int numAuxDataItems; /* Number of AuxData items. */
- int numCmdLocBytes; /* Number of bytes needed for encoded
- * command location information. */
+ int numCmdLocBytes; /* Number of bytes needed for encoded command
+ * location information. */
int maxExceptDepth; /* Maximum nesting level of ExceptionRanges;
* -1 if no ranges were compiled. */
- int maxStackDepth; /* Maximum number of stack elements needed
- * to execute the code. */
- unsigned char *codeStart; /* Points to the first byte of the code.
- * This is just after the final ByteCode
- * member cmdMapPtr. */
- Tcl_Obj **objArrayPtr; /* Points to the start of the literal
- * object array. This is just after the
- * last code byte. */
+ int maxStackDepth; /* Maximum number of stack elements needed to
+ * execute the code. */
+ unsigned char *codeStart; /* Points to the first byte of the code. This
+ * is just after the final ByteCode member
+ * cmdMapPtr. */
+ Tcl_Obj **objArrayPtr; /* Points to the start of the literal object
+ * array. This is just after the last code
+ * byte. */
ExceptionRange *exceptArrayPtr;
/* Points to the start of the ExceptionRange
- * array. This is just after the last
- * object in the object array. */
+ * array. This is just after the last object
+ * in the object array. */
AuxData *auxDataArrayPtr; /* Points to the start of the auxiliary data
- * array. This is just after the last entry
- * in the ExceptionRange array. */
+ * array. This is just after the last entry in
+ * the ExceptionRange array. */
unsigned char *codeDeltaStart;
- /* Points to the first of a sequence of
- * bytes that encode the change in the
- * starting offset of each command's code.
- * If -127<=delta<=127, it is encoded as 1
- * byte, otherwise 0xFF (128) appears and
- * the delta is encoded by the next 4 bytes.
- * Code deltas are always positive. This
- * sequence is just after the last entry in
- * the AuxData array. */
+ /* Points to the first of a sequence of bytes
+ * that encode the change in the starting
+ * offset of each command's code. If -127 <=
+ * delta <= 127, it is encoded as 1 byte,
+ * otherwise 0xFF (128) appears and the delta
+ * is encoded by the next 4 bytes. Code deltas
+ * are always positive. This sequence is just
+ * after the last entry in the AuxData
+ * array. */
unsigned char *codeLengthStart;
- /* Points to the first of a sequence of
- * bytes that encode the length of each
- * command's code. The encoding is the same
- * as for code deltas. Code lengths are
- * always positive. This sequence is just
- * after the last entry in the code delta
- * sequence. */
+ /* Points to the first of a sequence of bytes
+ * that encode the length of each command's
+ * code. The encoding is the same as for code
+ * deltas. Code lengths are always positive.
+ * This sequence is just after the last entry
+ * in the code delta sequence. */
unsigned char *srcDeltaStart;
- /* Points to the first of a sequence of
- * bytes that encode the change in the
- * starting offset of each command's source.
- * The encoding is the same as for code
- * deltas. Source deltas can be negative.
- * This sequence is just after the last byte
- * in the code length sequence. */
+ /* Points to the first of a sequence of bytes
+ * that encode the change in the starting
+ * offset of each command's source. The
+ * encoding is the same as for code deltas.
+ * Source deltas can be negative. This
+ * sequence is just after the last byte in the
+ * code length sequence. */
unsigned char *srcLengthStart;
- /* Points to the first of a sequence of
- * bytes that encode the length of each
- * command's source. The encoding is the
- * same as for code deltas. Source lengths
- * are always positive. This sequence is
- * just after the last byte in the source
- * delta sequence. */
+ /* Points to the first of a sequence of bytes
+ * that encode the length of each command's
+ * source. The encoding is the same as for
+ * code deltas. Source lengths are always
+ * positive. This sequence is just after the
+ * last byte in the source delta sequence. */
#ifdef TCL_COMPILE_STATS
Tcl_Time createTime; /* Absolute time when the ByteCode was
* created. */
#endif /* TCL_COMPILE_STATS */
} ByteCode;
-
+
/*
- * Opcodes for the Tcl bytecode instructions. These must correspond to
- * the entries in the table of instruction descriptions,
- * tclInstructionTable, in tclCompile.c. Also, the order and number of
- * the expression opcodes (e.g., INST_LOR) must match the entries in
- * the array operatorStrings in tclExecute.c.
+ * Opcodes for the Tcl bytecode instructions. These must correspond to the
+ * entries in the table of instruction descriptions, tclInstructionTable, in
+ * tclCompile.c. Also, the order and number of the expression opcodes (e.g.,
+ * INST_LOR) must match the entries in the array operatorStrings in
+ * tclExecute.c.
*/
/* Opcodes 0 to 9 */
@@ -533,9 +526,9 @@ typedef struct ByteCode {
/* TIP #157 - {expand}... language syntax support. */
-#define INST_EXPAND_START 100
-#define INST_EXPAND_STKTOP 101
-#define INST_INVOKE_EXPANDED 102
+#define INST_EXPAND_START 100
+#define INST_EXPAND_STKTOP 101
+#define INST_INVOKE_EXPANDED 102
/*
* TIP #57 - 'lassign' command. Code generation requires immediate
@@ -545,21 +538,23 @@ typedef struct ByteCode {
#define INST_LIST_INDEX_IMM 103
#define INST_LIST_RANGE_IMM 104
-#define INST_START_CMD 105
+#define INST_START_CMD 105
#define INST_LIST_IN 106
#define INST_LIST_NOT_IN 107
-/* The last opcode */
-#define LAST_INST_OPCODE 107
+#define INST_PUSH_RETURN_OPTIONS 108
+/* The last opcode */
+#define LAST_INST_OPCODE 108
+
/*
- * Table describing the Tcl bytecode instructions: their name (for
- * displaying code), total number of code bytes required (including
- * operand bytes), and a description of the type of each operand.
- * These operand types include signed and unsigned integers of length
- * one and four bytes. The unsigned integers are used for indexes or
- * for, e.g., the count of objects to push in a "push" instruction.
+ * Table describing the Tcl bytecode instructions: their name (for displaying
+ * code), total number of code bytes required (including operand bytes), and a
+ * description of the type of each operand. These operand types include signed
+ * and unsigned integers of length one and four bytes. The unsigned integers
+ * are used for indexes or for, e.g., the count of objects to push in a "push"
+ * instruction.
*/
#define MAX_INSTRUCTION_OPERANDS 2
@@ -577,11 +572,11 @@ typedef enum InstOperandType {
typedef struct InstructionDesc {
char *name; /* Name of instruction. */
int numBytes; /* Total number of bytes for instruction. */
- int stackEffect; /* The worst-case balance stack effect of the
- * instruction, used for stack requirements
+ int stackEffect; /* The worst-case balance stack effect of the
+ * instruction, used for stack requirements
* computations. The value INT_MIN signals
- * that the instruction's worst case effect
- * is (1-opnd1).
+ * that the instruction's worst case effect is
+ * (1-opnd1).
*/
int numOperands; /* Number of operands. */
InstOperandType opTypes[MAX_INSTRUCTION_OPERANDS];
@@ -592,15 +587,15 @@ MODULE_SCOPE InstructionDesc tclInstructionTable[];
/*
* Compilation of some Tcl constructs such as if commands and the logical or
- * (||) and logical and (&&) operators in expressions requires the
- * generation of forward jumps. Since the PC target of these jumps isn't
- * known when the jumps are emitted, we record the offset of each jump in an
- * array of JumpFixup structures. There is one array for each sequence of
- * jumps to one target PC. When we learn the target PC, we update the jumps
- * with the correct distance. Also, if the distance is too great (> 127
- * bytes), we replace the single-byte jump with a four byte jump
- * instruction, move the instructions after the jump down, and update the
- * code offsets for any commands between the jump and the target.
+ * (||) and logical and (&&) operators in expressions requires the generation
+ * of forward jumps. Since the PC target of these jumps isn't known when the
+ * jumps are emitted, we record the offset of each jump in an array of
+ * JumpFixup structures. There is one array for each sequence of jumps to one
+ * target PC. When we learn the target PC, we update the jumps with the
+ * correct distance. Also, if the distance is too great (> 127 bytes), we
+ * replace the single-byte jump with a four byte jump instruction, move the
+ * instructions after the jump down, and update the code offsets for any
+ * commands between the jump and the target.
*/
typedef enum {
@@ -619,9 +614,9 @@ typedef struct JumpFixup {
* commands if the two-byte jump at jumpPc
* must be replaced with a five-byte one. */
int exceptIndex; /* Index of the first range entry in the
- * ExceptionRange array after the current
- * one. This field is used to adjust the
- * code offsets in subsequent ExceptionRange
+ * ExceptionRange array after the current one.
+ * This field is used to adjust the code
+ * offsets in subsequent ExceptionRange
* records when a jump is grown from 2 bytes
* to 5 bytes. */
} JumpFixup;
@@ -639,21 +634,21 @@ typedef struct JumpFixupArray {
} JumpFixupArray;
/*
- * The structure describing one variable list of a foreach command. Note
- * that only foreach commands inside procedure bodies are compiled inline so
- * a ForeachVarList structure always describes local variables. Furthermore,
+ * The structure describing one variable list of a foreach command. Note that
+ * only foreach commands inside procedure bodies are compiled inline so a
+ * ForeachVarList structure always describes local variables. Furthermore,
* only scalar variables are supported for inline-compiled foreach loops.
*/
typedef struct ForeachVarList {
int numVars; /* The number of variables in the list. */
int varIndexes[1]; /* An array of the indexes ("slot numbers")
- * for each variable in the procedure's
- * array of local variables. Only scalar
- * variables are supported. The actual
- * size of this field will be large enough
- * to numVars indexes. THIS MUST BE THE
- * LAST FIELD IN THE STRUCTURE! */
+ * for each variable in the procedure's array
+ * of local variables. Only scalar variables
+ * are supported. The actual size of this
+ * field will be large enough to numVars
+ * indexes. THIS MUST BE THE LAST FIELD IN THE
+ * STRUCTURE! */
} ForeachVarList;
/*
@@ -665,22 +660,21 @@ typedef struct ForeachVarList {
typedef struct ForeachInfo {
int numLists; /* The number of both the variable and value
* lists of the foreach command. */
- int firstValueTemp; /* Index of the first temp var in a proc
- * frame used to point to a value list. */
- int loopCtTemp; /* Index of temp var in a proc frame
- * holding the loop's iteration count. Used
- * to determine next value list element to
- * assign each loop var. */
+ int firstValueTemp; /* Index of the first temp var in a proc frame
+ * used to point to a value list. */
+ int loopCtTemp; /* Index of temp var in a proc frame holding
+ * the loop's iteration count. Used to
+ * determine next value list element to assign
+ * each loop var. */
ForeachVarList *varLists[1];/* An array of pointers to ForeachVarList
* structures describing each var list. The
* actual size of this field will be large
- * enough to numVars indexes. THIS MUST BE
- * THE LAST FIELD IN THE STRUCTURE! */
+ * enough to numVars indexes. THIS MUST BE THE
+ * LAST FIELD IN THE STRUCTURE! */
} ForeachInfo;
MODULE_SCOPE AuxDataType tclForeachInfoType;
-
-
+
/*
*----------------------------------------------------------------
* Procedures exported by tclBasic.c to be used within the engine.
@@ -702,7 +696,7 @@ MODULE_SCOPE int TclEvalObjvInternal _ANSI_ARGS_((Tcl_Interp *interp,
*
MODULE_SCOPE int TclCompEvalObj _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *objPtr));
-*/
+ */
/*
*----------------------------------------------------------------
@@ -759,8 +753,7 @@ MODULE_SCOPE void TclInitByteCodeObj _ANSI_ARGS_((Tcl_Obj *objPtr,
CompileEnv *envPtr));
MODULE_SCOPE void TclInitCompilation _ANSI_ARGS_((void));
MODULE_SCOPE void TclInitCompileEnv _ANSI_ARGS_((Tcl_Interp *interp,
- CompileEnv *envPtr, char *string,
- int numBytes));
+ CompileEnv *envPtr, char *string, int numBytes));
MODULE_SCOPE void TclInitJumpFixupArray _ANSI_ARGS_((
JumpFixupArray *fixupArrayPtr));
MODULE_SCOPE void TclInitLiteralTable _ANSI_ARGS_((
@@ -780,7 +773,8 @@ MODULE_SCOPE void TclPrintObject _ANSI_ARGS_((FILE *outFile,
Tcl_Obj *objPtr, int maxChars));
MODULE_SCOPE void TclPrintSource _ANSI_ARGS_((FILE *outFile,
CONST char *string, int maxChars));
-MODULE_SCOPE void TclRegisterAuxDataType _ANSI_ARGS_((AuxDataType *typePtr));
+MODULE_SCOPE void TclRegisterAuxDataType _ANSI_ARGS_((
+ AuxDataType *typePtr));
MODULE_SCOPE int TclRegisterLiteral _ANSI_ARGS_((CompileEnv *envPtr,
char *bytes, int length, int flags));
MODULE_SCOPE void TclReleaseLiteral _ANSI_ARGS_((Tcl_Interp *interp,
@@ -793,11 +787,11 @@ MODULE_SCOPE void TclVerifyGlobalLiteralTable _ANSI_ARGS_((
MODULE_SCOPE void TclVerifyLocalLiteralTable _ANSI_ARGS_((
CompileEnv *envPtr));
#endif
-MODULE_SCOPE int TclCompileVariableCmd _ANSI_ARGS_((
- Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr));
+MODULE_SCOPE int TclCompileVariableCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, CompileEnv *envPtr));
MODULE_SCOPE int TclWordKnownAtCompileTime _ANSI_ARGS_((
Tcl_Token *tokenPtr, Tcl_Obj *valuePtr));
-
+
/*
*----------------------------------------------------------------
* Macros and flag values used by Tcl bytecode compilation and execution
@@ -808,31 +802,34 @@ MODULE_SCOPE int TclWordKnownAtCompileTime _ANSI_ARGS_((
#define LITERAL_ON_HEAP 0x01
#define LITERAL_NS_SCOPE 0x02
/*
- * Form of TclRegisterLiteral with onHeap == 0.
- * In that case, it is safe to cast away CONSTness, and it
- * is cleanest to do that here, all in one place.
+ * Form of TclRegisterLiteral with onHeap == 0. In that case, it is safe to
+ * cast away CONSTness, and it is cleanest to do that here, all in one place.
+ *
+ * int TclRegisterNewLiteral(CompileEnv *envPtr, const char *bytes,
+ * int length);
*/
#define TclRegisterNewLiteral(envPtr, bytes, length) \
- TclRegisterLiteral(envPtr, (char *)(bytes), length, \
- /*flags*/ 0)
+ TclRegisterLiteral(envPtr, (char *)(bytes), length, /*flags*/ 0)
/*
- * Form of TclRegisterNSLiteral with onHeap == 0.
- * In that case, it is safe to cast away CONSTness, and it
- * is cleanest to do that here, all in one place.
+ * Form of TclRegisterNSLiteral with onHeap == 0. In that case, it is safe to
+ * cast away CONSTness, and it is cleanest to do that here, all in one place.
+ *
+ * int TclRegisterNewNSLiteral(CompileEnv *envPtr, const char *bytes,
+ * int length);
*/
#define TclRegisterNewNSLiteral(envPtr, bytes, length) \
TclRegisterLiteral(envPtr, (char *)(bytes), length, \
- /*flags*/ LITERAL_NS_SCOPE)
-
+ /*flags*/ LITERAL_NS_SCOPE)
/*
- * Macro used to manually adjust the stack requirements; used
- * in cases where the stack effect cannot be computed from
- * the opcode and its operands, but is still known at
- * compile time.
+ * Macro used to manually adjust the stack requirements; used in cases where
+ * the stack effect cannot be computed from the opcode and its operands, but
+ * is still known at compile time.
+ *
+ * void TclAdjustStackDepth(int delta, CompileEnv *envPtr);
*/
#define TclAdjustStackDepth(delta, envPtr) \
@@ -844,12 +841,13 @@ MODULE_SCOPE int TclWordKnownAtCompileTime _ANSI_ARGS_((
(envPtr)->currStackDepth += (delta)
/*
- * Macro used to update the stack requirements.
- * It is called by the macros TclEmitOpCode, TclEmitInst1 and
- * TclEmitInst4.
- * Remark that the very last instruction of a bytecode always
- * reduces the stack level: INST_DONE or INST_POP, so that the
- * maxStackdepth is always updated.
+ * Macro used to update the stack requirements. It is called by the macros
+ * TclEmitOpCode, TclEmitInst1 and TclEmitInst4.
+ * Remark that the very last instruction of a bytecode always reduces the
+ * stack level: INST_DONE or INST_POP, so that the maxStackdepth is always
+ * updated.
+ *
+ * void TclUpdateStackReqs(unsigned char op, int i, CompileEnv *envPtr);
*/
#define TclUpdateStackReqs(op, i, envPtr) \
@@ -859,16 +857,15 @@ MODULE_SCOPE int TclWordKnownAtCompileTime _ANSI_ARGS_((
if (delta == INT_MIN) {\
delta = 1 - (i);\
}\
- TclAdjustStackDepth(delta, envPtr);\
- }\
+ TclAdjustStackDepth(delta, envPtr);\
+ }\
}
/*
- * Macro to emit an opcode byte into a CompileEnv's code array.
- * The ANSI C "prototype" for this macro is:
+ * Macro to emit an opcode byte into a CompileEnv's code array. The ANSI C
+ * "prototype" for this macro is:
*
- * MODULE_SCOPE void TclEmitOpcode _ANSI_ARGS_((unsigned char op,
- * CompileEnv *envPtr));
+ * void TclEmitOpcode(unsigned char op, CompileEnv *envPtr);
*/
#define TclEmitOpcode(op, envPtr) \
@@ -878,11 +875,11 @@ MODULE_SCOPE int TclWordKnownAtCompileTime _ANSI_ARGS_((
TclUpdateStackReqs(op, 0, envPtr)
/*
- * Macros to emit an integer operand.
- * The ANSI C "prototype" for these macros are:
+ * Macros to emit an integer operand. The ANSI C "prototype" for these macros
+ * are:
*
- * MODULE_SCOPE void TclEmitInt1 _ANSI_ARGS_((int i, CompileEnv *envPtr));
- * MODULE_SCOPE void TclEmitInt4 _ANSI_ARGS_((int i, CompileEnv *envPtr));
+ * void TclEmitInt1(int i, CompileEnv *envPtr);
+ * void TclEmitInt4(int i, CompileEnv *envPtr);
*/
#define TclEmitInt1(i, envPtr) \
@@ -906,16 +903,13 @@ MODULE_SCOPE int TclWordKnownAtCompileTime _ANSI_ARGS_((
/*
* Macros to emit an instruction with signed or unsigned integer operands.
* Four byte integers are stored in "big-endian" order with the high order
- * byte stored at the lowest address.
- * The ANSI C "prototypes" for these macros are:
+ * byte stored at the lowest address. The ANSI C "prototypes" for these
+ * macros are:
*
- * MODULE_SCOPE void TclEmitInstInt1 _ANSI_ARGS_((unsigned char op, int i,
- * CompileEnv *envPtr));
- * MODULE_SCOPE void TclEmitInstInt4 _ANSI_ARGS_((unsigned char op, int i,
- * CompileEnv *envPtr));
+ * void TclEmitInstInt1(unsigned char op, int i, CompileEnv *envPtr);
+ * void TclEmitInstInt4(unsigned char op, int i, CompileEnv *envPtr);
*/
-
#define TclEmitInstInt1(op, i, envPtr) \
if (((envPtr)->codeNext + 2) > (envPtr)->codeEnd) { \
TclExpandCodeArray(envPtr); \
@@ -941,11 +935,11 @@ MODULE_SCOPE int TclWordKnownAtCompileTime _ANSI_ARGS_((
/*
* Macro to push a Tcl object onto the Tcl evaluation stack. It emits the
- * object's one or four byte array index into the CompileEnv's code
- * array. These support, respectively, a maximum of 256 (2**8) and 2**32
- * objects in a CompileEnv. The ANSI C "prototype" for this macro is:
+ * object's one or four byte array index into the CompileEnv's code array.
+ * These support, respectively, a maximum of 256 (2**8) and 2**32 objects in a
+ * CompileEnv. The ANSI C "prototype" for this macro is:
*
- * MODULE_SCOPE void TclEmitPush _ANSI_ARGS_((int objIndex, CompileEnv *envPtr));
+ * void TclEmitPush(int objIndex, CompileEnv *envPtr);
*/
#define TclEmitPush(objIndex, envPtr) \
@@ -959,12 +953,12 @@ MODULE_SCOPE int TclWordKnownAtCompileTime _ANSI_ARGS_((
}
/*
- * Macros to update a (signed or unsigned) integer starting at a pointer.
- * The two variants depend on the number of bytes. The ANSI C "prototypes"
- * for these macros are:
+ * Macros to update a (signed or unsigned) integer starting at a pointer. The
+ * two variants depend on the number of bytes. The ANSI C "prototypes" for
+ * these macros are:
*
- * MODULE_SCOPE void TclStoreInt1AtPtr _ANSI_ARGS_((int i, unsigned char *p));
- * MODULE_SCOPE void TclStoreInt4AtPtr _ANSI_ARGS_((int i, unsigned char *p));
+ * void TclStoreInt1AtPtr(int i, unsigned char *p);
+ * void TclStoreInt4AtPtr(int i, unsigned char *p);
*/
#define TclStoreInt1AtPtr(i, p) \
@@ -977,14 +971,12 @@ MODULE_SCOPE int TclWordKnownAtCompileTime _ANSI_ARGS_((
*(p+3) = (unsigned char) ((unsigned int) (i) )
/*
- * Macros to update instructions at a particular pc with a new op code
- * and a (signed or unsigned) int operand. The ANSI C "prototypes" for
- * these macros are:
+ * Macros to update instructions at a particular pc with a new op code and a
+ * (signed or unsigned) int operand. The ANSI C "prototypes" for these macros
+ * are:
*
- * MODULE_SCOPE void TclUpdateInstInt1AtPc _ANSI_ARGS_((unsigned char op, int i,
- * unsigned char *pc));
- * MODULE_SCOPE void TclUpdateInstInt4AtPc _ANSI_ARGS_((unsigned char op, int i,
- * unsigned char *pc));
+ * void TclUpdateInstInt1AtPc(unsigned char op, int i, unsigned char *pc);
+ * void TclUpdateInstInt4AtPc(unsigned char op, int i, unsigned char *pc);
*/
#define TclUpdateInstInt1AtPc(op, i, pc) \
@@ -996,12 +988,12 @@ MODULE_SCOPE int TclWordKnownAtCompileTime _ANSI_ARGS_((
TclStoreInt4AtPtr((i), ((pc)+1))
/*
- * Macro to fix up a forward jump to point to the current
- * code-generation position in the bytecode being created (the most
- * common case). The ANSI C "prototypes" for this macro is:
+ * Macro to fix up a forward jump to point to the current code-generation
+ * position in the bytecode being created (the most common case). The ANSI C
+ * "prototypes" for this macro is:
*
- * MODULE_SCOPE int TclFixupForwardJumpToHere _ANSI_ARGS_((CompileEnv *envPtr,
- * JumpFixup *fixupPtr, int threshold));
+ * int TclFixupForwardJumpToHere(CompileEnv *envPtr, JumpFixup *fixupPtr,
+ * int threshold);
*/
#define TclFixupForwardJumpToHere(envPtr, fixupPtr, threshold) \
@@ -1011,23 +1003,22 @@ MODULE_SCOPE int TclWordKnownAtCompileTime _ANSI_ARGS_((
/*
* Macros to get a signed integer (GET_INT{1,2}) or an unsigned int
- * (GET_UINT{1,2}) from a pointer. There are two variants for each
- * return type that depend on the number of bytes fetched.
- * The ANSI C "prototypes" for these macros are:
+ * (GET_UINT{1,2}) from a pointer. There are two variants for each return type
+ * that depend on the number of bytes fetched. The ANSI C "prototypes" for
+ * these macros are:
*
- * MODULE_SCOPE int TclGetInt1AtPtr _ANSI_ARGS_((unsigned char *p));
- * MODULE_SCOPE int TclGetInt4AtPtr _ANSI_ARGS_((unsigned char *p));
- * MODULE_SCOPE unsigned int TclGetUInt1AtPtr _ANSI_ARGS_((unsigned char *p));
- * MODULE_SCOPE unsigned int TclGetUInt4AtPtr _ANSI_ARGS_((unsigned char *p));
+ * int TclGetInt1AtPtr(unsigned char *p);
+ * int TclGetInt4AtPtr(unsigned char *p);
+ * unsigned int TclGetUInt1AtPtr(unsigned char *p);
+ * unsigned int TclGetUInt4AtPtr(unsigned char *p);
*/
/*
- * The TclGetInt1AtPtr macro is tricky because we want to do sign
- * extension on the 1-byte value. Unfortunately the "char" type isn't
- * signed on all platforms so sign-extension doesn't always happen
- * automatically. Sometimes we can explicitly declare the pointer to be
- * signed, but other times we have to explicitly sign-extend the value
- * in software.
+ * The TclGetInt1AtPtr macro is tricky because we want to do sign extension on
+ * the 1-byte value. Unfortunately the "char" type isn't signed on all
+ * platforms so sign-extension doesn't always happen automatically. Sometimes
+ * we can explicitly declare the pointer to be signed, but other times we have
+ * to explicitly sign-extend the value in software.
*/
#ifndef __CHAR_UNSIGNED__
@@ -1035,10 +1026,10 @@ MODULE_SCOPE int TclWordKnownAtCompileTime _ANSI_ARGS_((
#else
# ifdef HAVE_SIGNED_CHAR
# define TclGetInt1AtPtr(p) ((int) *((signed char *) p))
-# else
+# else
# define TclGetInt1AtPtr(p) (((int) *((char *) p)) \
| ((*(p) & 0200) ? (-256) : 0))
-# endif
+# endif
#endif
#define TclGetInt4AtPtr(p) (((int) TclGetInt1AtPtr(p) << 24) | \
@@ -1053,11 +1044,11 @@ MODULE_SCOPE int TclWordKnownAtCompileTime _ANSI_ARGS_((
(*((p)+3)))
/*
- * Macros used to compute the minimum and maximum of two integers.
- * The ANSI C "prototypes" for these macros are:
+ * Macros used to compute the minimum and maximum of two integers. The ANSI C
+ * "prototypes" for these macros are:
*
- * MODULE_SCOPE int TclMin _ANSI_ARGS_((int i, int j));
- * MODULE_SCOPE int TclMax _ANSI_ARGS_((int i, int j));
+ * int TclMin(int i, int j);
+ * int TclMax(int i, int j);
*/
#define TclMin(i, j) ((((int) i) < ((int) j))? (i) : (j))
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index c86be8f..9277a70 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.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: tclExecute.c,v 1.190 2005/05/18 20:55:04 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.191 2005/06/20 21:27:13 dkf Exp $
*/
#include "tclInt.h"
@@ -1085,8 +1085,8 @@ TclExecuteByteCode(interp, codePtr)
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 call Tcl_AsyncReady() */
+ 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
* is necessary. Set by DECACHE_STACK_INFO() */
@@ -1101,8 +1101,8 @@ TclExecuteByteCode(interp, codePtr)
/*
- * Result variable - needed only when going to checkForcatch or
- * other error handlers; also used as local in some opcodes.
+ * Result variable - needed only when going to checkForcatch or other
+ * error handlers; also used as local in some opcodes.
*/
int result = TCL_OK; /* Return code returned after execution. */
@@ -1247,25 +1247,28 @@ TclExecuteByteCode(interp, codePtr)
#endif
/*
- * Check for asynchronous handlers [Bug 746722]; we
- * do the check every ASYNC_CHECK_COUNT_MASK instruction,
- * of the form (2**n-1).
+ * Check for asynchronous handlers [Bug 746722]; we do the check every
+ * ASYNC_CHECK_COUNT_MASK instruction, of the form (2**n-1).
*/
if ((instructionCount++ & ASYNC_CHECK_COUNT_MASK) == 0) {
if (Tcl_AsyncReady()) {
+ int localResult;
DECACHE_STACK_INFO();
- result = Tcl_AsyncInvoke(interp, result);
+ localResult = Tcl_AsyncInvoke(interp, result);
CACHE_STACK_INFO();
- if (result == TCL_ERROR) {
+ if (localResult == TCL_ERROR) {
+ result = localResult;
goto checkForCatch;
}
}
if (Tcl_LimitReady(interp)) {
+ int localResult;
DECACHE_STACK_INFO();
- result = Tcl_LimitCheck(interp);
+ localResult = Tcl_LimitCheck(interp);
CACHE_STACK_INFO();
- if (result == TCL_ERROR) {
+ if (localResult == TCL_ERROR) {
+ result = localResult;
goto checkForCatch;
}
}
@@ -1420,177 +1423,166 @@ TclExecuteByteCode(interp, codePtr)
TRACE_WITH_OBJ(("=> "), objResultPtr);
NEXT_INST_F(1, 0, 1);
- case INST_OVER:
- {
- int opnd;
-
- opnd = TclGetUInt4AtPtr(pc+1);
- objResultPtr = *(tosPtr - opnd);
- TRACE_WITH_OBJ(("=> "), objResultPtr);
- NEXT_INST_F(5, 0, 1);
- }
+ case INST_OVER: {
+ int opnd;
- case INST_CONCAT1:
- {
- int opnd, length, appendLen = 0;
- char *bytes, *p;
- Tcl_Obj **currPtr;
-
- opnd = TclGetUInt1AtPtr(pc+1);
+ opnd = TclGetUInt4AtPtr(pc+1);
+ objResultPtr = *(tosPtr - opnd);
+ TRACE_WITH_OBJ(("=> "), objResultPtr);
+ NEXT_INST_F(5, 0, 1);
+ }
- /*
- * Compute the length to be appended.
- */
-
- for (currPtr = tosPtr - (opnd-2); currPtr <= tosPtr;
- currPtr++) {
- bytes = Tcl_GetStringFromObj(*currPtr, &length);
- if (bytes != NULL) {
- appendLen += length;
- }
- }
+ case INST_CONCAT1: {
+ int opnd, length, appendLen = 0;
+ char *bytes, *p;
+ Tcl_Obj **currPtr;
- /*
- * If nothing is to be appended, just return the first
- * object by dropping all the others from the stack; this
- * saves both the computation and copy of the string rep
- * of the first object, enabling the fast '$x[set x {}]'
- * idiom for 'K $x [set x{}]'.
- */
+ opnd = TclGetUInt1AtPtr(pc+1);
- if (appendLen == 0) {
- TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
- NEXT_INST_V(2, (opnd-1), 0);
+ /*
+ * Compute the length to be appended.
+ */
+
+ for (currPtr = tosPtr - (opnd-2); currPtr <= tosPtr; currPtr++) {
+ bytes = Tcl_GetStringFromObj(*currPtr, &length);
+ if (bytes != NULL) {
+ appendLen += length;
}
+ }
- /*
- * If the first object is shared, we need a new obj for
- * the result; otherwise, we can reuse the first object.
- * In any case, make sure it has enough room to accomodate
- * all the concatenated bytes. Note that if it is unshared
- * its bytes are already copied by Tcl_SetObjectLength, so
- * that we set the loop parameters to avoid copying them
- * again: p points to the end of the already copied bytes,
- * currPtr to the second object.
- */
-
- objResultPtr = *(tosPtr-(opnd-1));
- bytes = Tcl_GetStringFromObj(objResultPtr, &length);
+ /*
+ * If nothing is to be appended, just return the first object by
+ * dropping all the others from the stack; this saves both the
+ * computation and copy of the string rep of the first object,
+ * enabling the fast '$x[set x {}]' idiom for 'K $x [set x{}]'.
+ */
+
+ if (appendLen == 0) {
+ TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
+ NEXT_INST_V(2, (opnd-1), 0);
+ }
+
+ /*
+ * If the first object is shared, we need a new obj for the result;
+ * otherwise, we can reuse the first object. In any case, make sure
+ * it has enough room to accomodate all the concatenated bytes. Note
+ * that if it is unshared its bytes are already copied by
+ * Tcl_SetObjectLength, so that we set the loop parameters to avoid
+ * copying them again: p points to the end of the already copied
+ * bytes, currPtr to the second object.
+ */
+
+ objResultPtr = *(tosPtr-(opnd-1));
+ bytes = Tcl_GetStringFromObj(objResultPtr, &length);
#if !TCL_COMPILE_DEBUG
- if (!Tcl_IsShared(objResultPtr)) {
- Tcl_SetObjLength(objResultPtr, (length + appendLen));
- p = TclGetString(objResultPtr) + length;
- currPtr = tosPtr - (opnd - 2);
- } else {
+ if (!Tcl_IsShared(objResultPtr)) {
+ Tcl_SetObjLength(objResultPtr, (length + appendLen));
+ p = TclGetString(objResultPtr) + length;
+ currPtr = tosPtr - (opnd - 2);
+ } else {
#endif
- p = (char *) ckalloc((unsigned) (length + appendLen + 1));
- TclNewObj(objResultPtr);
- objResultPtr->bytes = p;
- objResultPtr->length = length + appendLen;
- currPtr = tosPtr - (opnd - 1);
+ p = (char *) ckalloc((unsigned) (length + appendLen + 1));
+ TclNewObj(objResultPtr);
+ objResultPtr->bytes = p;
+ objResultPtr->length = length + appendLen;
+ currPtr = tosPtr - (opnd - 1);
#if !TCL_COMPILE_DEBUG
- }
+ }
#endif
- /*
- * Append the remaining characters.
- */
+ /*
+ * Append the remaining characters.
+ */
- for (; currPtr <= tosPtr; currPtr++) {
- bytes = Tcl_GetStringFromObj(*currPtr, &length);
- if (bytes != NULL) {
- memcpy((VOID *) p, (VOID *) bytes,
- (size_t) length);
- p += length;
- }
+ for (; currPtr <= tosPtr; currPtr++) {
+ bytes = Tcl_GetStringFromObj(*currPtr, &length);
+ if (bytes != NULL) {
+ memcpy((VOID *) p, (VOID *) bytes, (size_t) length);
+ p += length;
}
- *p = '\0';
-
- TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
- NEXT_INST_V(2, opnd, 1);
}
+ *p = '\0';
- case INST_EXPAND_START:
+ TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
+ NEXT_INST_V(2, opnd, 1);
+ }
+
+ case INST_EXPAND_START: {
/*
- * Push an element to the expandNestList. This records
- * the current tosPtr - i.e., the point in the stack
- * where the expanded command starts.
+ * Push an element to the expandNestList. This records the current
+ * tosPtr - i.e., the point in the stack where the expanded command
+ * starts.
*
- * Use a Tcl_Obj as linked list element; slight mem waste,
- * but faster allocation than ckalloc. This also abuses
- * the Tcl_Obj structure, as we do not define a special
- * tclObjType for it. It is not dangerous as the obj is
- * never passed anywhere, so that all manipulations are
- * performed here and in INST_INVOKE_EXPANDED (in case of
- * an expansion error, also in INST_EXPAND_STKTOP).
+ * Use a Tcl_Obj as linked list element; slight mem waste, but faster
+ * allocation than ckalloc. This also abuses the Tcl_Obj structure, as
+ * we do not define a special tclObjType for it. It is not dangerous
+ * as the obj is never passed anywhere, so that all manipulations are
+ * performed here and in INST_INVOKE_EXPANDED (in case of an expansion
+ * error, also in INST_EXPAND_STKTOP).
*/
- {
- Tcl_Obj *objPtr;
+ Tcl_Obj *objPtr;
- TclNewObj(objPtr);
- objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) (tosPtr - eePtr->stackPtr);
- objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) expandNestList;
- expandNestList = objPtr;
- NEXT_INST_F(1, 0, 0);
- }
+ TclNewObj(objPtr);
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *)
+ (tosPtr - eePtr->stackPtr);
+ objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) expandNestList;
+ expandNestList = objPtr;
+ NEXT_INST_F(1, 0, 0);
+ }
- case INST_EXPAND_STKTOP:
- {
- int objc, length, i;
- Tcl_Obj **objv, *valuePtr, *objPtr;
+ case INST_EXPAND_STKTOP: {
+ int objc, length, i;
+ Tcl_Obj **objv, *valuePtr, *objPtr;
- /*
- * Make sure that the element at stackTop is a list; if not,
- * remove the element from the expand link list and leave.
- */
-
+ /*
+ * Make sure that the element at stackTop is a list; if not, remove
+ * the element from the expand link list and leave.
+ */
- valuePtr = *tosPtr;
- result = Tcl_ListObjGetElements(interp, valuePtr, &objc, &objv);
- if (result != TCL_OK) {
- TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
- Tcl_GetObjResult(interp));
- objPtr = expandNestList;
- expandNestList = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr2;
- TclDecrRefCount(objPtr);
- goto checkForCatch;
- }
- tosPtr--;
+ valuePtr = *tosPtr;
+ if (Tcl_ListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) {
+ TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
+ Tcl_GetObjResult(interp));
+ objPtr = expandNestList;
+ expandNestList = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr2;
+ TclDecrRefCount(objPtr);
+ goto checkForCatch;
+ }
+ tosPtr--;
- /*
- * 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 stack depth, as seen by the
- * compiler.
- */
-
- length = objc + codePtr->maxStackDepth - TclGetInt4AtPtr(pc+1);
- while ((tosPtr + length) > eePtr->endPtr) {
- DECACHE_STACK_INFO();
- GrowEvaluationStack(eePtr);
- CACHE_STACK_INFO();
- }
-
- /*
- * Expand the list at stacktop onto the stack; free the list.
- */
+ /*
+ * 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
+ * stack depth, as seen by the compiler.
+ */
+
+ length = objc + codePtr->maxStackDepth - TclGetInt4AtPtr(pc+1);
+ while ((tosPtr + length) > eePtr->endPtr) {
+ DECACHE_STACK_INFO();
+ GrowEvaluationStack(eePtr);
+ CACHE_STACK_INFO();
+ }
- for (i = 0; i < objc; i++) {
- PUSH_OBJECT(objv[i]);
- }
- TclDecrRefCount(valuePtr);
- NEXT_INST_F(5, 0, 0);
+ /*
+ * Expand the list at stacktop onto the stack; free the list.
+ */
+
+ for (i = 0; i < objc; i++) {
+ PUSH_OBJECT(objv[i]);
}
+ TclDecrRefCount(valuePtr);
+ NEXT_INST_F(5, 0, 0);
+ }
{
/*
* INVOCATION BLOCK
*/
-
+
int objc, pcAdjustment;
-
+
case INST_INVOKE_EXPANDED:
{
Tcl_Obj *objPtr;
@@ -2698,8 +2690,7 @@ TclExecuteByteCode(interp, codePtr)
NEXT_INST_F(1, 2, -1); /* already has the correct refCount */
}
- case INST_LIST_INDEX_IMM:
- {
+ case INST_LIST_INDEX_IMM: {
/*** lindex with objc==3 and index in bytecode stream ***/
int listc, idx, opnd;
@@ -4742,6 +4733,11 @@ TclExecuteByteCode(interp, codePtr)
TRACE(("=> %u\n", result));
NEXT_INST_F(1, 0, 1);
+ case INST_PUSH_RETURN_OPTIONS:
+ objResultPtr = Tcl_GetReturnOptions(interp, result);
+ TRACE_WITH_OBJ(("=> "), objResultPtr);
+ NEXT_INST_F(1, 0, 1);
+
default:
Tcl_Panic("TclExecuteByteCode: unrecognized opCode %u", *pc);
} /* end of switch on opCode */