Index: ChangeLog ================================================================== --- ChangeLog +++ ChangeLog @@ -1,18 +1,257 @@ +2013-01-28 Donal K. Fellows + + * generic/tclCompCmds.c (TclCompileArraySetCmd) + (TclCompileArrayUnsetCmd, TclCompileDictAppendCmd) + (TclCompileDictCreateCmd, CompileDictEachCmd, TclCompileDictIncrCmd) + (TclCompileDictLappendCmd, TclCompileDictMergeCmd) + (TclCompileDictUnsetCmd, TclCompileDictUpdateCmd) + (TclCompileDictWithCmd, TclCompileInfoCommandsCmd): + * generic/tclCompCmdsSZ.c (TclCompileStringMatchCmd) + (TclCompileStringMapCmd): Improve the code generation in cases where + full compilation is impossible but a full ensemble invoke is provably + not necessary. + +2013-01-26 Jan Nijtmans + + * unix/tclUnixCompat.c: [Bug 3601804]: platformCPUID segmentation + fault on Darwin. + +2013-01-23 Donal K. Fellows + + * library/http/http.tcl (http::geturl): [Bug 2911139]: Do not do vwait + for connect to avoid reentrancy problems (except when operating + without a -command option). Internally, this means that all sockets + created by the http package will always be operated in asynchronous + mode. + +2013-01-21 Jan Nijtmans + + * generic/tclInt.decls: Put back Tcl[GS]etStartupScript(Path|FileName) + in private stub table, so extensions using this (like Tk 8.4) will + continue to work in all Tcl 8.x versions. Extensions using this + still cannot be compiled against Tcl 8.6 headers. + +2013-01-18 Jan Nijtmans + + * generic/tclPort.h: [Bug 3598300]: unix: tcl.h does not include + sys/stat.h + +2013-01-17 Donal K. Fellows + + * generic/tclCompCmds.c (PushVarName): [Bug 3600328]: Added mechanism + for suppressing compilation of variables when we couldn't cope with + the results. Useful for some [array] subcommands. + * generic/tclEnsemble.c (CompileToCompiledCommand): Must restore the + compilation environment when a command compiler fails. + +2013-01-16 Donal K. Fellows + + * generic/tclZlib.c (TclZlibInit): [Bug 3601086]: Register the config + info in the iso8859-1 encoding as that is guaranteed to be present. + +2013-01-16 Jan Nijtmans + + * Makefile.in: Allow win32 build with -DTCL_NO_DEPRECATED, just as + * generic/tcl.h: in the UNIX build. Define Tcl_EvalObj and + * generic/tclDecls.h: Tcl_GlobalEvalObj as macros, even when + * generic/tclBasic.c: TCL_NO_DEPRECATED is defined, so Tk can benefit + from it too. + +2013-01-14 Jan Nijtmans + + * win/tcl.m4: More flexible search for win32 tclConfig.sh, backported + from TEA (not actually used in Tcl, only for Tk) + +2013-01-14 Jan Nijtmans + + * generic/tclInt.decls: Put back Tcl_[GS]etStartupScript in internal + stub table, so extensions using this, compiled against 8.5 headers + still run in Tcl 8.6. + +2013-01-13 Alexandre Ferrieux + + * doc/fileevent.n: [Bug 3436609]: Clarify readable fileevent "false + positives" in the case of multibyte encodings/transforms. + +2013-01-13 Jan Nijtmans + + * generic/tclIntDecls.h: If TCL_NO_DEPRECATED is defined, make sure + that TIP #139 functions all are taken from the public stub table, even + if the inclusion is through tclInt.h. + +2013-01-12 Jan Nijtmans + + * generic/tclInt.decls: Put back TclBackgroundException in internal + stub table, so extensions using this, compiled against 8.5 headers + still run in Tcl 8.6. + +2013-01-09 Jan Nijtmans + + * library/http/http.tcl: [Bug 3599395]: http assumes status line is a + proper Tcl list. + +2013-01-08 Jan Nijtmans + + * win/tclWinFile.c: [Bug 3092089]: [file normalize] can remove path + components. [Bug 3587096] win vista/7: "can't find init.tcl" when + called via junction without folder list access. + +2013-01-07 Jan Nijtmans + + * generic/tclOOStubLib.c: Restrict the stub library to only use + * generic/tclTomMathStubLib.c: Tcl_PkgRequireEx, Tcl_ResetResult and + Tcl_AppendResult, not any other function. This puts least restrictions + on eventual Tcl 9 stubs re-organization, and it works on the widest + range of Tcl versions. + +2013-01-06 Jan Nijtmans + + * library/http/http.tcl: Don't depend on Spencer-specific regexp + * tests/env.test: syntax (/u and /U) any more in unrelated places. + * tests/exec.test: + Bump http package to 2.8.6. + +2013-01-04 Donal K. Fellows + + * generic/tclEnsemble.c (CompileBasicNArgCommand): Added very simple + compiler (which just compiles to a normal invoke of the implementation + command) for many ensemble subcommands where we can prove that there + is no way for scripts to detect the difference even through error + handling or [info level]/[info frame]. This improves the code produced + from some ensembles (e.g., [info], [string]) to the point where the + ensemble is now not normally seen at the bytecode level at all. + +2013-01-04 Miguel Sofer + + * generic/tclInt.h: Insure that PURIFY builds cannot exploit the + * generic/tclExecute.c: Tcl stack to hide mem defects. + +2013-01-03 Donal K. Fellows + + * doc/fconfigure.n, doc/CrtChannel.3: Updated to reflect the fact that + the minimum buffer size is one byte, not ten. Identified by Schelte + Bron on the Tcler's Chat. + + * generic/tclExecute.c (TEBCresume:INST_INVOKE_REPLACE): + * generic/tclEnsemble.c (TclCompileEnsemble): Added new mechanism to + allow for more efficient dispatch of non-bytecode-compiled subcommands + of bytecode-compiled ensembles. This can provide substantial speed + benefits in some cases. + +2013-01-02 Miguel Sofer + + * generic/tclEnsemble.c: Remove stray calls to Tcl_Alloc and friends: + * generic/tclExecute.c: the core should only use ckalloc to allow + * generic/tclIORTrans.c: MEM_DEBUG to work properly. + * generic/tclTomMathInterface.c: + +2012-12-31 Donal K. Fellows + + * doc/string.n: Noted the obsolescence of the 'bytelength', + 'wordstart' and 'wordend' subcommands, and moved them to later in the + file. + +2012-12-27 Jan Nijtmans + + * generic/tclListObj.c: [Bug 3598580]: Tcl_ListObjReplace may release + deleted elements too early. + +2012-12-22 Alexandre Ferrieux + + * generic/tclUtil.c: Stop leaking allocated space when objifying a + zero-length DString. [Bug 3598150] spotted by afredd. + +2012-12-21 Jan Nijtmans + + * unix/dltest/pkgb.c: Inline compat Tcl_GetDefaultEncodingDir. + * generic/tclStubLib.c: Eliminate unnecessary static HasStubSupport() + and isDigit() functions, just do the same inline. + +2012-12-18 Donal K. Fellows + + * generic/tclCompCmdsSZ.c (TclSubstCompile): Improved the sequence of + instructions issued for [subst] when dealing with simple variable + references. + +2012-12-14 Don Porter + + *** 8.6.0 TAGGED FOR RELEASE *** + + * changes: updates for 8.6.0 + +2012-12-13 Don Porter + + * generic/tclZlib.c: Repair same issue with misusing the + * tests/zlib.test: 'fire and forget' nature of Tcl_ObjSetVar2 + in the new TIP 400 implementation. + +2012-12-13 Miguel Sofer + + * generic/tclCmdAH.c: (CatchObjCmdCallback): do not decrRefCount + * tests/cmdAH.test: the newValuePtr sent to Tcl_ObjSetVar2: + TOSV2 is 'fire and forget', it decrs on its own. + Fix for [Bug 3595576], found by andrewsh. + +2012-12-13 Jan Nijtmans + + * generic/tcl.h: Fix Tcl_DecrRefCount macro such that it doesn't + access its objPtr parameter twice any more. + +2012-12-11 Don Porter + + * generic/tcl.h: Bump version number to 8.6.0. + * library/init.tcl: + * unix/configure.in: + * win/configure.in: + * unix/tcl.spec: + * README: + + * unix/configure: autoconf-2.59 + * win/configure: + +2012-12-10 Donal K. Fellows + + * tools/tcltk-man2html.tcl (plus-pkgs): Increased robustness of + version number detection code to deal with packages whose names are + prefixes of other packages. + * unix/Makefile.in (dist): Added pkgs/package.list.txt to distribution + builds to ensure that 'make html' will work better. + +2012-12-09 Alexandre Ferrieux + + * tests/chan.test: Clean up unwanted eofchar side-effect of chan-4.6 + leading to a spurious "'" at end of chan.test under certain conditions + (see [Bug 3389289] and [Bug 3389251]). + + * doc/expr.n: [Bug 3594188]: Clarifications about commas. + +2012-12-08 Alexandre Ferrieux + + * generic/tclIO.c: Fix busyloop at exit under TCL_FINALIZE_ON_EXIT + when there are unflushed nonblocking channels. Thanks Miguel for + spotting. + +2012-12-07 Jan Nijtmans + + * unix/dltest/pkgb.c: Turn pkgb.so into a Tcl9 interoperability test + library: Whatever Tcl9 looks like, loading pkgb.so in Tcl 9 should + either result in an error-message, either succeed, but never crash. + 2012-11-28 Donal K. Fellows * generic/tclZlib.c (ZlibStreamSubcmd): [Bug 3590483]: Use a mechanism for complex option resolution that has fewer problems with more finicky compilers. 2012-11-26 Reinhard Max * unix/tclUnixSock.c: Factor out creation of the -sockname and - -peername lists from TcpGetOptionProc() to TcpHostPortList(). - Make it robust against implementations of getnameinfo() that error - out if reverse mapping fails instead of falling back to the - numeric representation. + -peername lists from TcpGetOptionProc() to TcpHostPortList(). Make it + robust against implementations of getnameinfo() that error out if + reverse mapping fails instead of falling back to the numeric + representation. 2012-11-20 Donal K. Fellows * generic/tclBinary.c (BinaryDecode64): [Bug 3033307]: Corrected handling of trailing whitespace when decoding base64. Thanks to Anton @@ -3958,10 +4197,11 @@ features to genStubs.tcl, partly: remove unneeded ifdeffery and put C++ guard around stubs pointer definition. * generic/*Decls.h: (regenerated) 2010-08-18 Miguel Sofer + * generic/tclBasic.c: New redesign of [tailcall]: find * generic/tclExecute.c: errors early on, so that errorInfo * generic/tclInt.h: contains the proper info [Bug 3047235] * generic/tclNamesp.c: Index: changes ================================================================== --- changes +++ changes @@ -8115,13 +8115,51 @@ Dropped support for OS X versions less than 10.4 (Tiger) (fellows) --- Released 8.6b3, September 18, 2012 --- See ChangeLog for details --- +2012-09-20 (enhancement) full Unicode support (nijtmans) +=> dde 1.4.0 + +2012-09-20 (enhancement) update bundled zlib to 1.2.7 (nijtmans) + 2012-10-03 (bug fix) exit panic on stacked std channel (griffin,porter) 2012-10-14 (bug fix) [tcl::Bgerror] crash on non-dict options (nijtmans) + +2012-10-16 (TIP 400) New [zlib] options to set compression dict (fellows) + +2012-10-16 (TIP 405) New commands [lmap] and [dict map] (fellows) + +2012-10-24 (enhancement) [dict unset] now bytecompiled (fellows) + +2012-11-05 (TIP 413) Revisions to default [string trim*] trimset (nijtmans) + *** POTENTIAL INCOMPATIBILITY *** + +2012-11-05 (enhancement) Now bytecompiled: [array exists], [array set], +[array unset], [dict create], [dict exists], [dict merge], [format], +[info commands], [info coroutine], [info level], [info object], +[namespace current], [namespace code], [namespace qualifiers], [namespace tail], +[namespace which], [regsub], [self], [string first], [string last], +[string map], [string range], [tailcall], [yield]. (fellows) 2012-11-06 (bug fix)[3581754] avoid multiple callback on keep-alive (fellows) => http 2.8.5 ---- Released 8.6.0, ??? ??, 2012 --- See ChangeLog for details --- +2012-11-07 tzdata updated to Olson's tzdata2012i (kenny) + +2012-11-13 (bug fix)[3567063] thread fp settings from master (mistachkin) + +2012-11-14 (bug fix)[2933003] tempfile creation in $TMPDIR (fellows) + +2012-11-15 (TIP 416) New [load] options -global and -lazy (nijtmans) + +2012-11-20 (bug fix)[3033307] base64 trail whitespace (kovalenko,goth) + +2012-12-03 (bug fix) [configure] query broke init from argv (porter) +=> tcltest 2.3.5 + +2012-12-13 (bug fix)[3595576] crash: [catch {} -> noSuchNs::var] (sofer,porter) + +2012-12-13 (bug fix) crash: [zlib gunzip $data -header noSuchNs::var] (porter) + +--- Released 8.6.0, December 20, 2012 --- See ChangeLog for details --- Index: compat/dirent2.h ================================================================== --- compat/dirent2.h +++ compat/dirent2.h @@ -12,12 +12,10 @@ */ #ifndef _DIRENT #define _DIRENT -#include "tcl.h" - /* * Dirent structure, which holds information about a single * directory entry. */ Index: compat/dlfcn.h ================================================================== --- compat/dlfcn.h +++ compat/dlfcn.h @@ -24,12 +24,10 @@ */ #ifndef __dlfcn_h__ #define __dlfcn_h__ -#include "tcl.h" - #ifdef __cplusplus extern "C" { #endif /* Index: compat/string.h ================================================================== --- compat/string.h +++ compat/string.h @@ -11,12 +11,10 @@ */ #ifndef _STRING #define _STRING -#include "tcl.h" - /* * The following #include is needed to define size_t. (This used to include * sys/stdtypes.h but that doesn't exist on older versions of SunOS, e.g. * 4.0.2, so I'm trying sys/types.h now.... hopefully it exists everywhere) */ Index: compat/unistd.h ================================================================== --- compat/unistd.h +++ compat/unistd.h @@ -12,11 +12,10 @@ */ #ifndef _UNISTD #define _UNISTD -#include "tcl.h" #include #ifndef NULL #define NULL 0 #endif Index: doc/CrtChannel.3 ================================================================== --- doc/CrtChannel.3 +++ doc/CrtChannel.3 @@ -248,12 +248,12 @@ by a previous call to \fBTcl_SetChannelBufferSize\fR, described below, then the default value of 4096 is returned. .PP \fBTcl_SetChannelBufferSize\fR sets the size, in bytes, of buffers that will be allocated in subsequent operations on the channel to store input or -output. The \fIsize\fR argument should be between ten and one million, -allowing buffers of ten bytes to one million bytes. If \fIsize\fR is +output. The \fIsize\fR argument should be between one and one million, +allowing buffers of one byte to one million bytes. If \fIsize\fR is outside this range, \fBTcl_SetChannelBufferSize\fR sets the buffer size to 4096. .PP \fBTcl_NotifyChannel\fR is called by a channel driver to indicate to the generic layer that the events specified by \fImask\fR have Index: doc/InitStubs.3 ================================================================== --- doc/InitStubs.3 +++ doc/InitStubs.3 @@ -61,13 +61,13 @@ .IP 2) 5 Define the \fBUSE_TCL_STUBS\fR symbol. Typically, you would include the \fB\-DUSE_TCL_STUBS\fR flag when compiling the extension. .IP 3) 5 Link the extension with the Tcl stubs library instead of the standard -Tcl library. For example, to use the Tcl 8.1 ABI on Unix platforms, -the library name is \fIlibtclstub8.1.a\fR; on Windows platforms, the -library name is \fItclstub81.lib\fR. +Tcl library. For example, to use the Tcl 8.6 ABI on Unix platforms, +the library name is \fIlibtclstub8.6.a\fR; on Windows platforms, the +library name is \fItclstub86.lib\fR. .PP If the extension also requires the Tk API, it must also call \fBTk_InitStubs\fR to initialize the Tk stubs interface and link with the Tk stubs libraries. See the \fBTk_InitStubs\fR page for more information. Index: doc/NRE.3 ================================================================== --- doc/NRE.3 +++ doc/NRE.3 @@ -293,11 +293,11 @@ ClientData data[], Tcl_Interp *interp, int result) { /* \fIdata[0] .. data[3]\fR are the four words of data - * passed to \fBTcl_NREvalObj\fR */ + * passed to \fBTcl_NRAddCallback\fR */ \fI... postprocessing ...\fR return result; } Index: doc/expr.n ================================================================== --- doc/expr.n +++ doc/expr.n @@ -37,13 +37,13 @@ non-numeric operands and string comparisons, as well as some additional operators not found in C. .SS OPERANDS .PP A Tcl expression consists of a combination of operands, operators, -and parentheses. +parentheses and commas. White space may be used between the operands and operators and -parentheses; it is ignored by the expression's instructions. +parentheses (or commas); it is ignored by the expression's instructions. Where possible, operands are interpreted as integer values. Integer values may be specified in decimal (the normal case), in binary (if the first two characters of the operand are \fB0b\fR), in octal (if the first two characters of the operand are \fB0o\fR), or in hexadecimal (if the first two characters of the operand are \fB0x\fR). @@ -277,10 +277,22 @@ The executor will search for \fBtcl::mathfunc::sin\fR using the usual rules for resolving functions in namespaces. Either \fB::tcl::mathfunc::sin\fR or \fB[namespace current]::tcl::mathfunc::sin\fR will satisfy the request, and others may as well (depending on the current \fBnamespace path\fR setting). +.PP +Some mathematical functions have several arguments, separated by commas like in C. Thus: +.PP +.CS +\fBexpr\fR {hypot($x,$y)} +.CE +.PP +ends up as +.PP +.CS +tcl::mathfunc::hypot $x $y +.CE .PP See the \fBmathfunc\fR(n) manual page for the math functions that are available by default. .SS "TYPES, OVERFLOW, AND PRECISION" .PP Index: doc/fconfigure.n ================================================================== --- doc/fconfigure.n +++ doc/fconfigure.n @@ -70,12 +70,12 @@ .TP \fB\-buffersize\fR \fInewSize\fR . \fINewvalue\fR must be an integer; its value is used to set the size of buffers, in bytes, subsequently allocated for this channel to store input -or output. \fINewvalue\fR must be between ten and one million, allowing -buffers of ten to one million bytes in size. +or output. \fINewvalue\fR must be between one and one million, allowing +buffers of one to one million bytes in size. .TP \fB\-encoding\fR \fIname\fR . This option is used to specify the encoding of the channel, so that the data can be converted to and from Unicode for use in Tcl. For instance, in Index: doc/fileevent.n ================================================================== --- doc/fileevent.n +++ doc/fileevent.n @@ -78,17 +78,20 @@ .PP A channel is considered to be writable if at least one byte of data can be written to the underlying file or device without blocking, or if an error condition is present on the underlying file or device. .PP -Event-driven I/O works best for channels that have been -placed into nonblocking mode with the \fBfconfigure\fR command. -In blocking mode, a \fBputs\fR command may block if you give it -more data than the underlying file or device can accept, and a -\fBgets\fR or \fBread\fR command will block if you attempt to read -more data than is ready; no events will be processed while the -commands block. +Event-driven I/O works best for channels that have been placed into +nonblocking mode with the \fBfconfigure\fR command. In blocking mode, +a \fBputs\fR command may block if you give it more data than the +underlying file or device can accept, and a \fBgets\fR or \fBread\fR +command will block if you attempt to read more data than is ready; a +readable underlying file or device may not even guarantee that a +blocking [read 1] will succeed (counter-examples being multi-byte +encodings, compression or encryption transforms ). In all such cases, +no events will be processed while the commands block. +.PP In nonblocking mode \fBputs\fR, \fBread\fR, and \fBgets\fR never block. See the documentation for the individual commands for information on how they handle blocking and nonblocking channels. .PP Testing for the end of file condition should be done after any attempts Index: doc/namespace.n ================================================================== --- doc/namespace.n +++ doc/namespace.n @@ -285,11 +285,11 @@ and for \fB::\fR it returns an empty string. This command is the complement of the \fBnamespace qualifiers\fR command. It does not check whether the namespace names are, in fact, the names of currently defined namespaces. .TP -\fBnamespace upvar\fR \fInamespace\fR ?\fIotherVar myVar \fR... +\fBnamespace upvar\fR \fInamespace\fR ?\fIotherVar myVar \fR...? . This command arranges for zero or more local variables in the current procedure to refer to variables in \fInamespace\fR. The namespace name is resolved as described in section \fBNAME RESOLUTION\fR. The command Index: doc/string.n ================================================================== --- doc/string.n +++ doc/string.n @@ -17,41 +17,21 @@ .SH DESCRIPTION .PP Performs one of several string operations, depending on \fIoption\fR. The legal \fIoption\fRs (which may be abbreviated) are: .TP -\fBstring bytelength \fIstring\fR -. -Returns a decimal string giving the number of bytes used to represent -\fIstring\fR in memory. Because UTF\-8 uses one to three bytes to -represent Unicode characters, the byte length will not be the same as -the character length in general. The cases where a script cares about -the byte length are rare. -.RS -.PP -In almost all cases, you should use the -\fBstring length\fR operation (including determining the length of a -Tcl byte array value). Refer to the \fBTcl_NumUtfChars\fR manual -entry for more details on the UTF\-8 representation. -.PP -\fICompatibility note:\fR it is likely that this subcommand will be -withdrawn in a future version of Tcl. It is better to use the -\fBencoding convertto\fR command to convert a string to a known -encoding and then apply \fBstring length\fR to that. -.RE -.TP -\fBstring compare\fR ?\fB\-nocase\fR? ?\fB\-length int\fR? \fIstring1 string2\fR +\fBstring compare\fR ?\fB\-nocase\fR? ?\fB\-length\fI length\fR? \fIstring1 string2\fR . Perform a character-by-character comparison of strings \fIstring1\fR and \fIstring2\fR. Returns \-1, 0, or 1, depending on whether \fIstring1\fR is lexicographically less than, equal to, or greater than \fIstring2\fR. If \fB\-length\fR is specified, then only the first \fIlength\fR characters are used in the comparison. If \fB\-length\fR is negative, it is ignored. If \fB\-nocase\fR is specified, then the strings are compared in a case-insensitive manner. .TP -\fBstring equal\fR ?\fB\-nocase\fR? ?\fB\-length int\fR? \fIstring1 string2\fR +\fBstring equal\fR ?\fB\-nocase\fR? ?\fB\-length\fI length\fR? \fIstring1 string2\fR . Perform a character-by-character comparison of strings \fIstring1\fR and \fIstring2\fR. Returns 1 if \fIstring1\fR and \fIstring2\fR are identical, or 0 when not. If \fB\-length\fR is specified, then only the first \fIlength\fR characters are used in the comparison. If @@ -352,10 +332,35 @@ . Returns a value equal to \fIstring\fR except that any trailing characters present in the string given by \fIchars\fR are removed. If \fIchars\fR is not specified then white space is removed (any character for which \fBstring is space\fR returns 1, and "\0"). +.SS "OBSOLETE SUBCOMMANDS" +.PP +These subcommands are currently supported, but are likely to go away in a +future release as their functionality is either virtually never used or highly +misleading. +.TP +\fBstring bytelength \fIstring\fR +. +Returns a decimal string giving the number of bytes used to represent +\fIstring\fR in memory. Because UTF\-8 uses one to three bytes to +represent Unicode characters, the byte length will not be the same as +the character length in general. The cases where a script cares about +the byte length are rare. +.RS +.PP +In almost all cases, you should use the +\fBstring length\fR operation (including determining the length of a +Tcl byte array value). Refer to the \fBTcl_NumUtfChars\fR manual +entry for more details on the UTF\-8 representation. +.PP +\fICompatibility note:\fR it is likely that this subcommand will be +withdrawn in a future version of Tcl. It is better to use the +\fBencoding convertto\fR command to convert a string to a known +encoding and then apply \fBstring length\fR to that. +.RE .TP \fBstring wordend \fIstring charIndex\fR . Returns the index of the character just after the last one in the word containing character \fIcharIndex\fR of \fIstring\fR. \fIcharIndex\fR Index: generic/tcl.h ================================================================== --- generic/tcl.h +++ generic/tcl.h @@ -347,11 +347,11 @@ struct {long tv_sec;} st_atim; struct {long tv_sec;} st_mtim; struct {long tv_sec;} st_ctim; /* Here is a 4-byte gap */ } Tcl_StatBuf; -#elif defined(HAVE_STRUCT_STAT64) +#elif defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__) typedef struct stat64 Tcl_StatBuf; #else typedef struct stat Tcl_StatBuf; #endif @@ -679,14 +679,11 @@ /* * Macros to increment and decrement a Tcl_Obj's reference count, and to test * whether an object is shared (i.e. has reference count > 1). Note: clients * should use Tcl_DecrRefCount() when they are finished using an object, and * should never call TclFreeObj() directly. TclFreeObj() is only defined and - * made public in tcl.h to support Tcl_DecrRefCount's macro definition. Note - * also that Tcl_DecrRefCount() refers to the parameter "obj" twice. This - * means that you should avoid calling it with an expression that is expensive - * to compute or has side effects. + * made public in tcl.h to support Tcl_DecrRefCount's macro definition. */ void Tcl_IncrRefCount(Tcl_Obj *objPtr); void Tcl_DecrRefCount(Tcl_Obj *objPtr); int Tcl_IsShared(Tcl_Obj *objPtr); @@ -2308,11 +2305,16 @@ /* * Use do/while0 idiom for optimum correctness without compiler warnings. * http://c2.com/cgi/wiki?TrivialDoWhileLoop */ # define Tcl_DecrRefCount(objPtr) \ - do { if (--(objPtr)->refCount <= 0) TclFreeObj(objPtr); } while(0) + do { \ + Tcl_Obj *_objPtr = (objPtr); \ + if (--(_objPtr)->refCount <= 0) { \ + TclFreeObj(_objPtr); \ + } \ + } while(0) # define Tcl_IsShared(objPtr) \ ((objPtr)->refCount > 1) #endif /* @@ -2407,10 +2409,13 @@ #ifndef TCL_NO_DEPRECATED # undef Tcl_EvalObj # define Tcl_EvalObj(interp,objPtr) \ Tcl_EvalObjEx((interp),(objPtr),0) +# undef Tcl_GlobalEvalObj +# define Tcl_GlobalEvalObj(interp,objPtr) \ + Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL) #endif /* !TCL_NO_DEPRECATED */ #endif /* RC_INVOKED */ Index: generic/tclAssembly.c ================================================================== --- generic/tclAssembly.c +++ generic/tclAssembly.c @@ -16,14 +16,14 @@ /*- *- THINGS TO DO: *- More instructions: *- done - alternate exit point (affects stack and exception range checking) *- break and continue - if exception ranges can be sorted out. - *- foreach_start4, foreach_step4 + *- foreach_start, foreach_step *- returnImm, returnStk *- expandStart, expandStkTop, invokeExpanded - *- dictFirst, dictNext, dictDone + *- dictFirst, dictNext *- dictUpdateStart, dictUpdateEnd *- jumpTable testing *- syntax (?) *- returnCodeBranch */ @@ -47,18 +47,18 @@ typedef enum BasicBlockCatchState { BBCS_UNKNOWN = 0, /* Catch context has not yet been identified */ BBCS_NONE, /* Block is outside of any catch */ BBCS_INCATCH, /* Block is within a catch context */ - BBCS_CAUGHT, /* Block is within a catch context and - * may be executed after an exception fires */ + BBCS_CAUGHT, /* Block is within a catch context and may be + * executed after an exception fires */ } BasicBlockCatchState; /* * Structure that defines a basic block - a linear sequence of bytecode - * instructions with no jumps in or out (including not changing the - * state of any exception range). + * instructions with no jumps in or out (including not changing the state of + * any exception range). */ typedef struct BasicBlock { int originalStartOffset; /* Instruction offset before JUMP1s were * substituted with JUMP4's */ @@ -131,11 +131,11 @@ ASSEM_1BYTE, /* Fixed arity, 1-byte instruction */ ASSEM_BEGIN_CATCH, /* Begin catch: one 4-byte jump offset to be * converted to appropriate exception * ranges */ ASSEM_BOOL, /* One Boolean operand */ - ASSEM_BOOL_LVT4, /* One Boolean, one 4-byte LVT ref. */ + ASSEM_BOOL_LVT, /* One Boolean, one 4-byte LVT ref. */ ASSEM_CONCAT1, /* 1-byte unsigned-integer operand count, must * be strictly positive, consumes N, produces * 1 */ ASSEM_DICT_GET, /* 'dict get' and related - consumes N+1 * operands, produces 1, N > 0 */ @@ -159,14 +159,14 @@ * positive, consumes N, produces 1 */ ASSEM_LIST, /* 4-byte operand count, must be nonnegative, * consumses N, produces 1 */ ASSEM_LSET_FLAT, /* 4-byte operand count, must be >= 3, * consumes N, produces 1 */ - ASSEM_LVT4_SINT1, /* One 4-byte operand that references a local + ASSEM_LVT_SINT1, /* One 4-byte operand that references a local * variable, one signed-integer 1-byte * operand */ - ASSEM_LVT4, /* One 4-byte operand that references a local + ASSEM_LVT, /* One 4-byte operand that references a local * variable */ ASSEM_OVER, /* OVER: 4-byte operand count, consumes N+1, * produces N+2 */ ASSEM_PUSH, /* one literal operand */ ASSEM_REGEXP, /* One Boolean operand, but weird mapping to @@ -173,11 +173,11 @@ * call flags */ ASSEM_REVERSE, /* REVERSE: 4-byte operand count, consumes N, * produces N */ ASSEM_SINT1, /* One 1-byte signed-integer operand * (INCR_STK_IMM) */ - ASSEM_SINT4_LVT4, /* Signed 4-byte integer operand followed by + ASSEM_SINT4_LVT, /* Signed 4-byte integer operand followed by * LVT entry. Fixed arity */ } TalInstType; /* * Description of an instruction recognized by the assembler. @@ -311,49 +311,26 @@ DupAssembleCodeInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ NULL /* setFromAnyProc */ }; -/* - * TIP #280: Remember the per-word line information of the current command. An - * index is used instead of a pointer as recursive compilation may reallocate, - * i.e. move, the array. This is also the reason to save the nuloc now, it may - * change during the course of the function. - * - * Macro to encapsulate the variable definition and setup. - */ - -#define DefineLineInformation \ - ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \ - int eclIndex = mapPtr->nuloc - 1 - -#define SetLineInformation(word) \ - envPtr->line = mapPtr->loc[eclIndex].line[(word)]; \ - envPtr->clNext = mapPtr->loc[eclIndex].next[(word)] - -/* - * Flags bits used by PushVarName. - */ - -#define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */ - /* * Source instructions recognized in the Tcl Assembly Language (TAL) */ static const TalInstDesc TalInstructionTable[] = { /* PUSH must be first, see the code near the end of TclAssembleCode */ {"push", ASSEM_PUSH, INST_PUSH, 0, 1}, {"add", ASSEM_1BYTE, INST_ADD, 2, 1}, - {"append", ASSEM_LVT4, INST_APPEND_SCALAR, 1, 1}, - {"appendArray", ASSEM_LVT4, INST_APPEND_ARRAY, 2, 1}, + {"append", ASSEM_LVT, INST_APPEND_SCALAR, 1, 1}, + {"appendArray", ASSEM_LVT, INST_APPEND_ARRAY, 2, 1}, {"appendArrayStk", ASSEM_1BYTE, INST_APPEND_ARRAY_STK, 3, 1}, {"appendStk", ASSEM_1BYTE, INST_APPEND_STK, 2, 1}, - {"arrayExistsImm", ASSEM_LVT4, INST_ARRAY_EXISTS_IMM, 0, 1}, + {"arrayExistsImm", ASSEM_LVT, INST_ARRAY_EXISTS_IMM, 0, 1}, {"arrayExistsStk", ASSEM_1BYTE, INST_ARRAY_EXISTS_STK, 1, 1}, - {"arrayMakeImm", ASSEM_LVT4, INST_ARRAY_MAKE_IMM, 0, 0}, + {"arrayMakeImm", ASSEM_LVT, INST_ARRAY_MAKE_IMM, 0, 0}, {"arrayMakeStk", ASSEM_1BYTE, INST_ARRAY_MAKE_STK, 1, 0}, {"beginCatch", ASSEM_BEGIN_CATCH, INST_BEGIN_CATCH, 0, 0}, {"bitand", ASSEM_1BYTE, INST_BITAND, 2, 1}, {"bitnot", ASSEM_1BYTE, INST_BITNOT, 1, 1}, @@ -360,59 +337,56 @@ {"bitor", ASSEM_1BYTE, INST_BITOR, 2, 1}, {"bitxor", ASSEM_1BYTE, INST_BITXOR, 2, 1}, {"concat", ASSEM_CONCAT1, INST_CONCAT, INT_MIN,1}, {"coroName", ASSEM_1BYTE, INST_COROUTINE_NAME, 0, 1}, {"currentNamespace",ASSEM_1BYTE, INST_NS_CURRENT, 0, 1}, - {"dictAppend", ASSEM_LVT4, INST_DICT_APPEND, 2, 1}, + {"dictAppend", ASSEM_LVT, INST_DICT_APPEND, 2, 1}, {"dictExists", ASSEM_DICT_GET, INST_DICT_EXISTS, INT_MIN,1}, {"dictExpand", ASSEM_1BYTE, INST_DICT_EXPAND, 3, 1}, {"dictGet", ASSEM_DICT_GET, INST_DICT_GET, INT_MIN,1}, - {"dictIncrImm", ASSEM_SINT4_LVT4, - INST_DICT_INCR_IMM, 1, 1}, - {"dictLappend", ASSEM_LVT4, INST_DICT_LAPPEND, 2, 1}, + {"dictIncrImm", ASSEM_SINT4_LVT,INST_DICT_INCR_IMM, 1, 1}, + {"dictLappend", ASSEM_LVT, INST_DICT_LAPPEND, 2, 1}, {"dictRecombineStk",ASSEM_1BYTE, INST_DICT_RECOMBINE_STK,3, 0}, - {"dictRecombineImm",ASSEM_LVT4, INST_DICT_RECOMBINE_IMM,2, 0}, + {"dictRecombineImm",ASSEM_LVT, INST_DICT_RECOMBINE_IMM,2, 0}, {"dictSet", ASSEM_DICT_SET, INST_DICT_SET, INT_MIN,1}, {"dictUnset", ASSEM_DICT_UNSET, INST_DICT_UNSET, INT_MIN,1}, {"div", ASSEM_1BYTE, INST_DIV, 2, 1}, {"dup", ASSEM_1BYTE, INST_DUP, 1, 2}, {"endCatch", ASSEM_END_CATCH,INST_END_CATCH, 0, 0}, {"eq", ASSEM_1BYTE, INST_EQ, 2, 1}, {"eval", ASSEM_EVAL, INST_EVAL_STK, 1, 1}, {"evalStk", ASSEM_1BYTE, INST_EVAL_STK, 1, 1}, - {"exist", ASSEM_LVT4, INST_EXIST_SCALAR, 0, 1}, - {"existArray", ASSEM_LVT4, INST_EXIST_ARRAY, 1, 1}, + {"exch", ASSEM_1BYTE, INST_EXCH, 2, 2}, + {"exist", ASSEM_LVT, INST_EXIST_SCALAR, 0, 1}, + {"existArray", ASSEM_LVT, INST_EXIST_ARRAY, 1, 1}, {"existArrayStk", ASSEM_1BYTE, INST_EXIST_ARRAY_STK, 2, 1}, {"existStk", ASSEM_1BYTE, INST_EXIST_STK, 1, 1}, {"expon", ASSEM_1BYTE, INST_EXPON, 2, 1}, {"expr", ASSEM_EVAL, INST_EXPR_STK, 1, 1}, {"exprStk", ASSEM_1BYTE, INST_EXPR_STK, 1, 1}, {"ge", ASSEM_1BYTE, INST_GE, 2, 1}, {"gt", ASSEM_1BYTE, INST_GT, 2, 1}, - {"incr", ASSEM_LVT4, INST_INCR_SCALAR, 1, 1}, - {"incrArray", ASSEM_LVT4, INST_INCR_ARRAY, 2, 1}, - {"incrArrayImm", ASSEM_LVT4_SINT1, - INST_INCR_ARRAY_IMM, 1, 1}, + {"incr", ASSEM_LVT, INST_INCR_SCALAR, 1, 1}, + {"incrArray", ASSEM_LVT, INST_INCR_ARRAY, 2, 1}, + {"incrArrayImm", ASSEM_LVT_SINT1,INST_INCR_ARRAY_IMM, 1, 1}, {"incrArrayStk", ASSEM_1BYTE, INST_INCR_ARRAY_STK, 3, 1}, {"incrArrayStkImm", ASSEM_SINT1, INST_INCR_ARRAY_STK_IMM,2, 1}, - {"incrImm", ASSEM_LVT4_SINT1, - INST_INCR_SCALAR_IMM, 0, 1}, - {"incrStk", ASSEM_1BYTE, INST_INCR_SCALAR_STK, 2, 1}, - {"incrStkImm", ASSEM_SINT1, INST_INCR_SCALAR_STK_IMM, - 1, 1}, + {"incrImm", ASSEM_LVT_SINT1,INST_INCR_SCALAR_IMM, 0, 1}, + {"incrStk", ASSEM_1BYTE, INST_INCR_STK, 2, 1}, + {"incrStkImm", ASSEM_SINT1, INST_INCR_STK_IMM, 1, 1}, {"infoLevelArgs", ASSEM_1BYTE, INST_INFO_LEVEL_ARGS, 1, 1}, {"infoLevelNumber", ASSEM_1BYTE, INST_INFO_LEVEL_NUM, 0, 1}, {"invokeStk", ASSEM_INVOKE, INST_INVOKE_STK, INT_MIN,1}, {"jump", ASSEM_JUMP, INST_JUMP, 0, 0}, {"jumpFalse", ASSEM_JUMP, INST_JUMP_FALSE, 1, 0}, {"jumpTable", ASSEM_JUMPTABLE,INST_JUMP_TABLE, 1, 0}, {"jumpTrue", ASSEM_JUMP, INST_JUMP_TRUE, 1, 0}, {"label", ASSEM_LABEL, 0, 0, 0}, {"land", ASSEM_1BYTE, INST_LAND, 2, 1}, - {"lappend", ASSEM_LVT4, INST_LAPPEND_SCALAR, 1, 1}, - {"lappendArray", ASSEM_LVT4, INST_LAPPEND_ARRAY, 2, 1}, + {"lappend", ASSEM_LVT, INST_LAPPEND_SCALAR, 1, 1}, + {"lappendArray", ASSEM_LVT, INST_LAPPEND_ARRAY, 2, 1}, {"lappendArrayStk", ASSEM_1BYTE, INST_LAPPEND_ARRAY_STK, 3, 1}, {"lappendStk", ASSEM_1BYTE, INST_LAPPEND_STK, 2, 1}, {"le", ASSEM_1BYTE, INST_LE, 2, 1}, {"lindexMulti", ASSEM_LINDEX_MULTI, INST_LIST_INDEX_MULTI, INT_MIN,1}, @@ -420,12 +394,12 @@ {"listIn", ASSEM_1BYTE, INST_LIST_IN, 2, 1}, {"listIndex", ASSEM_1BYTE, INST_LIST_INDEX, 2, 1}, {"listIndexImm", ASSEM_INDEX, INST_LIST_INDEX_IMM, 1, 1}, {"listLength", ASSEM_1BYTE, INST_LIST_LENGTH, 1, 1}, {"listNotIn", ASSEM_1BYTE, INST_LIST_NOT_IN, 2, 1}, - {"load", ASSEM_LVT4, INST_LOAD_SCALAR, 0, 1}, - {"loadArray", ASSEM_LVT4, INST_LOAD_ARRAY, 1, 1}, + {"load", ASSEM_LVT, INST_LOAD_SCALAR, 0, 1}, + {"loadArray", ASSEM_LVT, INST_LOAD_ARRAY, 1, 1}, {"loadArrayStk", ASSEM_1BYTE, INST_LOAD_ARRAY_STK, 2, 1}, {"loadStk", ASSEM_1BYTE, INST_LOAD_SCALAR_STK, 1, 1}, {"lor", ASSEM_1BYTE, INST_LOR, 2, 1}, {"lsetFlat", ASSEM_LSET_FLAT,INST_LSET_FLAT, INT_MIN,1}, {"lsetList", ASSEM_1BYTE, INST_LSET_LIST, 3, 1}, @@ -434,11 +408,11 @@ {"mod", ASSEM_1BYTE, INST_MOD, 2, 1}, {"mult", ASSEM_1BYTE, INST_MULT, 2, 1}, {"neq", ASSEM_1BYTE, INST_NEQ, 2, 1}, {"nop", ASSEM_1BYTE, INST_NOP, 0, 0}, {"not", ASSEM_1BYTE, INST_LNOT, 1, 1}, - {"nsupvar", ASSEM_LVT4, INST_NSUPVAR, 2, 1}, + {"nsupvar", ASSEM_LVT, INST_NSUPVAR, 2, 1}, {"over", ASSEM_OVER, INST_OVER, INT_MIN,-1-1}, {"pop", ASSEM_1BYTE, INST_POP, 1, 0}, {"pushReturnCode", ASSEM_1BYTE, INST_PUSH_RETURN_CODE, 0, 1}, {"pushReturnOpts", ASSEM_1BYTE, INST_PUSH_RETURN_OPTIONS, 0, 1}, @@ -445,12 +419,12 @@ {"pushResult", ASSEM_1BYTE, INST_PUSH_RESULT, 0, 1}, {"regexp", ASSEM_REGEXP, INST_REGEXP, 2, 1}, {"resolveCmd", ASSEM_1BYTE, INST_RESOLVE_COMMAND, 1, 1}, {"reverse", ASSEM_REVERSE, INST_REVERSE, INT_MIN,-1-0}, {"rshift", ASSEM_1BYTE, INST_RSHIFT, 2, 1}, - {"store", ASSEM_LVT4, INST_STORE_SCALAR, 1, 1}, - {"storeArray", ASSEM_LVT4, INST_STORE_ARRAY, 2, 1}, + {"store", ASSEM_LVT, INST_STORE_SCALAR, 1, 1}, + {"storeArray", ASSEM_LVT, INST_STORE_ARRAY, 2, 1}, {"storeArrayStk", ASSEM_1BYTE, INST_STORE_ARRAY_STK, 3, 1}, {"storeStk", ASSEM_1BYTE, INST_STORE_SCALAR_STK, 2, 1}, {"strcmp", ASSEM_1BYTE, INST_STR_CMP, 2, 1}, {"streq", ASSEM_1BYTE, INST_STR_EQ, 2, 1}, {"strfind", ASSEM_1BYTE, INST_STR_FIND, 2, 1}, @@ -466,17 +440,18 @@ {"tclooIsObject", ASSEM_1BYTE, INST_TCLOO_IS_OBJECT, 1, 1}, {"tclooNamespace", ASSEM_1BYTE, INST_TCLOO_NS, 1, 1}, {"tclooSelf", ASSEM_1BYTE, INST_TCLOO_SELF, 0, 1}, {"tryCvtToNumeric", ASSEM_1BYTE, INST_TRY_CVT_TO_NUMERIC,1, 1}, {"uminus", ASSEM_1BYTE, INST_UMINUS, 1, 1}, - {"unset", ASSEM_BOOL_LVT4,INST_UNSET_SCALAR, 0, 0}, - {"unsetArray", ASSEM_BOOL_LVT4,INST_UNSET_ARRAY, 1, 0}, + {"under", ASSEM_1BYTE, INST_UNDER, 2, 3}, + {"unset", ASSEM_BOOL_LVT, INST_UNSET_SCALAR, 0, 0}, + {"unsetArray", ASSEM_BOOL_LVT, INST_UNSET_ARRAY, 1, 0}, {"unsetArrayStk", ASSEM_BOOL, INST_UNSET_ARRAY_STK, 2, 0}, {"unsetStk", ASSEM_BOOL, INST_UNSET_STK, 1, 0}, {"uplus", ASSEM_1BYTE, INST_UPLUS, 1, 1}, - {"upvar", ASSEM_LVT4, INST_UPVAR, 2, 1}, - {"variable", ASSEM_LVT4, INST_VARIABLE, 1, 0}, + {"upvar", ASSEM_LVT, INST_UPVAR, 2, 1}, + {"variable", ASSEM_LVT, INST_VARIABLE, 1, 0}, {"verifyDict", ASSEM_1BYTE, INST_DICT_VERIFY, 1, 0}, {"yield", ASSEM_1BYTE, INST_YIELD, 1, 1}, {NULL, 0, 0, 0, 0} }; @@ -483,25 +458,20 @@ /* * List of instructions that cannot throw an exception under any * circumstances. These instructions are the ones that are permissible after * an exception is caught but before the corresponding exception range is * popped from the stack. + * * The instructions must be in ascending order by numeric operation code. */ static const unsigned char NonThrowingByteCodes[] = { - INST_PUSH, INST_POP, INST_DUP, /* 1-3 */ - INST_JUMP, /* 28 */ - INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE, /* 64- */ - INST_PUSH_RETURN_OPTIONS, /* -67 */ - INST_OVER, /* 115 */ - INST_REVERSE, INST_NOP, /* 117-118 */ - INST_STR_MAP, INST_STR_FIND, /* 128-129 */ - INST_COROUTINE_NAME, /* 134 */ - INST_NS_CURRENT, /* 136 */ - INST_INFO_LEVEL_NUM, /* 137 */ - INST_RESOLVE_COMMAND /* 139 */ + INST_PUSH, INST_POP, INST_DUP, INST_JUMP, + INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE, + INST_PUSH_RETURN_OPTIONS, INST_OVER, INST_REVERSE, INST_NOP, + INST_STR_MAP, INST_STR_FIND, INST_COROUTINE_NAME, INST_NS_CURRENT, + INST_INFO_LEVEL_NUM, INST_RESOLVE_COMMAND, INST_EXCH, INST_UNDER }; /* * Helper macros. */ @@ -731,16 +701,14 @@ * On failure, report error line. */ if (codePtr == NULL) { Tcl_AddErrorInfo(interp, "\n (\""); - Tcl_AddErrorInfo(interp, Tcl_GetString(objv[0])); + Tcl_AppendObjToErrorInfo(interp, objv[0]); Tcl_AddErrorInfo(interp, "\" body, line "); backtrace = Tcl_NewIntObj(Tcl_GetErrorLine(interp)); - Tcl_IncrRefCount(backtrace); - Tcl_AddErrorInfo(interp, Tcl_GetString(backtrace)); - Tcl_DecrRefCount(backtrace); + Tcl_AppendObjToErrorInfo(interp, backtrace); Tcl_AddErrorInfo(interp, ")"); return TCL_ERROR; } /* @@ -1308,11 +1276,11 @@ goto cleanup; } BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0); break; - case ASSEM_BOOL_LVT4: + case ASSEM_BOOL_LVT: if (parsePtr->numWords != 3) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean varName"); goto cleanup; } if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) { @@ -1559,11 +1527,11 @@ goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd); break; - case ASSEM_LVT4_SINT1: + case ASSEM_LVT_SINT1: if (parsePtr->numWords != 3) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "varName imm8"); goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); @@ -1574,11 +1542,11 @@ } BBEmitInstInt4(assemEnvPtr, tblIdx, localVar, 0); TclEmitInt1(opnd, envPtr); break; - case ASSEM_LVT4: + case ASSEM_LVT: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname"); goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); @@ -1637,11 +1605,11 @@ goto cleanup; } BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0); break; - case ASSEM_SINT4_LVT4: + case ASSEM_SINT4_LVT: if (parsePtr->numWords != 3) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName"); goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) { @@ -4142,15 +4110,15 @@ Tcl_Obj* lineNo; /* Line number in the source */ Tcl_AddErrorInfo(interp, "\n in assembly code between lines "); lineNo = Tcl_NewIntObj(bbPtr->startLine); Tcl_IncrRefCount(lineNo); - Tcl_AddErrorInfo(interp, Tcl_GetString(lineNo)); + Tcl_AppendObjToErrorInfo(interp, lineNo); Tcl_AddErrorInfo(interp, " and "); if (bbPtr->successor1 != NULL) { Tcl_SetIntObj(lineNo, bbPtr->successor1->startLine); - Tcl_AddErrorInfo(interp, Tcl_GetString(lineNo)); + Tcl_AppendObjToErrorInfo(interp, lineNo); } else { Tcl_AddErrorInfo(interp, "end of assembly code"); } Tcl_DecrRefCount(lineNo); } Index: generic/tclBasic.c ================================================================== --- generic/tclBasic.c +++ generic/tclBasic.c @@ -121,11 +121,10 @@ int actual, Tcl_Obj *const *objv); static Tcl_NRPostProc NRCoroutineCallerCallback; static Tcl_NRPostProc NRCoroutineExitCallback; static int NRCommand(ClientData data[], Tcl_Interp *interp, int result); -static Tcl_NRPostProc NRRunObjProc; static void ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode); static int RewindCoroutine(CoroutineData *corPtr, int result); static void TEOV_SwitchVarFrame(Tcl_Interp *interp); static void TEOV_PushExceptionHandlers(Tcl_Interp *interp, @@ -144,14 +143,11 @@ static Tcl_NRPostProc TEOV_Error; static Tcl_NRPostProc TEOV_Exception; static Tcl_NRPostProc TEOV_NotFoundCallback; static Tcl_NRPostProc TEOV_RestoreVarFrame; static Tcl_NRPostProc TEOV_RunLeaveTraces; -static Tcl_NRPostProc YieldToCallback; -static void ClearTailcall(Tcl_Interp *interp, - struct NRE_callback *tailcallPtr); static Tcl_ObjCmdProc NRCoroInjectObjCmd; MODULE_SCOPE const TclStubs tclStubs; /* @@ -3768,11 +3764,12 @@ { Interp *iPtr = (Interp *) interp; int result; Namespace *lookupNsPtr = iPtr->lookupNsPtr; Command **cmdPtrPtr; - + NRE_callback *callbackPtr; + iPtr->lookupNsPtr = NULL; /* * Push a callback with cleanup tasks for commands; the cmdPtr at data[0] * will be filled later when the command is found: save its address at @@ -3781,19 +3778,18 @@ * data[1] stores a marker for use by tailcalls; it will be set to 1 by * command redirectors (imports, alias, ensembles) so that tailcalls * finishes the source command and not just the target. */ - if (iPtr->evalFlags & TCL_EVAL_REDIRECT) { - TclNRAddCallback(interp, NRCommand, NULL, INT2PTR(1), INT2PTR(objc), objv); - iPtr->evalFlags &= ~TCL_EVAL_REDIRECT; + if (iPtr->deferredCallbacks) { + callbackPtr = iPtr->deferredCallbacks; + iPtr->deferredCallbacks = NULL; } else { - TclNRAddCallback(interp, NRCommand, NULL, NULL, INT2PTR(objc), objv); + TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL); + callbackPtr = TOP_CB(interp); } - cmdPtrPtr = (Command **) &(TOP_CB(interp)->data[0]); - - TclNRSpliceDeferred(interp); + cmdPtrPtr = (Command **) &(callbackPtr->data[0]); iPtr->numLevels++; result = TclInterpReady(interp); if ((result != TCL_OK) || (objc == 0)) { @@ -3903,31 +3899,20 @@ *cmdPtrPtr = cmdPtr; cmdPtr->refCount++; /* - * Find the objProc to call: nreProc if available, objProc otherwise. Push - * a callback to do the actual running. + * Find the objProc to call: nreProc if available, objProc otherwise. */ if (cmdPtr->nreProc) { - TclNRAddCallback(interp, NRRunObjProc, cmdPtr, - INT2PTR(objc), (ClientData) objv, NULL); - return TCL_OK; + return cmdPtr->nreProc(cmdPtr->objClientData, interp, objc, objv); } else { return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv); } } -void -TclPushTailcallPoint( - Tcl_Interp *interp) -{ - TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL); - ((Interp *) interp)->numLevels++; -} - int TclNRRunCallbacks( Tcl_Interp *interp, int result, struct NRE_callback *rootPtr) @@ -3959,10 +3944,18 @@ if (cmdPtr) { TclCleanupCommandMacro(cmdPtr); } ((Interp *)interp)->numLevels--; + + /* + * If there is a tailcall, schedule it + */ + + if (data[1] && (data[1] != INT2PTR(1))) { + TclNRAddCallback(interp, TclNRTailcallEval, data[1], NULL, NULL, NULL); + } /* OPT ?? * Do not interrupt a series of cleanups with async or limit checks: * just check at the end? */ @@ -3977,26 +3970,10 @@ result = Tcl_LimitCheck(interp); } return result; } - -static int -NRRunObjProc( - ClientData data[], - Tcl_Interp *interp, - int result) -{ - /* OPT: do not call? */ - - Command* cmdPtr = data[0]; - int objc = PTR2INT(data[1]); - Tcl_Obj **objv = data[2]; - - return cmdPtr->nreProc(cmdPtr->objClientData, interp, objc, objv); -} - /* *---------------------------------------------------------------------- * * TEOV_Exception - @@ -4217,13 +4194,13 @@ if (lookupNsPtr) { savedNsPtr = varFramePtr->nsPtr; varFramePtr->nsPtr = lookupNsPtr; } - TclNRDeferCallback(interp, TEOV_NotFoundCallback, INT2PTR(handlerObjc), + TclSkipTailcall(interp); + TclNRAddCallback(interp, TEOV_NotFoundCallback, INT2PTR(handlerObjc), newObjv, savedNsPtr, NULL); - iPtr->evalFlags |= TCL_EVAL_REDIRECT; return TclNREvalObjv(interp, newObjc, newObjv, TCL_EVAL_NOERR, NULL); } static int TEOV_NotFoundCallback( @@ -5370,11 +5347,11 @@ } /* *---------------------------------------------------------------------- * - * Tcl_EvalObj -- + * Tcl_EvalObj, Tcl_GlobalEvalObj -- * * These functions are deprecated but we keep them around for backwards * compatibility reasons. * * Results: @@ -5392,10 +5369,18 @@ Tcl_Interp *interp, Tcl_Obj *objPtr) { return Tcl_EvalObjEx(interp, objPtr, 0); } +#undef Tcl_GlobalEvalObj +int +Tcl_GlobalEvalObj( + Tcl_Interp *interp, + Tcl_Obj *objPtr) +{ + return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL); +} /* *---------------------------------------------------------------------- * * Tcl_EvalObjEx, TclEvalObjEx -- @@ -5539,11 +5524,12 @@ eoFramePtr->data.eval.path = NULL; iPtr->cmdFramePtr = eoFramePtr; } - TclNRDeferCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr, + TclMarkTailcall(interp); + TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr, NULL, NULL); ListObjGetElements(listPtr, objc, objv); return TclNREvalObjv(interp, objc, objv, flags, NULL); } @@ -7728,33 +7714,62 @@ * * FIXME NRE! */ void -TclSpliceTailcall( +TclMarkTailcall( + Tcl_Interp *interp) +{ + Interp *iPtr = (Interp *) interp; + + if (iPtr->deferredCallbacks == NULL) { + TclNRAddCallback(interp, NRCommand, NULL, NULL, + NULL, NULL); + iPtr->deferredCallbacks = TOP_CB(interp); + } +} + +void +TclSkipTailcall( + Tcl_Interp *interp) +{ + Interp *iPtr = (Interp *) interp; + + TclMarkTailcall(interp); + iPtr->deferredCallbacks->data[1] = INT2PTR(1); +} + +void +TclPushTailcallPoint( + Tcl_Interp *interp) +{ + TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL); + ((Interp *) interp)->numLevels++; +} + +void +TclSetTailcall( Tcl_Interp *interp, - NRE_callback *tailcallPtr) + Tcl_Obj *listPtr) { /* * Find the splicing spot: right before the NRCommand of the thing - * being tailcalled. Note that we skip NRCommands marked in data[1] + * being tailcalled. Note that we skip NRCommands marked by a 1 in data[1] * (used by command redirectors). */ NRE_callback *runPtr; for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) { - if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) { + if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) { break; } } if (!runPtr) { Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!"); } - - tailcallPtr->nextPtr = runPtr->nextPtr; - runPtr->nextPtr = tailcallPtr; + runPtr->data[1] = listPtr; } int TclNRTailcallObjCmd( ClientData clientData, @@ -7780,11 +7795,11 @@ * Invocation without args just clears a scheduled tailcall; invocation * with an argument replaces any previously scheduled tailcall. */ if (iPtr->varFramePtr->tailcallPtr) { - ClearTailcall(interp, iPtr->varFramePtr->tailcallPtr); + Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr); iPtr->varFramePtr->tailcallPtr = NULL; } /* * Create the callback to actually evaluate the tailcalled @@ -7795,27 +7810,24 @@ if (objc > 1) { Tcl_Obj *listPtr, *nsObjPtr; Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; Tcl_Namespace *ns1Ptr; - NRE_callback *tailcallPtr; - listPtr = Tcl_NewListObj(objc-1, objv+1); - Tcl_IncrRefCount(listPtr); + /* The tailcall data is in a Tcl list: the first element is the + * namespace, the rest the command to be tailcalled. */ + + listPtr = Tcl_NewListObj(objc, objv); nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr)) || (nsPtr != ns1Ptr)) { Tcl_Panic("Tailcall failed to find the proper namespace"); } - Tcl_IncrRefCount(nsObjPtr); - - TclNRAddCallback(interp, TclNRTailcallEval, listPtr, nsObjPtr, - NULL, NULL); - tailcallPtr = TOP_CB(interp); - TOP_CB(interp) = tailcallPtr->nextPtr; - iPtr->varFramePtr->tailcallPtr = tailcallPtr; + TclListObjSetElement(interp, listPtr, 0, nsObjPtr); + + iPtr->varFramePtr->tailcallPtr = listPtr; } return TCL_RETURN; } int @@ -7823,16 +7835,18 @@ ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; - Tcl_Obj *listPtr = data[0]; - Tcl_Obj *nsObjPtr = data[1]; + Tcl_Obj *listPtr = data[0], *nsObjPtr; Tcl_Namespace *nsPtr; int objc; Tcl_Obj **objv; + Tcl_ListObjGetElements(interp, listPtr, &objc, &objv); + nsObjPtr = objv[0]; + if (result == TCL_OK) { result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr); } if (result != TCL_OK) { @@ -7847,36 +7861,26 @@ /* * Perform the tailcall */ - TclNRDeferCallback(interp, TailcallCleanup, listPtr, nsObjPtr, NULL,NULL); + TclMarkTailcall(interp); + TclNRAddCallback(interp, TailcallCleanup, listPtr, NULL, NULL,NULL); iPtr->lookupNsPtr = (Namespace *) nsPtr; - ListObjGetElements(listPtr, objc, objv); - return TclNREvalObjv(interp, objc, objv, 0, NULL); + return TclNREvalObjv(interp, objc-1, objv+1, 0, NULL); } static int TailcallCleanup( ClientData data[], Tcl_Interp *interp, int result) { Tcl_DecrRefCount((Tcl_Obj *) data[0]); - Tcl_DecrRefCount((Tcl_Obj *) data[1]); return result; } -static void -ClearTailcall( - Tcl_Interp *interp, - NRE_callback *tailcallPtr) -{ - TailcallCleanup(tailcallPtr->data, interp, TCL_OK); - TCLNR_FREE(interp, tailcallPtr); -} - void Tcl_NRAddCallback( Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr, @@ -7974,54 +7978,36 @@ * Add the tailcall in the caller env, then just yield. * * This is essentially code from TclNRTailcallObjCmd */ - listPtr = Tcl_NewListObj(objc-1, objv+1); - Tcl_IncrRefCount(listPtr); + /* + * Add the tailcall in the caller env, then just yield. + * + * This is essentially code from TclNRTailcallObjCmd + */ + + listPtr = Tcl_NewListObj(objc, objv); nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr)) || (nsPtr != ns1Ptr)) { Tcl_Panic("yieldto failed to find the proper namespace"); } - Tcl_IncrRefCount(nsObjPtr); + TclListObjSetElement(interp, listPtr, 0, nsObjPtr); + /* * Add the callback in the caller's env, then instruct TEBC to yield. */ iPtr->execEnvPtr = corPtr->callerEEPtr; - TclNRAddCallback(interp, YieldToCallback, corPtr, listPtr, nsObjPtr, - NULL); + TclSetTailcall(interp, listPtr); iPtr->execEnvPtr = corPtr->eePtr; return TclNRYieldObjCmd(INT2PTR(CORO_ACTIVATE_YIELDM), interp, 1, objv); } - -static int -YieldToCallback( - ClientData data[], - Tcl_Interp *interp, - int result) -{ - /* CoroutineData *corPtr = data[0];*/ - Tcl_Obj *listPtr = data[1]; - ClientData nsPtr = data[2]; - NRE_callback *cbPtr; - - /* - * yieldTo: invoke the command using tailcall tech. - */ - - TclNRAddCallback(interp, TclNRTailcallEval, listPtr, nsPtr, NULL, NULL); - cbPtr = TOP_CB(interp); - TOP_CB(interp) = cbPtr->nextPtr; - - TclSpliceTailcall(interp, cbPtr); - return TCL_OK; -} static int RewindCoroutineCallback( ClientData data[], Tcl_Interp *interp, @@ -8470,11 +8456,10 @@ corPtr->running.framePtr = iPtr->rootFramePtr; corPtr->running.varFramePtr = iPtr->rootFramePtr; corPtr->running.cmdFramePtr = NULL; corPtr->running.lineLABCPtr = corPtr->lineLABCPtr; - corPtr->stackLevel = NULL; corPtr->auxNumLevels = 0; /* * Create the coro's execEnv, switch to it to push the exit and coro * command callbacks, then switch back. @@ -8489,16 +8474,20 @@ RESTORE_CONTEXT(corPtr->running); iPtr->execEnvPtr = corPtr->eePtr; TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr, NULL, NULL, NULL); + + /* Mark the coro as 'not suspended' while scheduling the command */ + corPtr->stackLevel = INT2PTR(1); /* insure that the command is looked up in the correct namespace */ iPtr->lookupNsPtr = lookupNsPtr; Tcl_NREvalObj(interp, Tcl_NewListObj(objc-2, objv+2), 0); iPtr->numLevels--; + corPtr->stackLevel = NULL; SAVE_CONTEXT(corPtr->running); RESTORE_CONTEXT(corPtr->caller); iPtr->execEnvPtr = corPtr->callerEEPtr; /* Index: generic/tclBinary.c ================================================================== --- generic/tclBinary.c +++ generic/tclBinary.c @@ -125,10 +125,34 @@ 'w', 'x', 'y', 'z', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '+', '/', '=' }; +/* + * How to construct the ensembles. + */ + +static const EnsembleImplMap binaryMap[] = { + { "format", BinaryFormatCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0 }, + { "scan", BinaryScanCmd, TclCompileBasicMin2ArgCmd, NULL, NULL, 0 }, + { "encode", NULL, NULL, NULL, NULL, 0 }, + { "decode", NULL, NULL, NULL, NULL, 0 }, + { NULL, NULL, NULL, NULL, NULL, 0 } +}; +static const EnsembleImplMap encodeMap[] = { + { "hex", BinaryEncodeHex, TclCompileBasic1ArgCmd, NULL, (ClientData)HexDigits, 0 }, + { "uuencode", BinaryEncode64, NULL, NULL, (ClientData)UueDigits, 0 }, + { "base64", BinaryEncode64, NULL, NULL, (ClientData)B64Digits, 0 }, + { NULL, NULL, NULL, NULL, NULL, 0 } +}; +static const EnsembleImplMap decodeMap[] = { + { "hex", BinaryDecodeHex, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, + { "uuencode", BinaryDecodeUu, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, + { "base64", BinaryDecode64, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, + { NULL, NULL, NULL, NULL, NULL, 0 } +}; + /* * The following object type represents an array of bytes. An array of bytes * is not equivalent to an internationalized string. Conceptually, a string is * an array of 16-bit quantities organized as a sequence of properly formed * UTF-8 characters, while a ByteArray is an array of 8-bit quantities. @@ -686,30 +710,10 @@ * Creates a new binary command as a mapped ensemble. * *---------------------------------------------------------------------- */ -static const EnsembleImplMap binaryMap[] = { -{ "format", BinaryFormatCmd, NULL, NULL, NULL, 0 }, -{ "scan", BinaryScanCmd, NULL, NULL, NULL, 0 }, -{ "encode", NULL, NULL, NULL, NULL, 0 }, -{ "decode", NULL, NULL, NULL, NULL, 0 }, -{ NULL, NULL, NULL, NULL, NULL, 0 } -}; -static const EnsembleImplMap encodeMap[] = { -{ "hex", BinaryEncodeHex, NULL, NULL, (ClientData)HexDigits, 0 }, -{ "uuencode", BinaryEncode64, NULL, NULL, (ClientData)UueDigits, 0 }, -{ "base64", BinaryEncode64, NULL, NULL, (ClientData)B64Digits, 0 }, -{ NULL, NULL, NULL, NULL, NULL, 0 } -}; -static const EnsembleImplMap decodeMap[] = { -{ "hex", BinaryDecodeHex, NULL, NULL, NULL, 0 }, -{ "uuencode", BinaryDecodeUu, NULL, NULL, NULL, 0 }, -{ "base64", BinaryDecode64, NULL, NULL, NULL, 0 }, -{ NULL, NULL, NULL, NULL, NULL, 0 } -}; - Tcl_Command TclInitBinaryCmd( Tcl_Interp *interp) { Tcl_Command binaryEnsemble; @@ -2355,11 +2359,11 @@ int i, index, value, size, count = 0, cut = 0, strict = 0; enum {OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; if (objc < 2 || objc > 3) { - Tcl_WrongNumArgs(interp, 1, objv, "data"); + Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); return TCL_ERROR; } for (i = 1; i < objc-1; ++i) { if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", TCL_EXACT, &index) != TCL_OK) { @@ -2569,11 +2573,11 @@ char c; enum {OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; if (objc < 2 || objc > 3) { - Tcl_WrongNumArgs(interp, 1, objv, "data"); + Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); return TCL_ERROR; } for (i = 1; i < objc-1; ++i) { if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", TCL_EXACT, &index) != TCL_OK) { @@ -2665,11 +2669,11 @@ int i, index, size, cut = 0, count = 0; enum { OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; if (objc < 2 || objc > 3) { - Tcl_WrongNumArgs(interp, 1, objv, "data"); + Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); return TCL_ERROR; } for (i = 1; i < objc-1; ++i) { if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", TCL_EXACT, &index) != TCL_OK) { Index: generic/tclCkalloc.c ================================================================== --- generic/tclCkalloc.c +++ generic/tclCkalloc.c @@ -154,10 +154,14 @@ TclInitDbCkalloc(void) { if (!ckallocInit) { ckallocInit = 1; ckallocMutexPtr = Tcl_GetAllocMutex(); +#ifndef TCL_THREADS + /* Silence compiler warning */ + (void)ckallocMutexPtr; +#endif } } /* *---------------------------------------------------------------------- Index: generic/tclCmdAH.c ================================================================== --- generic/tclCmdAH.c +++ generic/tclCmdAH.c @@ -9,10 +9,11 @@ * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ +#include #include "tclInt.h" #include /* * The state structure used by [foreach]. Note that the actual structure has @@ -222,11 +223,12 @@ if (objc == 4) { Tcl_Obj *options = Tcl_GetReturnOptions(interp, result); if (NULL == Tcl_ObjSetVar2(interp, optionVarNamePtr, NULL, options, TCL_LEAVE_ERR_MSG)) { - Tcl_DecrRefCount(options); + /* Do not decrRefCount 'options', it was already done by + * Tcl_ObjSetVar2 */ return TCL_ERROR; } } Tcl_ResetResult(interp); @@ -810,44 +812,44 @@ * the native filesystem or because they reveal information about the * native filesystem. */ static const EnsembleImplMap initMap[] = { - {"atime", FileAttrAccessTimeCmd, NULL, NULL, NULL, 0}, - {"attributes", TclFileAttrsCmd, NULL, NULL, NULL, 0}, - {"channels", TclChannelNamesCmd, NULL, NULL, NULL, 0}, - {"copy", TclFileCopyCmd, NULL, NULL, NULL, 0}, - {"delete", TclFileDeleteCmd, NULL, NULL, NULL, 0}, - {"dirname", PathDirNameCmd, NULL, NULL, NULL, 0}, - {"executable", FileAttrIsExecutableCmd, NULL, NULL, NULL, 0}, - {"exists", FileAttrIsExistingCmd, NULL, NULL, NULL, 0}, - {"extension", PathExtensionCmd, NULL, NULL, NULL, 0}, - {"isdirectory", FileAttrIsDirectoryCmd, NULL, NULL, NULL, 0}, - {"isfile", FileAttrIsFileCmd, NULL, NULL, NULL, 0}, - {"join", PathJoinCmd, NULL, NULL, NULL, 0}, - {"link", TclFileLinkCmd, NULL, NULL, NULL, 0}, - {"lstat", FileAttrLinkStatCmd, NULL, NULL, NULL, 0}, - {"mtime", FileAttrModifyTimeCmd, NULL, NULL, NULL, 0}, - {"mkdir", TclFileMakeDirsCmd, NULL, NULL, NULL, 0}, - {"nativename", PathNativeNameCmd, NULL, NULL, NULL, 0}, - {"normalize", PathNormalizeCmd, NULL, NULL, NULL, 0}, - {"owned", FileAttrIsOwnedCmd, NULL, NULL, NULL, 0}, - {"pathtype", PathTypeCmd, NULL, NULL, NULL, 0}, - {"readable", FileAttrIsReadableCmd, NULL, NULL, NULL, 0}, - {"readlink", TclFileReadLinkCmd, NULL, NULL, NULL, 0}, - {"rename", TclFileRenameCmd, NULL, NULL, NULL, 0}, - {"rootname", PathRootNameCmd, NULL, NULL, NULL, 0}, - {"separator", FilesystemSeparatorCmd, NULL, NULL, NULL, 0}, - {"size", FileAttrSizeCmd, NULL, NULL, NULL, 0}, - {"split", PathSplitCmd, NULL, NULL, NULL, 0}, - {"stat", FileAttrStatCmd, NULL, NULL, NULL, 0}, - {"system", PathFilesystemCmd, NULL, NULL, NULL, 0}, - {"tail", PathTailCmd, NULL, NULL, NULL, 0}, - {"tempfile", TclFileTemporaryCmd, NULL, NULL, NULL, 0}, - {"type", FileAttrTypeCmd, NULL, NULL, NULL, 0}, - {"volumes", FilesystemVolumesCmd, NULL, NULL, NULL, 0}, - {"writable", FileAttrIsWritableCmd, NULL, NULL, NULL, 0}, + {"atime", FileAttrAccessTimeCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, + {"attributes", TclFileAttrsCmd, NULL, NULL, NULL, 0}, + {"channels", TclChannelNamesCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"copy", TclFileCopyCmd, NULL, NULL, NULL, 0}, + {"delete", TclFileDeleteCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, + {"dirname", PathDirNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"executable", FileAttrIsExecutableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"exists", FileAttrIsExistingCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"extension", PathExtensionCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"isdirectory", FileAttrIsDirectoryCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"isfile", FileAttrIsFileCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"join", PathJoinCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0}, + {"link", TclFileLinkCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0}, + {"lstat", FileAttrLinkStatCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, + {"mtime", FileAttrModifyTimeCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, + {"mkdir", TclFileMakeDirsCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, + {"nativename", PathNativeNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"normalize", PathNormalizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"owned", FileAttrIsOwnedCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"pathtype", PathTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"readable", FileAttrIsReadableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"readlink", TclFileReadLinkCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"rename", TclFileRenameCmd, NULL, NULL, NULL, 0}, + {"rootname", PathRootNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"separator", FilesystemSeparatorCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"size", FileAttrSizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"split", PathSplitCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"stat", FileAttrStatCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, + {"system", PathFilesystemCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"tail", PathTailCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"tempfile", TclFileTemporaryCmd, TclCompileBasic0To2ArgCmd, NULL, NULL, 0}, + {"type", FileAttrTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"volumes", FilesystemVolumesCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, + {"writable", FileAttrIsWritableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; return TclMakeEnsemble(interp, "file", initMap); } Index: generic/tclCmdIL.c ================================================================== --- generic/tclCmdIL.c +++ generic/tclCmdIL.c @@ -159,34 +159,34 @@ * Array of values describing how to implement each standard subcommand of the * "info" command. */ static const EnsembleImplMap defaultInfoMap[] = { - {"args", InfoArgsCmd, NULL, NULL, NULL, 0}, - {"body", InfoBodyCmd, NULL, NULL, NULL, 0}, - {"cmdcount", InfoCmdCountCmd, NULL, NULL, NULL, 0}, + {"args", InfoArgsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"body", InfoBodyCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"cmdcount", InfoCmdCountCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"commands", InfoCommandsCmd, TclCompileInfoCommandsCmd, NULL, NULL, 0}, - {"complete", InfoCompleteCmd, NULL, NULL, NULL, 0}, + {"complete", InfoCompleteCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"coroutine", TclInfoCoroutineCmd, TclCompileInfoCoroutineCmd, NULL, NULL, 0}, - {"default", InfoDefaultCmd, NULL, NULL, NULL, 0}, - {"errorstack", InfoErrorStackCmd, NULL, NULL, NULL, 0}, + {"default", InfoDefaultCmd, TclCompileBasic3ArgCmd, NULL, NULL, 0}, + {"errorstack", InfoErrorStackCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"exists", TclInfoExistsCmd, TclCompileInfoExistsCmd, NULL, NULL, 0}, - {"frame", InfoFrameCmd, NULL, NULL, NULL, 0}, - {"functions", InfoFunctionsCmd, NULL, NULL, NULL, 0}, - {"globals", TclInfoGlobalsCmd, NULL, NULL, NULL, 0}, - {"hostname", InfoHostnameCmd, NULL, NULL, NULL, 0}, + {"frame", InfoFrameCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"functions", InfoFunctionsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"globals", TclInfoGlobalsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"hostname", InfoHostnameCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"level", InfoLevelCmd, TclCompileInfoLevelCmd, NULL, NULL, 0}, - {"library", InfoLibraryCmd, NULL, NULL, NULL, 0}, - {"loaded", InfoLoadedCmd, NULL, NULL, NULL, 0}, - {"locals", TclInfoLocalsCmd, NULL, NULL, NULL, 0}, - {"nameofexecutable", InfoNameOfExecutableCmd, NULL, NULL, NULL, 0}, - {"patchlevel", InfoPatchLevelCmd, NULL, NULL, NULL, 0}, - {"procs", InfoProcsCmd, NULL, NULL, NULL, 0}, - {"script", InfoScriptCmd, NULL, NULL, NULL, 0}, - {"sharedlibextension", InfoSharedlibCmd, NULL, NULL, NULL, 0}, - {"tclversion", InfoTclVersionCmd, NULL, NULL, NULL, 0}, - {"vars", TclInfoVarsCmd, NULL, NULL, NULL, 0}, + {"library", InfoLibraryCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, + {"loaded", InfoLoadedCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"locals", TclInfoLocalsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"nameofexecutable", InfoNameOfExecutableCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, + {"patchlevel", InfoPatchLevelCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, + {"procs", InfoProcsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"script", InfoScriptCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"sharedlibextension", InfoSharedlibCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, + {"tclversion", InfoTclVersionCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, + {"vars", TclInfoVarsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; /* *---------------------------------------------------------------------- Index: generic/tclCmdMZ.c ================================================================== --- generic/tclCmdMZ.c +++ generic/tclCmdMZ.c @@ -3322,11 +3322,11 @@ Tcl_Command TclInitStringCmd( Tcl_Interp *interp) /* Current interpreter. */ { static const EnsembleImplMap stringImplMap[] = { - {"bytelength", StringBytesCmd, NULL, NULL, NULL, 0}, + {"bytelength", StringBytesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"compare", StringCmpCmd, TclCompileStringCmpCmd, NULL, NULL, 0}, {"equal", StringEqualCmd, TclCompileStringEqualCmd, NULL, NULL, 0}, {"first", StringFirstCmd, TclCompileStringFirstCmd, NULL, NULL, 0}, {"index", StringIndexCmd, TclCompileStringIndexCmd, NULL, NULL, 0}, {"is", StringIsCmd, NULL, NULL, NULL, 0}, @@ -3333,21 +3333,21 @@ {"last", StringLastCmd, TclCompileStringLastCmd, NULL, NULL, 0}, {"length", StringLenCmd, TclCompileStringLenCmd, NULL, NULL, 0}, {"map", StringMapCmd, TclCompileStringMapCmd, NULL, NULL, 0}, {"match", StringMatchCmd, TclCompileStringMatchCmd, NULL, NULL, 0}, {"range", StringRangeCmd, TclCompileStringRangeCmd, NULL, NULL, 0}, - {"repeat", StringReptCmd, NULL, NULL, NULL, 0}, + {"repeat", StringReptCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"replace", StringRplcCmd, NULL, NULL, NULL, 0}, - {"reverse", StringRevCmd, NULL, NULL, NULL, 0}, - {"tolower", StringLowerCmd, NULL, NULL, NULL, 0}, - {"toupper", StringUpperCmd, NULL, NULL, NULL, 0}, - {"totitle", StringTitleCmd, NULL, NULL, NULL, 0}, - {"trim", StringTrimCmd, NULL, NULL, NULL, 0}, - {"trimleft", StringTrimLCmd, NULL, NULL, NULL, 0}, - {"trimright", StringTrimRCmd, NULL, NULL, NULL, 0}, - {"wordend", StringEndCmd, NULL, NULL, NULL, 0}, - {"wordstart", StringStartCmd, NULL, NULL, NULL, 0}, + {"reverse", StringRevCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"tolower", StringLowerCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0}, + {"toupper", StringUpperCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0}, + {"totitle", StringTitleCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0}, + {"trim", StringTrimCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, + {"trimleft", StringTrimLCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, + {"trimright", StringTrimRCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, + {"wordend", StringEndCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, + {"wordstart", StringStartCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; return TclMakeEnsemble(interp, "string", stringImplMap); } Index: generic/tclCompCmds.c ================================================================== --- generic/tclCompCmds.c +++ generic/tclCompCmds.c @@ -34,78 +34,17 @@ static void CompileReturnInternal(CompileEnv *envPtr, unsigned char op, int code, int level, Tcl_Obj *returnOpts); static int IndexTailVarIfKnown(Tcl_Interp *interp, Tcl_Token *varTokenPtr, CompileEnv *envPtr); -static int PushVarName(Tcl_Interp *interp, - Tcl_Token *varTokenPtr, CompileEnv *envPtr, - int flags, int *localIndexPtr, - int *simpleVarNamePtr, int *isScalarPtr, - int line, int *clNext); static int CompileEachloopCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, CompileEnv *envPtr, int collect); static int CompileDictEachCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr, int collect); - -/* - * Macro that encapsulates an efficiency trick that avoids a function call for - * the simplest of compiles. The ANSI C "prototype" for this macro is: - * - * static void CompileWord(CompileEnv *envPtr, Tcl_Token *tokenPtr, - * Tcl_Interp *interp, int word); - */ - -#define CompileWord(envPtr, tokenPtr, interp, word) \ - if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) { \ - TclEmitPush(TclRegisterNewLiteral((envPtr), (tokenPtr)[1].start, \ - (tokenPtr)[1].size), (envPtr)); \ - } else { \ - envPtr->line = mapPtr->loc[eclIndex].line[word]; \ - envPtr->clNext = mapPtr->loc[eclIndex].next[word]; \ - TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \ - (envPtr)); \ - } - -/* - * TIP #280: Remember the per-word line information of the current command. An - * index is used instead of a pointer as recursive compilation may reallocate, - * i.e. move, the array. This is also the reason to save the nuloc now, it may - * change during the course of the function. - * - * Macro to encapsulate the variable definition and setup. - */ - -#define DefineLineInformation \ - ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \ - int eclIndex = mapPtr->nuloc - 1 - -#define SetLineInformation(word) \ - envPtr->line = mapPtr->loc[eclIndex].line[(word)]; \ - envPtr->clNext = mapPtr->loc[eclIndex].next[(word)] - -#define PushVarNameWord(i,v,e,f,l,s,sc,word) \ - PushVarName(i,v,e,f,l,s,sc, \ - mapPtr->loc[eclIndex].line[(word)], \ - mapPtr->loc[eclIndex].next[(word)]) - -/* - * Often want to issue one of two versions of an instruction based on whether - * the argument will fit in a single byte or not. This makes it much clearer. - */ - -#define Emit14Inst(nm,idx,envPtr) \ - TclEmitInstInt4(nm,idx,envPtr) - -/* - * Flags bits used by PushVarName. - */ - -#define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */ - /* * The structures below define the AuxData types defined in this file. */ const AuxDataType tclForeachInfoType = { @@ -147,11 +86,11 @@ * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - Tcl_Token *varTokenPtr, *valueTokenPtr; + Tcl_Token *varTokenPtr; int simpleVarName, isScalar, localIndex, numWords; DefineLineInformation; /* TIP #280 */ numWords = parsePtr->numWords; if (numWords == 1) { @@ -178,44 +117,43 @@ * qualifiers. */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarNameWord(interp, varTokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); + PUSH_VAR( varTokenPtr, 1, + &localIndex, &simpleVarName, &isScalar); /* * We are doing an assignment, otherwise TclCompileSetCmd was called, so * push the new value. This will need to be extended to push a value for * each argument. */ if (numWords > 2) { - valueTokenPtr = TokenAfter(varTokenPtr); - CompileWord(envPtr, valueTokenPtr, interp, 2); + PUSH_SUBST_WORD(TokenAfter(varTokenPtr), 2); } /* * Emit instructions to set/get the variable. */ if (simpleVarName) { if (isScalar) { if (localIndex < 0) { - TclEmitOpcode(INST_APPEND_STK, envPtr); + OP( APPEND_STK); } else { - Emit14Inst(INST_APPEND_SCALAR, localIndex, envPtr); + OP4( APPEND_SCALAR, localIndex); } } else { if (localIndex < 0) { - TclEmitOpcode(INST_APPEND_ARRAY_STK, envPtr); + OP( APPEND_ARRAY_STK); } else { - Emit14Inst(INST_APPEND_ARRAY, localIndex, envPtr); + OP4( APPEND_ARRAY, localIndex); } } } else { - TclEmitOpcode(INST_APPEND_STK, envPtr); + OP( APPEND_STK); } return TCL_OK; } @@ -253,20 +191,20 @@ if (parsePtr->numWords != 2) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarNameWord(interp, tokenPtr, envPtr, 0, + PushVarNameWord(interp, tokenPtr, envPtr, TCL_NO_ELEMENT, &localIndex, &simpleVarName, &isScalar, 1); if (!isScalar) { return TCL_ERROR; } if (localIndex >= 0) { - TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr); + OP4( ARRAY_EXISTS_IMM, localIndex); } else { - TclEmitOpcode( INST_ARRAY_EXISTS_STK, envPtr); + OP( ARRAY_EXISTS_STK); } return TCL_OK; } int @@ -280,60 +218,80 @@ { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; int simpleVarName, isScalar, localIndex; int dataVar, iterVar, keyVar, valVar, infoIndex; - int back, fwd, offsetBack, offsetFwd, savedStackDepth; + int offsetBack, offsetFwd, savedStackDepth; ForeachInfo *infoPtr; if (parsePtr->numWords != 3) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarNameWord(interp, tokenPtr, envPtr, 0, + PushVarNameWord(interp, tokenPtr, envPtr, TCL_NO_ELEMENT, &localIndex, &simpleVarName, &isScalar, 1); + tokenPtr = TokenAfter(tokenPtr); if (!isScalar) { return TCL_ERROR; } - tokenPtr = TokenAfter(tokenPtr); /* * Special case: literal empty value argument is just an "ensure array" * operation. */ if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD && tokenPtr[1].size == 0) { if (localIndex >= 0) { - TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr); - TclEmitInstInt4(INST_JUMP_TRUE, 10, envPtr); - TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex, envPtr); + OP4( ARRAY_EXISTS_IMM, localIndex); + OP4( JUMP_TRUE, 10); + OP4( ARRAY_MAKE_IMM, localIndex); } else { - TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_ARRAY_EXISTS_STK, envPtr); - TclEmitInstInt4(INST_JUMP_TRUE, 11, envPtr); + OP( DUP); + OP( ARRAY_EXISTS_STK); + OP4( JUMP_TRUE, 11); savedStackDepth = envPtr->currStackDepth; - TclEmitOpcode( INST_ARRAY_MAKE_STK, envPtr); - TclEmitInstInt4(INST_JUMP, 6, envPtr); + OP( ARRAY_MAKE_STK); + OP4( JUMP, 6); envPtr->currStackDepth = savedStackDepth; - TclEmitOpcode( INST_POP, envPtr); + OP( POP); } - PushLiteral(envPtr, "", 0); + PUSH( ""); + return TCL_OK; + } + + if (envPtr->procPtr == NULL) { + /* + * Right number of arguments, but not compilable as we can't allocate + * (unnamed) local variables to manage the internal iteration. + */ + + Tcl_Obj *objPtr = Tcl_NewObj(); + char *bytes; + int length, cmdLit; + + Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr); + bytes = Tcl_GetStringFromObj(objPtr, &length); + cmdLit = TclRegisterNewCmdLiteral(envPtr, bytes, length); + TclSetCmdNameObj(interp, envPtr->literalArrayPtr[cmdLit].objPtr, + cmdPtr); + TclEmitPush(cmdLit, envPtr); + TclDecrRefCount(objPtr); + OP( EXCH); + PUSH_SUBST_WORD(tokenPtr, 2); + OP4( INVOKE_STK, 3); return TCL_OK; } /* * Prepare for the internal foreach. */ - if (envPtr->procPtr == NULL) { - return TCL_ERROR; - } - dataVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); - iterVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); - keyVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); - valVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); + dataVar = NewUnnamedLocal(envPtr); + iterVar = NewUnnamedLocal(envPtr); + keyVar = NewUnnamedLocal(envPtr); + valVar = NewUnnamedLocal(envPtr); infoPtr = ckalloc(sizeof(ForeachInfo) + sizeof(ForeachVarList *)); infoPtr->numLists = 1; infoPtr->firstValueTemp = dataVar; infoPtr->loopCtTemp = iterVar; @@ -345,76 +303,64 @@ /* * Start issuing instructions to write to the array. */ - CompileWord(envPtr, tokenPtr, interp, 2); - TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_LIST_LENGTH, envPtr); - PushLiteral(envPtr, "1", 1); - TclEmitOpcode( INST_BITAND, envPtr); - offsetFwd = CurrentOffset(envPtr); - TclEmitInstInt4( INST_JUMP_FALSE, 0, envPtr); + PUSH_SUBST_WORD( tokenPtr, 2); + OP( DUP); + OP( LIST_LENGTH); + PUSH( "1"); + OP( BITAND); + JUMP(offsetFwd, JUMP_FALSE); savedStackDepth = envPtr->currStackDepth; - PushLiteral(envPtr, "list must have an even number of elements", - strlen("list must have an even number of elements")); - PushLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}", - strlen("-errorCode {TCL ARGUMENT FORMAT}")); - TclEmitInstInt4( INST_RETURN_IMM, 1, envPtr); - TclEmitInt4( 0, envPtr); + PUSH( "list must have an even number of elements"); + PUSH( "-errorCode {TCL ARGUMENT FORMAT}"); + OP44( RETURN_IMM, 1, 0); envPtr->currStackDepth = savedStackDepth; - fwd = CurrentOffset(envPtr) - offsetFwd; - TclStoreInt4AtPtr(fwd, envPtr->codeStart+offsetFwd+1); - Emit14Inst( INST_STORE_SCALAR, dataVar, envPtr); - TclEmitOpcode( INST_POP, envPtr); + FIXJUMP( offsetFwd); + OP4( STORE_SCALAR, dataVar); + OP( POP); if (localIndex >= 0) { - TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr); - TclEmitInstInt4(INST_JUMP_TRUE, 10, envPtr); - TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex, envPtr); - TclEmitInstInt4(INST_FOREACH_START, infoIndex, envPtr); - offsetBack = CurrentOffset(envPtr); - TclEmitInstInt4(INST_FOREACH_STEP, infoIndex, envPtr); - offsetFwd = CurrentOffset(envPtr); - TclEmitInstInt4(INST_JUMP_FALSE, 0, envPtr); - savedStackDepth = envPtr->currStackDepth; - Emit14Inst( INST_LOAD_SCALAR, keyVar, envPtr); - Emit14Inst( INST_LOAD_SCALAR, valVar, envPtr); - Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); - back = offsetBack - CurrentOffset(envPtr); - TclEmitInstInt4(INST_JUMP, back, envPtr); - fwd = CurrentOffset(envPtr) - offsetFwd; - TclStoreInt4AtPtr(fwd, envPtr->codeStart+offsetFwd+1); - envPtr->currStackDepth = savedStackDepth; - } else { - TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_ARRAY_EXISTS_STK, envPtr); - TclEmitInstInt4(INST_JUMP_TRUE, 4, envPtr); - TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_ARRAY_MAKE_STK, envPtr); - TclEmitInstInt4(INST_FOREACH_START, infoIndex, envPtr); - offsetBack = CurrentOffset(envPtr); - TclEmitInstInt4(INST_FOREACH_STEP, infoIndex, envPtr); - offsetFwd = CurrentOffset(envPtr); - TclEmitInstInt4(INST_JUMP_FALSE, 0, envPtr); - savedStackDepth = envPtr->currStackDepth; - TclEmitOpcode( INST_DUP, envPtr); - Emit14Inst( INST_LOAD_SCALAR, keyVar, envPtr); - Emit14Inst( INST_LOAD_SCALAR, valVar, envPtr); - TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr); - TclEmitOpcode( INST_POP, envPtr); - back = offsetBack - CurrentOffset(envPtr); - TclEmitInstInt4(INST_JUMP, back, envPtr); - fwd = CurrentOffset(envPtr) - offsetFwd; - TclStoreInt4AtPtr(fwd, envPtr->codeStart+offsetFwd+1); - envPtr->currStackDepth = savedStackDepth; - TclEmitOpcode( INST_POP, envPtr); - } - TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( dataVar, envPtr); - PushLiteral(envPtr, "", 0); + OP4( ARRAY_EXISTS_IMM, localIndex); + OP4( JUMP_TRUE, 10); + OP4( ARRAY_MAKE_IMM, localIndex); + OP4( FOREACH_START, infoIndex); + LABEL(offsetBack); + OP4( FOREACH_STEP, infoIndex); + JUMP(offsetFwd, JUMP_FALSE); + savedStackDepth = envPtr->currStackDepth; + OP4( LOAD_SCALAR, keyVar); + OP4( LOAD_SCALAR, valVar); + OP4( STORE_ARRAY, localIndex); + OP( POP); + BACKJUMP( offsetBack, JUMP); + FIXJUMP( offsetFwd); + envPtr->currStackDepth = savedStackDepth; + } else { + OP( DUP); + OP( ARRAY_EXISTS_STK); + OP4( JUMP_TRUE, 7); + OP( DUP); + OP( ARRAY_MAKE_STK); + OP4( FOREACH_START, infoIndex); + LABEL(offsetBack); + OP4( FOREACH_STEP, infoIndex); + JUMP(offsetFwd, JUMP_FALSE); + savedStackDepth = envPtr->currStackDepth; + OP( DUP); + OP4( LOAD_SCALAR, keyVar); + OP4( LOAD_SCALAR, valVar); + OP( STORE_ARRAY_STK); + OP( POP); + BACKJUMP( offsetBack, JUMP); + FIXJUMP( offsetFwd); + envPtr->currStackDepth = savedStackDepth; + OP( POP); + } + OP14( UNSET_SCALAR, 0, dataVar); + PUSH( ""); return TCL_OK; } int TclCompileArrayUnsetCmd( @@ -428,35 +374,34 @@ DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); int simpleVarName, isScalar, localIndex, savedStackDepth; if (parsePtr->numWords != 2) { - return TCL_ERROR; + return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } - PushVarNameWord(interp, tokenPtr, envPtr, 0, + PushVarNameWord(interp, tokenPtr, envPtr, TCL_NO_ELEMENT, &localIndex, &simpleVarName, &isScalar, 1); if (!isScalar) { return TCL_ERROR; } if (localIndex >= 0) { - TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr); - TclEmitInstInt4(INST_JUMP_FALSE, 11, envPtr); - TclEmitInstInt1(INST_UNSET_SCALAR, 1, envPtr); - TclEmitInt4( localIndex, envPtr); + OP4( ARRAY_EXISTS_IMM, localIndex); + OP4( JUMP_FALSE, 11); + OP14( UNSET_SCALAR, 1, localIndex); } else { - TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_ARRAY_EXISTS_STK, envPtr); - TclEmitInstInt4(INST_JUMP_FALSE, 12, envPtr); + OP( DUP); + OP( ARRAY_EXISTS_STK); + OP4( JUMP_FALSE, 12); savedStackDepth = envPtr->currStackDepth; - TclEmitInstInt1(INST_UNSET_STK, 1, envPtr); - TclEmitInstInt4(INST_JUMP, 6, envPtr); + OP1( UNSET_STK, 1); + OP4( JUMP, 6); envPtr->currStackDepth = savedStackDepth; - TclEmitOpcode( INST_POP, envPtr); + OP( POP); } - PushLiteral(envPtr, "", 0); + PUSH( ""); return TCL_OK; } /* *---------------------------------------------------------------------- @@ -491,12 +436,12 @@ /* * Emit a break instruction. */ - TclEmitOpcode(INST_BREAK, envPtr); - PushLiteral(envPtr, "", 0); /* Evil hack! */ + OP( BREAK); + PUSH( ""); /* Evil hack! */ return TCL_OK; } /* *---------------------------------------------------------------------- @@ -613,23 +558,22 @@ * [Bug 219184] * The reason for duplicating the script is that EVAL_STK would otherwise * begin by undeflowing the stack below the mark set by BEGIN_CATCH4. */ - SetLineInformation(1); if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { savedStackDepth = envPtr->currStackDepth; - TclEmitInstInt4( INST_BEGIN_CATCH, range, envPtr); + OP4( BEGIN_CATCH, range); ExceptionRangeStarts(envPtr, range); - CompileBody(envPtr, cmdTokenPtr, interp); + BODY( cmdTokenPtr, 1); } else { - CompileTokens(envPtr, cmdTokenPtr, interp); + PUSH_SUBST_WORD(cmdTokenPtr, 1); savedStackDepth = envPtr->currStackDepth; - TclEmitInstInt4( INST_BEGIN_CATCH, range, envPtr); + OP4( BEGIN_CATCH, range); ExceptionRangeStarts(envPtr, range); - TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_EVAL_STK, envPtr); + OP( DUP); + OP( EVAL_STK); } /* Stack at this point: * nonsimple: script result * simple: result */ @@ -640,18 +584,18 @@ * that case, we can skip quite a bit of the command epilogue; all we * have to do is drop the result and push the return code (and, of * course, finish the catch context). */ - TclEmitOpcode( INST_POP, envPtr); - PushLiteral(envPtr, "0", 1); - TclEmitInstInt4( INST_JUMP, 6, envPtr); + OP( POP); + PUSH( "0"); + OP4( JUMP, 6); envPtr->currStackDepth = savedStackDepth; ExceptionRangeTarget(envPtr, range, catchOffset); - TclEmitOpcode( INST_PUSH_RETURN_CODE, envPtr); + OP( PUSH_RETURN_CODE); ExceptionRangeEnds(envPtr, range); - TclEmitOpcode( INST_END_CATCH, envPtr); + OP( END_CATCH); /* * Stack at this point: * nonsimple: script returnCode * simple: returnCode @@ -663,11 +607,11 @@ /* * Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch result, * and jump around the "error case" code. */ - PushLiteral(envPtr, "0", 1); + PUSH( "0"); TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup); /* Stack at this point: ?script? result TCL_OK */ /* * Emit the "error case" epilogue. Push the interpreter result and the @@ -675,12 +619,12 @@ */ envPtr->currStackDepth = savedStackDepth; ExceptionRangeTarget(envPtr, range, catchOffset); /* Stack at this point: ?script? */ - TclEmitOpcode( INST_PUSH_RESULT, envPtr); - TclEmitOpcode( INST_PUSH_RETURN_CODE, envPtr); + OP( PUSH_RESULT); + OP( PUSH_RETURN_CODE); /* * Update the target of the jump after the "no errors" code. */ @@ -693,50 +637,50 @@ /* * Push the return options if the caller wants them. */ if (optsIndex != -1) { - TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr); + OP( PUSH_RETURN_OPTIONS); } /* * End the catch */ ExceptionRangeEnds(envPtr, range); - TclEmitOpcode( INST_END_CATCH, envPtr); + OP( END_CATCH); /* * At this point, the top of the stack is inconveniently ordered: * ?script? result returnCode ?returnOptions? * Reverse the stack to bring the result to the top. */ if (optsIndex != -1) { - TclEmitInstInt4( INST_REVERSE, 3, envPtr); + OP4( REVERSE, 3); } else { - TclEmitInstInt4( INST_REVERSE, 2, envPtr); + OP( EXCH); } /* * Store the result and remove it from the stack. */ - Emit14Inst( INST_STORE_SCALAR, resultIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); + OP4( STORE_SCALAR, resultIndex); + OP( POP); /* * Stack is now ?script? ?returnOptions? returnCode. * If the options dict has been requested, it is buried on the stack under * the return code. Reverse the stack to bring it to the top, store it and * remove it from the stack. */ if (optsIndex != -1) { - TclEmitInstInt4( INST_REVERSE, 2, envPtr); - Emit14Inst( INST_STORE_SCALAR, optsIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); + OP( EXCH); + OP4( STORE_SCALAR, optsIndex); + OP( POP); } dropScriptAtEnd: /* @@ -743,12 +687,12 @@ * Stack is now ?script? result. Get rid of the subst'ed script if it's * hanging arond. */ if (cmdTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - TclEmitInstInt4( INST_REVERSE, 2, envPtr); - TclEmitOpcode( INST_POP, envPtr); + OP( EXCH); + OP( POP); } /* * Result of all this, on either branch, should have been to leave one * operand -- the return code -- on the stack. @@ -798,12 +742,12 @@ /* * Emit a continue instruction. */ - TclEmitOpcode(INST_CONTINUE, envPtr); - PushLiteral(envPtr, "", 0); /* Evil hack! */ + OP( CONTINUE); + PUSH( ""); /* Evil hack! */ return TCL_OK; } /* *---------------------------------------------------------------------- @@ -872,20 +816,19 @@ */ tokenPtr = TokenAfter(varTokenPtr); numWords = parsePtr->numWords-1; for (i=1 ; itype != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; + return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr); } word = incrTokenPtr[1].start; numBytes = incrTokenPtr[1].size; intObj = Tcl_NewStringObj(word, numBytes); Tcl_IncrRefCount(intObj); code = TclGetIntFromObj(NULL, intObj, &incrAmount); TclDecrRefCount(intObj); if (code != TCL_OK) { - return TCL_ERROR; + return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr); } } else { incrAmount = 1; } @@ -945,29 +888,28 @@ * compile time; anything else exceeds the complexity of the opcode. So * discover what the index is. */ if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; + return TclCompileBasic2Or3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } name = varTokenPtr[1].start; nameChars = varTokenPtr[1].size; if (!TclIsLocalScalar(name, nameChars)) { - return TCL_ERROR; + return TclCompileBasic2Or3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr); if (dictVarIndex < 0) { - return TCL_ERROR; + return TclCompileBasic2Or3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } /* * Emit the key and the code to actually do the increment. */ - CompileWord(envPtr, keyTokenPtr, interp, 3); - TclEmitInstInt4( INST_DICT_INCR_IMM, incrAmount, envPtr); - TclEmitInt4( dictVarIndex, envPtr); + PUSH_SUBST_WORD(keyTokenPtr, 3); + OP44( DICT_INCR_IMM, incrAmount, dictVarIndex); return TCL_OK; } int TclCompileDictGetCmd( @@ -996,14 +938,14 @@ /* * Only compile this because we need INST_DICT_GET anyway. */ for (i=0 ; itokenPtr); if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; + return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } name = tokenPtr[1].start; nameChars = tokenPtr[1].size; if (!TclIsLocalScalar(name, nameChars)) { - return TCL_ERROR; + return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr); if (dictVarIndex < 0) { - return TCL_ERROR; + return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } /* * Remaining words (the key path) can be handled normally. */ for (i=2 ; inumWords ; i++) { tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, i); + PUSH_SUBST_WORD(tokenPtr, i); } /* * Now emit the instruction to do the dict manipulation. */ - TclEmitInstInt4( INST_DICT_UNSET, parsePtr->numWords-2, envPtr); - TclEmitInt4( dictVarIndex, envPtr); + OP44( DICT_UNSET, parsePtr->numWords-2, dictVarIndex); return TCL_OK; } int TclCompileDictCreateCmd( @@ -1115,12 +1056,11 @@ { DefineLineInformation; /* TIP #280 */ int worker; /* Temp var for building the value in. */ Tcl_Token *tokenPtr; Tcl_Obj *keyObj, *valueObj, *dictObj; - const char *bytes; - int i, len; + int i; if ((parsePtr->numWords & 1) == 0) { return TCL_ERROR; } @@ -1156,14 +1096,13 @@ /* * We did! Excellent. The "verifyDict" is to do type forcing. */ - bytes = Tcl_GetStringFromObj(dictObj, &len); - PushLiteral(envPtr, bytes, len); - TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_DICT_VERIFY, envPtr); + PUSH_OBJ( dictObj); + OP( DUP); + OP( DICT_VERIFY); Tcl_DecrRefCount(dictObj); return TCL_OK; /* * Otherwise, we've got to issue runtime code to do the building, which we @@ -1170,32 +1109,30 @@ * do by [dict set]ting into an unnamed local variable. This requires that * we are in a context with an LVT. */ nonConstant: - worker = TclFindCompiledLocal(NULL, 0, 1, envPtr); + worker = NewUnnamedLocal(envPtr); if (worker < 0) { - return TCL_ERROR; + return TclCompileBasicMin0ArgCmd(interp, parsePtr, cmdPtr, envPtr); } - PushLiteral(envPtr, "", 0); - Emit14Inst( INST_STORE_SCALAR, worker, envPtr); - TclEmitOpcode( INST_POP, envPtr); + PUSH( ""); + OP4( STORE_SCALAR, worker); + OP( POP); tokenPtr = TokenAfter(parsePtr->tokenPtr); for (i=1 ; inumWords ; i+=2) { - CompileWord(envPtr, tokenPtr, interp, i); + PUSH_SUBST_WORD(tokenPtr, i); tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, i+1); + PUSH_SUBST_WORD(tokenPtr, i+1); tokenPtr = TokenAfter(tokenPtr); - TclEmitInstInt4( INST_DICT_SET, 1, envPtr); - TclEmitInt4( worker, envPtr); + OP44( DICT_SET, 1, worker); TclAdjustStackDepth(-1, envPtr); - TclEmitOpcode( INST_POP, envPtr); + OP( POP); } - Emit14Inst( INST_LOAD_SCALAR, worker, envPtr); - TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( worker, envPtr); + OP4( LOAD_SCALAR, worker); + OP14( UNSET_SCALAR, 0, worker); return TCL_OK; } int TclCompileDictMergeCmd( @@ -1214,17 +1151,17 @@ * Deal with some special edge cases. Note that in the case with one * argument, the only thing to do is to verify the dict-ness. */ if (parsePtr->numWords < 2) { - PushLiteral(envPtr, "", 0); + PUSH( ""); return TCL_OK; } else if (parsePtr->numWords == 2) { tokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 1); - TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_DICT_VERIFY, envPtr); + PUSH_SUBST_WORD(tokenPtr, 1); + OP( DUP); + OP( DICT_VERIFY); return TCL_OK; } /* * There's real merging work to do. @@ -1231,82 +1168,81 @@ * * Allocate some working space. This means we'll only ever compile this * command when there's an LVT present. */ - workerIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr); + workerIndex = NewUnnamedLocal(envPtr); if (workerIndex < 0) { - return TCL_ERROR; + return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } - infoIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr); + infoIndex = NewUnnamedLocal(envPtr); /* * Get the first dictionary and verify that it is so. */ tokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 1); - TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_DICT_VERIFY, envPtr); - Emit14Inst( INST_STORE_SCALAR, workerIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); + PUSH_SUBST_WORD(tokenPtr, 1); + OP( DUP); + OP( DICT_VERIFY); + OP4( STORE_SCALAR, workerIndex); + OP( POP); /* * For each of the remaining dictionaries... */ outLoop = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); - TclEmitInstInt4( INST_BEGIN_CATCH, outLoop, envPtr); + OP4( BEGIN_CATCH, outLoop); ExceptionRangeStarts(envPtr, outLoop); for (i=2 ; inumWords ; i++) { + int endloop, loop; + /* * Get the dictionary, and merge its pairs into the first dict (using * a small loop). */ tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, i); - TclEmitInstInt4( INST_DICT_FIRST, infoIndex, envPtr); - TclEmitInstInt4( INST_JUMP_TRUE, 30, envPtr); - TclEmitInstInt4( INST_REVERSE, 2, envPtr); - TclEmitInstInt4( INST_DICT_SET, 1, envPtr); - TclEmitInt4( workerIndex, envPtr); + PUSH_SUBST_WORD(tokenPtr, i); + OP4( DICT_FIRST, infoIndex); + JUMP(endloop, JUMP_TRUE); + LABEL(loop); + OP( EXCH); + OP44( DICT_SET, 1, workerIndex); TclAdjustStackDepth(-1, envPtr); - TclEmitOpcode( INST_POP, envPtr); - TclEmitInstInt4( INST_DICT_NEXT, infoIndex, envPtr); - TclEmitInstInt4( INST_JUMP_FALSE, -20, envPtr); - TclEmitOpcode( INST_POP, envPtr); - TclEmitOpcode( INST_POP, envPtr); - TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( infoIndex, envPtr); + OP( POP); + OP4( DICT_NEXT, infoIndex); + BACKJUMP(loop, JUMP_FALSE); + FIXJUMP(endloop); + OP( POP); + OP( POP); + OP14( UNSET_SCALAR, 0, infoIndex); } ExceptionRangeEnds(envPtr, outLoop); - TclEmitOpcode( INST_END_CATCH, envPtr); + OP( END_CATCH); /* * Clean up any state left over. */ - Emit14Inst( INST_LOAD_SCALAR, workerIndex, envPtr); - TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( workerIndex, envPtr); - TclEmitInstInt4( INST_JUMP, 21, envPtr); + OP4( LOAD_SCALAR, workerIndex); + OP14( UNSET_SCALAR, 0, workerIndex); + OP4( JUMP, 21); /* * If an exception happens when starting to iterate over the second (and * subsequent) dicts. This is strictly not necessary, but it is nice. */ ExceptionRangeTarget(envPtr, outLoop, catchOffset); - TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr); - TclEmitOpcode( INST_PUSH_RESULT, envPtr); - TclEmitOpcode( INST_END_CATCH, envPtr); - TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( workerIndex, envPtr); - TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( infoIndex, envPtr); - TclEmitOpcode( INST_RETURN_STK, envPtr); + OP( PUSH_RETURN_OPTIONS); + OP( PUSH_RESULT); + OP( END_CATCH); + OP14( UNSET_SCALAR, 0, workerIndex); + OP14( UNSET_SCALAR, 0, infoIndex); + OP( RETURN_STK); return TCL_OK; } int @@ -1347,47 +1283,45 @@ * construct a new dictionary with the loop * body result. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr; - int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange; - int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset; - int numVars, endTargetOffset; + int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange, numVars; + int infoIndex, bodyTargetOffset, emptyTargetOffset, endTargetOffset; int collectVar = -1; /* Index of temp var holding the result * dict. */ int savedStackDepth = envPtr->currStackDepth; /* Needed because jumps confuse the stack * space calculator. */ const char **argv; Tcl_DString buffer; /* - * There must be at least three argument after the command. + * There must be three arguments after the command. */ if (parsePtr->numWords != 4) { - return TCL_ERROR; + return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } varsTokenPtr = TokenAfter(parsePtr->tokenPtr); dictTokenPtr = TokenAfter(varsTokenPtr); bodyTokenPtr = TokenAfter(dictTokenPtr); if (varsTokenPtr->type != TCL_TOKEN_SIMPLE_WORD || bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; + return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } /* * Create temporary variable to capture return values from loop body when * we're collecting results. */ if (collect == TCL_EACH_COLLECT) { - collectVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, - envPtr); + collectVar = NewUnnamedLocal(envPtr); if (collectVar < 0) { - return TCL_ERROR; + return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } } /* * Check we've got a pair of variables and that they are local variables. @@ -1397,47 +1331,47 @@ Tcl_DStringInit(&buffer); TclDStringAppendToken(&buffer, &varsTokenPtr[1]); if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numVars, &argv) != TCL_OK) { Tcl_DStringFree(&buffer); - return TCL_ERROR; + return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } Tcl_DStringFree(&buffer); if (numVars != 2) { ckfree(argv); - return TCL_ERROR; + return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } nameChars = strlen(argv[0]); if (!TclIsLocalScalar(argv[0], nameChars)) { ckfree(argv); - return TCL_ERROR; + return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } keyVarIndex = TclFindCompiledLocal(argv[0], nameChars, 1, envPtr); nameChars = strlen(argv[1]); if (!TclIsLocalScalar(argv[1], nameChars)) { ckfree(argv); - return TCL_ERROR; + return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } valueVarIndex = TclFindCompiledLocal(argv[1], nameChars, 1, envPtr); ckfree(argv); if ((keyVarIndex < 0) || (valueVarIndex < 0)) { - return TCL_ERROR; + return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } /* * Allocate a temporary variable to store the iterator reference. The * variable will contain a Tcl_DictSearch reference which will be * allocated by INST_DICT_FIRST and disposed when the variable is unset * (at which point it should also have been finished with). */ - infoIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr); + infoIndex = NewUnnamedLocal(envPtr); if (infoIndex < 0) { - return TCL_ERROR; + return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } /* * Preparation complete; issue instructions. Note that this code issues * fixed-sized jumps. That simplifies things a lot! @@ -1444,43 +1378,42 @@ * * First up, initialize the accumulator dictionary if needed. */ if (collect == TCL_EACH_COLLECT) { - PushLiteral(envPtr, "", 0); - Emit14Inst( INST_STORE_SCALAR, collectVar, envPtr); - TclEmitOpcode( INST_POP, envPtr); + PUSH( ""); + OP4( STORE_SCALAR, collectVar); + OP( POP); } /* * Get the dictionary and start the iteration. No catching of errors at * this point. */ - CompileWord(envPtr, dictTokenPtr, interp, 3); - TclEmitInstInt4( INST_DICT_FIRST, infoIndex, envPtr); - emptyTargetOffset = CurrentOffset(envPtr); - TclEmitInstInt4( INST_JUMP_TRUE, 0, envPtr); + PUSH_SUBST_WORD(dictTokenPtr, 3); + OP4( DICT_FIRST, infoIndex); + JUMP(emptyTargetOffset, JUMP_TRUE); /* * Now we catch errors from here on so that we can finalize the search * started by Tcl_DictObjFirst above. */ catchRange = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); - TclEmitInstInt4( INST_BEGIN_CATCH, catchRange, envPtr); + OP4( BEGIN_CATCH, catchRange); ExceptionRangeStarts(envPtr, catchRange); /* * Inside the iteration, write the loop variables. */ - bodyTargetOffset = CurrentOffset(envPtr); - Emit14Inst( INST_STORE_SCALAR, keyVarIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); - Emit14Inst( INST_STORE_SCALAR, valueVarIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); + LABEL(bodyTargetOffset); + OP4( STORE_SCALAR, keyVarIndex); + OP( POP); + OP4( STORE_SCALAR, valueVarIndex); + OP( POP); /* * Set up the loop exception targets. */ @@ -1489,21 +1422,19 @@ /* * Compile the loop body itself. It should be stack-neutral. */ - SetLineInformation(3); - CompileBody(envPtr, bodyTokenPtr, interp); + BODY( bodyTokenPtr, 3); if (collect == TCL_EACH_COLLECT) { - Emit14Inst( INST_LOAD_SCALAR, keyVarIndex, envPtr); - TclEmitInstInt4(INST_OVER, 1, envPtr); - TclEmitInstInt4(INST_DICT_SET, 1, envPtr); - TclEmitInt4( collectVar, envPtr); + OP4( LOAD_SCALAR, keyVarIndex); + OP( UNDER); + OP44( DICT_SET, 1, collectVar); TclAdjustStackDepth(-1, envPtr); - TclEmitOpcode( INST_POP, envPtr); + OP( POP); } - TclEmitOpcode( INST_POP, envPtr); + OP( POP); /* * Both exception target ranges (error and loop) end here. */ @@ -1515,15 +1446,14 @@ * from the dictionary and jumping back to the code to write them into * variables if there is another pair. */ ExceptionRangeTarget(envPtr, loopRange, continueOffset); - TclEmitInstInt4( INST_DICT_NEXT, infoIndex, envPtr); - jumpDisplacement = bodyTargetOffset - CurrentOffset(envPtr); - TclEmitInstInt4( INST_JUMP_FALSE, jumpDisplacement, envPtr); - TclEmitOpcode( INST_POP, envPtr); - TclEmitOpcode( INST_POP, envPtr); + OP4( DICT_NEXT, infoIndex); + BACKJUMP(bodyTargetOffset, JUMP_FALSE); + OP( POP); + OP( POP); /* * Now do the final cleanup for the no-error case (this is where we break * out of the loop to) by force-terminating the iteration (if not already * terminated), ditching the exception info and jumping to the last @@ -1530,63 +1460,53 @@ * instruction for this command. In theory, this could be done using the * "finally" clause (next generated) but this is faster. */ ExceptionRangeTarget(envPtr, loopRange, breakOffset); - TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( infoIndex, envPtr); - TclEmitOpcode( INST_END_CATCH, envPtr); - endTargetOffset = CurrentOffset(envPtr); - TclEmitInstInt4( INST_JUMP, 0, envPtr); + OP14( UNSET_SCALAR, 0, infoIndex); + OP( END_CATCH); + JUMP(endTargetOffset, JUMP); /* * Error handler "finally" clause, which force-terminates the iteration * and rethrows the error. */ ExceptionRangeTarget(envPtr, catchRange, catchOffset); - TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr); - TclEmitOpcode( INST_PUSH_RESULT, envPtr); - TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( infoIndex, envPtr); - TclEmitOpcode( INST_END_CATCH, envPtr); + OP( PUSH_RETURN_OPTIONS); + OP( PUSH_RESULT); + OP14( UNSET_SCALAR, 0, infoIndex); + OP( END_CATCH); if (collect == TCL_EACH_COLLECT) { - TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( collectVar, envPtr); + OP14( UNSET_SCALAR, 0, collectVar); } - TclEmitOpcode( INST_RETURN_STK, envPtr); + OP( RETURN_STK); /* * Otherwise we're done (the jump after the DICT_FIRST points here) and we * need to pop the bogus key/value pair (pushed to keep stack calculations * easy!) Note that we skip the END_CATCH. [Bug 1382528] */ envPtr->currStackDepth = savedStackDepth + 2; - jumpDisplacement = CurrentOffset(envPtr) - emptyTargetOffset; - TclUpdateInstInt4AtPc(INST_JUMP_TRUE, jumpDisplacement, - envPtr->codeStart + emptyTargetOffset); - TclEmitOpcode( INST_POP, envPtr); - TclEmitOpcode( INST_POP, envPtr); - TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( infoIndex, envPtr); + FIXJUMP( emptyTargetOffset); + OP( POP); + OP( POP); + OP14( UNSET_SCALAR, 0, infoIndex); /* * Final stage of the command (normal case) is that we push an empty * object (or push the accumulator as the result object). This is done * last to promote peephole optimization when it's dropped immediately. */ - jumpDisplacement = CurrentOffset(envPtr) - endTargetOffset; - TclUpdateInstInt4AtPc(INST_JUMP, jumpDisplacement, - envPtr->codeStart + endTargetOffset); + FIXJUMP( endTargetOffset); if (collect == TCL_EACH_COLLECT) { - Emit14Inst( INST_LOAD_SCALAR, collectVar, envPtr); - TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( collectVar, envPtr); + OP4( LOAD_SCALAR, collectVar); + OP14( UNSET_SCALAR, 0, collectVar); } else { - PushLiteral(envPtr, "", 0); + PUSH( ""); } return TCL_OK; } int @@ -1630,20 +1550,20 @@ * discover what the index is. */ dictVarTokenPtr = TokenAfter(parsePtr->tokenPtr); if (dictVarTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; + return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } name = dictVarTokenPtr[1].start; nameChars = dictVarTokenPtr[1].size; if (!TclIsLocalScalar(name, nameChars)) { - return TCL_ERROR; + return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } dictIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr); if (dictIndex < 0) { - return TCL_ERROR; + return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } /* * Assemble the instruction metadata. This is complex enough that it is * represented as auxData; it holds an ordered list of variable indices @@ -1690,11 +1610,11 @@ } if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { failedUpdateInfoAssembly: ckfree(duiPtr); TclStackFree(interp, keyTokenPtrs); - return TCL_ERROR; + return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } bodyTokenPtr = tokenPtr; /* * The list of variables to bind is stored in auxiliary data so that it @@ -1702,35 +1622,32 @@ */ infoIndex = TclCreateAuxData(duiPtr, &tclDictUpdateInfoType, envPtr); for (i=0 ; icurrStackDepth++; - SetLineInformation(parsePtr->numWords - 1); - CompileBody(envPtr, bodyTokenPtr, interp); + BODY( bodyTokenPtr, parsePtr->numWords - 1); envPtr->currStackDepth = savedStackDepth; ExceptionRangeEnds(envPtr, range); /* * Normal termination code: the stack has the key list below the result of * the body evaluation: swap them and finish the update code. */ - TclEmitOpcode( INST_END_CATCH, envPtr); - TclEmitInstInt4( INST_REVERSE, 2, envPtr); - TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr); - TclEmitInt4( infoIndex, envPtr); + OP( END_CATCH); + OP( EXCH); + OP44( DICT_UPDATE_END, dictIndex, infoIndex); /* * Jump around the exceptional termination code. */ @@ -1741,18 +1658,17 @@ * options in the stack, bring up the key list, finish the update code, * and finally return with the catched return data */ ExceptionRangeTarget(envPtr, range, catchOffset); - TclEmitOpcode( INST_PUSH_RESULT, envPtr); - TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr); - TclEmitOpcode( INST_END_CATCH, envPtr); - TclEmitInstInt4( INST_REVERSE, 3, envPtr); - - TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr); - TclEmitInt4( infoIndex, envPtr); - TclEmitOpcode( INST_RETURN_STK, envPtr); + OP( PUSH_RESULT); + OP( PUSH_RETURN_OPTIONS); + OP( END_CATCH); + OP4( REVERSE, 3); + + OP44( DICT_UPDATE_END, dictIndex, infoIndex); + OP( RETURN_STK); if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) { Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d", (int) (CurrentOffset(envPtr) - jumpFixup.codeOffset)); } @@ -1788,42 +1704,42 @@ * Get the index of the local variable that we will be working with. */ tokenPtr = TokenAfter(parsePtr->tokenPtr); if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; + return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } else { register const char *name = tokenPtr[1].start; register int nameChars = tokenPtr[1].size; if (!TclIsLocalScalar(name, nameChars)) { - return TCL_ERROR; + return TclCompileBasicMin2ArgCmd(interp, parsePtr,cmdPtr, envPtr); } dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr); if (dictVarIndex < 0) { - return TCL_ERROR; + return TclCompileBasicMin2ArgCmd(interp, parsePtr,cmdPtr, envPtr); } } /* * Produce the string to concatenate onto the dictionary entry. */ tokenPtr = TokenAfter(tokenPtr); for (i=2 ; inumWords ; i++) { - CompileWord(envPtr, tokenPtr, interp, i); + PUSH_SUBST_WORD(tokenPtr, i); tokenPtr = TokenAfter(tokenPtr); } if (parsePtr->numWords > 4) { - TclEmitInstInt1(INST_CONCAT, parsePtr->numWords-3, envPtr); + OP1( CONCAT, parsePtr->numWords-3); } /* * Do the concatenation. */ - TclEmitInstInt4(INST_DICT_APPEND, dictVarIndex, envPtr); + OP4( DICT_APPEND, dictVarIndex); return TCL_OK; } int TclCompileDictLappendCmd( @@ -1849,24 +1765,24 @@ varTokenPtr = TokenAfter(parsePtr->tokenPtr); keyTokenPtr = TokenAfter(varTokenPtr); valueTokenPtr = TokenAfter(keyTokenPtr); if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; + return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } name = varTokenPtr[1].start; nameChars = varTokenPtr[1].size; if (!TclIsLocalScalar(name, nameChars)) { - return TCL_ERROR; + return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr); if (dictVarIndex < 0) { - return TCL_ERROR; + return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } - CompileWord(envPtr, keyTokenPtr, interp, 3); - CompileWord(envPtr, valueTokenPtr, interp, 4); - TclEmitInstInt4( INST_DICT_LAPPEND, dictVarIndex, envPtr); + PUSH_SUBST_WORD(keyTokenPtr, 3); + PUSH_SUBST_WORD(valueTokenPtr, 4); + OP4( DICT_LAPPEND, dictVarIndex); return TCL_OK; } int TclCompileDictWithCmd( @@ -1902,11 +1818,11 @@ tokenPtr = TokenAfter(varTokenPtr); for (i=3 ; inumWords ; i++) { tokenPtr = TokenAfter(tokenPtr); } if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; + return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } /* * Test if the last word is an empty script; if so, we can compile it in * all cases, but if it is non-empty we need local variable table entries @@ -1914,11 +1830,12 @@ */ for (ptr=tokenPtr[1].start,end=ptr+tokenPtr[1].size ; ptr!=end ; ptr++) { if (*ptr!=' ' && *ptr!='\t' && *ptr!='\n' && *ptr!='\r') { if (envPtr->procPtr == NULL) { - return TCL_ERROR; + return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, + envPtr); } bodyIsEmpty = 0; break; } } @@ -1949,63 +1866,63 @@ * Case: Path into dict in LVT with empty body. */ tokenPtr = TokenAfter(varTokenPtr); for (i=2 ; inumWords-1 ; i++) { - CompileWord(envPtr, tokenPtr, interp, i-1); + PUSH_SUBST_WORD(tokenPtr, i-1); tokenPtr = TokenAfter(tokenPtr); } - TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr); - Emit14Inst( INST_LOAD_SCALAR, dictVar, envPtr); - TclEmitInstInt4(INST_OVER, 1, envPtr); - TclEmitOpcode( INST_DICT_EXPAND, envPtr); - TclEmitInstInt4(INST_DICT_RECOMBINE_IMM, dictVar, envPtr); - PushLiteral(envPtr, "", 0); + OP4( LIST, parsePtr->numWords-3); + OP4( LOAD_SCALAR, dictVar); + OP( UNDER); + OP( DICT_EXPAND); + OP4( DICT_RECOMBINE_IMM, dictVar); + PUSH( ""); } else { /* * Case: Direct dict in LVT with empty body. */ - PushLiteral(envPtr, "", 0); - Emit14Inst( INST_LOAD_SCALAR, dictVar, envPtr); - PushLiteral(envPtr, "", 0); - TclEmitOpcode( INST_DICT_EXPAND, envPtr); - TclEmitInstInt4(INST_DICT_RECOMBINE_IMM, dictVar, envPtr); - PushLiteral(envPtr, "", 0); + PUSH( ""); + OP4( LOAD_SCALAR, dictVar); + PUSH( ""); + OP( DICT_EXPAND); + OP4( DICT_RECOMBINE_IMM, dictVar); + PUSH( ""); } } else { if (gotPath) { /* * Case: Path into dict in non-simple var with empty body. */ tokenPtr = varTokenPtr; for (i=1 ; inumWords-1 ; i++) { - CompileWord(envPtr, tokenPtr, interp, i-1); + PUSH_SUBST_WORD(tokenPtr, i-1); tokenPtr = TokenAfter(tokenPtr); } - TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr); - TclEmitInstInt4(INST_OVER, 1, envPtr); - TclEmitOpcode( INST_LOAD_STK, envPtr); - TclEmitInstInt4(INST_OVER, 1, envPtr); - TclEmitOpcode( INST_DICT_EXPAND, envPtr); - TclEmitOpcode( INST_DICT_RECOMBINE_STK, envPtr); - PushLiteral(envPtr, "", 0); + OP4( LIST, parsePtr->numWords-3); + OP( UNDER); + OP( LOAD_STK); + OP( UNDER); + OP( DICT_EXPAND); + OP( DICT_RECOMBINE_STK); + PUSH( ""); } else { /* * Case: Direct dict in non-simple var with empty body. */ - CompileWord(envPtr, varTokenPtr, interp, 0); - TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_LOAD_STK, envPtr); - PushLiteral(envPtr, "", 0); - TclEmitOpcode( INST_DICT_EXPAND, envPtr); - PushLiteral(envPtr, "", 0); - TclEmitInstInt4(INST_REVERSE, 2, envPtr); - TclEmitOpcode( INST_DICT_RECOMBINE_STK, envPtr); - PushLiteral(envPtr, "", 0); + PUSH_SUBST_WORD(varTokenPtr, 0); + OP( DUP); + OP( LOAD_STK); + PUSH( ""); + OP( DICT_EXPAND); + PUSH( ""); + OP( EXCH); + OP( DICT_RECOMBINE_STK); + PUSH( ""); } } envPtr->currStackDepth = savedStackDepth + 1; return TCL_OK; } @@ -2017,111 +1934,110 @@ * * Start by allocating local (unnamed, untraced) working variables. */ if (dictVar == -1) { - varNameTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr); + varNameTmp = NewUnnamedLocal(envPtr); } else { varNameTmp = -1; } if (gotPath) { - pathTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr); + pathTmp = NewUnnamedLocal(envPtr); } else { pathTmp = -1; } - keysTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr); + keysTmp = NewUnnamedLocal(envPtr); /* * Issue instructions. First, the part to expand the dictionary. */ if (varNameTmp > -1) { - CompileWord(envPtr, varTokenPtr, interp, 0); - Emit14Inst( INST_STORE_SCALAR, varNameTmp, envPtr); + PUSH_SUBST_WORD(varTokenPtr, 0); + OP4( STORE_SCALAR, varNameTmp); } tokenPtr = TokenAfter(varTokenPtr); if (gotPath) { for (i=2 ; inumWords-1 ; i++) { - CompileWord(envPtr, tokenPtr, interp, i-1); + PUSH_SUBST_WORD(tokenPtr, i-1); tokenPtr = TokenAfter(tokenPtr); } - TclEmitInstInt4( INST_LIST, parsePtr->numWords-3,envPtr); - Emit14Inst( INST_STORE_SCALAR, pathTmp, envPtr); - TclEmitOpcode( INST_POP, envPtr); + OP4( LIST, parsePtr->numWords-3); + OP4( STORE_SCALAR, pathTmp); + OP( POP); } if (dictVar == -1) { - TclEmitOpcode( INST_LOAD_STK, envPtr); + OP( LOAD_STK); } else { - Emit14Inst( INST_LOAD_SCALAR, dictVar, envPtr); + OP4( LOAD_SCALAR, dictVar); } if (gotPath) { - Emit14Inst( INST_LOAD_SCALAR, pathTmp, envPtr); + OP4( LOAD_SCALAR, pathTmp); } else { - PushLiteral(envPtr, "", 0); + PUSH( ""); } - TclEmitOpcode( INST_DICT_EXPAND, envPtr); - Emit14Inst( INST_STORE_SCALAR, keysTmp, envPtr); - TclEmitOpcode( INST_POP, envPtr); + OP( DICT_EXPAND); + OP4( STORE_SCALAR, keysTmp); + OP( POP); /* * Now the body of the [dict with]. */ range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); - TclEmitInstInt4( INST_BEGIN_CATCH, range, envPtr); + OP4( BEGIN_CATCH, range); ExceptionRangeStarts(envPtr, range); envPtr->currStackDepth++; - SetLineInformation(parsePtr->numWords-1); - CompileBody(envPtr, tokenPtr, interp); + BODY( tokenPtr, parsePtr->numWords-1); envPtr->currStackDepth = savedStackDepth; ExceptionRangeEnds(envPtr, range); /* * Now fold the results back into the dictionary in the OK case. */ - TclEmitOpcode( INST_END_CATCH, envPtr); + OP( END_CATCH); if (varNameTmp > -1) { - Emit14Inst( INST_LOAD_SCALAR, varNameTmp, envPtr); + OP4( LOAD_SCALAR, varNameTmp); } if (gotPath) { - Emit14Inst( INST_LOAD_SCALAR, pathTmp, envPtr); + OP4( LOAD_SCALAR, pathTmp); } else { - PushLiteral(envPtr, "", 0); + PUSH( ""); } - Emit14Inst( INST_LOAD_SCALAR, keysTmp, envPtr); + OP4( LOAD_SCALAR, keysTmp); if (dictVar == -1) { - TclEmitOpcode( INST_DICT_RECOMBINE_STK, envPtr); + OP( DICT_RECOMBINE_STK); } else { - TclEmitInstInt4( INST_DICT_RECOMBINE_IMM, dictVar, envPtr); + OP4( DICT_RECOMBINE_IMM, dictVar); } TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup); /* * Now fold the results back into the dictionary in the exception case. */ ExceptionRangeTarget(envPtr, range, catchOffset); - TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr); - TclEmitOpcode( INST_PUSH_RESULT, envPtr); - TclEmitOpcode( INST_END_CATCH, envPtr); + OP( PUSH_RETURN_OPTIONS); + OP( PUSH_RESULT); + OP( END_CATCH); if (varNameTmp > -1) { - Emit14Inst( INST_LOAD_SCALAR, varNameTmp, envPtr); + OP4( LOAD_SCALAR, varNameTmp); } if (parsePtr->numWords > 3) { - Emit14Inst( INST_LOAD_SCALAR, pathTmp, envPtr); + OP4( LOAD_SCALAR, pathTmp); } else { - PushLiteral(envPtr, "", 0); + PUSH( ""); } - Emit14Inst( INST_LOAD_SCALAR, keysTmp, envPtr); + OP4( LOAD_SCALAR, keysTmp); if (dictVar == -1) { - TclEmitOpcode( INST_DICT_RECOMBINE_STK, envPtr); + OP( DICT_RECOMBINE_STK); } else { - TclEmitInstInt4( INST_DICT_RECOMBINE_IMM, dictVar, envPtr); + OP4( DICT_RECOMBINE_IMM, dictVar); } - TclEmitOpcode( INST_RETURN_STK, envPtr); + OP( RETURN_STK); /* * Prepare for the start of the next command. */ @@ -2231,13 +2147,13 @@ if (parsePtr->numWords != 2) { return TCL_ERROR; } messageTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushLiteral(envPtr, "-code error -level 0", 20); - CompileWord(envPtr, messageTokenPtr, interp, 1); - TclEmitOpcode(INST_RETURN_STK, envPtr); + PUSH( "-code error -level 0"); + PUSH_SUBST_WORD(messageTokenPtr, 1); + OP( RETURN_STK); envPtr->currStackDepth = savedStackDepth + 1; return TCL_OK; } /* @@ -2358,13 +2274,12 @@ /* * Inline compile the initial command. */ - SetLineInformation(1); - CompileBody(envPtr, startTokenPtr, interp); - TclEmitOpcode(INST_POP, envPtr); + BODY( startTokenPtr, 1); + OP( POP); /* * Jump to the evaluation of the condition. This code uses the "loop * rotation" optimisation (which eliminates one branch from the loop). * "for start cond next body" produces then: @@ -2381,50 +2296,46 @@ /* * Compile the loop body. */ bodyCodeOffset = ExceptionRangeStarts(envPtr, bodyRange); - SetLineInformation(4); - CompileBody(envPtr, bodyTokenPtr, interp); + BODY( bodyTokenPtr, 4); ExceptionRangeEnds(envPtr, bodyRange); envPtr->currStackDepth = savedStackDepth + 1; - TclEmitOpcode(INST_POP, envPtr); + OP( POP); /* * Compile the "next" subcommand. */ envPtr->currStackDepth = savedStackDepth; nextCodeOffset = ExceptionRangeStarts(envPtr, nextRange); - SetLineInformation(3); - CompileBody(envPtr, nextTokenPtr, interp); + BODY( nextTokenPtr, 3); ExceptionRangeEnds(envPtr, nextRange); envPtr->currStackDepth = savedStackDepth + 1; - TclEmitOpcode(INST_POP, envPtr); + OP( POP); envPtr->currStackDepth = savedStackDepth; /* * Compile the test expression then emit the conditional jump that * terminates the for. */ - testCodeOffset = CurrentOffset(envPtr); + LABEL( testCodeOffset); jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset; if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) { bodyCodeOffset += 3; nextCodeOffset += 3; testCodeOffset += 3; } - SetLineInformation(2); envPtr->currStackDepth = savedStackDepth; - TclCompileExprWords(interp, testTokenPtr, 1, envPtr); + PUSH_EXPR_WORD(testTokenPtr, 2); envPtr->currStackDepth = savedStackDepth + 1; - jumpDist = CurrentOffset(envPtr) - bodyCodeOffset; - TclEmitInstInt4(INST_JUMP_TRUE, -jumpDist, envPtr); + BACKJUMP( bodyCodeOffset, JUMP_TRUE); /* * Fix the starting points of the exception ranges (may have moved due to * jump type modification) and set where the exceptions target. */ @@ -2440,11 +2351,11 @@ /* * The for command's result is an empty string. */ envPtr->currStackDepth = savedStackDepth; - PushLiteral(envPtr, "", 0); + PUSH( ""); return TCL_OK; } /* @@ -2517,13 +2428,12 @@ * iteration count. */ int collectVar = -1; /* Index of temp var holding the result var * index. */ Tcl_Token *tokenPtr, *bodyTokenPtr; - unsigned char *jumpPc; JumpFixup jumpFalseFixup; - int jumpBackDist, jumpBackOffset, infoIndex, range, bodyIndex; + int infoIndex, range, bodyIndex; int numWords, numLists, numVars, loopIndex, tempVar, i, j, code; int savedStackDepth = envPtr->currStackDepth; DefineLineInformation; /* TIP #280 */ /* @@ -2632,12 +2542,11 @@ } loopIndex++; } if (collect == TCL_EACH_COLLECT) { - collectVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, - envPtr); + collectVar = NewUnnamedLocal(envPtr); if (collectVar < 0) { return TCL_ERROR; } } @@ -2652,18 +2561,16 @@ */ code = TCL_OK; firstValueTemp = -1; for (loopIndex = 0; loopIndex < numLists; loopIndex++) { - tempVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0, - /*create*/ 1, envPtr); + tempVar = NewUnnamedLocal(envPtr); if (loopIndex == 0) { firstValueTemp = tempVar; } } - loopCtTemp = TclFindCompiledLocal(NULL, /*nameChars*/ 0, - /*create*/ 1, envPtr); + loopCtTemp = NewUnnamedLocal(envPtr); /* * Create and initialize the ForeachInfo and ForeachVarList data * structures describing this command. Then create a AuxData record * pointing to the ForeachInfo structure. @@ -2705,69 +2612,65 @@ loopIndex = 0; for (i = 0, tokenPtr = parsePtr->tokenPtr; i < numWords-1; i++, tokenPtr = TokenAfter(tokenPtr)) { if ((i%2 == 0) && (i > 0)) { - SetLineInformation(i); - CompileTokens(envPtr, tokenPtr, interp); + PUSH_SUBST_WORD(tokenPtr, i); tempVar = (firstValueTemp + loopIndex); - Emit14Inst( INST_STORE_SCALAR, tempVar, envPtr); - TclEmitOpcode( INST_POP, envPtr); + OP4(STORE_SCALAR, tempVar); + OP( POP); loopIndex++; } } /* * Create temporary variable to capture return values from loop body. */ if (collect == TCL_EACH_COLLECT) { - PushLiteral(envPtr, "", 0); - Emit14Inst( INST_STORE_SCALAR, collectVar, envPtr); - TclEmitOpcode( INST_POP, envPtr); + PUSH( ""); + OP4( STORE_SCALAR, collectVar); + OP( POP); } /* * Initialize the temporary var that holds the count of loop iterations. */ - TclEmitInstInt4( INST_FOREACH_START, infoIndex, envPtr); + OP4( FOREACH_START, infoIndex); /* * Top of loop code: assign each loop variable and check whether * to terminate the loop. */ ExceptionRangeTarget(envPtr, range, continueOffset); - TclEmitInstInt4( INST_FOREACH_STEP, infoIndex, envPtr); + OP4( FOREACH_STEP, infoIndex); TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup); /* * Inline compile the loop body. */ - SetLineInformation(bodyIndex); ExceptionRangeStarts(envPtr, range); - CompileBody(envPtr, bodyTokenPtr, interp); + BODY( bodyTokenPtr, bodyIndex); ExceptionRangeEnds(envPtr, range); envPtr->currStackDepth = savedStackDepth + 1; if (collect == TCL_EACH_COLLECT) { - Emit14Inst( INST_LAPPEND_SCALAR, collectVar,envPtr); + OP4( LAPPEND_SCALAR, collectVar); } - TclEmitOpcode( INST_POP, envPtr); + OP( POP); /* * Jump back to the test at the top of the loop. Generate a 4 byte jump if * the distance to the test is > 120 bytes. This is conservative and * ensures that we won't have to replace this jump if we later need to * replace the ifFalse jump with a 4 byte jump. */ - jumpBackOffset = CurrentOffset(envPtr); - jumpBackDist = jumpBackOffset-envPtr->exceptArrayPtr[range].continueOffset; - TclEmitInstInt4(INST_JUMP, -jumpBackDist, envPtr); + BACKJUMP(envPtr->exceptArrayPtr[range].continueOffset, JUMP); /* * Fix the target of the jump after the foreach_step test. */ @@ -2775,20 +2678,10 @@ /* * Update the loop body's starting PC offset since it moved down. */ envPtr->exceptArrayPtr[range].codeOffset += 3; - - /* - * Update the jump back to the test at the top of the loop since it - * also moved down 3 bytes. - */ - - jumpBackOffset += 3; - jumpPc = (envPtr->codeStart + jumpBackOffset); - jumpBackDist += 3; - TclUpdateInstInt4AtPc(INST_JUMP, -jumpBackDist, jumpPc); } /* * Set the loop's break target. */ @@ -2800,15 +2693,14 @@ * list of results from evaluating the loop body. */ envPtr->currStackDepth = savedStackDepth; if (collect == TCL_EACH_COLLECT) { - Emit14Inst( INST_LOAD_SCALAR, collectVar, envPtr); - TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( collectVar, envPtr); + OP4( LOAD_SCALAR, collectVar); + OP14( UNSET_SCALAR, 0, collectVar); } else { - PushLiteral(envPtr, "", 0); + PUSH( ""); } envPtr->currStackDepth = savedStackDepth + 1; done: for (loopIndex = 0; loopIndex < numLists; loopIndex++) { @@ -3049,12 +2941,11 @@ /* * Not an error, always a constant result, so just push the result as a * literal. Job done. */ - bytes = Tcl_GetStringFromObj(tmpObj, &len); - PushLiteral(envPtr, bytes, len); + PUSH_OBJ(tmpObj); Tcl_DecrRefCount(tmpObj); return TCL_OK; checkForStringConcatCase: /* @@ -3064,11 +2955,11 @@ * * First, get the state of the system relatively sensible (cleaning up * after our attempt to spot a literal). */ - for (; --i>=0 ;) { + for (; i>=0 ; i--) { Tcl_DecrRefCount(objv[i]); } ckfree(objv); tokenPtr = TokenAfter(parsePtr->tokenPtr); tokenPtr = TokenAfter(tokenPtr); @@ -3120,19 +3011,19 @@ if (*bytes == '%') { Tcl_AppendToObj(tmpObj, start, bytes - start); if (*++bytes == '%') { Tcl_AppendToObj(tmpObj, "%", 1); } else { - char *b = Tcl_GetStringFromObj(tmpObj, &len); + (void) Tcl_GetStringFromObj(tmpObj, &len); /* * If there is a non-empty literal from the format string, * push it and reset. */ if (len > 0) { - PushLiteral(envPtr, b, len); + PUSH_OBJ(tmpObj); Tcl_DecrRefCount(tmpObj); tmpObj = Tcl_NewObj(); i++; } @@ -3140,11 +3031,11 @@ * Push the code to produce the string that would be * substituted with %s, except we'll be concatenating * directly. */ - CompileWord(envPtr, tokenPtr, interp, j); + PUSH_SUBST_WORD(tokenPtr, j); tokenPtr = TokenAfter(tokenPtr); j++; i++; } start = bytes + 1; @@ -3154,13 +3045,13 @@ /* * Handle the case of a trailing literal. */ Tcl_AppendToObj(tmpObj, start, bytes - start); - bytes = Tcl_GetStringFromObj(tmpObj, &len); + (void) Tcl_GetStringFromObj(tmpObj, &len); if (len > 0) { - PushLiteral(envPtr, bytes, len); + PUSH_OBJ(tmpObj); i++; } Tcl_DecrRefCount(tmpObj); Tcl_DecrRefCount(formatObj); @@ -3167,22 +3058,22 @@ if (i > 1) { /* * Do the concatenation, which produces the result. */ - TclEmitInstInt1(INST_CONCAT, i, envPtr); + OP1( CONCAT, i); } else { /* * EVIL HACK! Force there to be a string representation in the case * where there's just a "%s" in the format; case covered by the test * format-20.1 (and it is horrible...) */ - TclEmitOpcode(INST_DUP, envPtr); - PushLiteral(envPtr, "", 0); - TclEmitOpcode(INST_STR_EQ, envPtr); - TclEmitOpcode(INST_POP, envPtr); + OP( DUP); + PUSH( ""); + OP( STR_EQ); + OP( POP); } return TCL_OK; } /* @@ -3228,14 +3119,14 @@ if (envPtr->procPtr == NULL) { return TCL_ERROR; } /* - * Push the namespace + * Push the namespace. */ - PushLiteral(envPtr, "::", 2); + PUSH( "::"); /* * Loop over the variables. */ @@ -3245,20 +3136,20 @@ if (localIndex < 0) { return TCL_ERROR; } - CompileWord(envPtr, varTokenPtr, interp, 1); - TclEmitInstInt4( INST_NSUPVAR, localIndex, envPtr); + PUSH_SUBST_WORD(varTokenPtr, 1); + OP4( NSUPVAR, localIndex); } /* * Pop the namespace, and set the result to empty */ - TclEmitOpcode( INST_POP, envPtr); - PushLiteral(envPtr, "", 0); + OP( POP); + PUSH( ""); return TCL_OK; } /* *---------------------------------------------------------------------- @@ -3381,13 +3272,12 @@ realCond = 0; if (!boolVal) { compileScripts = 0; } } else { - SetLineInformation(wordIdx); Tcl_ResetResult(interp); - TclCompileExprWords(interp, testTokenPtr, 1, envPtr); + PUSH_EXPR_WORD(testTokenPtr, wordIdx); if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) { TclExpandJumpFixupArray(&jumpFalseFixupArray); } jumpIndex = jumpFalseFixupArray.next; jumpFalseFixupArray.next++; @@ -3423,13 +3313,12 @@ /* * Compile the "then" command body. */ if (compileScripts) { - SetLineInformation(wordIdx); envPtr->currStackDepth = savedStackDepth; - CompileBody(envPtr, tokenPtr, interp); + BODY( tokenPtr, wordIdx); } if (realCond) { /* * Jump to the end of the "if" command. Both jumpFalseFixupArray @@ -3511,12 +3400,11 @@ if (compileScripts) { /* * Compile the else command body. */ - SetLineInformation(wordIdx); - CompileBody(envPtr, tokenPtr, interp); + BODY(tokenPtr, wordIdx); } /* * Make sure there are no words after the else clause. */ @@ -3530,11 +3418,11 @@ /* * No else clause: the "if" command's result is an empty string. */ if (compileScripts) { - PushLiteral(envPtr, "", 0); + PUSH( ""); } } /* * Fix the unconditional jumps to the end of the "if" command. @@ -3608,13 +3496,12 @@ if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) { return TCL_ERROR; } varTokenPtr = TokenAfter(parsePtr->tokenPtr); - - PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX, - &localIndex, &simpleVarName, &isScalar, 1); + PUSH_VAR( varTokenPtr, 1, + &localIndex, &simpleVarName, &isScalar); /* * If an increment is given, push it, but see first if it's a small * integer. */ @@ -3637,12 +3524,11 @@ } if (!haveImmValue) { PushLiteral(envPtr, word, numBytes); } } else { - SetLineInformation(2); - CompileTokens(envPtr, incrTokenPtr, interp); + PUSH_SUBST_WORD(incrTokenPtr, 2); } } else { /* No incr amount given so use 1. */ haveImmValue = 1; } @@ -3650,42 +3536,40 @@ * Emit the instruction to increment the variable. */ if (!simpleVarName) { if (haveImmValue) { - TclEmitInstInt1( INST_INCR_STK_IMM, immValue, envPtr); + OP1( INCR_STK_IMM, immValue); } else { - TclEmitOpcode( INST_INCR_STK, envPtr); + OP( INCR_STK); } } else if (isScalar) { /* Simple scalar variable. */ if (localIndex >= 0) { if (haveImmValue) { - TclEmitInstInt4(INST_INCR_SCALAR_IMM, localIndex, envPtr); - TclEmitInt1(immValue, envPtr); + OP41( INCR_SCALAR_IMM, localIndex, immValue); } else { - TclEmitInstInt4(INST_INCR_SCALAR, localIndex, envPtr); + OP4( INCR_SCALAR, localIndex); } } else { if (haveImmValue) { - TclEmitInstInt1(INST_INCR_SCALAR_STK_IMM, immValue, envPtr); + OP1( INCR_STK_IMM, immValue); } else { - TclEmitOpcode( INST_INCR_SCALAR_STK, envPtr); + OP( INCR_STK); } } } else { /* Simple array variable. */ if (localIndex >= 0) { if (haveImmValue) { - TclEmitInstInt4(INST_INCR_ARRAY_IMM, localIndex, envPtr); - TclEmitInt1(immValue, envPtr); + OP41( INCR_ARRAY_IMM, localIndex, immValue); } else { - TclEmitInstInt4(INST_INCR_ARRAY, localIndex, envPtr); + OP4( INCR_ARRAY, localIndex); } } else { if (haveImmValue) { - TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue, envPtr); + OP1( INCR_ARRAY_STK_IMM, immValue); } else { - TclEmitOpcode( INST_INCR_ARRAY_STK, envPtr); + OP( INCR_ARRAY_STK); } } } return TCL_OK; @@ -3725,11 +3609,13 @@ /* * We require one compile-time known argument for the case we can compile. */ - if (parsePtr->numWords != 2) { + if (parsePtr->numWords == 1) { + return TclCompileBasic0ArgCmd(interp, parsePtr, cmdPtr, envPtr); + } else if (parsePtr->numWords != 2) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); objPtr = Tcl_NewObj(); Tcl_IncrRefCount(objPtr); @@ -3752,21 +3638,21 @@ /* * Confirmed as a literal that will not frighten the horses. Compile. Note * that the result needs to be list-ified. */ - CompileWord(envPtr, tokenPtr, interp, 1); - TclEmitOpcode( INST_RESOLVE_COMMAND, envPtr); - TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_STR_LEN, envPtr); - TclEmitInstInt4( INST_JUMP_FALSE, 10, envPtr); - TclEmitInstInt4( INST_LIST, 1, envPtr); + PUSH_SUBST_WORD(tokenPtr, 1); + OP( RESOLVE_COMMAND); + OP( DUP); + OP( STR_LEN); + OP4( JUMP_FALSE, 10); + OP4( LIST, 1); return TCL_OK; notCompilable: Tcl_DecrRefCount(objPtr); - return TCL_ERROR; + return TclCompileBasic1ArgCmd(interp, parsePtr, cmdPtr, envPtr); } int TclCompileInfoCoroutineCmd( Tcl_Interp *interp, /* Used for error reporting. */ @@ -3786,11 +3672,11 @@ /* * Not much to do; we compile to a single instruction... */ - TclEmitOpcode( INST_COROUTINE_NAME, envPtr); + OP( COROUTINE_NAME); return TCL_OK; } int TclCompileInfoExistsCmd( @@ -3816,30 +3702,30 @@ * body and if the name is simple text that does not include namespace * qualifiers. */ tokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex, - &simpleVarName, &isScalar, 1); + PUSH_VAR( tokenPtr, 1, + &localIndex, &simpleVarName, &isScalar); /* * Emit instruction to check the variable for existence. */ if (!simpleVarName) { - TclEmitOpcode( INST_EXIST_STK, envPtr); + OP( EXIST_STK); } else if (isScalar) { if (localIndex < 0) { - TclEmitOpcode( INST_EXIST_STK, envPtr); + OP( EXIST_STK); } else { - TclEmitInstInt4( INST_EXIST_SCALAR, localIndex, envPtr); + OP4(EXIST_SCALAR, localIndex); } } else { if (localIndex < 0) { - TclEmitOpcode( INST_EXIST_ARRAY_STK, envPtr); + OP( EXIST_ARRAY_STK); } else { - TclEmitInstInt4( INST_EXIST_ARRAY, localIndex, envPtr); + OP4(EXIST_ARRAY, localIndex); } } return TCL_OK; } @@ -3860,11 +3746,11 @@ if (parsePtr->numWords == 1) { /* * Not much to do; we compile to a single instruction... */ - TclEmitOpcode( INST_INFO_LEVEL_NUM, envPtr); + OP( INFO_LEVEL_NUM); } else if (parsePtr->numWords != 2) { return TCL_ERROR; } else { DefineLineInformation; /* TIP #280 */ @@ -3871,13 +3757,12 @@ /* * Compile the argument, then add the instruction to convert it into a * list of arguments. */ - SetLineInformation(1); - CompileTokens(envPtr, TokenAfter(parsePtr->tokenPtr), interp); - TclEmitOpcode( INST_INFO_LEVEL_ARGS, envPtr); + PUSH_SUBST_WORD(TokenAfter(parsePtr->tokenPtr), 1); + OP( INFO_LEVEL_ARGS); } return TCL_OK; } int @@ -3893,12 +3778,12 @@ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); if (parsePtr->numWords != 2) { return TCL_ERROR; } - CompileWord(envPtr, tokenPtr, interp, 1); - TclEmitOpcode( INST_TCLOO_CLASS, envPtr); + PUSH_SUBST_WORD(tokenPtr, 1); + OP( TCLOO_CLASS); return TCL_OK; } int TclCompileInfoObjectIsACmd( @@ -3929,12 +3814,12 @@ /* * Issue the code. */ - CompileWord(envPtr, tokenPtr, interp, 2); - TclEmitOpcode( INST_TCLOO_IS_OBJECT, envPtr); + PUSH_SUBST_WORD(tokenPtr, 2); + OP( TCLOO_IS_OBJECT); return TCL_OK; } int TclCompileInfoObjectNamespaceCmd( @@ -3949,12 +3834,12 @@ Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); if (parsePtr->numWords != 2) { return TCL_ERROR; } - CompileWord(envPtr, tokenPtr, interp, 1); - TclEmitOpcode( INST_TCLOO_NS, envPtr); + PUSH_SUBST_WORD(tokenPtr, 1); + OP( TCLOO_NS); return TCL_OK; } /* *---------------------------------------------------------------------- @@ -4014,23 +3899,20 @@ * procedure body and if the name is simple text that does not include * namespace qualifiers. */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); - - PushVarNameWord(interp, varTokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); + PUSH_VAR( varTokenPtr, 1, + &localIndex, &simpleVarName, &isScalar); /* * If we are doing an assignment, push the new value. In the no values * case, create an empty object. */ if (numWords > 2) { - Tcl_Token *valueTokenPtr = TokenAfter(varTokenPtr); - - CompileWord(envPtr, valueTokenPtr, interp, 2); + PUSH_SUBST_WORD(TokenAfter(varTokenPtr), 2); } /* * Emit instructions to set/get the variable. */ @@ -4039,22 +3921,22 @@ * The *_STK opcodes should be refactored to make better use of existing * LOAD/STORE instructions. */ if (!simpleVarName) { - TclEmitOpcode( INST_LAPPEND_STK, envPtr); + OP( LAPPEND_STK); } else if (isScalar) { if (localIndex < 0) { - TclEmitOpcode( INST_LAPPEND_STK, envPtr); + OP( LAPPEND_STK); } else { - Emit14Inst( INST_LAPPEND_SCALAR, localIndex, envPtr); + OP4(LAPPEND_SCALAR, localIndex); } } else { if (localIndex < 0) { - TclEmitOpcode( INST_LAPPEND_ARRAY_STK, envPtr); + OP( LAPPEND_ARRAY_STK); } else { - Emit14Inst( INST_LAPPEND_ARRAY, localIndex, envPtr); + OP4(LAPPEND_ARRAY, localIndex); } } return TCL_OK; } @@ -4103,11 +3985,11 @@ /* * Generate code to push list being taken apart by [lassign]. */ tokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 1); + PUSH_SUBST_WORD(tokenPtr, 1); /* * Generate code to assign values from the list to variables. */ @@ -4116,57 +3998,55 @@ /* * Generate the next variable name. */ - PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex, - &simpleVarName, &isScalar, idx+2); + PUSH_VAR( tokenPtr, idx+2, + &localIndex, &simpleVarName, &isScalar); /* * Emit instructions to get the idx'th item out of the list value on * the stack and assign it to the variable. */ if (!simpleVarName) { - TclEmitInstInt4( INST_OVER, 1, envPtr); - TclEmitInstInt4( INST_LIST_INDEX_IMM, idx, envPtr); - TclEmitOpcode( INST_STORE_STK, envPtr); - TclEmitOpcode( INST_POP, envPtr); - } else if (isScalar) { - if (localIndex >= 0) { - TclEmitOpcode( INST_DUP, envPtr); - TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr); - Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); - } else { - TclEmitInstInt4(INST_OVER, 1, envPtr); - TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr); - TclEmitOpcode( INST_STORE_SCALAR_STK, envPtr); - TclEmitOpcode( INST_POP, envPtr); - } - } else { - if (localIndex >= 0) { - TclEmitInstInt4(INST_OVER, 1, envPtr); - TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr); - Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); - } else { - TclEmitInstInt4(INST_OVER, 2, envPtr); - TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr); - TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr); - TclEmitOpcode( INST_POP, envPtr); + OP( UNDER); + OP4( LIST_INDEX_IMM, idx); + OP( STORE_STK); + OP( POP); + } else if (isScalar) { + if (localIndex >= 0) { + OP( DUP); + OP4( LIST_INDEX_IMM, idx); + OP4( STORE_SCALAR, localIndex); + OP( POP); + } else { + OP( UNDER); + OP4( LIST_INDEX_IMM, idx); + OP( STORE_SCALAR_STK); + OP( POP); + } + } else { + if (localIndex >= 0) { + OP( UNDER); + OP4( LIST_INDEX_IMM, idx); + OP4( STORE_ARRAY, localIndex); + OP( POP); + } else { + OP4( OVER, 2); + OP4( LIST_INDEX_IMM, idx); + OP( STORE_ARRAY_STK); + OP( POP); } } } /* * Generate code to leave the rest of the list on the stack. */ - TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr); - TclEmitInt4( -2 /* == "end" */, envPtr); - + OP44( LIST_RANGE_IMM, idx, -2 /* == "end" */); return TCL_OK; } /* *---------------------------------------------------------------------- @@ -4239,12 +4119,12 @@ * lindex end- * This is best compiled as a push of the arbitrary value followed * by an "immediate lindex" which is the most efficient variety. */ - CompileWord(envPtr, valTokenPtr, interp, 1); - TclEmitInstInt4( INST_LIST_INDEX_IMM, idx, envPtr); + PUSH_SUBST_WORD(valTokenPtr, 1); + OP4(LIST_INDEX_IMM, idx); return TCL_OK; } /* * If the conversion failed or the value was negative, we just keep on @@ -4256,23 +4136,23 @@ * Push the operands onto the stack. */ emitComplexLindex: for (i=1 ; inumWords == 1) { /* * [list] without arguments just pushes an empty object. */ - PushLiteral(envPtr, "", 0); + PUSH( ""); } else { /* * Push the all values onto the stack. */ numWords = parsePtr->numWords; valueTokenPtr = TokenAfter(parsePtr->tokenPtr); for (i = 1; i < numWords; i++) { - CompileWord(envPtr, valueTokenPtr, interp, i); + PUSH_SUBST_WORD(valueTokenPtr, i); valueTokenPtr = TokenAfter(valueTokenPtr); } - TclEmitInstInt4( INST_LIST, numWords - 1, envPtr); + OP4( LIST, numWords-1); } return TCL_OK; } @@ -4371,12 +4251,12 @@ if (parsePtr->numWords != 2) { return TCL_ERROR; } varTokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, varTokenPtr, interp, 1); - TclEmitOpcode( INST_LIST_LENGTH, envPtr); + PUSH_SUBST_WORD(varTokenPtr, 1); + OP( LIST_LENGTH); return TCL_OK; } /* *---------------------------------------------------------------------- @@ -4466,13 +4346,12 @@ * Issue instructions. It's not safe to skip doing the LIST_RANGE, as * we've not proved that the 'list' argument is really a list. Not that it * is worth trying to do that given current knowledge. */ - CompileWord(envPtr, listTokenPtr, interp, 1); - TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr); - TclEmitInt4( idx2, envPtr); + PUSH_SUBST_WORD(listTokenPtr, 1); + OP44( LIST_RANGE_IMM, idx1, idx2); return TCL_OK; } /* *---------------------------------------------------------------------- @@ -4584,18 +4463,17 @@ * Issue instructions. It's not safe to skip doing the LIST_RANGE, as * we've not proved that the 'list' argument is really a list. Not that it * is worth trying to do that given current knowledge. */ - CompileWord(envPtr, listTokenPtr, interp, 1); + PUSH_SUBST_WORD(listTokenPtr, 1); if (guaranteedDropAll) { - TclEmitOpcode( INST_LIST_LENGTH, envPtr); - TclEmitOpcode( INST_POP, envPtr); - PushLiteral(envPtr, "", 0); + OP( LIST_LENGTH); + OP( POP); + PUSH( ""); } else { - TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr); - TclEmitInt4( idx2, envPtr); + OP44( LIST_RANGE_IMM, idx1, idx2); } return TCL_OK; } /* @@ -4676,20 +4554,20 @@ * body and if the name is simple text that does not include namespace * qualifiers. */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarNameWord(interp, varTokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); + PUSH_VAR( varTokenPtr, 1, + &localIndex, &simpleVarName, &isScalar); /* * Push the "index" args and the new element value. */ for (i=2 ; inumWords ; ++i) { varTokenPtr = TokenAfter(varTokenPtr); - CompileWord(envPtr, varTokenPtr, interp, i); + PUSH_SUBST_WORD(varTokenPtr, i); } /* * Duplicate the variable name if it's been pushed. */ @@ -4698,11 +4576,11 @@ if (!simpleVarName || isScalar) { tempDepth = parsePtr->numWords - 2; } else { tempDepth = parsePtr->numWords - 1; } - TclEmitInstInt4( INST_OVER, tempDepth, envPtr); + OP4( OVER, tempDepth); } /* * Duplicate an array index if one's been pushed. */ @@ -4711,60 +4589,60 @@ if (localIndex < 0) { tempDepth = parsePtr->numWords - 1; } else { tempDepth = parsePtr->numWords - 2; } - TclEmitInstInt4( INST_OVER, tempDepth, envPtr); + OP4( OVER, tempDepth); } /* * Emit code to load the variable's value. */ if (!simpleVarName) { - TclEmitOpcode( INST_LOAD_STK, envPtr); + OP( LOAD_STK); } else if (isScalar) { if (localIndex < 0) { - TclEmitOpcode( INST_LOAD_SCALAR_STK, envPtr); + OP( LOAD_SCALAR_STK); } else { - Emit14Inst( INST_LOAD_SCALAR, localIndex, envPtr); + OP4(LOAD_SCALAR, localIndex); } } else { if (localIndex < 0) { - TclEmitOpcode( INST_LOAD_ARRAY_STK, envPtr); + OP( LOAD_ARRAY_STK); } else { - Emit14Inst( INST_LOAD_ARRAY, localIndex, envPtr); + OP4(LOAD_ARRAY, localIndex); } } /* * Emit the correct variety of 'lset' instruction. */ if (parsePtr->numWords == 4) { - TclEmitOpcode( INST_LSET_LIST, envPtr); + OP( LSET_LIST); } else { - TclEmitInstInt4( INST_LSET_FLAT, parsePtr->numWords-1, envPtr); + OP4( LSET_FLAT, parsePtr->numWords-1); } /* * Emit code to put the value back in the variable. */ if (!simpleVarName) { - TclEmitOpcode( INST_STORE_STK, envPtr); + OP( STORE_STK); } else if (isScalar) { if (localIndex < 0) { - TclEmitOpcode( INST_STORE_SCALAR_STK, envPtr); + OP( STORE_SCALAR_STK); } else { - Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr); + OP4(STORE_SCALAR, localIndex); } } else { if (localIndex < 0) { - TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr); + OP( STORE_ARRAY_STK); } else { - Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr); + OP4(STORE_ARRAY, localIndex); } } return TCL_OK; } @@ -4839,11 +4717,11 @@ /* * Not much to do; we compile to a single instruction... */ - TclEmitOpcode( INST_NS_CURRENT, envPtr); + OP( NS_CURRENT); return TCL_OK; } int TclCompileNamespaceCodeCmd( @@ -4885,15 +4763,15 @@ * implementation does internally. Note that we can't bind the namespace * name directly here, because TclOO plays complex games with namespaces; * the value needs to be determined at runtime for safety. */ - PushLiteral(envPtr, "::namespace", 11); - PushLiteral(envPtr, "inscope", 7); - TclEmitOpcode( INST_NS_CURRENT, envPtr); - CompileWord(envPtr, tokenPtr, interp, 1); - TclEmitInstInt4( INST_LIST, 4, envPtr); + PUSH( "::namespace"); + PUSH( "inscope"); + OP( NS_CURRENT); + PUSH_SUBST_WORD(tokenPtr, 1); + OP4( LIST, 4); return TCL_OK; } int TclCompileNamespaceQualifiersCmd( @@ -4910,26 +4788,25 @@ if (parsePtr->numWords != 2) { return TCL_ERROR; } - CompileWord(envPtr, tokenPtr, interp, 1); - PushLiteral(envPtr, "0", 1); - PushLiteral(envPtr, "::", 2); - TclEmitInstInt4( INST_OVER, 2, envPtr); - TclEmitOpcode( INST_STR_FIND_LAST, envPtr); - off = CurrentOffset(envPtr); - PushLiteral(envPtr, "1", 1); - TclEmitOpcode( INST_SUB, envPtr); - TclEmitInstInt4( INST_OVER, 2, envPtr); - TclEmitInstInt4( INST_OVER, 1, envPtr); - TclEmitOpcode( INST_STR_INDEX, envPtr); - PushLiteral(envPtr, ":", 1); - TclEmitOpcode( INST_STR_EQ, envPtr); - off = off - CurrentOffset(envPtr); - TclEmitInstInt4( INST_JUMP_TRUE, off, envPtr); - TclEmitOpcode( INST_STR_RANGE, envPtr); + PUSH_SUBST_WORD(tokenPtr, 1); + PUSH( "0"); + PUSH( "::"); + OP4( OVER, 2); + OP( STR_FIND_LAST); + LABEL(off); + PUSH( "1"); + OP( SUB); + OP4( OVER, 2); + OP( UNDER); + OP( STR_INDEX); + PUSH( ":"); + OP( STR_EQ); + BACKJUMP(off, JUMP_TRUE); + OP( STR_RANGE); return TCL_OK; } int TclCompileNamespaceTailCmd( @@ -4950,23 +4827,23 @@ /* * Take care; only add 2 to found index if the string was actually found. */ - CompileWord(envPtr, tokenPtr, interp, 1); - PushLiteral(envPtr, "::", 2); - TclEmitInstInt4( INST_OVER, 1, envPtr); - TclEmitOpcode( INST_STR_FIND_LAST, envPtr); - TclEmitOpcode( INST_DUP, envPtr); - PushLiteral(envPtr, "0", 1); - TclEmitOpcode( INST_GE, envPtr); + PUSH_SUBST_WORD(tokenPtr, 1); + PUSH( "::"); + OP( UNDER); + OP( STR_FIND_LAST); + OP( DUP); + PUSH( "0"); + OP( GE); TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFixup); - PushLiteral(envPtr, "2", 1); - TclEmitOpcode( INST_ADD, envPtr); + PUSH( "2"); + OP( ADD); TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127); - PushLiteral(envPtr, "end", 3); - TclEmitOpcode( INST_STR_RANGE, envPtr); + PUSH( "end"); + OP( STR_RANGE); return TCL_OK; } int TclCompileNamespaceUpvarCmd( @@ -4997,11 +4874,11 @@ /* * Push the namespace */ tokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 1); + PUSH_SUBST_WORD(tokenPtr, 1); /* * Loop over the (otherVar, thisVar) pairs. If any of the thisVar is not a * local variable, return an error so that the non-compiled command will * be called at runtime. @@ -5010,26 +4887,26 @@ localTokenPtr = tokenPtr; for (i=3; i<=numWords; i+=2) { otherTokenPtr = TokenAfter(localTokenPtr); localTokenPtr = TokenAfter(otherTokenPtr); - CompileWord(envPtr, otherTokenPtr, interp, 1); - PushVarNameWord(interp, localTokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); + PUSH_SUBST_WORD(otherTokenPtr, i-1); + PUSH_VAR(localTokenPtr, i, + &localIndex, &simpleVarName, &isScalar); if ((localIndex < 0) || !isScalar) { return TCL_ERROR; } - TclEmitInstInt4( INST_NSUPVAR, localIndex, envPtr); + OP4( NSUPVAR, localIndex); } /* * Pop the namespace, and set the result to empty */ - TclEmitOpcode( INST_POP, envPtr); - PushLiteral(envPtr, "", 0); + OP( POP); + PUSH( ""); return TCL_OK; } int TclCompileNamespaceWhichCmd( @@ -5070,12 +4947,12 @@ /* * Issue the bytecode. */ - CompileWord(envPtr, tokenPtr, interp, idx); - TclEmitOpcode( INST_RESOLVE_COMMAND, envPtr); + PUSH_SUBST_WORD(tokenPtr, idx); + OP( RESOLVE_COMMAND); return TCL_OK; } /* *---------------------------------------------------------------------- @@ -5191,11 +5068,11 @@ if (len == 0) { /* * The semantics of regexp are always match on re == "". */ - PushLiteral(envPtr, "1", 1); + PUSH( "1"); return TCL_OK; } /* * Attempt to convert pattern to glob. If successful, push the @@ -5203,31 +5080,31 @@ */ if (TclReToGlob(NULL, varTokenPtr[1].start, len, &ds, &exact) == TCL_OK) { simple = 1; - PushLiteral(envPtr, Tcl_DStringValue(&ds),Tcl_DStringLength(&ds)); + PUSH_DSTRING(&ds); Tcl_DStringFree(&ds); } } if (!simple) { - CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-2); + PUSH_SUBST_WORD(varTokenPtr, parsePtr->numWords-2); } /* * Push the string arg. */ varTokenPtr = TokenAfter(varTokenPtr); - CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-1); + PUSH_SUBST_WORD(varTokenPtr, parsePtr->numWords-1); if (simple) { if (exact && !nocase) { - TclEmitOpcode( INST_STR_EQ, envPtr); + OP( STR_EQ); } else { - TclEmitInstInt1( INST_STR_MATCH, nocase, envPtr); + OP1(STR_MATCH, nocase); } } else { /* * Pass correct RE compile flags. We use only Int1 (8-bit), but * that handles all the flags we want to pass. @@ -5234,11 +5111,11 @@ * Don't use TCL_REG_NOSUB as we may have backrefs. */ int cflags = TCL_REG_ADVANCED | (nocase ? TCL_REG_NOCASE : 0); - TclEmitInstInt1( INST_REGEXP, cflags, envPtr); + OP1( REGEXP, cflags); } return TCL_OK; } @@ -5398,14 +5275,13 @@ */ result = TCL_OK; bytes = Tcl_DStringValue(&pattern) + 1; PushLiteral(envPtr, bytes, len); - bytes = Tcl_GetStringFromObj(replacementObj, &len); - PushLiteral(envPtr, bytes, len); - CompileWord(envPtr, stringTokenPtr, interp, parsePtr->numWords-2); - TclEmitOpcode( INST_STR_MAP, envPtr); + PUSH_OBJ(replacementObj); + PUSH_SUBST_WORD(stringTokenPtr, parsePtr->numWords-2); + OP( STR_MAP); done: Tcl_DStringFree(&pattern); if (patternObj) { Tcl_DecrRefCount(patternObj); @@ -5469,13 +5345,13 @@ && (wordTokenPtr[1].size == 8) && (strncmp(wordTokenPtr[1].start, "-options", 8) == 0)) { Tcl_Token *optsTokenPtr = TokenAfter(wordTokenPtr); Tcl_Token *msgTokenPtr = TokenAfter(optsTokenPtr); - CompileWord(envPtr, optsTokenPtr, interp, 2); - CompileWord(envPtr, msgTokenPtr, interp, 3); - TclEmitOpcode(INST_RETURN_STK, envPtr); + PUSH_SUBST_WORD(optsTokenPtr, 2); + PUSH_SUBST_WORD(msgTokenPtr, 3); + OP( RETURN_STK); envPtr->currStackDepth = savedStackDepth + 1; return TCL_OK; } /* @@ -5522,17 +5398,17 @@ * All options are known at compile time, so we're going to bytecompile. * Emit instructions to push the result on the stack. */ if (explicitResult) { - CompileWord(envPtr, wordTokenPtr, interp, numWords-1); + PUSH_SUBST_WORD(wordTokenPtr, numWords-1); } else { /* * No explict result argument, so default result is empty string. */ - PushLiteral(envPtr, "", 0); + PUSH( ""); } /* * Check for optimization: When [return] is in a proc, and there's no * enclosing [catch], and there are no return options, then the INST_DONE @@ -5562,11 +5438,11 @@ * ... and there is no enclosing catch. Issue the maximally * efficient exit instruction. */ Tcl_DecrRefCount(returnOpts); - TclEmitOpcode(INST_DONE, envPtr); + OP( DONE); return TCL_OK; } } /* Optimize [return -level 0 $x]. */ @@ -5676,18 +5552,18 @@ if (newTypePtr != typePtr) { if (numWords%2) { return TCL_ERROR; } - CompileWord(envPtr, tokenPtr, interp, 1); + PUSH_SUBST_WORD(tokenPtr, 1); otherTokenPtr = TokenAfter(tokenPtr); i = 4; } else { if (!(numWords%2)) { return TCL_ERROR; } - PushLiteral(envPtr, "1", 1); + PUSH( "1"); otherTokenPtr = tokenPtr; i = 3; } } else { Tcl_DecrRefCount(objPtr); @@ -5701,26 +5577,26 @@ */ for (; i<=numWords; i+=2, otherTokenPtr = TokenAfter(localTokenPtr)) { localTokenPtr = TokenAfter(otherTokenPtr); - CompileWord(envPtr, otherTokenPtr, interp, 1); - PushVarNameWord(interp, localTokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); + PUSH_SUBST_WORD(otherTokenPtr, 1); + PUSH_VAR(localTokenPtr, 1, + &localIndex, &simpleVarName, &isScalar); if ((localIndex < 0) || !isScalar) { return TCL_ERROR; } - TclEmitInstInt4( INST_UPVAR, localIndex, envPtr); + OP4( UPVAR, localIndex); } /* * Pop the frame index, and set the result to empty */ - TclEmitOpcode( INST_POP, envPtr); - PushLiteral(envPtr, "", 0); + OP( POP); + PUSH( ""); return TCL_OK; } /* *---------------------------------------------------------------------- @@ -5769,39 +5645,39 @@ /* * Loop over the (var, value) pairs. */ valueTokenPtr = parsePtr->tokenPtr; - for (i=2; i<=numWords; i+=2) { + for (i=1; i