diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 98 | ||||
| -rw-r--r-- | generic/tclCompile.c | 51 | ||||
| -rw-r--r-- | generic/tclCompile.h | 579 | ||||
| -rw-r--r-- | generic/tclExecute.c | 302 |
5 files changed, 541 insertions, 494 deletions
@@ -1,5 +1,10 @@ 2005-06-20 Donal K. Fellows <dkf@users.sf.net> + * generic/tclCompile.h (INST_PUSH_RETURN_OPTIONS): New opcode to allow + * generic/tclCompCmds.c (TclCompileCatchCmd): compilation of TIP90 + * generic/tclCompile.c: catch [Bug 1219112] + * generic/tclExecute.c (TclExecuteByteCode): + * generic/tclCompCmds.c (TclCompileSwitchCmd): Ensure we spill to the command form in all cases where it generates an error. 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 */ |