Compare commits

..
1 Commits
Author SHA1 Message Date
Kevin Walzer 7fc2722d6c Testing patches for iOS support 2014-07-31 02:04:10 +00:00
279 changed files with 7411 additions and 10179 deletions
+1 -1
View File
@@ -1,5 +1,5 @@
README: Tcl
This is the Tcl 8.6.4 source distribution.
This is the Tcl 8.6.1 source distribution.
http://sourceforge.net/projects/tcl/files/Tcl/
You can get any source release of Tcl from the URL above.
+2 -226
View File
@@ -8274,7 +8274,7 @@ Dropped support for OS X versions less than 10.4 (Tiger) (fellows)
2013-08-01 (bug fix)[1905562] RE recursion limit increased to support
reported usage of large expressions (porter)
2013-08-02 (bug fix)[9d6162] superclass slot empty crash (vdgoot,fellows)
2013-08-02 (bug fix)[9d6162] superclass slot empty crash (vdgoot,fellows)2013-08-02 (bug fix)[9d6162] superclass slot empty crash (vdgoot,fellows)
2013-08-03 (enhancement)[3611643] [auto_mkindex] support TclOO (fellows)
@@ -8303,228 +8303,4 @@ reported usage of large expressions (porter)
Many optmizations, improvements, and tightened stack management in bytecode.
--- Released 8.6.1, September 20, 2013 --- http://core.tcl.tk/tcl/ for details
2013-09-27 (enhancement) improved ::env synchronization (fellows)
2013-10-20 (bug fix)[2835313] segfault from
[apply {{} {while 1 {a {*}[return -level 0 -code continue]}}}] (fellows)
2013-10-22 (bug fix)[3556215] [scan %E%G%X] support (fellows)
2013-10-25 (bug fix)[3eb2ec1] upper case scheme names in url. (nijtmans)
=> http 2.8.8
2013-10-29 (bug fix)[414d103] HP-UX: restore [exec] in threaded Tcl (nijtmans)
2013-11-04 (bug fix) C++ friendly stubs struct declarations (nijtmans)
2013-11-05 (bug fix)[426679e] OpenBSD man page rendering (nijtmans)
2013-11-12 (bug fix)[5425f2c] [fconfigure -error] breaks [socket -async]
2013-11-20 (bug fix) Improved environment variable management (nijtmans)
=> tcltest 2.3.7
2013-11-21 (platforms) Support for Windows 8.1 (nijtmans)
2013-12-06 (RFE) improved [foreach] bytecode (fellows)
2013-12-10 (RFE) improved [lmap] bytecode (sofer)
2013-12-11 (RFE) improved [catch] bytecode (sofer)
2013-12-18 (bug fix)[0b874c3] SEGV [coroutine X coroutine Y info frame] (porter)
2013-12-20 (RFE) reduced numeric conversion in bytecode (sofer)
2014-01-07 (RFE) compilers for [concat], [linsert], [namespace origin],
[next], [string replace], [string tolower], [string totitle], [string toupper],
[string trim], [string trimleft], [string trimright] (fellows)
2014-01-22 (RFE) compilers for [nextto], [yieldto] (fellows)
2014-02-02 (RFE) compiler for [string is] (fellows)
2014-02-06 (bug fix)[a4494e2] panic in test namespace-13.2 (porter)
2014-03-20 (bug fix)[2f7cbd0] FreeBSD 10.0 build failure (nijtmans)
2014-03-26 (RFE)[b42b208] Cygwin: [file attr -readonly -archive -hidden -system]
(nijtmans)
2014-03-27 (bug fix) segfault iocmd-23.11 (porter)
2014-04-02 (bug fix)[581937a] Win: readable event on async connect failure
2014-04-04 (bug fix)[581937a,97069ea] async socket connect fail (oehlmann)
2014-04-10 (bug fix)[792641f] Win: no \ in normalized path (nijtmans)
2014-04-11 (bug fix)[3118489] protect NUL in filenames (nijtmans)
2014-04-15 (bug fix)[88aef05] segfault iocmd-21.20 (porter)
2014-04-16 (update) Win: use Winsock 2.2 (nijtmans)
2014-04-16 (bug fix)[d19a30d] segfault clock-67.[23] (sebres)
2014-04-21 (bug fix) segfault iocmd-21.2[12] (porter)
2014-04-22 (bug fix) segfault iogt-2.4 (porter)
2014-04-23 (bug fix)[3493120] memleak in thread exit
2014-05-08 refactoring of core I/O functions (porter)
2014-05-09 (bug fix)[3389978] Win: extended paths support (nijtmans)
2014-05-09 (bug fix) segfault iocmd-32.1 (porter)
2014-05-11 (bug fix)[6d2f249] nested ensemble compile failure (fellows)
2014-05-17 (RFE)[47d6625] wideint support in [lsearch -integer] [lsort -integer] (nijtmans)
*** POTENTIAL INCOMPATIBILITY ***
2014-05-20 (bug fix) Stop eof and blocked state leaking thru stacks (porter)
*** POTENTIAL INCOMPATIBILITY ***
2014-05-20 (bug fix)[13d3af3] Win: socket -async tried only first IP address
2014-05-28 (platforms) work around systems that fail when a shared library
is deleted after it is [load]ed (kupries)
2014-05-31 (bug fix) chan events on pipes must be on proper ends (porter)
2014-06-04 (bug fix) socket-2.12 (porter)
2014-06-05 (bug fix) io-12.6 (kupries,porter)
2014-06-15 (RFE)[1b0266d] [dict replace|remove] return canonical dict (fellows)
*** POTENTIAL INCOMPATIBILITY ***
2014-06-16 (bug fix) socket-2.13 workaround broken select() (porter)
2014-06-20 (bug fix)[b47b176] iortrans.tf-11.0 (porter)
2014-06-22 (RFE)[2f9df4c] -cleanup scripts before -out compare (nijtmans)
2014-07-04 (update) Update Unicode data to 7.0 (nijtmans)
*** POTENTIAL INCOMPATIBILITY ***
2014-07-08 (bug) [chan push] converts blocked writes to error (aspect,porter)
2014-07-10 (bug fix)[7368d2] memleak Tcl_SetVar2(..,TCL_APPEND_VALUE) (porter)
*** POTENTIAL INCOMPATIBILITY ***
2014-07-11 (bug) leaks in SetFsPathFromAny, [info frame] (porter)
2014-07-15 (bug) compress dict leak in zlib xform channel close (porter)
2014-07-17 (bug fix)[9969cf8] leak trace data in coroutine deletion (porter)
2014-07-18 (RFE)[b43f2b4] fix [lappend] multi performance collapse (fellows)
2014-07-19 (bug fix)[75b8433] memleak managing oo instance lists (porter)
2014-07-21 (bug fix)[e6477e1] memleak in AtForkChild() (porter)
2014-07-22 (bug fix)[12b0997] memleak in iocmd.tf-32.0 (porter)
2014-07-28 (RFE) Optimized binary [chan copy] by moving buffers (porter)
2014-07-30 (enhancement) use refcounts, not Tcl_Preserve to manage lifetime
of Tcl_Channel (porter)
*** POTENTIAL INCOMPATIBILITY ***
2014-07-31 (bug fix)[a84a720] double free in oo chain deletion (porter)
2014-08-01 (bug fix)[e75faba] SEGV [apply {{} {namespace upvar a b [x]}}] (porter)
2014-08-01 (update) "macosx*-i386-x86_64" "macosx-universal" no longer compatible (kupries)
=> platform 1.0.13
2014-08-12 tzdata updated to Olson's tzdata2014f (kenny)
2014-08-17 (bug fix)[7d52e11] [info class subclasses oo::object] should
include ::oo::class (fellows)
2014-08-25 (TIP 429) New command [string cat] (leitgeb,ferrieux)
--- Released 8.6.2, August 27, 2014 --- http://core.tcl.tk/tcl/ for details
2014-08-28 (bug)[b9e1a3] Correct Method Search Order (nadkarni,fellows)
=> TclOO 1.0.3
*** POTENTIAL INCOMPATIBILITY ***
2014-09-05 (bug)[ccc2c2] Regression [lreplace {} 1 1] (bron,fellows)
2014-09-08 (bug)<oo-1.18.2> Crash regression in [oo::class destroy] (porter)
2014-09-09 (bug)[84af11] Regress [regsub -all {\(.*} a(b) {}] (fellows)
2014-09-10 (bug)[cee90e] [try {} on ok {} - on return {} {}] panic (porter)
2014-09-20 (feature) [tcl::unsupported::getbytecode] disassember (fellows)
2014-09-27 (enhancement) [string cat] bytecode optimization (leitgeb,ferrieux)
2014-09-27 (bug)[82521b] segfault in mangled bytecode (ogilvie,sofer)
2014-10-02 (bug)[bc5b79] Hang in some [read]s of limited size (rogers,porter)
2014-10-03 (bug)[bc1a96] segfault in [array set] of traced array (tab,porter)
2014-10-08 (bug)[59a2e7] MSVC14 compile support (dower,nijtmans)
2014-10-10 (bug)[ed29c4] [fcopy] treats [blocked] as error (rowen,porter)
2014-10-10 (bug)[bf7135] regression in Tcl_Write() interface (porter)
2014-10-18 (bug)[10dc6d] fix [gets] on non-blocking channels (fassel,porter)
2014-10-26 Support for Windows 10 (nijtmans)
2014-10-31 (bug)[dcc034] restore [open comX: r+] (lll,nijtmans)
2014-11-05 (bug)[214cc0] Restore [lappend v] return value (sayers,porter)
2014-11-06 (bug)[5adc35] Stop forcing EOF to be permanent (porter)
--- Released 8.6.3, November 12, 2014 --- http://core.tcl.tk/tcl/ for details
2014-11-21 (bug)[743338] Win: socket error encoding (ladayaroslav,nijtmans)
2014-12-01 (bug) restore tbcload/tclcompiler support (kupries)
2014-12-03 (bug)[0c043a] Fix compiled [set var($) val] (porter)
2014-12-04 (bug)[d2ffcc] Limit $... and bareword parsing to ASCII (ladayaroslav,porter)
*** POTENTIAL INCOMPATIBILITY ***
2014-12-06 (bug)[c6cd4a] Win: hang in async socket connection (shults,nadkarni)
2014-12-10 tzdata updated to Olson's tzdata2014j (venkat)
2014-12-13 fix header files installation on OS X (houben)
2014-12-17 (TIP 427) [fconfigure $h -connecting, -peername, -sockname] (oehlmann,rmax)
2014-12-18 (bug)[af08c8] Crash in full finalize encoding teardown (porter)
2014-12-18 (bug)[7c187a] [chan copy] crash (io-53.17) (benno,porter)
2015-01-26 (bug)[df0848] Trouble with INFINITY macro (dower,nijtmans)
2015-01-29 (bug) Stop crashes when extension var resolvers misbehave (porter)
2015-01-29 (bug)[088727] [read] past EOF (io-73.4) (fenugrec,porter)
2015-02-11 tzdata updated to Olson's tzdata2015a (venkat)
2015-02-20 (bug)[32b615] Fix compiled [lreplace] (lreplace-4.[345]) (aspect)
2015-03-10 (enhancement) Revise OS X notifier for better Cocoa (walzer)
*** POTENTIAL INCOMPATIBILITY ***
--- Released 8.6.4, March 12, 2015 --- http://core.tcl.tk/tcl/ for details
--- Released 8.6.1, Septemer 20, 2013 --- http://core.tcl.tk/tcl/ for details
+22
View File
@@ -0,0 +1,22 @@
/*
* limits.h --
*
* This is a dummy header file to #include in Tcl when there
* is no limits.h in /usr/include. There are only a few
* definitions here; also see tclPort.h, which already
* #defines some of the things here if they're not arleady
* defined.
*
* Copyright (c) 1991 The Regents of the University of California.
* Copyright (c) 1994 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#define LONG_MIN 0x80000000
#define LONG_MAX 0x7fffffff
#define INT_MIN 0x80000000
#define INT_MAX 0x7fffffff
#define SHRT_MIN 0x8000
#define SHRT_MAX 0x7fff
+1 -1
View File
@@ -336,7 +336,7 @@ typedef struct Tcl_ChannelType {
It is not necessary to provide implementations for all channel
operations. Those which are not necessary may be set to NULL in the
struct: \fIblockModeProc\fR, \fIseekProc\fR, \fIsetOptionProc\fR,
\fIgetOptionProc\fR, \fIgetHandleProc\fR, and \fIclose2Proc\fR, in addition to
\fIgetOptionProc\fR, and \fIclose2Proc\fR, in addition to
\fIflushProc\fR, \fIhandlerProc\fR, \fIthreadActionProc\fR, and
\fItruncateProc\fR. Other functions that cannot be implemented in a
meaningful way should return \fBEINVAL\fR when called, to indicate
+41 -7
View File
@@ -257,13 +257,47 @@ is filled with the corresponding number of bytes that were stored in
.PP
\fBTcl_WinUtfToTChar\fR and \fBTcl_WinTCharToUtf\fR are
Windows-only convenience
functions for converting between UTF-8 and Windows strings
based on the TCHAR type which is by convention
a Unicode character on Windows NT.
These functions are essentially wrappers around
\fBTcl_UtfToExternalDString\fR and
\fBTcl_ExternalToUtfDString\fR that convert to and from the
Unicode encoding.
functions for converting between UTF-8 and Windows strings. On Windows 95
(as with the Unix operating system),
all strings exchanged between Tcl and the operating system are
.QW "char"
based. On Windows NT, some strings exchanged between Tcl and the
operating system are
.QW "char"
oriented while others are in Unicode. By
convention, in Windows a TCHAR is a character in the ANSI code page
on Windows 95 and a Unicode character on Windows NT.
.PP
If you planned to use the same
.QW "char"
based interfaces on both Windows
95 and Windows NT, you could use \fBTcl_UtfToExternal\fR and
\fBTcl_ExternalToUtf\fR (or their \fBTcl_DString\fR equivalents) with an
encoding of NULL (the current system encoding). On the other hand,
if you planned to use the Unicode interface when running on Windows NT
and the
.QW "char"
interfaces when running on Windows 95, you would have
to perform the following type of test over and over in your program
(as represented in pseudo-code):
.PP
.CS
if (running NT) {
encoding <- Tcl_GetEncoding("unicode");
nativeBuffer <- Tcl_UtfToExternal(encoding, utfBuffer);
Tcl_FreeEncoding(encoding);
} else {
nativeBuffer <- Tcl_UtfToExternal(NULL, utfBuffer);
}
.CE
.PP
\fBTcl_WinUtfToTChar\fR and \fBTcl_WinTCharToUtf\fR automatically
handle this test and use the proper encoding based on the current
operating system. \fBTcl_WinUtfToTChar\fR returns a pointer to
a TCHAR string, and \fBTcl_WinTCharToUtf\fR expects a TCHAR string
pointer as the \fIsrc\fR string. Otherwise, these functions
behave identically to \fBTcl_UtfToExternalDString\fR and
\fBTcl_ExternalToUtfDString\fR.
.PP
\fBTcl_GetEncodingName\fR is roughly the inverse of \fBTcl_GetEncoding\fR.
Given an \fIencoding\fR, the return value is the \fIname\fR argument that
+6 -14
View File
@@ -9,7 +9,7 @@
.so man.macros
.BS
.SH NAME
Tcl_ConditionNotify, Tcl_ConditionWait, Tcl_ConditionFinalize, Tcl_GetThreadData, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_MutexFinalize, Tcl_MutexUnlockAndFinalize, Tcl_CreateThread, Tcl_JoinThread \- Tcl thread support
Tcl_ConditionNotify, Tcl_ConditionWait, Tcl_ConditionFinalize, Tcl_GetThreadData, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_MutexFinalize, Tcl_CreateThread, Tcl_JoinThread \- Tcl thread support
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -35,9 +35,6 @@ void
void
\fBTcl_MutexFinalize\fR(\fImutexPtr\fR)
.sp
void
\fBTcl_MutexUnlockAndFinalize\fR(\fImutexPtr\fR)
.sp
int
\fBTcl_CreateThread\fR(\fIidPtr, proc, clientData, stackSize, flags\fR)
.sp
@@ -141,16 +138,11 @@ A mutex is a lock that is used to serialize all threads through a piece
of code by calling \fBTcl_MutexLock\fR and \fBTcl_MutexUnlock\fR.
If one thread holds a mutex, any other thread calling \fBTcl_MutexLock\fR will
block until \fBTcl_MutexUnlock\fR is called.
A mutex can be destroyed after its use by calling \fBTcl_MutexFinalize\fR or
\fBTcl_MutexUnlockAndFinalize\fR. The \fBTcl_MutexFinalize\fR function may
only be used on unlocked mutexes; otherwise, its behavior is undefined. The
\fBTcl_MutexUnlockAndFinalize\fR function may only be used on locked mutexes;
otherwise, its behavior is undefined.
A mutex can be destroyed after its use by calling \fBTcl_MutexFinalize\fR.
The result of locking a mutex twice from the same thread is undefined.
On some platforms it will result in a deadlock.
The \fBTcl_MutexLock\fR, \fBTcl_MutexUnlock\fR, \fBTcl_MutexFinalize\fR, and
\fBTcl_MutexUnlockAndFinalize\fR procedures are defined as empty macros if
not compiling with threads enabled.
The \fBTcl_MutexLock\fR, \fBTcl_MutexUnlock\fR and \fBTcl_MutexFinalize\fR
procedures are defined as empty macros if not compiling with threads enabled.
For declaration of mutexes the \fBTCL_DECLARE_MUTEX\fR macro should be used.
This macro assures correct mutex handling even when the core is compiled
without threads enabled.
@@ -184,8 +176,8 @@ They are implemented as opaque pointers that should be NULL
upon first use.
The mutexes and condition variables are
either cleaned up by process exit handlers (if living that long) or
explicitly by calls to \fBTcl_MutexFinalize\fR (or
\fBTcl_MutexUnlockAndFinalize\fR) and \fBTcl_ConditionFinalize\fR.
explicitly by calls to \fBTcl_MutexFinalize\fR or
\fBTcl_ConditionFinalize\fR.
Thread local storage is reclaimed during \fBTcl_FinalizeThread\fR.
.SH "SCRIPT-LEVEL ACCESS TO THREADS"
.PP
+23 -10
View File
@@ -86,14 +86,11 @@ operation is being performed on the command. The bit
\fBTCL_TRACE_DESTROYED\fR will be set in \fIflags\fR if the trace is about
to be destroyed; this information may be useful to \fIproc\fR so that
it can clean up its own internal data structures (see the section
\fBTCL_TRACE_DESTROYED\fR below for more details). Because the
deletion of commands can take place as part of the deletion of the interp
that contains them, \fIproc\fR must be careful about checking what
the passed in \fIinterp\fR value can be called upon to do.
The routine \fBTcl_InterpDeleted\fR is an important tool for this.
When \fBTcl_InterpDeleted\fR returns 1, \fIproc\fR will not be able
to invoke any scripts in \fIinterp\fR. The function of \fIproc\fR
in that circumstance is limited to the cleanup of its own data structures.
\fBTCL_TRACE_DESTROYED\fR below for more details). Lastly, the bit
\fBTCL_INTERP_DESTROYED\fR will be set if the entire interpreter is being
destroyed. When this bit is set, \fIproc\fR must be especially
careful in the things it does (see the section \fBTCL_INTERP_DESTROYED\fR
below).
.PP
\fBTcl_UntraceCommand\fR may be used to remove a trace. If the
command specified by \fIinterp\fR, \fIcmdName\fR, and \fIflags\fR has
@@ -126,8 +123,7 @@ traces for a given command that have the same \fIproc\fR.
.PP
During rename traces, the command being renamed is visible with both
names simultaneously, and the command still exists during delete
traces, unless the interp that contains it is being deleted.
However, there is no
traces (if \fBTCL_INTERP_DESTROYED\fR is not set). However, there is no
mechanism for signaling that an error occurred in a trace procedure,
so great care should be taken that errors do not get silently lost.
.SH "MULTIPLE TRACES"
@@ -146,5 +142,22 @@ rename the command, the last renaming takes precedence.
In a delete callback to \fIproc\fR, the \fBTCL_TRACE_DESTROYED\fR bit
is set in \fIflags\fR.
.\" Perhaps need some more comments here? - DKF
.SH "TCL_INTERP_DESTROYED"
.PP
When an interpreter is destroyed, unset traces are called for
all of its commands.
The \fBTCL_INTERP_DESTROYED\fR bit will be set in the \fIflags\fR
argument passed to the trace procedures.
Trace procedures must be extremely careful in what they do if
the \fBTCL_INTERP_DESTROYED\fR bit is set.
It is not safe for the procedures to invoke any Tcl procedures
on the interpreter, since its state is partially deleted.
All that trace procedures should do under these circumstances is
to clean up and free their own internal data structures.
.SH BUGS
.PP
Tcl does not do any error checking to prevent trace procedures
from misusing the interpreter during traces with \fBTCL_INTERP_DESTROYED\fR
set.
.SH KEYWORDS
clientData, trace, command
+66 -1
View File
@@ -269,13 +269,17 @@ present, as is done when launching applications under wish. It is desirable
to have console applications hidden and detached. This is a designed-in
limitation as \fBexec\fR wants to communicate over pipes. The Expect
extension addresses this issue when communicating with a TUI application.
.PP
.RE
.TP
\fBWindows NT\fR
.
When attempting to execute an application, \fBexec\fR first searches for
the name as it was specified. Then, in order, \fB.com\fR, \fB.exe\fR, and
\fB.bat\fR are appended to the end of the specified name and it searches
for the longer name. If a directory name was not specified as part of the
application name, the following directories are automatically searched in
order when attempting to locate the application:
.RS
.IP \(bu 3
The directory from which the Tcl executable was loaded.
.IP \(bu 3
@@ -295,6 +299,67 @@ the caller must prepend the desired command with
because built-in commands are not implemented using executables.
.RE
.TP
\fBWindows 9x\fR
.
When attempting to execute an application, \fBexec\fR first searches for
the name as it was specified. Then, in order, \fB.com\fR, \fB.exe\fR, and
\fB.bat\fR are appended to the end of the specified name and it searches
for the longer name. If a directory name was not specified as part of the
application name, the following directories are automatically searched in
order when attempting to locate the application:
.RS
.IP \(bu 3
The directory from which the Tcl executable was loaded.
.IP \(bu 3
The current directory.
.IP \(bu 3
The Windows 9x system directory.
.IP \(bu 3
The Windows 9x home directory.
.IP \(bu 3
The directories listed in the path.
.RE
.RS
.PP
In order to execute shell built-in commands like \fBdir\fR and \fBcopy\fR,
the caller must prepend the desired command with
.QW "\fBcommand.com /c\0\fR"
because built-in commands are not implemented using executables.
.PP
Once a 16-bit DOS application has read standard input from a console and
then quit, all subsequently run 16-bit DOS applications will see the
standard input as already closed. 32-bit applications do not have this
problem and will run correctly, even after a 16-bit DOS application thinks
that standard input is closed. There is no known workaround for this bug
at this time.
.PP
Redirection between the \fBNUL:\fR device and a 16-bit application does not
always work. When redirecting from \fBNUL:\fR, some applications may hang,
others will get an infinite stream of
.QW 0x01
bytes, and some will actually
correctly get an immediate end-of-file; the behavior seems to depend upon
something compiled into the application itself. When redirecting greater than
4K or so to \fBNUL:\fR, some applications will hang. The above problems do not
happen with 32-bit applications.
.PP
All DOS 16-bit applications are run synchronously. All standard input from
a pipe to a 16-bit DOS application is collected into a temporary file; the
other end of the pipe must be closed before the 16-bit DOS application
begins executing. All standard output or error from a 16-bit DOS
application to a pipe is collected into temporary files; the application
must terminate before the temporary files are redirected to the next stage
of the pipeline. This is due to a workaround for a Windows 95 bug in the
implementation of pipes, and is how the standard Windows 95 DOS shell
handles pipes itself.
.PP
Certain applications, such as \fBcommand.com\fR, should not be executed
interactively. Applications which directly access the console window,
rather than reading from their standard input and writing to their standard
output may fail, hang Tcl, or even hang the system if their own private
console window is not available to them.
.RE
.TP
\fBUnix\fR (including Mac OS X)
.
The \fBexec\fR command is fully functional and works as described.
+5 -3
View File
@@ -241,9 +241,11 @@ as relative to the cwd). Furthermore,
paths are always expanded
to absolute form. When creating links on filesystems that either do not
support any links, or do not support the specific type requested, an
error message will be returned. Most Unix platforms support both
symbolic and hard links (the latter for files only). Windows
supports symbolic directory links and hard file links on NTFS drives.
error message will be returned. In particular Windows 95, 98 and ME do
not support any links at present, but most Unix platforms support both
symbolic and hard links (the latter for files only) and Windows
NT/2000/XP (on NTFS drives) support symbolic
directory links and hard file links.
.RE
.TP
\fBfile lstat \fIname varName\fR
+7 -1
View File
@@ -204,7 +204,13 @@ of the form
it refers to the home
directory of the user whose account information resides on the specified NT
domain server. Otherwise, user account information is obtained from
the local computer.
the local computer. On Windows 95 and 98, \fBglob\fR accepted patterns
like
.QW .../
and
.QW ..../
for successively higher up parent directories, but later versions of
Windows do not accept these forms.
.PP
Since the backslash character has a special meaning to the glob
command, glob patterns containing Windows style path separators need
+3 -5
View File
@@ -96,11 +96,9 @@ forward to the proper implementation of the method (which it does by invoking
the \fBnext\fR command as filters are inserted into the front of the method
call chain) and is responsible for returning the result of \fBnext\fR.
.PP
Filters are invoked when processing an invokation of the \fBunknown\fR
method because of a failure to locate a method implementation, but \fInot\fR
when invoking either constructors or destructors. (Note however that the
\fBdestroy\fR method is a conventional method, and filters are invoked as
normal when it is called.)
Filters are not invoked when processing an invocation of the \fBunknown\fR
method because of a failure to locate a method implementation, or when
invoking either constructors or destructors.
.SH EXAMPLES
.PP
This example demonstrates how to use the \fBnext\fR command to call the
+48 -13
View File
@@ -361,28 +361,63 @@ may cause this error.
A BREAK condition has been detected by your UART (see above).
.SH "PORTABILITY ISSUES"
.TP
\fBWindows \fR
\fBWindows \fR(all versions)
.
Valid values for \fIfileName\fR to open a serial port are of the form
\fBcom\fIX\fB\fR, where \fIX\fR is a number, generally from 1 to 9.
A legacy form accepted as well is \fBcom\fIX\fB:\fR. This notation only
works for serial ports from 1 to 9. An attempt to open a serial port that
\fBcom\fIX\fB:\fR, where \fIX\fR is a number, generally from 1 to 4.
This notation only works for serial ports from 1 to 9, if the system
happens to have more than four. An attempt to open a serial port that
does not exist or has a number greater than 9 will fail. An alternate
form of opening serial ports is to use the filename \fB//./comX\fR,
where X is any number that corresponds to a serial port.
.PP
.RS
form of opening serial ports is to use the filename \fB\e\e.\ecomX\fR,
where X is any number that corresponds to a serial port; please note
that this method is considerably slower on Windows 95 and Windows 98.
.TP
\fBWindows NT\fR
.
When running Tcl interactively, there may be some strange interactions
between the real console, if one is present, and a command pipeline that uses
standard input or output. If a command pipeline is opened for reading, some
of the lines entered at the console will be sent to the command pipeline and
some will be sent to the Tcl evaluator. If a command pipeline is opened for
writing, keystrokes entered into the console are not visible until the
pipe is closed. These problems only occur because both Tcl and the child
application are competing for the console at the same time. If the command
pipeline is started from a script, so that Tcl is not accessing the console,
or if the command pipeline does not use standard input or output, but is
redirected from or to a file, then the above problems do not occur.
pipe is closed. This behavior occurs whether the command pipeline is
executing 16-bit or 32-bit applications. These problems only occur because
both Tcl and the child application are competing for the console at
the same time. If the command pipeline is started from a script, so that Tcl
is not accessing the console, or if the command pipeline does not use
standard input or output, but is redirected from or to a file, then the
above problems do not occur.
.TP
\fBWindows 95\fR
.
A command pipeline that executes a 16-bit DOS application cannot be opened
for both reading and writing, since 16-bit DOS applications that receive
standard input from a pipe and send standard output to a pipe run
synchronously. Command pipelines that do not execute 16-bit DOS
applications run asynchronously and can be opened for both reading and
writing.
.RS
.PP
When running Tcl interactively, there may be some strange interactions
between the real console, if one is present, and a command pipeline that uses
standard input or output. If a command pipeline is opened for reading from
a 32-bit application, some of the keystrokes entered at the console will be
sent to the command pipeline and some will be sent to the Tcl evaluator. If
a command pipeline is opened for writing to a 32-bit application, no output
is visible on the console until the pipe is closed. These problems only
occur because both Tcl and the child application are competing for the
console at the same time. If the command pipeline is started from a script,
so that Tcl is not accessing the console, or if the command pipeline does
not use standard input or output, but is redirected from or to a file, then
the above problems do not occur.
.PP
Whether or not Tcl is running interactively, if a command pipeline is opened
for reading from a 16-bit DOS application, the call to \fBopen\fR will not
return until end-of-file has been received from the command pipeline's
standard output. If a command pipeline is opened for writing to a 16-bit DOS
application, no data will be sent to the command pipeline's standard output
until the pipe is actually closed. This problem occurs because 16-bit DOS
applications are run synchronously, as described above.
.RE
.TP
\fBUnix\fR\0\0\0\0\0\0\0
+1 -25
View File
@@ -683,33 +683,9 @@ earlier in the RE taking priority over ones starting later. Note that
outer subexpressions thus take priority over their component
subexpressions.
.PP
The quantifiers \fB{1,1}\fR and \fB{1,1}?\fR can be used to
Note that the quantifiers \fB{1,1}\fR and \fB{1,1}?\fR can be used to
force longest and shortest preference, respectively, on a
subexpression or a whole RE.
.RS
.PP
\fBNOTE:\fR This means that you can usually make a RE be non-greedy overall by
putting \fB{1,1}?\fR after one of the first non-constraint atoms or
parenthesized sub-expressions in it. \fIIt pays to experiment\fR with the
placing of this non-greediness override on a suitable range of input texts
when you are writing a RE if you are using this level of complexity.
.PP
For example, this regular expression is non-greedy, and will match the
shortest substring possible given that
.QW \fBabc\fR
will be matched as early as possible (the quantifier does not change that):
.PP
.CS
ab{1,1}?c.*x.*cba
.CE
.PP
The atom
.QW \fBa\fR
has no greediness preference, we explicitly give one for
.QW \fBb\fR ,
and the remaining quantifiers are overridden to be non-greedy by the preceding
non-greedy quantifier.
.RE
.PP
Match lengths are measured in characters, not collating elements. An
empty string is considered longer than no match at all. For example,
-8
View File
@@ -97,10 +97,6 @@ writable channel event on the socket to get notified when the
asynchronous connection has succeeded or failed. See the \fBvwait\fR
and the \fBchan\fR commands for more details on the event loop and
channel events.
.PP
The \fBchan configure\fR option \fB-connecting\fR may be used to check if the connect is still running. To verify a successful connect, the option \fB-error\fR may be checked when \fB-connecting\fR returned 0.
.PP
Operation without the event queue requires at the moment calls to \fBchan configure\fR to advance the internal state machine.
.RE
.SH "SERVER SOCKETS"
.PP
@@ -190,10 +186,6 @@ sockets, this option returns a list of three elements; these are the
address, the host name and the port to which the peer socket is connected
or bound. If the host name cannot be computed, the second element of the
list is identical to the address, its first element.
.TP
\fB\-connecting\fR
.
This option is not supported by server sockets. For client sockets, this option returns 1 if an asyncroneous connect is still in progress, 0 otherwise.
.PP
.SH "EXAMPLES"
.PP
-15
View File
@@ -19,21 +19,6 @@ string \- Manipulate strings
Performs one of several string operations, depending on \fIoption\fR.
The legal \fIoption\fRs (which may be abbreviated) are:
.TP
\fBstring cat\fR ?\fIstring1\fR? ?\fIstring2...\fR?
.VS 8.6.2
Concatenate the given \fIstring\fRs just like placing them directly
next to each other and return the resulting compound string. If no
\fIstring\fRs are present, the result is an empty string.
.RS
.PP
This primitive is occasionally handier than juxtaposition of strings
when mixed quoting is wanted, or when the aim is to return the result
of a concatenation without resorting to \fBreturn\fR \fB\-level 0\fR,
and is more efficient than building a list of arguments and using
\fBjoin\fR with an empty join string.
.RE
.VE
.TP
\fBstring compare\fR ?\fB\-nocase\fR? ?\fB\-length\fI length\fR? \fIstring1 string2\fR
.
Perform a character-by-character comparison of strings \fIstring1\fR
+8
View File
@@ -642,6 +642,14 @@ This test can only be run on any Windows platform.
.
This test can only be run on any Windows NT platform.
.TP
\fI95\fR
.
This test can only be run on any Windows 95 platform.
.TP
\fI98\fR
.
This test can only be run on any Windows 98 platform.
.TP
\fImac\fR
.
This test can only be run on any Mac platform.
+7 -2
View File
@@ -308,13 +308,18 @@ is the value returned by \fBuname -m\fR.
\fBos\fR
.
The name of the operating system running on this machine,
such as \fBWindows NT\fR or \fBSunOS\fR.
such as \fBWindows 95\fR, \fBWindows NT\fR, or \fBSunOS\fR.
On UNIX machines, this is the value returned by \fBuname -s\fR.
On Windows 95 and Windows 98, the value returned will be \fBWindows
95\fR to provide better backwards compatibility to Windows 95; to
distinguish between the two, check the \fBosVersion\fR.
.TP
\fBosVersion\fR
.
The version number for the operating system running on this machine.
On UNIX machines, this is the value returned by \fBuname -r\fR.
On UNIX machines, this is the value returned by \fBuname -r\fR. On
Windows 95, the version will be 4.0; on Windows 98, the version will
be 4.10.
.TP
\fBpathSeparator\fR
.VS 8.6
+7 -7
View File
@@ -996,13 +996,13 @@ parseqatom(
switch (v->nexttype) {
case '*':
m = 0;
n = DUPINF;
n = INFINITY;
qprefer = (v->nextvalue) ? LONGER : SHORTER;
NEXT();
break;
case '+':
m = 1;
n = DUPINF;
n = INFINITY;
qprefer = (v->nextvalue) ? LONGER : SHORTER;
NEXT();
break;
@@ -1019,7 +1019,7 @@ parseqatom(
if (SEE(DIGIT)) {
n = scannum(v);
} else {
n = DUPINF;
n = INFINITY;
}
if (m > n) {
ERR(REG_BADBR);
@@ -1217,8 +1217,8 @@ parseqatom(
*/
dupnfa(v->nfa, atom->begin, atom->end, s, atom->begin);
assert(m >= 1 && m != DUPINF && n >= 1);
repeat(v, s, atom->begin, m-1, (n == DUPINF) ? n : n-1);
assert(m >= 1 && m != INFINITY && n >= 1);
repeat(v, s, atom->begin, m-1, (n == INFINITY) ? n : n-1);
f = COMBINE(qprefer, atom->flags);
t = subre(v, '.', f, s, atom->end); /* prefix and atom */
NOERR();
@@ -1323,7 +1323,7 @@ repeat(
#define SOME 2
#define INF 3
#define PAIR(x, y) ((x)*4 + (y))
#define REDUCE(x) ( ((x) == DUPINF) ? INF : (((x) > 1) ? SOME : (x)) )
#define REDUCE(x) ( ((x) == INFINITY) ? INF : (((x) > 1) ? SOME : (x)) )
const int rm = REDUCE(m);
const int rn = REDUCE(n);
struct state *s, *s2;
@@ -2108,7 +2108,7 @@ stdump(
}
if (t->min != 1 || t->max != 1) {
fprintf(f, " {%d,", t->min);
if (t->max != DUPINF) {
if (t->max != INFINITY) {
fprintf(f, "%d", t->max);
}
fprintf(f, "}");
+2 -2
View File
@@ -1122,7 +1122,7 @@ complicatedBackrefDissect(
*/
i = 0;
for (p = begin; p <= stop && (i < max || max == DUPINF); p += len) {
for (p = begin; p <= stop && (i < max || max == INFINITY); p += len) {
if (v->g->compare(paren, p, len) != 0) {
break;
}
@@ -1137,7 +1137,7 @@ complicatedBackrefDissect(
if (p != end) { /* didn't consume all of it */
return REG_NOMATCH;
}
if (min <= i && (i <= max || max == DUPINF)) {
if (min <= i && (i <= max || max == INFINITY)) {
return REG_OKAY;
}
return REG_NOMATCH; /* out of range */
+1 -1
View File
@@ -99,7 +99,7 @@
#define xxx 1
#define DUPMAX _POSIX2_RE_DUP_MAX
#define DUPINF (DUPMAX+1)
#define INFINITY (DUPMAX+1)
#define REMAGIC 0xfed7 /* magic number for main struct */
-5
View File
@@ -2326,11 +2326,6 @@ declare 630 {
# ----- BASELINE -- FOR -- 8.6.0 ----- #
# TIP #435
declare 631 {
void Tcl_MutexUnlockAndFinalize(Tcl_Mutex *mutex)
}
##############################################################################
# Define the platform specific public Tcl interface. These functions are only
+24 -27
View File
@@ -56,10 +56,10 @@ extern "C" {
#define TCL_MAJOR_VERSION 8
#define TCL_MINOR_VERSION 6
#define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE
#define TCL_RELEASE_SERIAL 4
#define TCL_RELEASE_SERIAL 1
#define TCL_VERSION "8.6"
#define TCL_PATCH_LEVEL "8.6.4"
#define TCL_PATCH_LEVEL "8.6.1"
/*
*----------------------------------------------------------------------------
@@ -76,6 +76,16 @@ extern "C" {
# endif
#endif
/*
* STRICT: See MSDN Article Q83456
*/
#ifdef _WIN32
# ifndef STRICT
# define STRICT
# endif
#endif /* _WIN32 */
/*
* Utility macros: STRINGIFY takes an argument and wraps it in "" (double
* quotation marks), JOIN joins two arguments.
@@ -392,12 +402,16 @@ typedef long LONG;
* Don't know what platform it is and configure hasn't discovered what is
* going on for us. Try to guess...
*/
# include <limits.h>
# if (INT_MAX < LONG_MAX)
# define TCL_WIDE_INT_IS_LONG 1
# else
# define TCL_WIDE_INT_TYPE long long
# endif
# ifdef NO_LIMITS_H
# error please define either TCL_WIDE_INT_TYPE or TCL_WIDE_INT_IS_LONG
# else /* !NO_LIMITS_H */
# include <limits.h>
# if (INT_MAX < LONG_MAX)
# define TCL_WIDE_INT_IS_LONG 1
# else
# define TCL_WIDE_INT_TYPE long long
# endif
# endif /* NO_LIMITS_H */
# endif /* _WIN32 */
#endif /* !TCL_WIDE_INT_TYPE & !TCL_WIDE_INT_IS_LONG */
#ifdef TCL_WIDE_INT_IS_LONG
@@ -2130,28 +2144,11 @@ typedef struct Tcl_EncodingType {
* substituting one or more "close" characters in
* the destination buffer and then continue to
* convert the source.
* TCL_ENCODING_NO_TERMINATE - If set, Tcl_ExternalToUtf will not append a
* terminating NUL byte. Knowing that it will
* not need space to do so, it will fill all
* dstLen bytes with encoded UTF-8 content, as
* other circumstances permit. If clear, the
* default behavior is to reserve a byte in
* the dst space for NUL termination, and to
* append the NUL byte.
* TCL_ENCODING_CHAR_LIMIT - If set and dstCharsPtr is not NULL, then
* Tcl_ExternalToUtf takes the initial value
* of *dstCharsPtr is taken as a limit of the
* maximum number of chars to produce in the
* encoded UTF-8 content. Otherwise, the
* number of chars produced is controlled only
* by other limiting factors.
*/
#define TCL_ENCODING_START 0x01
#define TCL_ENCODING_END 0x02
#define TCL_ENCODING_STOPONERROR 0x04
#define TCL_ENCODING_NO_TERMINATE 0x08
#define TCL_ENCODING_CHAR_LIMIT 0x10
/*
* The following definitions are the error codes returned by the conversion
@@ -2422,7 +2419,9 @@ EXTERN void Tcl_MainEx(int argc, char **argv,
Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
const char *version, int exact);
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
#endif
/*
*----------------------------------------------------------------------------
@@ -2592,8 +2591,6 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
#define Tcl_MutexLock(mutexPtr)
#undef Tcl_MutexUnlock
#define Tcl_MutexUnlock(mutexPtr)
#undef Tcl_MutexUnlockAndFinalize
#define Tcl_MutexUnlockAndFinalize(mutexPtr)
#undef Tcl_MutexFinalize
#define Tcl_MutexFinalize(mutexPtr)
#undef Tcl_ConditionNotify
+1 -1
View File
@@ -31,7 +31,7 @@
* until Tcl uses config.h properly.
*/
#if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__)
#if defined(_MSC_VER) || defined(__MINGW32__) || defined(__BORLANDC__)
typedef unsigned long caddr_t;
#endif
+26 -72
View File
@@ -840,9 +840,7 @@ Tcl_CreateInterp(void)
*/
Tcl_CreateObjCommand(interp, "::tcl::unsupported::disassemble",
Tcl_DisassembleObjCmd, INT2PTR(0), NULL);
Tcl_CreateObjCommand(interp, "::tcl::unsupported::getbytecode",
Tcl_DisassembleObjCmd, INT2PTR(1), NULL);
Tcl_DisassembleObjCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "::tcl::unsupported::representation",
Tcl_RepresentationCmd, NULL, NULL);
@@ -4142,9 +4140,8 @@ TclNREvalObjv(
/*
* data[1] stores a marker for use by tailcalls; it will be set to 1 by
* command redirectors (imports, alias, ensembles) so that tailcall skips
* this callback (that marks the end of the target command) and goes back
* to the end of the source command.
* command redirectors (imports, alias, ensembles) so that tailcalls
* finishes the source command and not just the target.
*/
if (iPtr->deferredCallbacks) {
@@ -4407,7 +4404,7 @@ NRCommand(
iPtr->numLevels--;
/*
* If there is a tailcall, schedule it next
* If there is a tailcall, schedule it
*/
if (data[1] && (data[1] != INT2PTR(1))) {
@@ -8171,31 +8168,27 @@ Tcl_NRCmdSwap(
}
/*****************************************************************************
* Tailcall related code
* Stuff for tailcalls
*****************************************************************************
*
* The steps of the tailcall dance are as follows:
* Just to show that IT CAN BE DONE! The precise semantics are not simple,
* require more thought. Possibly need a new Tcl return code to do it right?
* Questions include:
* (1) How is the objc/objv tailcall to be run? My current thinking is that
* it should essentially be
* [tailcall a b c] <=> [uplevel 1 [list a b c]]
* with two caveats
* (a) the current frame is dropped first, after running all pending
* cleanup tasks and saving its namespace
* (b) 'a' is looked up in the returning frame's namespace, but the
* command is run in the context to which we are returning
* Current implementation does this if [tailcall] is called from within
* a proc, errors otherwise.
* (2) Should a tailcall bypass [catch] in the returning frame? Current
* implementation does not (or does it? Changed, test!) - it causes an
* error.
*
* 1. when [tailcall] is invoked, it stores the corresponding callback in
* the current CallFrame and returns TCL_RETURN
* 2. when the CallFrame is popped, it calls TclSetTailcall to store the
* callback in the proper NRCommand callback - the spot where the command
* that pushed the CallFrame is completely cleaned up
* 3. when the NRCommand callback runs, it schedules the tailcall callback
* to run immediately after it returns
*
* One delicate point is to properly define the NRCommand where the tailcall
* will execute. There are functions whose purpose is to help define the
* precise spot:
* TclMarkTailcall: if the NEXT command to be pushed tailcalls, execution
* should continue right here
* TclSkipTailcall: if the NEXT command to be pushed tailcalls, execution
* should continue after the CURRENT command is fully returned ("skip
* the next command: we are redirecting to it, tailcalls should run
* after WE return")
* TclPushTailcallPoint: the search for a tailcalling spot cannot traverse
* this point. This is special for OO, as some of the oo constructs
* that behave like commands may not push an NRCommand callback.
* FIXME NRE!
*/
void
@@ -8229,18 +8222,6 @@ TclPushTailcallPoint(
((Interp *) interp)->numLevels++;
}
/*
*----------------------------------------------------------------------
*
* TclSetTailcall --
*
* Splice a tailcall command in the proper spot of the NRE callback
* stack, so that it runs at the right time.
*
*----------------------------------------------------------------------
*/
void
TclSetTailcall(
Tcl_Interp *interp,
@@ -8265,23 +8246,6 @@ TclSetTailcall(
runPtr->data[1] = listPtr;
}
/*
*----------------------------------------------------------------------
*
* TclNRTailcallObjCmd --
*
* Prepare the tailcall as a list and store it in the current
* varFrame. When the frame is later popped the tailcall will be spliced
* at the proper place.
*
* Results:
* The first NRCommand callback that is not marked to be skipped is
* updated so that its data[1] field contains the tailcall list.
*
*----------------------------------------------------------------------
*/
int
TclNRTailcallObjCmd(
ClientData clientData,
@@ -8296,9 +8260,9 @@ TclNRTailcallObjCmd(
return TCL_ERROR;
}
if (!(iPtr->varFramePtr->isProcCallFrame & 1)) {
if (!(iPtr->varFramePtr->isProcCallFrame & 1)) { /* or is upleveled */
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"tailcall can only be called from a proc, lambda or method", -1));
"tailcall can only be called from a proc or lambda", -1));
Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);
return TCL_ERROR;
}
@@ -8316,7 +8280,8 @@ TclNRTailcallObjCmd(
/*
* Create the callback to actually evaluate the tailcalled
* command, then set it in the varFrame so that PopCallFrame can use it
* at the proper time.
* at the proper time. Being lazy: exploit the TclNRAddCallBack macro to
* build the callback.
*/
if (objc > 1) {
@@ -8341,17 +8306,6 @@ TclNRTailcallObjCmd(
return TCL_RETURN;
}
/*
*----------------------------------------------------------------------
*
* TclNRTailcallEval --
*
* This NREcallback actually causes the tailcall to be evaluated.
*
*----------------------------------------------------------------------
*/
int
TclNRTailcallEval(
ClientData data[],
-54
View File
@@ -2835,59 +2835,6 @@ StringCmpCmd(
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* StringCatCmd --
*
* This procedure is invoked to process the "string cat" Tcl command.
* See the user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
StringCatCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int i;
Tcl_Obj *objResultPtr;
if (objc < 2) {
/*
* If there are no args, the result is an empty object.
* Just leave the preset empty interp result.
*/
return TCL_OK;
}
if (objc == 2) {
/*
* Other trivial case, single arg, just return it.
*/
Tcl_SetObjResult(interp, objv[1]);
return TCL_OK;
}
objResultPtr = objv[1];
if (Tcl_IsShared(objResultPtr)) {
objResultPtr = Tcl_DuplicateObj(objResultPtr);
}
for(i = 2;i < objc;i++) {
Tcl_AppendObjToObj(objResultPtr, objv[i]);
}
Tcl_SetObjResult(interp, objResultPtr);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
@@ -3383,7 +3330,6 @@ TclInitStringCmd(
{
static const EnsembleImplMap stringImplMap[] = {
{"bytelength", StringBytesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"cat", StringCatCmd, TclCompileStringCatCmd, NULL, NULL, 0},
{"compare", StringCmpCmd, TclCompileStringCmpCmd, NULL, NULL, 0},
{"equal", StringEqualCmd, TclCompileStringEqualCmd, NULL, NULL, 0},
{"first", StringFirstCmd, TclCompileStringFirstCmd, NULL, NULL, 0},
+112 -231
View File
@@ -26,23 +26,14 @@ static void FreeDictUpdateInfo(ClientData clientData);
static void PrintDictUpdateInfo(ClientData clientData,
Tcl_Obj *appendObj, ByteCode *codePtr,
unsigned int pcOffset);
static void DisassembleDictUpdateInfo(ClientData clientData,
Tcl_Obj *dictObj, ByteCode *codePtr,
unsigned int pcOffset);
static ClientData DupForeachInfo(ClientData clientData);
static void FreeForeachInfo(ClientData clientData);
static void PrintForeachInfo(ClientData clientData,
Tcl_Obj *appendObj, ByteCode *codePtr,
unsigned int pcOffset);
static void DisassembleForeachInfo(ClientData clientData,
Tcl_Obj *dictObj, ByteCode *codePtr,
unsigned int pcOffset);
static void PrintNewForeachInfo(ClientData clientData,
Tcl_Obj *appendObj, ByteCode *codePtr,
unsigned int pcOffset);
static void DisassembleNewForeachInfo(ClientData clientData,
Tcl_Obj *dictObj, ByteCode *codePtr,
unsigned int pcOffset);
static int CompileEachloopCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
CompileEnv *envPtr, int collect);
@@ -58,24 +49,21 @@ const AuxDataType tclForeachInfoType = {
"ForeachInfo", /* name */
DupForeachInfo, /* dupProc */
FreeForeachInfo, /* freeProc */
PrintForeachInfo, /* printProc */
DisassembleForeachInfo /* disassembleProc */
PrintForeachInfo /* printProc */
};
const AuxDataType tclNewForeachInfoType = {
"NewForeachInfo", /* name */
DupForeachInfo, /* dupProc */
FreeForeachInfo, /* freeProc */
PrintNewForeachInfo, /* printProc */
DisassembleNewForeachInfo /* disassembleProc */
PrintNewForeachInfo /* printProc */
};
const AuxDataType tclDictUpdateInfoType = {
"DictUpdateInfo", /* name */
DupDictUpdateInfo, /* dupProc */
FreeDictUpdateInfo, /* freeProc */
PrintDictUpdateInfo, /* printProc */
DisassembleDictUpdateInfo /* disassembleProc */
PrintDictUpdateInfo /* printProc */
};
/*
@@ -177,9 +165,9 @@ TclCompileAppendCmd(
*/
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
localIndex = LocalScalarFromToken(varTokenPtr, envPtr);
if (localIndex < 0) {
PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT,
&localIndex, &isScalar, 1);
if (!isScalar || localIndex < 0) {
return TCL_ERROR;
}
@@ -301,8 +289,7 @@ TclCompileArraySetCmd(
* a proc, we cannot do a better compile than generic.
*/
if ((varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) ||
(envPtr->procPtr == NULL && !(isDataEven && len == 0))) {
if (envPtr->procPtr == NULL && !(isDataEven && len == 0)) {
code = TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
goto done;
}
@@ -343,9 +330,8 @@ TclCompileArraySetCmd(
* a non-local variable: upvar from a local one! This consumes the
* variable name that was left at stacktop.
*/
localIndex = TclFindCompiledLocal(varTokenPtr->start,
varTokenPtr->size, 1, envPtr);
localIndex = AnonymousLocal(envPtr);
PushStringLiteral(envPtr, "0");
TclEmitInstInt4(INST_REVERSE, 2, envPtr);
TclEmitInstInt4(INST_UPVAR, localIndex, envPtr);
@@ -2098,13 +2084,11 @@ TclCompileDictWithCmd(
* DupDictUpdateInfo: a copy of the auxiliary data
* FreeDictUpdateInfo: none
* PrintDictUpdateInfo: none
* DisassembleDictUpdateInfo: none
*
* Side effects:
* DupDictUpdateInfo: allocates memory
* FreeDictUpdateInfo: releases memory
* PrintDictUpdateInfo: none
* DisassembleDictUpdateInfo: none
*
*----------------------------------------------------------------------
*/
@@ -2147,25 +2131,6 @@ PrintDictUpdateInfo(
Tcl_AppendPrintfToObj(appendObj, "%%v%u", duiPtr->varIndices[i]);
}
}
static void
DisassembleDictUpdateInfo(
ClientData clientData,
Tcl_Obj *dictObj,
ByteCode *codePtr,
unsigned int pcOffset)
{
DictUpdateInfo *duiPtr = clientData;
int i;
Tcl_Obj *variables = Tcl_NewObj();
for (i=0 ; i<duiPtr->length ; i++) {
Tcl_ListObjAppendElement(NULL, variables,
Tcl_NewIntObj(duiPtr->varIndices[i]));
}
Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("variables", -1),
variables);
}
/*
*----------------------------------------------------------------------
@@ -2403,6 +2368,7 @@ TclCompileForCmd(
SetLineInformation(2);
TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
TclClearNumConversion(envPtr);
jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
if (jumpDist > 127) {
@@ -2527,16 +2493,24 @@ CompileEachloopCmd(
* (TCL_EACH_*) */
{
Proc *procPtr = envPtr->procPtr;
ForeachInfo *infoPtr=NULL; /* Points to the structure describing this
ForeachInfo *infoPtr; /* Points to the structure describing this
* foreach command. Stored in a AuxData
* record in the ByteCode. */
Tcl_Token *tokenPtr, *bodyTokenPtr;
int jumpBackOffset, infoIndex, range;
int numWords, numLists, i, j, code = TCL_OK;
Tcl_Obj *varListObj = NULL;
int numWords, numLists, numVars, loopIndex, i, j, code;
DefineLineInformation; /* TIP #280 */
/*
* We parse the variable list argument words and create two arrays:
* varcList[i] is number of variables in i-th var list.
* varvList[i] points to array of var names in i-th var list.
*/
int *varcList;
const char ***varvList;
/*
* If the foreach command isn't in a procedure, don't compile it inline:
* the payoff is too small.
@@ -2565,73 +2539,105 @@ CompileEachloopCmd(
}
/*
* Create and initialize the ForeachInfo and ForeachVarList data
* structures describing this command. Then create a AuxData record
* pointing to the ForeachInfo structure.
* Allocate storage for the varcList and varvList arrays if necessary.
*/
numLists = (numWords - 2)/2;
infoPtr = ckalloc(sizeof(ForeachInfo)
+ (numLists - 1) * sizeof(ForeachVarList *));
infoPtr->numLists = 0; /* Count this up as we go */
varcList = TclStackAlloc(interp, numLists * sizeof(int));
memset(varcList, 0, numLists * sizeof(int));
varvList = (const char ***) TclStackAlloc(interp,
numLists * sizeof(const char **));
memset((char*) varvList, 0, numLists * sizeof(const char **));
/*
* Parse each var list into sequence of var names. Don't
* Break up each var list and set the varcList and varvList arrays. Don't
* compile the foreach inline if any var name needs substitutions or isn't
* a scalar, or if any var list needs substitutions.
*/
varListObj = Tcl_NewObj();
loopIndex = 0;
for (i = 0, tokenPtr = parsePtr->tokenPtr;
i < numWords-1;
i++, tokenPtr = TokenAfter(tokenPtr)) {
ForeachVarList *varListPtr;
int numVars;
Tcl_DString varList;
if (i%2 != 1) {
continue;
}
/*
* If the variable list is empty, we can enter an infinite loop when
* the interpreted version would not. Take care to ensure this does
* not happen. [Bug 1671138]
*/
if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) ||
TCL_OK != Tcl_ListObjLength(NULL, varListObj, &numVars) ||
numVars == 0) {
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
code = TCL_ERROR;
goto done;
}
varListPtr = ckalloc(sizeof(ForeachVarList)
+ (numVars - 1) * sizeof(int));
varListPtr->numVars = numVars;
infoPtr->varLists[i/2] = varListPtr;
infoPtr->numLists++;
/*
* Lots of copying going on here. Need a ListObj wizard to show a
* better way.
*/
Tcl_DStringInit(&varList);
TclDStringAppendToken(&varList, &tokenPtr[1]);
code = Tcl_SplitList(NULL, Tcl_DStringValue(&varList),
&varcList[loopIndex], &varvList[loopIndex]);
Tcl_DStringFree(&varList);
if (code != TCL_OK) {
code = TCL_ERROR;
goto done;
}
numVars = varcList[loopIndex];
/*
* If the variable list is empty, we can enter an infinite loop when
* the interpreted version would not. Take care to ensure this does
* not happen. [Bug 1671138]
*/
if (numVars == 0) {
code = TCL_ERROR;
goto done;
}
for (j = 0; j < numVars; j++) {
Tcl_Obj *varNameObj;
const char *bytes;
int numBytes, varIndex;
const char *varName = varvList[loopIndex][j];
Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj);
bytes = Tcl_GetStringFromObj(varNameObj, &numBytes);
varIndex = LocalScalar(bytes, numBytes, envPtr);
if (varIndex < 0) {
if (!TclIsLocalScalar(varName, (int) strlen(varName))) {
code = TCL_ERROR;
goto done;
}
varListPtr->varIndexes[j] = varIndex;
}
Tcl_SetObjLength(varListObj, 0);
loopIndex++;
}
/*
* We will compile the foreach command.
*/
code = TCL_OK;
/*
* Create and initialize the ForeachInfo and ForeachVarList data
* structures describing this command. Then create a AuxData record
* pointing to the ForeachInfo structure.
*/
infoPtr = ckalloc(sizeof(ForeachInfo)
+ (numLists - 1) * sizeof(ForeachVarList *));
infoPtr->numLists = numLists;
for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
ForeachVarList *varListPtr;
numVars = varcList[loopIndex];
varListPtr = ckalloc(sizeof(ForeachVarList)
+ (numVars - 1) * sizeof(int));
varListPtr->numVars = numVars;
for (j = 0; j < numVars; j++) {
const char *varName = varvList[loopIndex][j];
int nameChars = strlen(varName);
varListPtr->varIndexes[j] = TclFindCompiledLocal(varName,
nameChars, /*create*/ 1, envPtr);
}
infoPtr->varLists[loopIndex] = varListPtr;
}
infoIndex = TclCreateAuxData(infoPtr, &tclNewForeachInfoType, envPtr);
/*
@@ -2703,14 +2709,13 @@ CompileEachloopCmd(
}
done:
if (code == TCL_ERROR) {
if (infoPtr) {
FreeForeachInfo(infoPtr);
for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
if (varvList[loopIndex] != NULL) {
ckfree(varvList[loopIndex]);
}
}
if (varListObj) {
Tcl_DecrRefCount(varListObj);
}
TclStackFree(interp, (void *)varvList);
TclStackFree(interp, varcList);
return code;
}
@@ -2804,10 +2809,10 @@ FreeForeachInfo(
/*
*----------------------------------------------------------------------
*
* PrintForeachInfo, DisassembleForeachInfo --
* PrintForeachInfo --
*
* Functions to write a human-readable or script-readablerepresentation
* of a ForeachInfo structure to a Tcl_Obj for debugging.
* Function to write a human-readable representation of a ForeachInfo
* structure to stdout for debugging.
*
* Results:
* None.
@@ -2887,89 +2892,6 @@ PrintNewForeachInfo(
Tcl_AppendToObj(appendObj, "]", -1);
}
}
static void
DisassembleForeachInfo(
ClientData clientData,
Tcl_Obj *dictObj,
ByteCode *codePtr,
unsigned int pcOffset)
{
register ForeachInfo *infoPtr = clientData;
register ForeachVarList *varsPtr;
int i, j;
Tcl_Obj *objPtr, *innerPtr;
/*
* Data stores.
*/
objPtr = Tcl_NewObj();
for (i=0 ; i<infoPtr->numLists ; i++) {
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewIntObj(infoPtr->firstValueTemp + i));
}
Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("data", -1), objPtr);
/*
* Loop counter.
*/
Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("loop", -1),
Tcl_NewIntObj(infoPtr->loopCtTemp));
/*
* Assignment targets.
*/
objPtr = Tcl_NewObj();
for (i=0 ; i<infoPtr->numLists ; i++) {
innerPtr = Tcl_NewObj();
varsPtr = infoPtr->varLists[i];
for (j=0 ; j<varsPtr->numVars ; j++) {
Tcl_ListObjAppendElement(NULL, innerPtr,
Tcl_NewIntObj(varsPtr->varIndexes[j]));
}
Tcl_ListObjAppendElement(NULL, objPtr, innerPtr);
}
Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", -1), objPtr);
}
static void
DisassembleNewForeachInfo(
ClientData clientData,
Tcl_Obj *dictObj,
ByteCode *codePtr,
unsigned int pcOffset)
{
register ForeachInfo *infoPtr = clientData;
register ForeachVarList *varsPtr;
int i, j;
Tcl_Obj *objPtr, *innerPtr;
/*
* Jump offset.
*/
Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("jumpOffset", -1),
Tcl_NewIntObj(infoPtr->loopCtTemp));
/*
* Assignment targets.
*/
objPtr = Tcl_NewObj();
for (i=0 ; i<infoPtr->numLists ; i++) {
innerPtr = Tcl_NewObj();
varsPtr = infoPtr->varLists[i];
for (j=0 ; j<varsPtr->numVars ; j++) {
Tcl_ListObjAppendElement(NULL, innerPtr,
Tcl_NewIntObj(varsPtr->varIndexes[j]));
}
Tcl_ListObjAppendElement(NULL, objPtr, innerPtr);
}
Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", -1), objPtr);
}
/*
*----------------------------------------------------------------------
@@ -3192,54 +3114,6 @@ TclCompileFormatCmd(
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclLocalScalarFromToken --
*
* Get the index into the table of compiled locals that corresponds
* to a local scalar variable name.
*
* Results:
* Returns the non-negative integer index value into the table of
* compiled locals corresponding to a local scalar variable name.
* If the arguments passed in do not identify a local scalar variable
* then return -1.
*
* Side effects:
* May add an entery into the table of compiled locals.
*
*----------------------------------------------------------------------
*/
int
TclLocalScalarFromToken(
Tcl_Token *tokenPtr,
CompileEnv *envPtr)
{
int isScalar, index;
TclPushVarName(NULL, tokenPtr, envPtr, TCL_NO_ELEMENT, &index, &isScalar);
if (!isScalar) {
index = -1;
}
return index;
}
int
TclLocalScalar(
const char *bytes,
int numBytes,
CompileEnv *envPtr)
{
Tcl_Token token[2] = {{TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1},
{TCL_TOKEN_TEXT, NULL, 0, 0}};
token[1].start = bytes;
token[1].size = numBytes;
return TclLocalScalarFromToken(token, envPtr);
}
/*
*----------------------------------------------------------------------
*
@@ -3298,7 +3172,16 @@ TclPushVarName(
nameChars = elNameChars = 0;
localIndex = -1;
if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
/*
* Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether
* curly braces surround the variable name. This really matters for array
* elements to handle things like
* set {x($foo)} 5
* which raises an undefined var error if we are not careful here.
*/
if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
(varTokenPtr->start[0] != '{')) {
/*
* A simple variable name. Divide it up into "name" and "elName"
* strings. If it is not a local variable, look it up at runtime.
@@ -3322,7 +3205,7 @@ TclPushVarName(
}
}
if (!(flags & TCL_NO_ELEMENT) && (elName != NULL) && elNameChars) {
if ((elName != NULL) && elNameChars) {
/*
* An array element, the element name is a simple string:
* assemble the corresponding token.
@@ -3337,7 +3220,7 @@ TclPushVarName(
elemTokenCount = 1;
}
}
} else if (interp && ((n = varTokenPtr->numComponents) > 1)
} else if (((n = varTokenPtr->numComponents) > 1)
&& (varTokenPtr[1].type == TCL_TOKEN_TEXT)
&& (varTokenPtr[n].type == TCL_TOKEN_TEXT)
&& (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {
@@ -3373,10 +3256,9 @@ TclPushVarName(
nameChars = p - varTokenPtr[1].start;
elName = p + 1;
remainingChars = (varTokenPtr[2].start - p) - 1;
elNameChars = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 1;
elNameChars = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 2;
if (!(flags & TCL_NO_ELEMENT)) {
if (remainingChars) {
if (remainingChars) {
/*
* Make a first token with the extra characters in the first
* token.
@@ -3396,14 +3278,13 @@ TclPushVarName(
memcpy(elemTokenPtr+1, varTokenPtr+2,
(n-1) * sizeof(Tcl_Token));
} else {
} else {
/*
* Use the already available tokens.
*/
elemTokenPtr = &varTokenPtr[2];
elemTokenCount = n - 1;
}
}
}
}
@@ -3438,7 +3319,7 @@ TclPushVarName(
localIndex = -1;
}
}
if (interp && localIndex < 0) {
if (localIndex < 0) {
PushLiteral(envPtr, name, nameChars);
}
@@ -3455,7 +3336,7 @@ TclPushVarName(
PushStringLiteral(envPtr, "");
}
}
} else if (interp) {
} else {
/*
* The var name isn't simple: compile and push it.
*/
+31 -29
View File
@@ -281,6 +281,7 @@ TclCompileIfCmd(
SetLineInformation(wordIdx);
Tcl_ResetResult(interp);
TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
TclClearNumConversion(envPtr);
if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
TclExpandJumpFixupArray(&jumpFalseFixupArray);
}
@@ -530,6 +531,7 @@ TclCompileIncrCmd(
} else {
SetLineInformation(2);
CompileTokens(envPtr, incrTokenPtr, interp);
TclClearNumConversion(envPtr);
}
} else { /* No incr amount given so use 1. */
haveImmValue = 1;
@@ -871,7 +873,7 @@ TclCompileLappendCmd(
/* TODO: Consider support for compiling expanded args. */
numWords = parsePtr->numWords;
if (numWords < 3) {
if (numWords == 1) {
return TCL_ERROR;
}
@@ -1210,7 +1212,20 @@ TclCompileListCmd(
valueTokenPtr = TokenAfter(valueTokenPtr);
}
if (listObj != NULL) {
TclEmitPush(TclAddLiteralObj(envPtr, listObj, NULL), envPtr);
int len;
const char *bytes = Tcl_GetStringFromObj(listObj, &len);
PushLiteral(envPtr, bytes, len);
Tcl_DecrRefCount(listObj);
if (len > 0) {
/*
* Force list interpretation!
*/
TclEmitOpcode( INST_DUP, envPtr);
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
TclEmitOpcode( INST_POP, envPtr);
}
return TCL_OK;
}
@@ -1465,7 +1480,7 @@ TclCompileLreplaceCmd(
Tcl_Token *tokenPtr, *listTokenPtr;
DefineLineInformation; /* TIP #280 */
Tcl_Obj *tmpObj;
int idx1, idx2, i, offset, offset2;
int idx1, idx2, i, offset;
if (parsePtr->numWords < 4) {
return TCL_ERROR;
@@ -1488,10 +1503,6 @@ TclCompileLreplaceCmd(
return TCL_ERROR;
}
if(idx2 != INDEX_END && idx2 < idx1) {
idx2 = idx1-1;
}
/*
* Work out what this [lreplace] is actually doing.
*/
@@ -1575,18 +1586,12 @@ TclCompileLreplaceCmd(
TclEmitOpcode( INST_GT, envPtr);
offset = CurrentOffset(envPtr);
TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr);
TclEmitOpcode( INST_DUP, envPtr);
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
offset2 = CurrentOffset(envPtr);
TclEmitInstInt1( INST_JUMP_FALSE1, 0, envPtr);
TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
"list doesn't contain element %d", idx1), NULL), envPtr);
CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
envPtr->codeStart + offset + 1);
TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
envPtr->codeStart + offset2 + 1);
TclAdjustStackDepth(-1, envPtr);
}
TclEmitOpcode( INST_DUP, envPtr);
@@ -1631,18 +1636,12 @@ TclCompileLreplaceCmd(
TclEmitOpcode( INST_GT, envPtr);
offset = CurrentOffset(envPtr);
TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr);
TclEmitOpcode( INST_DUP, envPtr);
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
offset2 = CurrentOffset(envPtr);
TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr);
TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
"list doesn't contain element %d", idx1), NULL), envPtr);
CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
envPtr->codeStart + offset + 1);
TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
envPtr->codeStart + offset2 + 1);
TclAdjustStackDepth(-1, envPtr);
}
TclEmitOpcode( INST_DUP, envPtr);
@@ -2035,7 +2034,7 @@ TclCompileNamespaceUpvarCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
int localIndex, numWords, i;
int isScalar, localIndex, numWords, i;
DefineLineInformation; /* TIP #280 */
if (envPtr->procPtr == NULL) {
@@ -2070,8 +2069,10 @@ TclCompileNamespaceUpvarCmd(
localTokenPtr = TokenAfter(otherTokenPtr);
CompileWord(envPtr, otherTokenPtr, interp, i);
localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
if (localIndex < 0) {
PushVarNameWord(interp, localTokenPtr, envPtr, 0,
&localIndex, &isScalar, i+1);
if ((localIndex < 0) || !isScalar) {
return TCL_ERROR;
}
TclEmitInstInt4( INST_NSUPVAR, localIndex, envPtr);
@@ -2257,7 +2258,7 @@ TclCompileRegexpCmd(
* converted pattern as a literal.
*/
if (TclReToGlob(NULL, varTokenPtr[1].start, len, &ds, &exact, NULL)
if (TclReToGlob(NULL, varTokenPtr[1].start, len, &ds, &exact)
== TCL_OK) {
simple = 1;
PushLiteral(envPtr, Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));
@@ -2349,7 +2350,7 @@ TclCompileRegsubCmd(
Tcl_Obj *patternObj = NULL, *replacementObj = NULL;
Tcl_DString pattern;
const char *bytes;
int len, exact, quantified, result = TCL_ERROR;
int len, exact, result = TCL_ERROR;
if (parsePtr->numWords < 5 || parsePtr->numWords > 6) {
return TCL_ERROR;
@@ -2409,8 +2410,7 @@ TclCompileRegsubCmd(
*/
bytes = Tcl_GetStringFromObj(patternObj, &len);
if (TclReToGlob(NULL, bytes, len, &pattern, &exact, &quantified)
!= TCL_OK || exact || quantified) {
if (TclReToGlob(NULL, bytes, len, &pattern, &exact) != TCL_OK || exact) {
goto done;
}
bytes = Tcl_DStringValue(&pattern);
@@ -2752,7 +2752,7 @@ TclCompileUpvarCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
int localIndex, numWords, i;
int isScalar, localIndex, numWords, i;
DefineLineInformation; /* TIP #280 */
Tcl_Obj *objPtr;
@@ -2815,8 +2815,10 @@ TclCompileUpvarCmd(
localTokenPtr = TokenAfter(otherTokenPtr);
CompileWord(envPtr, otherTokenPtr, interp, i);
localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
if (localIndex < 0) {
PushVarNameWord(interp, localTokenPtr, envPtr, 0,
&localIndex, &isScalar, i+1);
if ((localIndex < 0) || !isScalar) {
return TCL_ERROR;
}
TclEmitInstInt4( INST_UPVAR, localIndex, envPtr);
+3 -105
View File
@@ -28,9 +28,6 @@ static void FreeJumptableInfo(ClientData clientData);
static void PrintJumptableInfo(ClientData clientData,
Tcl_Obj *appendObj, ByteCode *codePtr,
unsigned int pcOffset);
static void DisassembleJumptableInfo(ClientData clientData,
Tcl_Obj *dictObj, ByteCode *codePtr,
unsigned int pcOffset);
static int CompileAssociativeBinaryOpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, const char *identity,
int instruction, CompileEnv *envPtr);
@@ -75,8 +72,7 @@ const AuxDataType tclJumptableInfoType = {
"JumptableInfo", /* name */
DupJumptableInfo, /* dupProc */
FreeJumptableInfo, /* freeProc */
PrintJumptableInfo, /* printProc */
DisassembleJumptableInfo /* disassembleProc */
PrintJumptableInfo /* printProc */
};
/*
@@ -272,78 +268,6 @@ TclCompileSetCmd(
*----------------------------------------------------------------------
*/
int
TclCompileStringCatCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
int i, numWords = parsePtr->numWords, numArgs;
Tcl_Token *wordTokenPtr;
Tcl_Obj *obj, *folded;
DefineLineInformation; /* TIP #280 */
/* Trivial case, no arg */
if (numWords<2) {
PushStringLiteral(envPtr, "");
return TCL_OK;
}
/* General case: issue CONCAT1's (by chunks of 254 if needed), folding
contiguous constants along the way */
numArgs = 0;
folded = NULL;
wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
for (i = 1; i < numWords; i++) {
obj = Tcl_NewObj();
if (TclWordKnownAtCompileTime(wordTokenPtr, obj)) {
if (folded) {
Tcl_AppendObjToObj(folded, obj);
Tcl_DecrRefCount(obj);
} else {
folded = obj;
}
} else {
Tcl_DecrRefCount(obj);
if (folded) {
int len;
const char *bytes = Tcl_GetStringFromObj(folded, &len);
PushLiteral(envPtr, bytes, len);
Tcl_DecrRefCount(folded);
folded = NULL;
numArgs ++;
}
CompileWord(envPtr, wordTokenPtr, interp, i);
numArgs ++;
if (numArgs >= 254) { /* 254 to take care of the possible +1 of "folded" above */
TclEmitInstInt1(INST_STR_CONCAT1, numArgs, envPtr);
numArgs = 1; /* concat pushes 1 obj, the result */
}
}
wordTokenPtr = TokenAfter(wordTokenPtr);
}
if (folded) {
int len;
const char *bytes = Tcl_GetStringFromObj(folded, &len);
PushLiteral(envPtr, bytes, len);
Tcl_DecrRefCount(folded);
folded = NULL;
numArgs ++;
}
if (numArgs > 1) {
TclEmitInstInt1(INST_STR_CONCAT1, numArgs, envPtr);
}
return TCL_OK;
}
int
TclCompileStringCmpCmd(
Tcl_Interp *interp, /* Used for error reporting. */
@@ -2095,7 +2019,7 @@ IssueSwitchChainedTests(
*/
if (TclReToGlob(NULL, bodyToken[i]->start,
bodyToken[i]->size, &ds, &exact, NULL) == TCL_OK){
bodyToken[i]->size, &ds, &exact) == TCL_OK) {
simple = 1;
PushLiteral(envPtr, Tcl_DStringValue(&ds),
Tcl_DStringLength(&ds));
@@ -2445,13 +2369,11 @@ IssueSwitchJumpTable(
* DupJumptableInfo: a copy of the jump-table
* FreeJumptableInfo: none
* PrintJumptableInfo: none
* DisassembleJumptableInfo: none
*
* Side effects:
* DupJumptableInfo: allocates memory
* FreeJumptableInfo: releases memory
* PrintJumptableInfo: none
* DisassembleJumptableInfo: none
*
*----------------------------------------------------------------------
*/
@@ -2514,30 +2436,6 @@ PrintJumptableInfo(
keyPtr, pcOffset + offset);
}
}
static void
DisassembleJumptableInfo(
ClientData clientData,
Tcl_Obj *dictObj,
ByteCode *codePtr,
unsigned int pcOffset)
{
register JumptableInfo *jtPtr = clientData;
Tcl_Obj *mapping = Tcl_NewObj();
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
const char *keyPtr;
int offset;
hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) {
keyPtr = Tcl_GetHashKey(&jtPtr->hashTable, hPtr);
offset = PTR2INT(Tcl_GetHashValue(hPtr));
Tcl_DictObjPut(NULL, mapping, Tcl_NewStringObj(keyPtr, -1),
Tcl_NewIntObj(offset));
}
Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("mapping", -1), mapping);
}
/*
*----------------------------------------------------------------------
@@ -3068,7 +2966,6 @@ IssueTryClausesInstructions(
if (!handlerTokens[i]) {
forwardsNeedFixing = 1;
JUMP4( JUMP, forwardsToFix[i]);
TclAdjustStackDepth(1, envPtr);
} else {
int dontChangeOptions;
@@ -3782,6 +3679,7 @@ TclCompileWhileCmd(
}
SetLineInformation(1);
TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
TclClearNumConversion(envPtr);
jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
if (jumpDist > 127) {
+43 -40
View File
@@ -365,7 +365,7 @@ static const unsigned char prec[] = {
0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0,
0,
/* Unary operator lexemes */
PREC_UNARY, /* UNARY_PLUS */
PREC_UNARY, /* UNARY_MINUS */
@@ -420,7 +420,7 @@ static const unsigned char instruction[] = {
0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0,
0,
/* Unary operator lexemes */
INST_UPLUS, /* UNARY_PLUS */
INST_UMINUS, /* UNARY_MINUS */
@@ -488,7 +488,7 @@ static const unsigned char Lexeme[] = {
typedef struct JumpList {
JumpFixup jump; /* Pass this argument to matching calls of
* TclEmitForwardJump() and
* TclEmitForwardJump() and
* TclFixupForwardJump(). */
struct JumpList *next; /* Point to next item on the stack */
} JumpList;
@@ -838,7 +838,7 @@ ParseExpr(
switch (lexeme) {
case NUMBER:
case BOOLEAN:
case BOOLEAN:
/*
* TODO: Consider using a dict or hash to collapse all
* duplicate literals into a single representative value.
@@ -861,7 +861,7 @@ ParseExpr(
start += scanned;
numBytes -= scanned;
continue;
default:
break;
}
@@ -1324,7 +1324,7 @@ ParseExpr(
nodePtr->mark = MARK_LEFT;
nodePtr->left = complete;
/*
/*
* The COMMA operator cannot be optimized, since the function
* needs all of its arguments, and optimization would reduce the
* number. Other binary operators root constant expressions when
@@ -1546,7 +1546,7 @@ ConvertTreeToTokens(
* Tcl_ParseExpr() we do not change them now. Internally, we can
* do better.
*/
int toCopy = tokenPtr->numComponents + 1;
if (tokenPtr->numComponents == tokenPtr[1].numComponents + 1) {
@@ -1562,7 +1562,7 @@ ConvertTreeToTokens(
subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
parsePtr->numTokens += toCopy;
} else {
/*
/*
* Multiple element word. Create a TCL_TOKEN_SUB_EXPR token to
* lead, with fields initialized from the leading token, then
* copy entire set of word tokens.
@@ -1611,7 +1611,7 @@ ConvertTreeToTokens(
case COMMA:
case COLON:
/*
/*
* Historical practice has been to have no Tcl_Tokens for
* these operators.
*/
@@ -1747,7 +1747,7 @@ ConvertTreeToTokens(
/*
* Before we leave this node/operator/subexpression for the
* last time, finish up its tokens....
*
*
* Our current position scanning the string is where the
* substring for the subexpression ends.
*/
@@ -1967,7 +1967,7 @@ ParseLexeme(
case 'i':
if ((numBytes > 1) && (start[1] == 'n')
&& ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) {
&& ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
/*
* Must make this check so we can tell the difference between the
* "in" operator and the "int" function name and the "infinity"
@@ -1981,15 +1981,14 @@ ParseLexeme(
case 'e':
if ((numBytes > 1) && (start[1] == 'q')
&& ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) {
&& ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
*lexemePtr = STREQ;
return 2;
}
break;
case 'n':
if ((numBytes > 1)
&& ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) {
if ((numBytes > 1) && ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
switch (start[1]) {
case 'e':
*lexemePtr = STRNEQ;
@@ -2004,8 +2003,9 @@ ParseLexeme(
literal = Tcl_NewObj();
if (TclParseNumber(NULL, literal, NULL, start, numBytes, &end,
TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
if (end < start + numBytes && !TclIsBareword(*end)) {
if (end < start + numBytes && !isalnum(UCHAR(*end))
&& UCHAR(*end) != '_') {
number:
TclInitStringRep(literal, start, end-start);
*lexemePtr = NUMBER;
@@ -2029,9 +2029,9 @@ ParseLexeme(
const char *p = start;
while (p < end) {
if (!TclIsBareword(*p++)) {
if (!isalnum(UCHAR(*p++))) {
/*
* The number has non-bareword characters, so we
* The number has non-bareword characters, so we
* must treat it as a number.
*/
goto number;
@@ -2054,30 +2054,33 @@ ParseLexeme(
}
}
/*
* We reject leading underscores in bareword. No sensible reason why.
* Might be inspired by reserved identifier rules in C, which of course
* have no direct relevance here.
*/
if (Tcl_UtfCharComplete(start, numBytes)) {
scanned = Tcl_UtfToUniChar(start, &ch);
} else {
char utfBytes[TCL_UTF_MAX];
if (!TclIsBareword(*start) || *start == '_') {
if (Tcl_UtfCharComplete(start, numBytes)) {
scanned = Tcl_UtfToUniChar(start, &ch);
} else {
char utfBytes[TCL_UTF_MAX];
memcpy(utfBytes, start, (size_t) numBytes);
utfBytes[numBytes] = '\0';
scanned = Tcl_UtfToUniChar(utfBytes, &ch);
}
memcpy(utfBytes, start, (size_t) numBytes);
utfBytes[numBytes] = '\0';
scanned = Tcl_UtfToUniChar(utfBytes, &ch);
}
if (!isalnum(UCHAR(ch))) {
*lexemePtr = INVALID;
Tcl_DecrRefCount(literal);
return scanned;
}
end = start;
while (numBytes && TclIsBareword(*end)) {
end += 1;
numBytes -= 1;
while (isalnum(UCHAR(ch)) || (UCHAR(ch) == '_')) {
end += scanned;
numBytes -= scanned;
if (Tcl_UtfCharComplete(end, numBytes)) {
scanned = Tcl_UtfToUniChar(end, &ch);
} else {
char utfBytes[TCL_UTF_MAX];
memcpy(utfBytes, end, (size_t) numBytes);
utfBytes[numBytes] = '\0';
scanned = Tcl_UtfToUniChar(utfBytes, &ch);
}
}
*lexemePtr = BAREWORD;
if (literalPtr) {
@@ -2095,7 +2098,7 @@ ParseLexeme(
* TclCompileExpr --
*
* This procedure compiles a string containing a Tcl expression into Tcl
* bytecodes.
* bytecodes.
*
* Results:
* None.
@@ -2330,7 +2333,7 @@ CompileExprTree(
* Use the numWords count we've kept to invoke the function
* command with the correct number of arguments.
*/
if (numWords < 255) {
TclEmitInvoke(envPtr, INST_INVOKE_STK1, numWords);
} else {
@@ -2424,7 +2427,7 @@ CompileExprTree(
const char *bytes = TclGetStringFromObj(literal, &length);
int index = TclRegisterNewLiteral(envPtr, bytes, length);
Tcl_Obj *objPtr = TclFetchLiteral(envPtr, index);
if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
/*
* Would like to do this:
@@ -2567,7 +2570,7 @@ TclSingleOpCmd(
*
* TclSortingOpCmd --
* Implements the commands:
* <, <=, >, >=, ==, eq
* <, <=, >, >=, ==, eq
* in the ::tcl::mathop namespace. These commands are defined for
* arbitrary number of arguments by computing the AND of the base
* operator applied to all neighbor argument pairs.
+818 -11
View File
@@ -55,9 +55,9 @@ InstructionDesc const tclInstructionTable[] = {
/* Name Bytes stackEffect #Opnds Operand types */
{"done", 1, -1, 0, {OPERAND_NONE}},
/* Finish ByteCode execution and return stktop (top stack item) */
{"push1", 2, +1, 1, {OPERAND_LIT1}},
{"push1", 2, +1, 1, {OPERAND_UINT1}},
/* Push object at ByteCode objArray[op1] */
{"push4", 5, +1, 1, {OPERAND_LIT4}},
{"push4", 5, +1, 1, {OPERAND_UINT4}},
/* Push object at ByteCode objArray[op4] */
{"pop", 1, -1, 0, {OPERAND_NONE}},
/* Pop the topmost stack object */
@@ -125,17 +125,17 @@ InstructionDesc const tclInstructionTable[] = {
{"incrStkImm", 2, 0, 1, {OPERAND_INT1}},
/* Incr general variable; unparsed name is top, amount is op1 */
{"jump1", 2, 0, 1, {OPERAND_OFFSET1}},
{"jump1", 2, 0, 1, {OPERAND_INT1}},
/* Jump relative to (pc + op1) */
{"jump4", 5, 0, 1, {OPERAND_OFFSET4}},
{"jump4", 5, 0, 1, {OPERAND_INT4}},
/* Jump relative to (pc + op4) */
{"jumpTrue1", 2, -1, 1, {OPERAND_OFFSET1}},
{"jumpTrue1", 2, -1, 1, {OPERAND_INT1}},
/* Jump relative to (pc + op1) if stktop expr object is true */
{"jumpTrue4", 5, -1, 1, {OPERAND_OFFSET4}},
{"jumpTrue4", 5, -1, 1, {OPERAND_INT4}},
/* Jump relative to (pc + op4) if stktop expr object is true */
{"jumpFalse1", 2, -1, 1, {OPERAND_OFFSET1}},
{"jumpFalse1", 2, -1, 1, {OPERAND_INT1}},
/* Jump relative to (pc + op1) if stktop expr object is false */
{"jumpFalse4", 5, -1, 1, {OPERAND_OFFSET4}},
{"jumpFalse4", 5, -1, 1, {OPERAND_INT4}},
/* Jump relative to (pc + op4) if stktop expr object is false */
{"lor", 1, -1, 0, {OPERAND_NONE}},
@@ -298,7 +298,7 @@ InstructionDesc const tclInstructionTable[] = {
/* List Index: push (lindex stktop op4) */
{"listRangeImm", 9, 0, 2, {OPERAND_IDX4, OPERAND_IDX4}},
/* List Range: push (lrange stktop op4 op4) */
{"startCommand", 9, 0, 2, {OPERAND_OFFSET4, OPERAND_UINT4}},
{"startCommand", 9, 0, 2, {OPERAND_INT4,OPERAND_UINT4}},
/* Start of bytecoded command: op is the length of the cmd's code, op2
* is number of commands here */
@@ -692,6 +692,11 @@ static void RegisterAuxDataType(const AuxDataType *typePtr);
static int SetByteCodeFromAny(Tcl_Interp *interp,
Tcl_Obj *objPtr);
static void StartExpanding(CompileEnv *envPtr);
static int FormatInstruction(ByteCode *codePtr,
const unsigned char *pc, Tcl_Obj *bufferObj);
static void PrintSourceToObj(Tcl_Obj *appendObj,
const char *stringPtr, int maxChars);
static void UpdateStringOfInstName(Tcl_Obj *objPtr);
/*
* TIP #280: Helper for building the per-word line information of all compiled
@@ -729,6 +734,19 @@ static const Tcl_ObjType substCodeType = {
NULL, /* setFromAnyProc */
};
/*
* The structure below defines an instruction name Tcl object to allow
* reporting of inner contexts in errorstack without string allocation.
*/
static const Tcl_ObjType tclInstNameType = {
"instname", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfInstName, /* updateStringProc */
NULL, /* setFromAnyProc */
};
/*
* Helper macros.
*/
@@ -4342,11 +4360,10 @@ TclInitAuxDataTypeTable(void)
Tcl_InitHashTable(&auxDataTypeTable, TCL_STRING_KEYS);
/*
* There are only four AuxData types at this time, so register them here.
* There are only three AuxData types at this time, so register them here.
*/
RegisterAuxDataType(&tclForeachInfoType);
RegisterAuxDataType(&tclNewForeachInfoType);
RegisterAuxDataType(&tclJumptableInfoType);
RegisterAuxDataType(&tclDictUpdateInfoType);
}
@@ -4579,6 +4596,796 @@ EncodeCmdLocMap(
return p;
}
#ifdef TCL_COMPILE_DEBUG
/*
*----------------------------------------------------------------------
*
* TclPrintByteCodeObj --
*
* This procedure prints ("disassembles") the instructions of a bytecode
* object to stdout.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
void
TclPrintByteCodeObj(
Tcl_Interp *interp, /* Used only for Tcl_GetStringFromObj. */
Tcl_Obj *objPtr) /* The bytecode object to disassemble. */
{
Tcl_Obj *bufPtr = TclDisassembleByteCodeObj(objPtr);
fprintf(stdout, "\n%s", TclGetString(bufPtr));
Tcl_DecrRefCount(bufPtr);
}
/*
*----------------------------------------------------------------------
*
* TclPrintInstruction --
*
* This procedure prints ("disassembles") one instruction from a bytecode
* object to stdout.
*
* Results:
* Returns the length in bytes of the current instruiction.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
TclPrintInstruction(
ByteCode *codePtr, /* Bytecode containing the instruction. */
const unsigned char *pc) /* Points to first byte of instruction. */
{
Tcl_Obj *bufferObj;
int numBytes;
TclNewObj(bufferObj);
numBytes = FormatInstruction(codePtr, pc, bufferObj);
fprintf(stdout, "%s", TclGetString(bufferObj));
Tcl_DecrRefCount(bufferObj);
return numBytes;
}
/*
*----------------------------------------------------------------------
*
* TclPrintObject --
*
* This procedure prints up to a specified number of characters from the
* argument Tcl object's string representation to a specified file.
*
* Results:
* None.
*
* Side effects:
* Outputs characters to the specified file.
*
*----------------------------------------------------------------------
*/
void
TclPrintObject(
FILE *outFile, /* The file to print the source to. */
Tcl_Obj *objPtr, /* Points to the Tcl object whose string
* representation should be printed. */
int maxChars) /* Maximum number of chars to print. */
{
char *bytes;
int length;
bytes = Tcl_GetStringFromObj(objPtr, &length);
TclPrintSource(outFile, bytes, TclMin(length, maxChars));
}
/*
*----------------------------------------------------------------------
*
* TclPrintSource --
*
* This procedure prints up to a specified number of characters from the
* argument string to a specified file. It tries to produce legible
* output by adding backslashes as necessary.
*
* Results:
* None.
*
* Side effects:
* Outputs characters to the specified file.
*
*----------------------------------------------------------------------
*/
void
TclPrintSource(
FILE *outFile, /* The file to print the source to. */
const char *stringPtr, /* The string to print. */
int maxChars) /* Maximum number of chars to print. */
{
Tcl_Obj *bufferObj;
TclNewObj(bufferObj);
PrintSourceToObj(bufferObj, stringPtr, maxChars);
fprintf(outFile, "%s", TclGetString(bufferObj));
Tcl_DecrRefCount(bufferObj);
}
#endif /* TCL_COMPILE_DEBUG */
/*
*----------------------------------------------------------------------
*
* TclDisassembleByteCodeObj --
*
* Given an object which is of bytecode type, return a disassembled
* version of the bytecode (in a new refcount 0 object). No guarantees
* are made about the details of the contents of the result.
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
TclDisassembleByteCodeObj(
Tcl_Obj *objPtr) /* The bytecode object to disassemble. */
{
ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
unsigned char *codeStart, *codeLimit, *pc;
unsigned char *codeDeltaNext, *codeLengthNext;
unsigned char *srcDeltaNext, *srcLengthNext;
int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i;
Interp *iPtr = (Interp *) *codePtr->interpHandle;
Tcl_Obj *bufferObj;
char ptrBuf1[20], ptrBuf2[20];
TclNewObj(bufferObj);
if (codePtr->refCount <= 0) {
return bufferObj; /* Already freed. */
}
codeStart = codePtr->codeStart;
codeLimit = codeStart + codePtr->numCodeBytes;
numCmds = codePtr->numCommands;
/*
* Print header lines describing the ByteCode.
*/
sprintf(ptrBuf1, "%p", codePtr);
sprintf(ptrBuf2, "%p", iPtr);
Tcl_AppendPrintfToObj(bufferObj,
"ByteCode 0x%s, refCt %u, epoch %u, interp 0x%s (epoch %u)\n",
ptrBuf1, codePtr->refCount, codePtr->compileEpoch, ptrBuf2,
iPtr->compileEpoch);
Tcl_AppendToObj(bufferObj, " Source ", -1);
PrintSourceToObj(bufferObj, codePtr->source,
TclMin(codePtr->numSrcBytes, 55));
Tcl_AppendPrintfToObj(bufferObj,
"\n Cmds %d, src %d, inst %d, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes,
codePtr->numLitObjects, codePtr->numAuxDataItems,
codePtr->maxStackDepth,
#ifdef TCL_COMPILE_STATS
codePtr->numSrcBytes?
codePtr->structureSize/(float)codePtr->numSrcBytes :
#endif
0.0);
#ifdef TCL_COMPILE_STATS
Tcl_AppendPrintfToObj(bufferObj,
" Code %lu = header %lu+inst %d+litObj %lu+exc %lu+aux %lu+cmdMap %d\n",
(unsigned long) codePtr->structureSize,
(unsigned long) (sizeof(ByteCode) - sizeof(size_t) - sizeof(Tcl_Time)),
codePtr->numCodeBytes,
(unsigned long) (codePtr->numLitObjects * sizeof(Tcl_Obj *)),
(unsigned long) (codePtr->numExceptRanges*sizeof(ExceptionRange)),
(unsigned long) (codePtr->numAuxDataItems * sizeof(AuxData)),
codePtr->numCmdLocBytes);
#endif /* TCL_COMPILE_STATS */
/*
* If the ByteCode is the compiled body of a Tcl procedure, print
* information about that procedure. Note that we don't know the
* procedure's name since ByteCode's can be shared among procedures.
*/
if (codePtr->procPtr != NULL) {
Proc *procPtr = codePtr->procPtr;
int numCompiledLocals = procPtr->numCompiledLocals;
sprintf(ptrBuf1, "%p", procPtr);
Tcl_AppendPrintfToObj(bufferObj,
" Proc 0x%s, refCt %d, args %d, compiled locals %d\n",
ptrBuf1, procPtr->refCount, procPtr->numArgs,
numCompiledLocals);
if (numCompiledLocals > 0) {
CompiledLocal *localPtr = procPtr->firstLocalPtr;
for (i = 0; i < numCompiledLocals; i++) {
Tcl_AppendPrintfToObj(bufferObj,
" slot %d%s%s%s%s%s%s", i,
(localPtr->flags & (VAR_ARRAY|VAR_LINK)) ? "" : ", scalar",
(localPtr->flags & VAR_ARRAY) ? ", array" : "",
(localPtr->flags & VAR_LINK) ? ", link" : "",
(localPtr->flags & VAR_ARGUMENT) ? ", arg" : "",
(localPtr->flags & VAR_TEMPORARY) ? ", temp" : "",
(localPtr->flags & VAR_RESOLVED) ? ", resolved" : "");
if (TclIsVarTemporary(localPtr)) {
Tcl_AppendToObj(bufferObj, "\n", -1);
} else {
Tcl_AppendPrintfToObj(bufferObj, ", \"%s\"\n",
localPtr->name);
}
localPtr = localPtr->nextPtr;
}
}
}
/*
* Print the ExceptionRange array.
*/
if (codePtr->numExceptRanges > 0) {
Tcl_AppendPrintfToObj(bufferObj, " Exception ranges %d, depth %d:\n",
codePtr->numExceptRanges, codePtr->maxExceptDepth);
for (i = 0; i < codePtr->numExceptRanges; i++) {
ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i];
Tcl_AppendPrintfToObj(bufferObj,
" %d: level %d, %s, pc %d-%d, ",
i, rangePtr->nestingLevel,
(rangePtr->type==LOOP_EXCEPTION_RANGE ? "loop" : "catch"),
rangePtr->codeOffset,
(rangePtr->codeOffset + rangePtr->numCodeBytes - 1));
switch (rangePtr->type) {
case LOOP_EXCEPTION_RANGE:
Tcl_AppendPrintfToObj(bufferObj, "continue %d, break %d\n",
rangePtr->continueOffset, rangePtr->breakOffset);
break;
case CATCH_EXCEPTION_RANGE:
Tcl_AppendPrintfToObj(bufferObj, "catch %d\n",
rangePtr->catchOffset);
break;
default:
Tcl_Panic("TclDisassembleByteCodeObj: bad ExceptionRange type %d",
rangePtr->type);
}
}
}
/*
* If there were no commands (e.g., an expression or an empty string was
* compiled), just print all instructions and return.
*/
if (numCmds == 0) {
pc = codeStart;
while (pc < codeLimit) {
Tcl_AppendToObj(bufferObj, " ", -1);
pc += FormatInstruction(codePtr, pc, bufferObj);
}
return bufferObj;
}
/*
* Print table showing the code offset, source offset, and source length
* for each command. These are encoded as a sequence of bytes.
*/
Tcl_AppendPrintfToObj(bufferObj, " Commands %d:", numCmds);
codeDeltaNext = codePtr->codeDeltaStart;
codeLengthNext = codePtr->codeLengthStart;
srcDeltaNext = codePtr->srcDeltaStart;
srcLengthNext = codePtr->srcLengthStart;
codeOffset = srcOffset = 0;
for (i = 0; i < numCmds; i++) {
if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) {
codeDeltaNext++;
delta = TclGetInt4AtPtr(codeDeltaNext);
codeDeltaNext += 4;
} else {
delta = TclGetInt1AtPtr(codeDeltaNext);
codeDeltaNext++;
}
codeOffset += delta;
if ((unsigned) *codeLengthNext == (unsigned) 0xFF) {
codeLengthNext++;
codeLen = TclGetInt4AtPtr(codeLengthNext);
codeLengthNext += 4;
} else {
codeLen = TclGetInt1AtPtr(codeLengthNext);
codeLengthNext++;
}
if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
srcDeltaNext++;
delta = TclGetInt4AtPtr(srcDeltaNext);
srcDeltaNext += 4;
} else {
delta = TclGetInt1AtPtr(srcDeltaNext);
srcDeltaNext++;
}
srcOffset += delta;
if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
srcLengthNext++;
srcLen = TclGetInt4AtPtr(srcLengthNext);
srcLengthNext += 4;
} else {
srcLen = TclGetInt1AtPtr(srcLengthNext);
srcLengthNext++;
}
Tcl_AppendPrintfToObj(bufferObj, "%s%4d: pc %d-%d, src %d-%d",
((i % 2)? " " : "\n "),
(i+1), codeOffset, (codeOffset + codeLen - 1),
srcOffset, (srcOffset + srcLen - 1));
}
if (numCmds > 0) {
Tcl_AppendToObj(bufferObj, "\n", -1);
}
/*
* Print each instruction. If the instruction corresponds to the start of
* a command, print the command's source. Note that we don't need the code
* length here.
*/
codeDeltaNext = codePtr->codeDeltaStart;
srcDeltaNext = codePtr->srcDeltaStart;
srcLengthNext = codePtr->srcLengthStart;
codeOffset = srcOffset = 0;
pc = codeStart;
for (i = 0; i < numCmds; i++) {
if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) {
codeDeltaNext++;
delta = TclGetInt4AtPtr(codeDeltaNext);
codeDeltaNext += 4;
} else {
delta = TclGetInt1AtPtr(codeDeltaNext);
codeDeltaNext++;
}
codeOffset += delta;
if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
srcDeltaNext++;
delta = TclGetInt4AtPtr(srcDeltaNext);
srcDeltaNext += 4;
} else {
delta = TclGetInt1AtPtr(srcDeltaNext);
srcDeltaNext++;
}
srcOffset += delta;
if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
srcLengthNext++;
srcLen = TclGetInt4AtPtr(srcLengthNext);
srcLengthNext += 4;
} else {
srcLen = TclGetInt1AtPtr(srcLengthNext);
srcLengthNext++;
}
/*
* Print instructions before command i.
*/
while ((pc-codeStart) < codeOffset) {
Tcl_AppendToObj(bufferObj, " ", -1);
pc += FormatInstruction(codePtr, pc, bufferObj);
}
Tcl_AppendPrintfToObj(bufferObj, " Command %d: ", i+1);
PrintSourceToObj(bufferObj, (codePtr->source + srcOffset),
TclMin(srcLen, 55));
Tcl_AppendToObj(bufferObj, "\n", -1);
}
if (pc < codeLimit) {
/*
* Print instructions after the last command.
*/
while (pc < codeLimit) {
Tcl_AppendToObj(bufferObj, " ", -1);
pc += FormatInstruction(codePtr, pc, bufferObj);
}
}
return bufferObj;
}
/*
*----------------------------------------------------------------------
*
* FormatInstruction --
*
* Appends a representation of a bytecode instruction to a Tcl_Obj.
*
*----------------------------------------------------------------------
*/
static int
FormatInstruction(
ByteCode *codePtr, /* Bytecode containing the instruction. */
const unsigned char *pc, /* Points to first byte of instruction. */
Tcl_Obj *bufferObj) /* Object to append instruction info to. */
{
Proc *procPtr = codePtr->procPtr;
unsigned char opCode = *pc;
register const InstructionDesc *instDesc = &tclInstructionTable[opCode];
unsigned char *codeStart = codePtr->codeStart;
unsigned pcOffset = pc - codeStart;
int opnd = 0, i, j, numBytes = 1;
int localCt = procPtr ? procPtr->numCompiledLocals : 0;
CompiledLocal *localPtr = procPtr ? procPtr->firstLocalPtr : NULL;
char suffixBuffer[128]; /* Additional info to print after main opcode
* and immediates. */
char *suffixSrc = NULL;
Tcl_Obj *suffixObj = NULL;
AuxData *auxPtr = NULL;
suffixBuffer[0] = '\0';
Tcl_AppendPrintfToObj(bufferObj, "(%u) %s ", pcOffset, instDesc->name);
for (i = 0; i < instDesc->numOperands; i++) {
switch (instDesc->opTypes[i]) {
case OPERAND_INT1:
opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++;
if (opCode == INST_JUMP1 || opCode == INST_JUMP_TRUE1
|| opCode == INST_JUMP_FALSE1) {
sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
}
Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
break;
case OPERAND_INT4:
opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
if (opCode == INST_JUMP4 || opCode == INST_JUMP_TRUE4
|| opCode == INST_JUMP_FALSE4) {
sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
} else if (opCode == INST_START_CMD) {
sprintf(suffixBuffer, "next cmd at pc %u", pcOffset+opnd);
}
Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
break;
case OPERAND_UINT1:
opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
if (opCode == INST_PUSH1) {
suffixObj = codePtr->objArrayPtr[opnd];
}
Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
break;
case OPERAND_AUX4:
case OPERAND_UINT4:
opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
if (opCode == INST_PUSH4) {
suffixObj = codePtr->objArrayPtr[opnd];
} else if (opCode == INST_START_CMD && opnd != 1) {
sprintf(suffixBuffer+strlen(suffixBuffer),
", %u cmds start here", opnd);
}
Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
if (instDesc->opTypes[i] == OPERAND_AUX4) {
auxPtr = &codePtr->auxDataArrayPtr[opnd];
}
break;
case OPERAND_IDX4:
opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
if (opnd >= -1) {
Tcl_AppendPrintfToObj(bufferObj, "%d ", opnd);
} else if (opnd == -2) {
Tcl_AppendPrintfToObj(bufferObj, "end ");
} else {
Tcl_AppendPrintfToObj(bufferObj, "end-%d ", -2-opnd);
}
break;
case OPERAND_LVT1:
opnd = TclGetUInt1AtPtr(pc+numBytes);
numBytes++;
goto printLVTindex;
case OPERAND_LVT4:
opnd = TclGetUInt4AtPtr(pc+numBytes);
numBytes += 4;
printLVTindex:
if (localPtr != NULL) {
if (opnd >= localCt) {
Tcl_Panic("FormatInstruction: bad local var index %u (%u locals)",
(unsigned) opnd, localCt);
}
for (j = 0; j < opnd; j++) {
localPtr = localPtr->nextPtr;
}
if (TclIsVarTemporary(localPtr)) {
sprintf(suffixBuffer, "temp var %u", (unsigned) opnd);
} else {
sprintf(suffixBuffer, "var ");
suffixSrc = localPtr->name;
}
}
Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", (unsigned) opnd);
break;
case OPERAND_SCLS1:
opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
Tcl_AppendPrintfToObj(bufferObj, "%s ",
tclStringClassTable[opnd].name);
break;
case OPERAND_NONE:
default:
break;
}
}
if (suffixObj) {
const char *bytes;
int length;
Tcl_AppendToObj(bufferObj, "\t# ", -1);
bytes = Tcl_GetStringFromObj(codePtr->objArrayPtr[opnd], &length);
PrintSourceToObj(bufferObj, bytes, TclMin(length, 40));
} else if (suffixBuffer[0]) {
Tcl_AppendPrintfToObj(bufferObj, "\t# %s", suffixBuffer);
if (suffixSrc) {
PrintSourceToObj(bufferObj, suffixSrc, 40);
}
}
Tcl_AppendToObj(bufferObj, "\n", -1);
if (auxPtr && auxPtr->type->printProc) {
Tcl_AppendToObj(bufferObj, "\t\t[", -1);
auxPtr->type->printProc(auxPtr->clientData, bufferObj, codePtr,
pcOffset);
Tcl_AppendToObj(bufferObj, "]\n", -1);
}
return numBytes;
}
/*
*----------------------------------------------------------------------
*
* TclGetInnerContext --
*
* If possible, returns a list capturing the inner context. Otherwise
* return NULL.
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
TclGetInnerContext(
Tcl_Interp *interp,
const unsigned char *pc,
Tcl_Obj **tosPtr)
{
int objc = 0, off = 0;
Tcl_Obj *result;
Interp *iPtr = (Interp *) interp;
switch (*pc) {
case INST_STR_LEN:
case INST_LNOT:
case INST_BITNOT:
case INST_UMINUS:
case INST_UPLUS:
case INST_TRY_CVT_TO_NUMERIC:
case INST_EXPAND_STKTOP:
case INST_EXPR_STK:
objc = 1;
break;
case INST_LIST_IN:
case INST_LIST_NOT_IN: /* Basic list containment operators. */
case INST_STR_EQ:
case INST_STR_NEQ: /* String (in)equality check */
case INST_STR_CMP: /* String compare. */
case INST_STR_INDEX:
case INST_STR_MATCH:
case INST_REGEXP:
case INST_EQ:
case INST_NEQ:
case INST_LT:
case INST_GT:
case INST_LE:
case INST_GE:
case INST_MOD:
case INST_LSHIFT:
case INST_RSHIFT:
case INST_BITOR:
case INST_BITXOR:
case INST_BITAND:
case INST_EXPON:
case INST_ADD:
case INST_SUB:
case INST_DIV:
case INST_MULT:
objc = 2;
break;
case INST_RETURN_STK:
/* early pop. TODO: dig out opt dict too :/ */
objc = 1;
break;
case INST_SYNTAX:
case INST_RETURN_IMM:
objc = 2;
break;
case INST_INVOKE_STK4:
objc = TclGetUInt4AtPtr(pc+1);
break;
case INST_INVOKE_STK1:
objc = TclGetUInt1AtPtr(pc+1);
break;
}
result = iPtr->innerContext;
if (Tcl_IsShared(result)) {
Tcl_DecrRefCount(result);
iPtr->innerContext = result = Tcl_NewListObj(objc + 1, NULL);
Tcl_IncrRefCount(result);
} else {
int len;
/*
* Reset while keeping the list intrep as much as possible.
*/
Tcl_ListObjLength(interp, result, &len);
Tcl_ListObjReplace(interp, result, 0, len, 0, NULL);
}
Tcl_ListObjAppendElement(NULL, result, TclNewInstNameObj(*pc));
for (; objc>0 ; objc--) {
Tcl_Obj *objPtr;
objPtr = tosPtr[1 - objc + off];
if (!objPtr) {
Tcl_Panic("InnerContext: bad tos -- appending null object");
}
if ((objPtr->refCount<=0)
#ifdef TCL_MEM_DEBUG
|| (objPtr->refCount==0x61616161)
#endif
) {
Tcl_Panic("InnerContext: bad tos -- appending freed object %p",
objPtr);
}
Tcl_ListObjAppendElement(NULL, result, objPtr);
}
return result;
}
/*
*----------------------------------------------------------------------
*
* TclNewInstNameObj --
*
* Creates a new InstName Tcl_Obj based on the given instruction
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
TclNewInstNameObj(
unsigned char inst)
{
Tcl_Obj *objPtr = Tcl_NewObj();
objPtr->typePtr = &tclInstNameType;
objPtr->internalRep.longValue = (long) inst;
objPtr->bytes = NULL;
return objPtr;
}
/*
*----------------------------------------------------------------------
*
* UpdateStringOfInstName --
*
* Update the string representation for an instruction name object.
*
*----------------------------------------------------------------------
*/
static void
UpdateStringOfInstName(
Tcl_Obj *objPtr)
{
int inst = objPtr->internalRep.longValue;
char *s, buf[20];
int len;
if ((inst < 0) || (inst > LAST_INST_OPCODE)) {
sprintf(buf, "inst_%d", inst);
s = buf;
} else {
s = (char *) tclInstructionTable[objPtr->internalRep.longValue].name;
}
len = strlen(s);
objPtr->bytes = ckalloc(len + 1);
memcpy(objPtr->bytes, s, len + 1);
objPtr->length = len;
}
/*
*----------------------------------------------------------------------
*
* PrintSourceToObj --
*
* Appends a quoted representation of a string to a Tcl_Obj.
*
*----------------------------------------------------------------------
*/
static void
PrintSourceToObj(
Tcl_Obj *appendObj, /* The object to print the source to. */
const char *stringPtr, /* The string to print. */
int maxChars) /* Maximum number of chars to print. */
{
register const char *p;
register int i = 0, len;
if (stringPtr == NULL) {
Tcl_AppendToObj(appendObj, "\"\"", -1);
return;
}
Tcl_AppendToObj(appendObj, "\"", -1);
p = stringPtr;
for (; (*p != '\0') && (i < maxChars); p+=len) {
Tcl_UniChar ch;
len = TclUtfToUniChar(p, &ch);
switch (ch) {
case '"':
Tcl_AppendToObj(appendObj, "\\\"", -1);
i += 2;
continue;
case '\f':
Tcl_AppendToObj(appendObj, "\\f", -1);
i += 2;
continue;
case '\n':
Tcl_AppendToObj(appendObj, "\\n", -1);
i += 2;
continue;
case '\r':
Tcl_AppendToObj(appendObj, "\\r", -1);
i += 2;
continue;
case '\t':
Tcl_AppendToObj(appendObj, "\\t", -1);
i += 2;
continue;
case '\v':
Tcl_AppendToObj(appendObj, "\\v", -1);
i += 2;
continue;
default:
if (ch < 0x20 || ch >= 0x7f) {
Tcl_AppendPrintfToObj(appendObj, "\\u%04x", ch);
i += 6;
} else {
Tcl_AppendPrintfToObj(appendObj, "%c", ch);
i++;
}
continue;
}
}
Tcl_AppendToObj(appendObj, "\"", -1);
if (*p != '\0') {
Tcl_AppendToObj(appendObj, "...", -1);
}
}
#ifdef TCL_COMPILE_STATS
/*
*----------------------------------------------------------------------
+20 -36
View File
@@ -48,13 +48,6 @@ MODULE_SCOPE int tclTraceCompile;
MODULE_SCOPE int tclTraceExec;
#endif
/*
* The type of lambda expressions. Note that every lambda will *always* have a
* string representation.
*/
MODULE_SCOPE const Tcl_ObjType tclLambdaType;
/*
*------------------------------------------------------------------------
@@ -245,16 +238,6 @@ typedef struct AuxDataType {
AuxDataPrintProc *printProc;/* Callback function to invoke when printing
* the aux data as part of debugging. NULL
* means that the data can't be printed. */
AuxDataPrintProc *disassembleProc;
/* Callback function to invoke when doing a
* disassembly of the aux data (like the
* printProc, except that the output is
* intended to be script-readable). The
* appendObj argument should be filled in with
* a descriptive dictionary; it will start out
* with "name" mapped to the content of the
* name field. NULL means that the printProc
* should be used instead. */
} AuxDataType;
/*
@@ -849,12 +832,6 @@ typedef enum InstOperandType {
* variable table. */
OPERAND_AUX4, /* Four byte unsigned index into the aux data
* table. */
OPERAND_OFFSET1, /* One byte signed jump offset. */
OPERAND_OFFSET4, /* Four byte signed jump offset. */
OPERAND_LIT1, /* One byte unsigned index into table of
* literals. */
OPERAND_LIT4, /* Four byte unsigned index into table of
* literals. */
OPERAND_SCLS1 /* Index into tclStringClassTable. */
} InstOperandType;
@@ -1151,10 +1128,6 @@ MODULE_SCOPE void TclFinalizeLoopExceptionRange(CompileEnv *envPtr,
MODULE_SCOPE char * TclLiteralStats(LiteralTable *tablePtr);
MODULE_SCOPE int TclLog2(int value);
#endif
MODULE_SCOPE int TclLocalScalar(const char *bytes, int numBytes,
CompileEnv *envPtr);
MODULE_SCOPE int TclLocalScalarFromToken(Tcl_Token *tokenPtr,
CompileEnv *envPtr);
MODULE_SCOPE void TclOptimizeBytecode(void *envPtr);
#ifdef TCL_COMPILE_DEBUG
MODULE_SCOPE void TclPrintByteCodeObj(Tcl_Interp *interp,
@@ -1192,15 +1165,12 @@ MODULE_SCOPE void TclVerifyLocalLiteralTable(CompileEnv *envPtr);
MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
Tcl_Obj *valuePtr);
MODULE_SCOPE void TclLogCommandInfo(Tcl_Interp *interp,
const char *script, const char *command,
int length, const unsigned char *pc,
Tcl_Obj **tosPtr);
const char *script,
const char *command, int length,
const unsigned char *pc, Tcl_Obj **tosPtr);
MODULE_SCOPE Tcl_Obj *TclGetInnerContext(Tcl_Interp *interp,
const unsigned char *pc, Tcl_Obj **tosPtr);
const unsigned char *pc, Tcl_Obj **tosPtr);
MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData,
register Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[], int isLambda);
/*
@@ -1417,6 +1387,18 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData,
} \
} while (0)
/*
* If the expr compiler finished with TRY_CONVERT, macro to remove it when the
* job is done by the following instruction.
*/
#define TclClearNumConversion(envPtr) \
do { \
if (*(envPtr->codeNext - 1) == INST_TRY_CVT_TO_NUMERIC) { \
envPtr->codeNext--; \
} \
} while (0)
/*
* Macros to update a (signed or unsigned) integer starting at a pointer. The
* two variants depend on the number of bytes. The ANSI C "prototypes" for
@@ -1682,9 +1664,11 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData,
#define AnonymousLocal(envPtr) \
(TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, (envPtr)))
#define LocalScalar(chars,len,envPtr) \
TclLocalScalar(chars, len, envPtr)
(!TclIsLocalScalar((chars), (len)) ? -1 : \
TclFindCompiledLocal((chars), (len), /*create*/ 1, (envPtr)))
#define LocalScalarFromToken(tokenPtr,envPtr) \
TclLocalScalarFromToken(tokenPtr, envPtr)
((tokenPtr)->type != TCL_TOKEN_SIMPLE_WORD ? -1 : \
LocalScalar((tokenPtr)[1].start, (tokenPtr)[1].size, (envPtr)))
/*
* Flags bits used by TclPushVarName.
-5
View File
@@ -1815,8 +1815,6 @@ EXTERN int Tcl_FSUnloadFile(Tcl_Interp *interp,
EXTERN void Tcl_ZlibStreamSetCompressionDictionary(
Tcl_ZlibStream zhandle,
Tcl_Obj *compressionDictionaryObj);
/* 631 */
EXTERN void Tcl_MutexUnlockAndFinalize(Tcl_Mutex *mutex);
typedef struct {
const struct TclPlatStubs *tclPlatStubs;
@@ -2483,7 +2481,6 @@ typedef struct TclStubs {
void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */
int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
void (*tcl_MutexUnlockAndFinalize) (Tcl_Mutex *mutex); /* 631 */
} TclStubs;
extern const TclStubs *tclStubsPtr;
@@ -3776,8 +3773,6 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_FSUnloadFile) /* 629 */
#define Tcl_ZlibStreamSetCompressionDictionary \
(tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */
#define Tcl_MutexUnlockAndFinalize \
(tclStubsPtr->tcl_MutexUnlockAndFinalize) /* 631 */
#endif /* defined(USE_TCL_STUBS) */
File diff suppressed because it is too large Load Diff
+25 -73
View File
@@ -180,9 +180,9 @@ TCL_DECLARE_MUTEX(encodingMutex)
* the system encoding will be used to perform the conversion.
*/
static Tcl_Encoding defaultEncoding = NULL;
static Tcl_Encoding systemEncoding = NULL;
Tcl_Encoding tclIdentityEncoding = NULL;
static Tcl_Encoding defaultEncoding;
static Tcl_Encoding systemEncoding;
Tcl_Encoding tclIdentityEncoding;
/*
* The following variable is used in the sparse matrix code for a
@@ -652,10 +652,7 @@ TclFinalizeEncodingSubsystem(void)
Tcl_MutexLock(&encodingMutex);
encodingsInitialized = 0;
FreeEncoding(systemEncoding);
systemEncoding = NULL;
defaultEncoding = NULL;
FreeEncoding(tclIdentityEncoding);
tclIdentityEncoding = NULL;
hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
while (hPtr != NULL) {
@@ -1206,10 +1203,7 @@ Tcl_ExternalToUtf(
* output buffer. */
{
const Encoding *encodingPtr;
int result, srcRead, dstWrote, dstChars = 0;
int noTerminate = flags & TCL_ENCODING_NO_TERMINATE;
int charLimited = (flags & TCL_ENCODING_CHAR_LIMIT) && dstCharsPtr;
int maxChars = INT_MAX;
int result, srcRead, dstWrote, dstChars;
Tcl_EncodingState state;
if (encoding == NULL) {
@@ -1234,40 +1228,19 @@ Tcl_ExternalToUtf(
}
if (dstCharsPtr == NULL) {
dstCharsPtr = &dstChars;
flags &= ~TCL_ENCODING_CHAR_LIMIT;
} else if (charLimited) {
maxChars = *dstCharsPtr;
}
if (!noTerminate) {
/*
* If there are any null characters in the middle of the buffer,
* they will converted to the UTF-8 null character (\xC080). To get
* the actual \0 at the end of the destination buffer, we need to
* append it manually. First make room for it...
*/
/*
* If there are any null characters in the middle of the buffer, they will
* converted to the UTF-8 null character (\xC080). To get the actual \0 at
* the end of the destination buffer, we need to append it manually.
*/
dstLen--;
}
do {
int savedFlags = flags;
Tcl_EncodingState savedState = *statePtr;
result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,
flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
dstCharsPtr);
if (*dstCharsPtr <= maxChars) {
break;
}
dstLen = Tcl_UtfAtIndex(dst, maxChars) - 1 - dst + TCL_UTF_MAX;
flags = savedFlags;
*statePtr = savedState;
} while (1);
if (!noTerminate) {
/* ...and then append it */
dst[*dstWrotePtr] = '\0';
}
dstLen--;
result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,
flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
dstCharsPtr);
dst[*dstWrotePtr] = '\0';
return result;
}
@@ -2131,9 +2104,6 @@ BinaryProc(
if (dstLen < 0) {
dstLen = 0;
}
if ((flags & TCL_ENCODING_CHAR_LIMIT) && srcLen > *dstCharsPtr) {
srcLen = *dstCharsPtr;
}
if (srcLen > dstLen) {
srcLen = dstLen;
result = TCL_CONVERT_NOSPACE;
@@ -2294,7 +2264,7 @@ UtfToUtfProc(
{
const char *srcStart, *srcEnd, *srcClose;
const char *dstStart, *dstEnd;
int result, numChars, charLimit = INT_MAX;
int result, numChars;
Tcl_UniChar ch;
result = TCL_OK;
@@ -2305,14 +2275,11 @@ UtfToUtfProc(
if ((flags & TCL_ENCODING_END) == 0) {
srcClose -= TCL_UTF_MAX;
}
if (flags & TCL_ENCODING_CHAR_LIMIT) {
charLimit = *dstCharsPtr;
}
dstStart = dst;
dstEnd = dst + dstLen - TCL_UTF_MAX;
for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
for (numChars = 0; src < srcEnd; numChars++) {
if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
/*
* If there is more string to follow, this will ensure that the
@@ -2334,7 +2301,7 @@ UtfToUtfProc(
*dst++ = *src++;
} else if (pureNullMode == 1 && UCHAR(*src) == 0xc0 &&
(src + 1 < srcEnd) && UCHAR(*(src+1)) == 0x80) {
UCHAR(*(src+1)) == 0x80) {
/*
* Convert 0xc080 to real nulls when we are in output mode.
*/
@@ -2408,12 +2375,9 @@ UnicodeToUtfProc(
{
const char *srcStart, *srcEnd;
const char *dstEnd, *dstStart;
int result, numChars, charLimit = INT_MAX;
int result, numChars;
Tcl_UniChar ch;
if (flags & TCL_ENCODING_CHAR_LIMIT) {
charLimit = *dstCharsPtr;
}
result = TCL_OK;
if ((srcLen % sizeof(Tcl_UniChar)) != 0) {
result = TCL_CONVERT_MULTIBYTE;
@@ -2427,7 +2391,7 @@ UnicodeToUtfProc(
dstStart = dst;
dstEnd = dst + dstLen - TCL_UTF_MAX;
for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
for (numChars = 0; src < srcEnd; numChars++) {
if (dst > dstEnd) {
result = TCL_CONVERT_NOSPACE;
break;
@@ -2595,15 +2559,12 @@ TableToUtfProc(
{
const char *srcStart, *srcEnd;
const char *dstEnd, *dstStart, *prefixBytes;
int result, byte, numChars, charLimit = INT_MAX;
int result, byte, numChars;
Tcl_UniChar ch;
const unsigned short *const *toUnicode;
const unsigned short *pageZero;
TableEncodingData *dataPtr = clientData;
if (flags & TCL_ENCODING_CHAR_LIMIT) {
charLimit = *dstCharsPtr;
}
srcStart = src;
srcEnd = src + srcLen;
@@ -2615,7 +2576,7 @@ TableToUtfProc(
pageZero = toUnicode[0];
result = TCL_OK;
for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
for (numChars = 0; src < srcEnd; numChars++) {
if (dst > dstEnd) {
result = TCL_CONVERT_NOSPACE;
break;
@@ -2829,11 +2790,8 @@ Iso88591ToUtfProc(
{
const char *srcStart, *srcEnd;
const char *dstEnd, *dstStart;
int result, numChars, charLimit = INT_MAX;
int result, numChars;
if (flags & TCL_ENCODING_CHAR_LIMIT) {
charLimit = *dstCharsPtr;
}
srcStart = src;
srcEnd = src + srcLen;
@@ -2841,7 +2799,7 @@ Iso88591ToUtfProc(
dstEnd = dst + dstLen - TCL_UTF_MAX;
result = TCL_OK;
for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
for (numChars = 0; src < srcEnd; numChars++) {
Tcl_UniChar ch;
if (dst > dstEnd) {
@@ -3002,9 +2960,7 @@ TableFreeProc(
*/
ckfree(dataPtr->toUnicode);
dataPtr->toUnicode = NULL;
ckfree(dataPtr->fromUnicode);
dataPtr->fromUnicode = NULL;
ckfree(dataPtr);
}
@@ -3057,12 +3013,9 @@ EscapeToUtfProc(
const char *prefixBytes, *tablePrefixBytes, *srcStart, *srcEnd;
const unsigned short *const *tableToUnicode;
const Encoding *encodingPtr;
int state, result, numChars, charLimit = INT_MAX;
int state, result, numChars;
const char *dstStart, *dstEnd;
if (flags & TCL_ENCODING_CHAR_LIMIT) {
charLimit = *dstCharsPtr;
}
result = TCL_OK;
tablePrefixBytes = NULL; /* lint. */
tableToUnicode = NULL; /* lint. */
@@ -3080,7 +3033,7 @@ EscapeToUtfProc(
state = 0;
}
for (numChars = 0; src < srcEnd && numChars <= charLimit; ) {
for (numChars = 0; src < srcEnd; ) {
int byte, hi, lo, ch;
if (dst > dstEnd) {
@@ -3480,7 +3433,6 @@ EscapeFreeProc(
subTablePtr = dataPtr->subTables;
for (i = 0; i < dataPtr->numSubTables; i++) {
FreeEncoding((Tcl_Encoding) subTablePtr->encodingPtr);
subTablePtr->encodingPtr = NULL;
subTablePtr++;
}
}
+1 -35
View File
@@ -2749,7 +2749,6 @@ TclCompileEnsemble(
int ourResult = TCL_ERROR;
unsigned numBytes;
const char *word;
DefineLineInformation;
Tcl_IncrRefCount(replaced);
if (parsePtr->numWords < depth + 1) {
@@ -3008,23 +3007,6 @@ TclCompileEnsemble(
goto cleanup;
}
/*
* Throw out any line information generated by the failed compile attempt.
*/
while (mapPtr->nuloc - 1 > eclIndex) {
mapPtr->nuloc--;
ckfree(mapPtr->loc[mapPtr->nuloc].line);
mapPtr->loc[mapPtr->nuloc].line = NULL;
}
/*
* Reset the index of next command. Toss out any from failed nested
* partial compiles.
*/
envPtr->numCommands = mapPtr->nuloc;
/*
* Failed to do a full compile for some reason. Try to do a direct invoke
* instead of going through the ensemble lookup process again.
@@ -3037,24 +3019,8 @@ TclCompileEnsemble(
cmdPtr = oldCmdPtr;
depth--;
}
(void) Tcl_ListObjReplace(NULL, replaced, depth, 2, 0, NULL);
}
/*
* The length of the "replaced" list must be depth-1. Trim back
* any extra elements that might have been appended by failing
* pathways above.
*/
(void) Tcl_ListObjReplace(NULL, replaced, depth-1, INT_MAX, 0, NULL);
/*
* TODO: Reconsider whether we ought to call CompileToInvokedCommand()
* when depth==1. In that case we are choosing to emit the
* INST_INVOKE_REPLACE bytecode when there is in fact no replacing
* to be done. It would be equally functional and presumably more
* performant to fall through to cleanup below, return TCL_ERROR,
* and let the compiler harness emit the INST_INVOKE_STK
* implementation for us.
*/
CompileToInvokedCommand(interp, parsePtr, replaced, cmdPtr, envPtr);
ourResult = TCL_OK;
}
+98 -1
View File
@@ -43,6 +43,11 @@ static char * EnvTraceProc(ClientData clientData, Tcl_Interp *interp,
static void ReplaceString(const char *oldStr, char *newStr);
MODULE_SCOPE void TclSetEnv(const char *name, const char *value);
MODULE_SCOPE void TclUnsetEnv(const char *name);
#if defined(__CYGWIN__)
static void TclCygwinPutenv(char *string);
# define putenv TclCygwinPutenv
#endif
/*
*----------------------------------------------------------------------
@@ -439,7 +444,7 @@ TclUnsetEnv(
* that no = should be included, and Windows requires it.
*/
#if defined(_WIN32)
#if defined(_WIN32) || defined(__CYGWIN__)
string = ckalloc(length + 2);
memcpy(string, name, (size_t) length);
string[length] = '=';
@@ -735,6 +740,98 @@ TclFinalizeEnvironment(void)
}
}
#if defined(__CYGWIN__)
/*
* When using cygwin, when an environment variable changes, we need to synch
* with both the cygwin environment (in case the application C code calls
* fork) and the Windows environment (in case the application TCL code calls
* exec, which calls the Windows CreateProcess function).
*/
DLLIMPORT extern void __stdcall SetEnvironmentVariableA(const char*, const char *);
static void
TclCygwinPutenv(
char *str)
{
char *name, *value;
/*
* Get the name and value, so that we can change the environment variable
* for Windows.
*/
name = alloca(strlen(str) + 1);
strcpy(name, str);
for (value=name ; *value!='=' && *value!='\0' ; ++value) {
/* Empty body */
}
if (*value == '\0') {
/* Can't happen. */
return;
}
*(value++) = '\0';
if (*value == '\0') {
value = NULL;
}
/*
* Set the cygwin environment variable.
*/
#undef putenv
if (value == NULL) {
unsetenv(name);
} else {
putenv(str);
}
/*
* Before changing the environment variable in Windows, if this is PATH,
* we need to convert the value back to a Windows style path.
*
* FIXME: The calling program may know it is running under windows, and
* may have set the path to a Windows path, or, worse, appended or
* prepended a Windows path to PATH.
*/
if (strcmp(name, "PATH") != 0) {
/*
* If this is Path, eliminate any PATH variable, to prevent any
* confusion.
*/
if (strcmp(name, "Path") == 0) {
SetEnvironmentVariableA("PATH", NULL);
unsetenv("PATH");
}
SetEnvironmentVariableA(name, value);
} else {
char *buf;
/*
* Eliminate any Path variable, to prevent any confusion.
*/
SetEnvironmentVariableA("Path", NULL);
unsetenv("Path");
if (value == NULL) {
buf = NULL;
} else {
int size;
size = cygwin_conv_path_list(0, value, NULL, 0);
buf = alloca(size + 1);
cygwin_conv_path_list(0, value, buf, size);
}
SetEnvironmentVariableA(name, buf);
}
}
#endif /* __CYGWIN__ */
/*
* Local Variables:
* mode: c
+4 -11
View File
@@ -119,7 +119,6 @@ static char * VwaitVarProc(ClientData clientData,
Tcl_Interp *interp, const char *name1,
const char *name2, int flags);
static void InvokeExitHandlers(void);
static void FinalizeThread(int quick);
/*
*----------------------------------------------------------------------
@@ -984,7 +983,7 @@ Tcl_Exit(
* Tcl_Channels that may have data enqueued.
*/
FinalizeThread(/* quick */ 1);
Tcl_FinalizeThread();
}
TclpExit(status);
Tcl_Panic("OS exit failed!");
@@ -1184,7 +1183,7 @@ Tcl_Finalize(void)
* This fixes the Tcl Bug #990552.
*/
TclFinalizeThreadData(/* quick */ 0);
TclFinalizeThreadData();
/*
* Now we can free constants for conversions to/from double.
@@ -1269,13 +1268,6 @@ Tcl_Finalize(void)
void
Tcl_FinalizeThread(void)
{
FinalizeThread(/* quick */ 0);
}
void
FinalizeThread(
int quick)
{
ExitHandler *exitPtr;
ThreadSpecificData *tsdPtr;
@@ -1317,7 +1309,8 @@ FinalizeThread(
*
* Fix [Bug #571002]
*/
TclFinalizeThreadData(quick);
TclFinalizeThreadData();
}
/*
+10 -11
View File
@@ -81,7 +81,9 @@ int tclTraceExec = 0;
static const char *const operatorStrings[] = {
"||", "&&", "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>",
"+", "-", "*", "/", "%", "+", "-", "~", "!"
"+", "-", "*", "/", "%", "+", "-", "~", "!",
"BUILTIN FUNCTION", "FUNCTION",
"", "", "", "", "", "", "", "", "eq", "ne"
};
/*
@@ -3185,8 +3187,8 @@ TEBCresume(
pc += 6;
TEBC_YIELD();
TclMarkTailcall(interp);
TclNRAddCallback(interp, TclClearRootEnsemble, NULL,NULL,NULL,NULL);
TclSkipTailcall(interp);
return TclNREvalObjEx(interp, objPtr, TCL_EVAL_INVOKE, NULL, INT_MIN);
/*
@@ -4946,7 +4948,6 @@ TEBCresume(
pc += pcAdjustment;
TEBC_YIELD();
TclPushTailcallPoint(interp);
oPtr = contextPtr->oPtr;
if (oPtr->flags & FILTER_HANDLING) {
TclNRAddCallback(interp, FinalizeOONextFilter,
@@ -5078,7 +5079,7 @@ TEBCresume(
valuePtr = OBJ_AT_TOS;
opnd = TclGetInt4AtPtr(pc+1);
TRACE(("\"%.30s\" %d => ", O2S(valuePtr), opnd));
TRACE(("\%.30s\" %d => ", O2S(valuePtr), opnd));
/*
* Get the contents of the list, making sure that it really is a list
@@ -5411,8 +5412,8 @@ TEBCresume(
s1 = (char *) Tcl_GetByteArrayFromObj(valuePtr, &s1len);
s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
memCmpFn = memcmp;
} else if ((valuePtr->typePtr == &tclStringType)
&& (value2Ptr->typePtr == &tclStringType)) {
} else if (((valuePtr->typePtr == &tclStringType)
&& (value2Ptr->typePtr == &tclStringType))) {
/*
* Do a unicode-specific comparison if both of the args are of
* String type. If the char length == byte length, we can do a
@@ -5423,9 +5424,7 @@ TEBCresume(
s1len = Tcl_GetCharLength(valuePtr);
s2len = Tcl_GetCharLength(value2Ptr);
if ((s1len == valuePtr->length)
&& (valuePtr->bytes != NULL)
&& (s2len == value2Ptr->length)
&& (value2Ptr->bytes != NULL)) {
&& (s2len == value2Ptr->length)) {
s1 = valuePtr->bytes;
s2 = value2Ptr->bytes;
memCmpFn = memcmp;
@@ -5592,7 +5591,7 @@ TEBCresume(
TclNewObj(objResultPtr);
} else if (TclIsPureByteArray(valuePtr)) {
objResultPtr = Tcl_NewByteArrayObj(
Tcl_GetByteArrayFromObj(valuePtr, NULL)+index, 1);
Tcl_GetByteArrayFromObj(valuePtr, &length)+index, 1);
} else if (valuePtr->bytes && length == valuePtr->length) {
objResultPtr = Tcl_NewStringObj((const char *)
valuePtr->bytes+index, 1);
@@ -9831,7 +9830,7 @@ IllegalExprOperandType(
if (opcode == INST_EXPON) {
operator = "**";
} else if (opcode <= INST_LNOT) {
} else if (opcode <= INST_STR_NEQ) {
operator = operatorStrings[opcode - INST_LOR];
}
+4 -4
View File
@@ -235,9 +235,9 @@ ExtractWinRoot(
if ((path[0] == 'c' || path[0] == 'C')
&& (path[1] == 'o' || path[1] == 'O')) {
if ((path[2] == 'm' || path[2] == 'M')
&& path[3] >= '1' && path[3] <= '9') {
&& path[3] >= '1' && path[3] <= '4') {
/*
* May have match for 'com[1-9]:?', which is a serial port.
* May have match for 'com[1-4]:?', which is a serial port.
*/
if (path[4] == '\0') {
@@ -257,9 +257,9 @@ ExtractWinRoot(
} else if ((path[0] == 'l' || path[0] == 'L')
&& (path[1] == 'p' || path[1] == 'P')
&& (path[2] == 't' || path[2] == 'T')) {
if (path[3] >= '1' && path[3] <= '9') {
if (path[3] >= '1' && path[3] <= '3') {
/*
* May have match for 'lpt[1-9]:?'
* May have match for 'lpt[1-3]:?'
*/
if (path[4] == '\0') {
+113 -362
View File
@@ -35,15 +35,15 @@ typedef struct ChannelHandler {
/*
* This structure keeps track of the current ChannelHandler being invoked in
* the current invocation of Tcl_NotifyChannel. There is a potential
* the current invocation of ChannelHandlerEventProc. There is a potential
* problem if a ChannelHandler is deleted while it is the current one, since
* Tcl_NotifyChannel needs to look at the nextPtr field. To handle this
* ChannelHandlerEventProc needs to look at the nextPtr field. To handle this
* problem, structures of the type below indicate the next handler to be
* processed for any (recursively nested) dispatches in progress. The
* nextHandlerPtr field is updated if the handler being pointed to is deleted.
* The nestedHandlerPtr field is used to chain together all recursive
* invocations, so that Tcl_DeleteChannelHandler can find all the recursively
* nested invocations of Tcl_NotifyChannel and compare the handler being
* The nextPtr field is used to chain together all recursive invocations, so
* that Tcl_DeleteChannelHandler can find all the recursively nested
* invocations of ChannelHandlerEventProc and compare the handler being
* deleted against the NEXT handler to be invoked in that invocation; when it
* finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr
* field of the structure to the next handler.
@@ -54,9 +54,20 @@ typedef struct NextChannelHandler {
* this invocation. */
struct NextChannelHandler *nestedHandlerPtr;
/* Next nested invocation of
* Tcl_NotifyChannel. */
* ChannelHandlerEventProc. */
} NextChannelHandler;
/*
* The following structure describes the event that is added to the Tcl
* event queue by the channel handler check procedure.
*/
typedef struct ChannelHandlerEvent {
Tcl_Event header; /* Standard header for all events. */
Channel *chanPtr; /* The channel that is ready. */
int readyMask; /* Events that have occurred. */
} ChannelHandlerEvent;
/*
* The following structure is used by Tcl_GetsObj() to encapsulates the
* state for a "gets" operation.
@@ -119,7 +130,7 @@ typedef struct CopyState {
typedef struct ThreadSpecificData {
NextChannelHandler *nestedHandlerPtr;
/* This variable holds the list of nested
* Tcl_NotifyChannel invocations. */
* ChannelHandlerEventProc invocations. */
ChannelState *firstCSPtr; /* List of all channels currently open,
* indexed by ChannelState, as only one
* ChannelState exists per set of stacked
@@ -155,7 +166,6 @@ static ChannelBuffer * AllocChannelBuffer(int length);
static void PreserveChannelBuffer(ChannelBuffer *bufPtr);
static void ReleaseChannelBuffer(ChannelBuffer *bufPtr);
static int IsShared(ChannelBuffer *bufPtr);
static void ChannelFree(Channel *chanPtr);
static void ChannelTimerProc(ClientData clientData);
static int ChanRead(Channel *chanPtr, char *dst, int dstSize);
static int CheckChannelErrors(ChannelState *statePtr,
@@ -421,11 +431,7 @@ ChanRead(
* Each read op must set the blocked and eof states anew, not let
* the effect of prior reads leak through.
*/
if (GotFlag(chanPtr->state, CHANNEL_EOF)) {
chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START;
}
ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF);
chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END;
if (WillRead(chanPtr) < 0) {
return -1;
}
@@ -434,11 +440,7 @@ ChanRead(
dst, dstSize, &result);
/* Stop any flag leakage through stacked channel levels */
if (GotFlag(chanPtr->state, CHANNEL_EOF)) {
chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START;
}
ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF);
chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END;
if (bytesRead > 0) {
/*
* If we get a short read, signal up that we may be BLOCKED.
@@ -624,7 +626,6 @@ TclFinalizeIOSubsystem(void)
if (active) {
TclChannelPreserve((Tcl_Channel)chanPtr);
/*
* TIP #398: by default, we no longer set the channel back into
* blocking mode. To restore the old blocking behavior, the
@@ -683,7 +684,6 @@ TclFinalizeIOSubsystem(void)
chanPtr->instanceData = NULL;
SetFlag(statePtr, CHANNEL_DEAD);
}
TclChannelRelease((Tcl_Channel)chanPtr);
}
}
@@ -1556,22 +1556,6 @@ Tcl_CreateChannel(
*/
assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc *));
assert(typePtr->typeName != NULL);
if (NULL == typePtr->closeProc) {
Tcl_Panic("channel type %s must define closeProc", typePtr->typeName);
}
if ((TCL_READABLE & mask) && (NULL == typePtr->inputProc)) {
Tcl_Panic("channel type %s must define inputProc when used for reader channel", typePtr->typeName);
}
if ((TCL_WRITABLE & mask) && (NULL == typePtr->outputProc)) {
Tcl_Panic("channel type %s must define outputProc when used for writer channel", typePtr->typeName);
}
if (NULL == typePtr->watchProc) {
Tcl_Panic("channel type %s must define watchProc", typePtr->typeName);
}
if ((NULL!=typePtr->wideSeekProc) && (NULL == typePtr->seekProc)) {
Tcl_Panic("channel type %s must define seekProc if defining wideSeekProc", typePtr->typeName);
}
/*
* JH: We could subsequently memset these to 0 to avoid the numerous
@@ -1939,16 +1923,6 @@ TclChannelRelease(
}
}
static void
ChannelFree(
Channel *chanPtr)
{
if (chanPtr->refCount == 0) {
ckfree(chanPtr);
return;
}
chanPtr->typePtr = NULL;
}
/*
*----------------------------------------------------------------------
@@ -2095,7 +2069,7 @@ Tcl_UnstackChannel(
*/
result = ChanClose(chanPtr, interp);
ChannelFree(chanPtr);
chanPtr->typePtr = NULL;
UpdateInterest(statePtr->topChanPtr);
@@ -2657,8 +2631,6 @@ FlushChannel(
* the post-condition that on a successful return to caller we've
* left space in the current output buffer for more writing (the flush
* call was to make new room).
* If the channel is blocking, then yes, so we guarantee that
* blocking flushes actually flush all pending data.
* Otherwise, no. Keep the current output buffer where it is so more
* can be written to it, possibly filling it, to promote more efficient
* buffer usage.
@@ -2666,8 +2638,7 @@ FlushChannel(
bufPtr = statePtr->curOutPtr;
if (bufPtr && BytesLeft(bufPtr) && /* Keep empties off queue */
(statePtr->outQueueHead == NULL || IsBufferFull(bufPtr)
|| !GotFlag(statePtr, CHANNEL_NONBLOCKING))) {
(statePtr->outQueueHead == NULL || IsBufferFull(bufPtr))) {
if (statePtr->outQueueHead == NULL) {
statePtr->outQueueHead = bufPtr;
} else {
@@ -2849,15 +2820,9 @@ FlushChannel(
* write in this call, and we've completed the BG flush.
* These are the two cases above. If we get here, that means
* there is some kind failure in the writable event machinery.
*
* The tls extension indeed suffers from flaws in its channel
* event mgmt. See http://core.tcl.tk/tcl/info/c31ca233ca.
* Until that patch is broadly distributed, disable the
* assertion checking here, so that programs using Tcl and
* tls can be debugged.
*/
assert(!calledFromAsyncFlush);
*/
}
}
@@ -3056,8 +3021,7 @@ CloseChannel(
statePtr->topChanPtr = downChanPtr;
downChanPtr->upChanPtr = NULL;
ChannelFree(chanPtr);
chanPtr->typePtr = NULL;
return Tcl_Close(interp, (Tcl_Channel) downChanPtr);
}
@@ -3068,7 +3032,7 @@ CloseChannel(
* stack, make sure to free the ChannelState structure associated with it.
*/
ChannelFree(chanPtr);
chanPtr->typePtr = NULL;
Tcl_EventuallyFree(statePtr, TCL_DYNAMIC);
@@ -3939,10 +3903,7 @@ Tcl_Write(
if (srcLen < 0) {
srcLen = strlen(src);
}
if (WriteBytes(chanPtr, src, srcLen) < 0) {
return -1;
}
return srcLen;
return WriteBytes(chanPtr, src, srcLen);
}
/*
@@ -4432,21 +4393,6 @@ Tcl_GetsObj(
return -1;
}
/*
* If we're sitting ready to read the eofchar, there's no need to
* do it.
*/
if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
SetFlag(statePtr, CHANNEL_EOF);
assert( statePtr->inputEncodingFlags & TCL_ENCODING_END );
assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) );
/* TODO: Do we need this? */
UpdateInterest(chanPtr);
return -1;
}
/*
* A binary version of Tcl_GetsObj. This could also handle encodings that
* are ascii-7 pure (iso8859, utf-8, ...) with a final encoding conversion
@@ -4513,7 +4459,6 @@ Tcl_GetsObj(
eof = NULL;
inEofChar = statePtr->inEofChar;
ResetFlag(statePtr, CHANNEL_BLOCKED);
while (1) {
if (dst >= dstEnd) {
if (FilterInputBytes(chanPtr, &gs) != 0) {
@@ -4605,14 +4550,14 @@ Tcl_GetsObj(
* Skip the raw bytes that make up the '\n'.
*/
char tmp[TCL_UTF_MAX];
char tmp[1 + TCL_UTF_MAX];
int rawRead;
bufPtr = gs.bufPtr;
Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr),
gs.rawRead, statePtr->inputEncodingFlags
| TCL_ENCODING_NO_TERMINATE, &gs.state, tmp,
TCL_UTF_MAX, &rawRead, NULL, NULL);
gs.rawRead, statePtr->inputEncodingFlags,
&gs.state, tmp, 1 + TCL_UTF_MAX, &rawRead, NULL,
NULL);
bufPtr->nextRemoved += rawRead;
gs.rawRead -= rawRead;
gs.bytesWrote--;
@@ -4665,7 +4610,6 @@ Tcl_GetsObj(
dstEnd = eof;
SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
statePtr->inputEncodingFlags |= TCL_ENCODING_END;
ResetFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR);
}
if (GotFlag(statePtr, CHANNEL_EOF)) {
skip = 0;
@@ -4713,9 +4657,8 @@ Tcl_GetsObj(
}
statePtr->inputEncodingState = gs.state;
Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr), gs.rawRead,
statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE,
&statePtr->inputEncodingState, dst,
eol - dst + skip + TCL_UTF_MAX - 1, &gs.rawRead, NULL,
statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst,
eol - dst + skip + TCL_UTF_MAX, &gs.rawRead, NULL,
&gs.charsWrote);
bufPtr->nextRemoved += gs.rawRead;
@@ -4780,13 +4723,6 @@ Tcl_GetsObj(
*/
done:
assert(!GotFlag(statePtr, CHANNEL_EOF)
|| GotFlag(statePtr, CHANNEL_STICKY_EOF)
|| Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
== (CHANNEL_EOF|CHANNEL_BLOCKED)) );
/*
* Regenerate the top channel, in case it was changed due to
* self-modifying reflected transforms.
@@ -4810,11 +4746,6 @@ Tcl_GetsObj(
* end-of-line or end-of-file has been seen. Bytes read from the input
* channel return as a ByteArray obj.
*
* WARNING! The notion of "binary" used here is different from
* notions of "binary" used in other places. In particular, this
* "binary" routine may be called when an -eofchar is set on the
* channel.
*
* Results:
* Number of characters accumulated in the object or -1 if error,
* blocked, or EOF. If -1, use Tcl_GetErrno() to retrieve the POSIX error
@@ -4876,7 +4807,6 @@ TclGetsObjBinary(
eolChar = (statePtr->inputTranslation == TCL_TRANSLATE_LF) ? '\n' : '\r';
ResetFlag(statePtr, CHANNEL_BLOCKED);
while (1) {
/*
* Subtract the number of bytes that were removed from channel
@@ -4903,17 +4833,6 @@ TclGetsObjBinary(
if (bufPtr == NULL) {
goto restore;
}
} else {
/*
* Incoming CHANNEL_STICKY_EOF is filtered out on entry.
* A new CHANNEL_STICKY_EOF set in this routine leads to
* return before coming back here. When we are not dealing
* with CHANNEL_STICKY_EOF, a CHANNEL_EOF implies an
* empty buffer. Here the buffer is non-empty so we know
* we're a non-EOF */
assert ( !GotFlag(statePtr, CHANNEL_STICKY_EOF) );
assert ( !GotFlag(statePtr, CHANNEL_EOF) );
}
dst = (unsigned char *) RemovePoint(bufPtr);
@@ -4955,7 +4874,6 @@ TclGetsObjBinary(
SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
statePtr->inputEncodingFlags |= TCL_ENCODING_END;
ResetFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR);
}
if (GotFlag(statePtr, CHANNEL_EOF)) {
skip = 0;
@@ -5065,11 +4983,6 @@ TclGetsObjBinary(
*/
done:
assert(!GotFlag(statePtr, CHANNEL_EOF)
|| GotFlag(statePtr, CHANNEL_STICKY_EOF)
|| Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
== (CHANNEL_EOF|CHANNEL_BLOCKED)) );
UpdateInterest(chanPtr);
TclChannelRelease((Tcl_Channel)chanPtr);
return copiedTotal;
@@ -5182,12 +5095,6 @@ FilterInputBytes(
*/
read:
if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)
== (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) {
gsPtr->charsWrote = 0;
gsPtr->rawRead = 0;
return -1;
}
if (GetInput(chanPtr) != 0) {
gsPtr->charsWrote = 0;
gsPtr->rawRead = 0;
@@ -5200,17 +5107,6 @@ FilterInputBytes(
gsPtr->rawRead = 0;
return -1;
}
} else {
/*
* Incoming CHANNEL_STICKY_EOF is filtered out on entry.
* A new CHANNEL_STICKY_EOF set in this routine leads to
* return before coming back here. When we are not dealing
* with CHANNEL_STICKY_EOF, a CHANNEL_EOF implies an
* empty buffer. Here the buffer is non-empty so we know
* we're a non-EOF */
assert ( !GotFlag(statePtr, CHANNEL_STICKY_EOF) );
assert ( !GotFlag(statePtr, CHANNEL_EOF) );
}
/*
@@ -5247,9 +5143,9 @@ FilterInputBytes(
}
gsPtr->state = statePtr->inputEncodingState;
result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,
statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE,
&statePtr->inputEncodingState, dst, spaceLeft, &gsPtr->rawRead,
&gsPtr->bytesWrote, &gsPtr->charsWrote);
statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
dst, spaceLeft+1, &gsPtr->rawRead, &gsPtr->bytesWrote,
&gsPtr->charsWrote);
/*
* Make sure that if we go through 'gets', that we reset the
@@ -5289,6 +5185,12 @@ FilterInputBytes(
* some more, but avoid blocking on a non-blocking channel.
*/
if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)
== (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) {
gsPtr->charsWrote = 0;
gsPtr->rawRead = 0;
return -1;
}
goto read;
}
} else {
@@ -5535,7 +5437,6 @@ Tcl_ReadRaw(
/* State info for channel */
int copied = 0;
assert(bytesToRead > 0);
if (CheckChannelErrors(statePtr, TCL_READABLE | CHANNEL_RAW_MODE) != 0) {
return -1;
}
@@ -5567,19 +5468,8 @@ Tcl_ReadRaw(
}
}
/*
* Go to the driver only if we got nothing from pushback.
* Have to do it this way to avoid EOF mis-timings when we
* consider the ability that EOF may not be a permanent
* condition in the driver, and in that case we have to
* synchronize.
*/
/* Go to the driver if more data needed. */
if (copied) {
return copied;
}
/* This test not needed. */
if (bytesToRead > 0) {
int nread = ChanRead(chanPtr, readBuf, bytesToRead);
@@ -5602,10 +5492,12 @@ Tcl_ReadRaw(
if (!GotFlag(statePtr, CHANNEL_BLOCKED) || copied == 0) {
copied = -1;
}
} else {
} else if (copied > 0) {
/*
* nread == 0. Driver is at EOF. Let that state filter up.
* nread == 0. Driver is at EOF, but if copied>0 bytes
* from pushback, then we should not signal it yet.
*/
ResetFlag(statePtr, CHANNEL_EOF);
}
}
return copied;
@@ -5704,11 +5596,19 @@ DoReadChars(
ChannelState *statePtr = chanPtr->state;
/* State info for channel */
ChannelBuffer *bufPtr;
int copied, copiedNow, result;
Tcl_Encoding encoding = statePtr->encoding;
int factor, copied, copiedNow, result;
Tcl_Encoding encoding;
int binaryMode;
#define UTF_EXPANSION_FACTOR 1024
int factor = UTF_EXPANSION_FACTOR;
/*
* This operation should occur at the top of a channel stack.
*/
chanPtr = statePtr->topChanPtr;
encoding = statePtr->encoding;
factor = UTF_EXPANSION_FACTOR;
TclChannelPreserve((Tcl_Channel)chanPtr);
binaryMode = (encoding == NULL)
&& (statePtr->inputTranslation == TCL_TRANSLATE_LF)
@@ -5732,46 +5632,8 @@ DoReadChars(
}
}
/*
* Early out when next read will see eofchar.
*
* NOTE: See DoRead for argument that it's a bug (one we're keeping)
* to have this escape before the one for zero-char read request.
*/
if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
SetFlag(statePtr, CHANNEL_EOF);
assert( statePtr->inputEncodingFlags & TCL_ENCODING_END );
assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) );
UpdateInterest(chanPtr);
return 0;
}
/* Special handling for zero-char read request. */
if (toRead == 0) {
if (GotFlag(statePtr, CHANNEL_EOF)) {
statePtr->inputEncodingFlags |= TCL_ENCODING_START;
}
ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
UpdateInterest(chanPtr);
return 0;
}
/*
* This operation should occur at the top of a channel stack.
*/
chanPtr = statePtr->topChanPtr;
TclChannelPreserve((Tcl_Channel)chanPtr);
/* Must clear the BLOCKED|EOF flags here since we check before reading */
if (GotFlag(statePtr, CHANNEL_EOF)) {
statePtr->inputEncodingFlags |= TCL_ENCODING_START;
}
ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
/* Must clear the BLOCKED flag here since we check before reading */
ResetFlag(statePtr, CHANNEL_BLOCKED);
for (copied = 0; (unsigned) toRead > 0; ) {
copiedNow = -1;
if (statePtr->inQueueHead != NULL) {
@@ -5846,11 +5708,6 @@ DoReadChars(
* Update the notifier state so we don't block while there is still data
* in the buffers.
*/
assert(!GotFlag(statePtr, CHANNEL_EOF)
|| GotFlag(statePtr, CHANNEL_STICKY_EOF)
|| Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
== (CHANNEL_EOF|CHANNEL_BLOCKED)) );
UpdateInterest(chanPtr);
TclChannelRelease((Tcl_Channel)chanPtr);
return copied;
@@ -5964,7 +5821,7 @@ ReadChars(
int savedIEFlags = statePtr->inputEncodingFlags;
int savedFlags = statePtr->flags;
char *dst, *src = RemovePoint(bufPtr);
int numBytes, srcLen = BytesLeft(bufPtr);
int dstLimit, numBytes, srcLen = BytesLeft(bufPtr);
/*
* One src byte can yield at most one character. So when the
@@ -5983,14 +5840,14 @@ ReadChars(
*/
int factor = *factorPtr;
int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;
int dstNeeded = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;
(void) TclGetStringFromObj(objPtr, &numBytes);
Tcl_AppendToObj(objPtr, NULL, dstLimit);
Tcl_AppendToObj(objPtr, NULL, dstNeeded);
if (toRead == srcLen) {
unsigned int size;
dst = TclGetStringStorage(objPtr, &size) + numBytes;
dstLimit = size - numBytes;
dstNeeded = size - numBytes;
} else {
dst = TclGetString(objPtr) + numBytes;
}
@@ -6011,35 +5868,18 @@ ReadChars(
* a consistent set of results. This takes the shape of a loop.
*/
dstLimit = dstNeeded + 1;
while (1) {
int dstDecoded, dstRead, dstWrote, srcRead, numChars, code;
int flags = statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE;
if (charsToRead > 0) {
flags |= TCL_ENCODING_CHAR_LIMIT;
numChars = charsToRead;
}
int dstDecoded, dstRead, dstWrote, srcRead, numChars;
/*
* Perform the encoding transformation. Read no more than
* srcLen bytes, write no more than dstLimit bytes.
*
* Some trickiness with encoding flags here. We do not want
* the end of a buffer to be treated as the end of all input
* when the presence of bytes in a next buffer are already
* known to exist. This is checked with an assert() because
* so far no test case causing the assertion to be false has
* been created. The normal operations of channel reading
* appear to cause EOF and TCL_ENCODING_END setting to appear
* only in situations where there are no further bytes in
* any buffers.
*/
assert(bufPtr->nextPtr == NULL || BytesLeft(bufPtr->nextPtr) == 0
|| (statePtr->inputEncodingFlags & TCL_ENCODING_END) == 0);
code = Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
flags, &statePtr->inputEncodingState,
int code = Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
statePtr->inputEncodingFlags & (bufPtr->nextPtr
? ~0 : ~TCL_ENCODING_END), &statePtr->inputEncodingState,
dst, dstLimit, &srcRead, &dstDecoded, &numChars);
/*
@@ -6103,7 +5943,7 @@ ReadChars(
* time.
*/
dstLimit = dstRead - 1 + TCL_UTF_MAX;
dstLimit = dstRead + TCL_UTF_MAX;
statePtr->flags = savedFlags;
statePtr->inputEncodingFlags = savedIEFlags;
statePtr->inputEncodingState = savedState;
@@ -6129,7 +5969,7 @@ ReadChars(
* up back here in this call.
*/
dstLimit = dstRead - 1 + TCL_UTF_MAX;
dstLimit = dstRead + TCL_UTF_MAX;
statePtr->flags = savedFlags;
statePtr->inputEncodingFlags = savedIEFlags;
statePtr->inputEncodingState = savedState;
@@ -6146,7 +5986,7 @@ ReadChars(
*/
if (code != TCL_OK) {
char buffer[TCL_UTF_MAX + 1];
char buffer[TCL_UTF_MAX + 2];
int read, decoded, count;
/*
@@ -6157,14 +5997,10 @@ ReadChars(
statePtr->inputEncodingFlags = savedIEFlags;
statePtr->inputEncodingState = savedState;
assert(bufPtr->nextPtr == NULL
|| BytesLeft(bufPtr->nextPtr) == 0 || 0 ==
(statePtr->inputEncodingFlags & TCL_ENCODING_END));
Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
(statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE),
&statePtr->inputEncodingState, buffer, TCL_UTF_MAX + 1,
&read, &decoded, &count);
statePtr->inputEncodingFlags & (bufPtr->nextPtr
? ~0 : ~TCL_ENCODING_END), &statePtr->inputEncodingState,
buffer, TCL_UTF_MAX + 2, &read, &decoded, &count);
if (count == 2) {
if (buffer[1] == '\n') {
@@ -6176,6 +6012,7 @@ ReadChars(
bufPtr->nextRemoved += srcRead;
}
dst[1] = '\0';
statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
Tcl_SetObjLength(objPtr, numBytes + 1);
@@ -6216,15 +6053,14 @@ ReadChars(
if (charsToRead > 0 && numChars > charsToRead) {
/*
* TODO: This cannot happen anymore.
*
* We read more chars than allowed. Reset limits to
* prevent that and try again. Don't forget the extra
* padding of TCL_UTF_MAX bytes demanded by the
* padding of TCL_UTF_MAX - 1 bytes demanded by the
* Tcl_ExternalToUtf() call!
*/
dstLimit = Tcl_UtfAtIndex(dst, charsToRead) - 1 + TCL_UTF_MAX - dst;
dstLimit = Tcl_UtfAtIndex(dst, charsToRead + 1)
+ TCL_UTF_MAX - 1 - dst;
statePtr->flags = savedFlags;
statePtr->inputEncodingFlags = savedIEFlags;
statePtr->inputEncodingState = savedState;
@@ -6248,8 +6084,9 @@ ReadChars(
* empty string.
*/
if (dstRead == 1 && dst[0] == '\n') {
if (dst[0] == '\n') {
assert(statePtr->inputTranslation == TCL_TRANSLATE_AUTO);
assert(dstRead == 1);
goto consume;
}
@@ -6480,7 +6317,7 @@ TranslateInputEOL(
SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
statePtr->inputEncodingFlags |= TCL_ENCODING_END;
ResetFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR);
ResetFlag(statePtr, INPUT_SAW_CR);
}
}
@@ -6537,13 +6374,9 @@ Tcl_Ungets(
/*
* Clear the EOF flags, and clear the BLOCKED bit.
*/
if (GotFlag(statePtr, CHANNEL_EOF)) {
statePtr->inputEncodingFlags |= TCL_ENCODING_START;
}
ResetFlag(statePtr,
CHANNEL_BLOCKED | CHANNEL_STICKY_EOF | CHANNEL_EOF | INPUT_SAW_CR);
statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
bufPtr = AllocChannelBuffer(len);
memcpy(InsertPoint(bufPtr), str, (size_t) len);
@@ -6694,14 +6527,6 @@ GetInput(
ChannelState *statePtr = chanPtr->state;
/* State info for channel */
/*
* Verify that all callers know better than to call us when
* it's recorded that the next char waiting to be read is the
* eofchar.
*/
assert( !GotFlag(statePtr, CHANNEL_STICKY_EOF) );
/*
* Prevent reading from a dead channel -- a channel that has been closed
* but not yet deallocated, which can happen if the exit handler for
@@ -6713,24 +6538,18 @@ GetInput(
return EINVAL;
}
/*
* WARNING: There was once a comment here claiming that it was
* a bad idea to make another call to the inputproc of a channel
* driver when EOF has already been detected on the channel. Through
* much of Tcl's history, this warning was then completely negated
* by having all (most?) read paths clear the EOF setting before
* reaching here. So we had a guard that was never triggered.
*
* Don't be tempted to restore the guard. Even if EOF is set on
* the channel, continue through and call the inputproc again. This
* is the way to enable the ability to [read] again beyond the EOF,
* which seems a strange thing to do, but for which use cases exist
* [Tcl Bug 5adc350683] and which may even be essential for channels
* representing things like ttys or other devices where the stream
* might take the logical form of a series of 'files' separated by
* an EOF condition.
/*
* For a channel at EOF do not bother allocating buffers; there's
* nothing more to read. Avoid calling the driver inputproc in
* case some of them do not react well to additional calls after
* they've reported an eof state..
* TODO: Candidate for a can't happen panic.
*/
if (GotFlag(statePtr, CHANNEL_EOF)) {
return 0;
}
/*
* First check for more buffers in the pushback area of the topmost
* channel in the stack and use them. They can be the result of a
@@ -6740,7 +6559,6 @@ GetInput(
if (chanPtr->inQueueHead != NULL) {
/* TODO: Tests to cover this. */
assert(statePtr->inQueueHead == NULL);
statePtr->inQueueHead = chanPtr->inQueueHead;
@@ -6771,7 +6589,6 @@ GetInput(
* Check the actual buffersize against the requested buffersize.
* Saved buffers of the wrong size are squashed. This is done
* to honor dynamic changes of the buffersize made by the user.
* TODO: Tests to cover this.
*/
if ((bufPtr != NULL)
@@ -6913,12 +6730,8 @@ Tcl_Seek(
* point. Also clear CR related flags.
*/
if (GotFlag(statePtr, CHANNEL_EOF)) {
statePtr->inputEncodingFlags |= TCL_ENCODING_START;
}
ResetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED |
INPUT_SAW_CR);
statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
/*
* If the channel is in asynchronous output mode, switch it back to
@@ -7293,7 +7106,9 @@ Tcl_Eof(
ChannelState *statePtr = ((Channel *) chan)->state;
/* State of real channel structure. */
return GotFlag(statePtr, CHANNEL_EOF) ? 1 : 0;
return (GotFlag(statePtr, CHANNEL_STICKY_EOF) ||
(GotFlag(statePtr, CHANNEL_EOF) &&
(Tcl_InputBuffered(chan) == 0))) ? 1 : 0;
}
/*
@@ -8012,11 +7827,7 @@ Tcl_SetChannelOption(
* ahead'. Ditto for blocked.
*/
if (GotFlag(statePtr, CHANNEL_EOF)) {
statePtr->inputEncodingFlags |= TCL_ENCODING_START;
}
ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_STICKY_EOF|CHANNEL_BLOCKED);
statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
return TCL_OK;
} else if (HaveOpt(1, "-translation")) {
const char *readMode, *writeMode;
@@ -8287,7 +8098,7 @@ Tcl_NotifyChannel(
/*
* Add this invocation to the list of recursive invocations of
* Tcl_NotifyChannel.
* ChannelHandlerEventProc.
*/
nh.nextHandlerPtr = NULL;
@@ -8302,7 +8113,7 @@ Tcl_NotifyChannel(
if ((chPtr->mask & mask) != 0) {
nh.nextHandlerPtr = chPtr->nextPtr;
chPtr->proc(chPtr->clientData, chPtr->mask & mask);
chPtr->proc(chPtr->clientData, mask);
chPtr = nh.nextHandlerPtr;
} else {
chPtr = chPtr->nextPtr;
@@ -8606,7 +8417,7 @@ Tcl_DeleteChannelHandler(
}
/*
* If Tcl_NotifyChannel is about to process this handler, tell it to
* If ChannelHandlerEventProc is about to process this handler, tell it to
* process the next one instead - we are going to delete *this* one.
*/
@@ -9219,7 +9030,7 @@ MBRead(
}
code = GetInput(inStatePtr->topChanPtr);
if (code == 0 || GotFlag(inStatePtr, CHANNEL_BLOCKED)) {
if (code == 0) {
return TCL_OK;
} else {
MBError(csPtr, TCL_READABLE, code);
@@ -9235,8 +9046,7 @@ MBWrite(
ChannelState *outStatePtr = csPtr->writePtr->state;
ChannelBuffer *bufPtr = inStatePtr->inQueueHead;
ChannelBuffer *tail = NULL;
int code;
Tcl_WideInt inBytes = 0;
int code, inBytes = 0;
/* Count up number of bytes waiting in the input queue */
while (bufPtr) {
@@ -9251,14 +9061,7 @@ MBWrite(
if (bufPtr) {
/* Split the overflowing buffer in two */
int extra = (int) (inBytes - csPtr->toRead);
/* Note that going with int for extra assumes that inBytes is not too
* much over toRead to require a wide itself. If that gets violated
* then the calculations involving extra must be made wide too.
*
* Noted with Win32/MSVC debug build treating the warning (possible of
* data in int64 to int conversion) as error.
*/
int extra = inBytes - csPtr->toRead;
bufPtr = AllocChannelBuffer(extra);
@@ -9284,9 +9087,6 @@ MBWrite(
}
outStatePtr->outQueueTail = tail;
inStatePtr->inQueueHead = bufPtr;
if (inStatePtr->inQueueTail == tail) {
inStatePtr->inQueueTail = bufPtr;
}
if (bufPtr == NULL) {
inStatePtr->inQueueTail = NULL;
}
@@ -9472,10 +9272,6 @@ CopyData(
csPtr);
}
if (size == 0) {
if (!GotFlag(inStatePtr, CHANNEL_NONBLOCKING)) {
/* We allowed a short read. Keep trying. */
continue;
}
if (bufObj != NULL) {
TclDecrRefCount(bufObj);
bufObj = NULL;
@@ -9687,40 +9483,6 @@ DoRead(
ChannelState *statePtr = chanPtr->state;
char *p = dst;
assert (bytesToRead >= 0);
/*
* Early out when we know a read will get the eofchar.
*
* NOTE: This seems to be a bug. The special handling for
* a zero-char read request ought to come first. As coded
* the EOF due to eofchar has distinguishing behavior from
* the EOF due to reported EOF on the underlying device, and
* that seems undesirable. However recent history indicates
* that new inconsistent behavior in a patchlevel has problems
* too. Keep on keeping on for now.
*/
if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
SetFlag(statePtr, CHANNEL_EOF);
assert( statePtr->inputEncodingFlags & TCL_ENCODING_END );
assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) );
UpdateInterest(chanPtr);
return 0;
}
/* Special handling for zero-char read request. */
if (bytesToRead == 0) {
if (GotFlag(statePtr, CHANNEL_EOF)) {
statePtr->inputEncodingFlags |= TCL_ENCODING_START;
}
ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
UpdateInterest(chanPtr);
return 0;
}
TclChannelPreserve((Tcl_Channel)chanPtr);
while (bytesToRead) {
/*
@@ -9732,14 +9494,18 @@ DoRead(
ChannelBuffer *bufPtr = statePtr->inQueueHead;
/*
* Don't read more data if we have what we need.
* When there's no buffered data to read, and we're at EOF,
* escape to the caller.
*/
while (!bufPtr || /* We got no buffer! OR */
(!IsBufferFull(bufPtr) && /* Our buffer has room AND */
(BytesLeft(bufPtr) < bytesToRead) ) ) {
/* Not enough bytes in it
* yet to fill the dst */
if (statePtr->flags & CHANNEL_EOF
&& (bufPtr == NULL || IsBufferEmpty(bufPtr))) {
break;
}
/* If there is no full buffer, attempt to create and/or fill one. */
while (!IsBufferFull(bufPtr)) {
int code;
moreData:
@@ -9748,11 +9514,11 @@ DoRead(
assert (bufPtr != NULL);
if (GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)) {
if (statePtr->flags & (CHANNEL_EOF|CHANNEL_BLOCKED)) {
/* Further reads cannot do any more */
break;
}
if (code) {
/* Read error */
UpdateInterest(chanPtr);
@@ -9791,7 +9557,8 @@ DoRead(
* 1) We're @EOF because we saw eof char.
*/
if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
if (statePtr->inEofChar
&& RemovePoint(bufPtr)[0] == statePtr->inEofChar) {
UpdateInterest(chanPtr);
break;
}
@@ -9842,33 +9609,17 @@ DoRead(
statePtr->inQueueTail = NULL;
}
RecycleBuffer(statePtr, bufPtr, 0);
bufPtr = statePtr->inQueueHead;
}
if ((GotFlag(statePtr, CHANNEL_NONBLOCKING) || allowShortReads)
&& GotFlag(statePtr, CHANNEL_BLOCKED)) {
break;
}
/*
* When there's no buffered data to read, and we're at EOF,
* escape to the caller.
*/
if (GotFlag(statePtr, CHANNEL_EOF)
&& (bufPtr == NULL || IsBufferEmpty(bufPtr))) {
break;
}
}
if (bytesToRead == 0) {
ResetFlag(statePtr, CHANNEL_BLOCKED);
}
assert(!GotFlag(statePtr, CHANNEL_EOF)
|| GotFlag(statePtr, CHANNEL_STICKY_EOF)
|| Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
== (CHANNEL_EOF|CHANNEL_BLOCKED)) );
TclChannelRelease((Tcl_Channel)chanPtr);
return (int)(p - dst);
}
+10 -21
View File
@@ -187,7 +187,6 @@ struct TransformChannelData {
Tcl_Channel self; /* Our own Channel handle. */
int readIsFlushed; /* Flag to note whether in.flushProc was
* called or not. */
int eofPending; /* Flag: EOF seen down, not raised up */
int flags; /* Currently CHANNEL_ASYNC or zero. */
int watchMask; /* Current watch/event/interest mask. */
int mode; /* Mode of parent channel, OR'ed combination
@@ -293,7 +292,6 @@ TclChannelTransform(
Tcl_DStringInit(&ds);
Tcl_GetChannelOption(interp, chan, "-blocking", &ds);
dataPtr->readIsFlushed = 0;
dataPtr->eofPending = 0;
dataPtr->flags = 0;
if (ds.string[0] == '0') {
dataPtr->flags |= CHANNEL_ASYNC;
@@ -626,7 +624,7 @@ TransformInputProc(
if (toRead == 0 || dataPtr->self == NULL) {
/*
* Catch a no-op. TODO: Is this a panic()?
* Catch a no-op.
*/
return 0;
}
@@ -678,17 +676,6 @@ TransformInputProc(
if (toRead <= 0) {
break;
}
if (dataPtr->eofPending) {
/*
* Already saw EOF from downChan; don't ask again.
* NOTE: Could move this up to avoid the last maxRead
* execution. Believe this would still be correct behavior,
* but the test suite tests the whole command callback
* sequence, so leave it unchanged for now.
*/
break;
}
/*
* Get bytes from the underlying channel.
@@ -724,7 +711,14 @@ TransformInputProc(
* on the down channel.
*/
dataPtr->eofPending = 1;
if (dataPtr->readIsFlushed) {
/*
* Already flushed, nothing to do anymore.
*/
break;
}
dataPtr->readIsFlushed = 1;
ExecuteCallback(dataPtr, NULL, A_FLUSH_READ, NULL, 0,
TRANSMIT_IBUF, P_PRESERVE);
@@ -752,11 +746,8 @@ TransformInputProc(
break;
}
} /* while toRead > 0 */
if (gotBytes == 0) {
dataPtr->eofPending = 0;
}
ReleaseData(dataPtr);
return gotBytes;
}
@@ -867,7 +858,6 @@ TransformSeekProc(
P_NO_PRESERVE);
ResultClear(&dataPtr->result);
dataPtr->readIsFlushed = 0;
dataPtr->eofPending = 0;
}
ReleaseData(dataPtr);
@@ -941,7 +931,6 @@ TransformWideSeekProc(
P_NO_PRESERVE);
ResultClear(&dataPtr->result);
dataPtr->readIsFlushed = 0;
dataPtr->eofPending = 0;
}
ReleaseData(dataPtr);
+4 -17
View File
@@ -161,7 +161,6 @@ typedef struct {
int mode; /* Mask of R/W mode */
int nonblocking; /* Flag: Channel is blocking or not. */
int readIsDrained; /* Flag: Read buffers are flushed. */
int eofPending; /* Flag: EOF seen down, but not raised up */
int dead; /* Boolean signal that some operations
* should no longer be attempted. */
ResultBuffer result;
@@ -1083,10 +1082,6 @@ ReflectInput(
bufObj = Tcl_NewByteArrayObj(NULL, toRead);
Tcl_IncrRefCount(bufObj);
gotBytes = 0;
if (rtPtr->eofPending) {
goto stop;
}
rtPtr->readIsDrained = 0;
while (toRead > 0) {
/*
* Loop until the request is satisfied (or no data available from
@@ -1102,11 +1097,6 @@ ReflectInput(
goto stop;
}
if (rtPtr->eofPending) {
goto stop;
}
/*
* The buffer is exhausted, but the caller wants even more. We now
* have to go to the underlying channel, get more bytes and then
@@ -1175,9 +1165,11 @@ ReflectInput(
* Zero returned from Tcl_ReadRaw() always indicates EOF
* on the down channel.
*/
rtPtr->eofPending = 1;
if (rtPtr->readIsDrained) {
goto stop;
}
/*
* Now this is a bit different. The partial data waiting is
* converted and returned.
@@ -1219,9 +1211,6 @@ ReflectInput(
} /* while toRead > 0 */
stop:
if (gotBytes == 0) {
rtPtr->eofPending = 0;
}
Tcl_DecrRefCount(bufObj);
Tcl_Release(rtPtr);
return gotBytes;
@@ -1777,7 +1766,6 @@ NewReflectedTransform(
rtPtr->timer = NULL;
rtPtr->mode = 0;
rtPtr->readIsDrained = 0;
rtPtr->eofPending = 0;
rtPtr->nonblocking =
(((Channel *) parentChan)->state->flags & CHANNEL_NONBLOCKING);
rtPtr->dead = 0;
@@ -3330,7 +3318,6 @@ TransformClear(
(void) InvokeTclMethod(rtPtr, "clear", NULL, NULL, NULL);
rtPtr->readIsDrained = 0;
rtPtr->eofPending = 0;
ResultClear(&rtPtr->result);
}
+3 -20
View File
@@ -12,26 +12,9 @@
#include "tclInt.h"
#if defined(_WIN32) && defined(UNICODE)
/* On Windows, we need to do proper Unicode->UTF-8 conversion. */
typedef struct ThreadSpecificData {
int initialized;
Tcl_DString errorMsg; /* UTF-8 encoded error-message */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
#undef gai_strerror
static const char *gai_strerror(int code) {
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (tsdPtr->initialized) {
Tcl_DStringFree(&tsdPtr->errorMsg);
} else {
tsdPtr->initialized = 1;
}
Tcl_WinTCharToUtf(gai_strerrorW(code), -1, &tsdPtr->errorMsg);
return Tcl_DStringValue(&tsdPtr->errorMsg);
}
/* On Windows, we always need the ASCII version. */
# undef gai_strerror
# define gai_strerror gai_strerrorA
#endif
/*
+5 -12
View File
@@ -1741,7 +1741,7 @@ enum PkgPreferOptions {
* definition there.
* Some macros require knowledge of some fields in the struct in order to
* avoid hitting the TSD unnecessarily. In order to facilitate this, a pointer
* to the relevant fields is kept in the allocCache field in struct Interp.
* to the relevant fields is kept in the objCache field in struct Interp.
*----------------------------------------------------------------
*/
@@ -2927,7 +2927,7 @@ MODULE_SCOPE void TclFinalizePreserve(void);
MODULE_SCOPE void TclFinalizeSynchronization(void);
MODULE_SCOPE void TclFinalizeThreadAlloc(void);
MODULE_SCOPE void TclFinalizeThreadAllocThread(void);
MODULE_SCOPE void TclFinalizeThreadData(int quick);
MODULE_SCOPE void TclFinalizeThreadData(void);
MODULE_SCOPE void TclFinalizeThreadObjects(void);
MODULE_SCOPE double TclFloor(const mp_int *a);
MODULE_SCOPE void TclFormatNaN(double value, char *buffer);
@@ -2985,8 +2985,8 @@ MODULE_SCOPE void TclInitNotifier(void);
MODULE_SCOPE void TclInitObjSubsystem(void);
MODULE_SCOPE void TclInitSubsystems(void);
MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp);
MODULE_SCOPE int TclIsLocalScalar(const char *src, int len);
MODULE_SCOPE int TclIsSpaceProc(char byte);
MODULE_SCOPE int TclIsBareword(char byte);
MODULE_SCOPE Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[]);
MODULE_SCOPE int TclJoinThread(Tcl_ThreadId id, int *result);
MODULE_SCOPE void TclLimitRemoveAllHandlers(Tcl_Interp *interp);
@@ -3059,8 +3059,6 @@ MODULE_SCOPE void TclpInitUnlock(void);
MODULE_SCOPE Tcl_Obj * TclpObjListVolumes(void);
MODULE_SCOPE void TclpMasterLock(void);
MODULE_SCOPE void TclpMasterUnlock(void);
MODULE_SCOPE void TclpMutexLock(void);
MODULE_SCOPE void TclpMutexUnlock(void);
MODULE_SCOPE int TclpMatchFiles(Tcl_Interp *interp, char *separators,
Tcl_DString *dirPtr, char *pattern, char *tail);
MODULE_SCOPE int TclpObjNormalizePath(Tcl_Interp *interp,
@@ -3097,8 +3095,7 @@ MODULE_SCOPE void TclRememberJoinableThread(Tcl_ThreadId id);
MODULE_SCOPE void TclRememberMutex(Tcl_Mutex *mutex);
MODULE_SCOPE void TclRemoveScriptLimitCallbacks(Tcl_Interp *interp);
MODULE_SCOPE int TclReToGlob(Tcl_Interp *interp, const char *reStr,
int reStrLen, Tcl_DString *dsPtr, int *flagsPtr,
int *quantifiersFoundPtr);
int reStrLen, Tcl_DString *dsPtr, int *flagsPtr);
MODULE_SCOPE int TclScanElement(const char *string, int length,
int *flagPtr);
MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp,
@@ -3649,9 +3646,6 @@ MODULE_SCOPE int TclCompileReturnCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileSetCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileStringCatCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileStringCmpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -4118,8 +4112,7 @@ MODULE_SCOPE void TclpFreeAllocCache(void *);
AllocCache *cachePtr; \
if (((interp) == NULL) || \
((cachePtr = ((Interp *)(interp))->allocCache), \
((cachePtr->numObjects == 0) || \
(cachePtr->numObjects >= ALLOC_NOBJHIGH)))) { \
(cachePtr->numObjects >= ALLOC_NOBJHIGH))) { \
TclThreadFreeObj(objPtr); \
} else { \
(objPtr)->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr; \
+1 -3
View File
@@ -104,9 +104,7 @@ TclpLoadMemory(
int size, /* Dummy: unused by this implementation */
int codeSize, /* Dummy: unused by this implementation */
Tcl_LoadHandle *loadHandle, /* Dummy: unused by this implementation */
Tcl_FSUnloadFileProc **unloadProcPtr,
/* Dummy: unused by this implementation */
int flags)
Tcl_FSUnloadFileProc **unloadProcPtr, int flags)
/* Dummy: unused by this implementation */
{
Tcl_SetObjResult(interp, Tcl_NewStringObj("dynamic loading from memory "
+3 -11
View File
@@ -394,7 +394,6 @@ InitFoundation(
fPtr->classCls->flags |= ROOT_CLASS;
TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls);
TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls);
TclOOAddToSubclasses(fPtr->classCls, fPtr->objectCls);
AddRef(fPtr->objectCls->thisPtr);
AddRef(fPtr->objectCls);
@@ -1287,9 +1286,7 @@ TclOORemoveFromInstances(
removeInstance:
if (Deleted(clsPtr->thisPtr)) {
if (!IsRootClass(clsPtr)) {
DelRef(clsPtr->instances.list[i]);
}
DelRef(clsPtr->instances.list[i]);
clsPtr->instances.list[i] = NULL;
} else {
clsPtr->instances.num--;
@@ -1675,13 +1672,10 @@ Tcl_NewObjectInstance(
/*
* Take care to not delete a deleted object; that would be
* bad. [Bug 2903011] Also take care to make sure that we have
* the name of the command before we delete it. [Bug
* 9dd1bd7a74]
* bad. [Bug 2903011]
*/
if (!Deleted(oPtr)) {
(void) TclOOObjectName(interp, oPtr);
Tcl_DeleteCommandFromToken(interp, oPtr->command);
}
return NULL;
@@ -1824,12 +1818,10 @@ FinalizeAlloc(
/*
* Take care to not delete a deleted object; that would be bad. [Bug
* 2903011] Also take care to make sure that we have the name of the
* command before we delete it. [Bug 9dd1bd7a74]
* 2903011]
*/
if (!Deleted(oPtr)) {
(void) TclOOObjectName(interp, oPtr);
Tcl_DeleteCommandFromToken(interp, oPtr->command);
}
DelRef(oPtr);
+1 -1
View File
@@ -24,7 +24,7 @@
* win/tclooConfig.sh
*/
#define TCLOO_VERSION "1.0.3"
#define TCLOO_VERSION "1.0.1"
#define TCLOO_PATCHLEVEL TCLOO_VERSION
#include "tcl.h"
+27 -72
View File
@@ -38,12 +38,6 @@ struct ChainBuilder {
#define DEFINITE_PUBLIC 0x200000
#define KNOWN_STATE (DEFINITE_PROTECTED | DEFINITE_PUBLIC)
#define SPECIAL (CONSTRUCTOR | DESTRUCTOR | FORCE_UNKNOWN)
#define BUILDING_MIXINS 0x400000
#define TRAVERSED_MIXIN 0x800000
#define OBJECT_MIXIN 0x1000000
#define MIXIN_CONSISTENT(flags) \
(((flags) & OBJECT_MIXIN) || \
!((flags) & BUILDING_MIXINS) == !((flags) & TRAVERSED_MIXIN))
/*
* Function declarations for things defined in this file.
@@ -51,13 +45,13 @@ struct ChainBuilder {
static void AddClassFiltersToCallContext(Object *const oPtr,
Class *clsPtr, struct ChainBuilder *const cbPtr,
Tcl_HashTable *const doneFilters, int flags);
Tcl_HashTable *const doneFilters);
static void AddClassMethodNames(Class *clsPtr, const int flags,
Tcl_HashTable *const namesPtr);
static inline void AddMethodToCallChain(Method *const mPtr,
struct ChainBuilder *const cbPtr,
Tcl_HashTable *const doneFilters,
Class *const filterDecl, int flags);
Class *const filterDecl);
static inline void AddSimpleChainToCallContext(Object *const oPtr,
Tcl_Obj *const methodNameObj,
struct ChainBuilder *const cbPtr,
@@ -156,7 +150,7 @@ void
TclOODeleteChain(
CallChain *callPtr)
{
if (callPtr == NULL || --callPtr->refCount >= 1) {
if (--callPtr->refCount >= 1) {
return;
}
if (callPtr->chain != callPtr->staticChain) {
@@ -440,7 +434,7 @@ TclOOGetSortedMethodList(
AddClassMethodNames(oPtr->selfCls, flags, &names);
FOREACH(mixinPtr, oPtr->mixins) {
AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN, &names);
AddClassMethodNames(mixinPtr, flags, &names);
}
/*
@@ -604,7 +598,7 @@ AddClassMethodNames(
/* TODO: Beware of infinite loops! */
FOREACH(mixinPtr, clsPtr->mixins) {
AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN, namesPtr);
AddClassMethodNames(mixinPtr, flags, namesPtr);
}
}
@@ -701,13 +695,13 @@ AddSimpleChainToCallContext(
FOREACH(mixinPtr, oPtr->mixins) {
AddSimpleClassChainToCallContext(mixinPtr, methodNameObj, cbPtr,
doneFilters, flags|TRAVERSED_MIXIN, filterDecl);
doneFilters, flags, filterDecl);
}
if (oPtr->methodsPtr) {
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char*) methodNameObj);
if (hPtr != NULL) {
AddMethodToCallChain(Tcl_GetHashValue(hPtr), cbPtr,
doneFilters, filterDecl, flags);
doneFilters, filterDecl);
}
}
}
@@ -738,15 +732,9 @@ AddMethodToCallChain(
* processed. If NULL, not processing filters.
* Note that this function does not update
* this hashtable. */
Class *const filterDecl, /* The class that declared the filter. If
Class *const filterDecl) /* The class that declared the filter. If
* NULL, either the filter was declared by the
* object or this isn't a filter. */
int flags) /* Used to check if we're mixin-consistent
* only. Mixin-consistent means that either
* we're looking to add things from a mixin
* and we have passed a mixin, or we're not
* looking to add things from a mixin and have
* not passed a mixin. */
{
register CallChain *callPtr = cbPtr->callChainPtr;
int i;
@@ -755,11 +743,9 @@ AddMethodToCallChain(
* Return if this is just an entry used to record whether this is a public
* method. If so, there's nothing real to call and so nothing to add to
* the call chain.
*
* This is also where we enforce mixin-consistency.
*/
if (mPtr == NULL || mPtr->typePtr == NULL || !MIXIN_CONSISTENT(flags)) {
if (mPtr == NULL || mPtr->typePtr == NULL) {
return;
}
@@ -1014,8 +1000,6 @@ TclOOGetCallContext(
*/
if (flags & FORCE_UNKNOWN) {
AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
&cb, NULL, BUILDING_MIXINS, NULL);
AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
&cb, NULL, 0, NULL);
callPtr->flags |= OO_UNKNOWN_METHOD;
@@ -1040,32 +1024,21 @@ TclOOGetCallContext(
doFilters = 1;
Tcl_InitObjHashTable(&doneFilters);
FOREACH(mixinPtr, oPtr->mixins) {
AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters,
TRAVERSED_MIXIN|BUILDING_MIXINS|OBJECT_MIXIN);
AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters,
OBJECT_MIXIN);
AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters);
}
FOREACH(filterObj, oPtr->filters) {
AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters,
BUILDING_MIXINS, NULL);
AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters, 0,
NULL);
}
AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters,
BUILDING_MIXINS);
AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters,
0);
AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters);
Tcl_DeleteHashTable(&doneFilters);
}
count = cb.filterLength = callPtr->numChain;
/*
* Add the actual method implementations. We have to do this twice to
* handle class mixins right.
* Add the actual method implementations.
*/
AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL,
flags|BUILDING_MIXINS, NULL);
AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL, flags, NULL);
/*
@@ -1084,8 +1057,6 @@ TclOOGetCallContext(
TclOODeleteChain(callPtr);
return NULL;
}
AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
&cb, NULL, BUILDING_MIXINS, NULL);
AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
&cb, NULL, 0, NULL);
callPtr->flags |= OO_UNKNOWN_METHOD;
@@ -1230,9 +1201,7 @@ TclOOGetStereotypeCallChain(
*/
Tcl_InitObjHashTable(&doneFilters);
AddClassFiltersToCallContext(&obj, clsPtr, &cb, &doneFilters,
BUILDING_MIXINS);
AddClassFiltersToCallContext(&obj, clsPtr, &cb, &doneFilters, 0);
AddClassFiltersToCallContext(&obj, clsPtr, &cb, &doneFilters);
Tcl_DeleteHashTable(&doneFilters);
count = cb.filterLength = callPtr->numChain;
@@ -1240,8 +1209,6 @@ TclOOGetStereotypeCallChain(
* Add the actual method implementations.
*/
AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL,
flags|BUILDING_MIXINS, NULL);
AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL, flags, NULL);
/*
@@ -1251,8 +1218,6 @@ TclOOGetStereotypeCallChain(
*/
if (count == callPtr->numChain) {
AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb,
NULL, BUILDING_MIXINS, NULL);
AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb,
NULL, 0, NULL);
callPtr->flags |= OO_UNKNOWN_METHOD;
@@ -1294,15 +1259,12 @@ AddClassFiltersToCallContext(
Class *clsPtr, /* Class to get the filters from. */
struct ChainBuilder *const cbPtr,
/* Context to fill with call chain entries. */
Tcl_HashTable *const doneFilters,
Tcl_HashTable *const doneFilters)
/* Where to record what filters have been
* processed. Keys are objects, values are
* ignored. */
int flags) /* Whether we've gone along a mixin link
* yet. */
{
int i, clearedFlags =
flags & ~(TRAVERSED_MIXIN|OBJECT_MIXIN|BUILDING_MIXINS);
int i;
Class *superPtr, *mixinPtr;
Tcl_Obj *filterObj;
@@ -1317,8 +1279,7 @@ AddClassFiltersToCallContext(
*/
FOREACH(mixinPtr, clsPtr->mixins) {
AddClassFiltersToCallContext(oPtr, mixinPtr, cbPtr, doneFilters,
flags|TRAVERSED_MIXIN);
AddClassFiltersToCallContext(oPtr, mixinPtr, cbPtr, doneFilters);
}
/*
@@ -1327,18 +1288,13 @@ AddClassFiltersToCallContext(
* override how filters work to extend their behaviour.
*/
if (MIXIN_CONSISTENT(flags)) {
FOREACH(filterObj, clsPtr->filters) {
int isNew;
FOREACH(filterObj, clsPtr->filters) {
int isNew;
(void) Tcl_CreateHashEntry(doneFilters, (char *) filterObj,
&isNew);
if (isNew) {
AddSimpleChainToCallContext(oPtr, filterObj, cbPtr,
doneFilters, clearedFlags|BUILDING_MIXINS, clsPtr);
AddSimpleChainToCallContext(oPtr, filterObj, cbPtr,
doneFilters, clearedFlags, clsPtr);
}
(void) Tcl_CreateHashEntry(doneFilters, (char *) filterObj, &isNew);
if (isNew) {
AddSimpleChainToCallContext(oPtr, filterObj, cbPtr, doneFilters,
0, clsPtr);
}
}
@@ -1352,8 +1308,7 @@ AddClassFiltersToCallContext(
goto tailRecurse;
default:
FOREACH(superPtr, clsPtr->superclasses) {
AddClassFiltersToCallContext(oPtr, superPtr, cbPtr, doneFilters,
flags);
AddClassFiltersToCallContext(oPtr, superPtr, cbPtr, doneFilters);
}
case 0:
return;
@@ -1400,16 +1355,16 @@ AddSimpleClassChainToCallContext(
tailRecurse:
FOREACH(superPtr, classPtr->mixins) {
AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr,
doneFilters, flags|TRAVERSED_MIXIN, filterDecl);
doneFilters, flags, filterDecl);
}
if (flags & CONSTRUCTOR) {
AddMethodToCallChain(classPtr->constructorPtr, cbPtr, doneFilters,
filterDecl, flags);
filterDecl);
} else if (flags & DESTRUCTOR) {
AddMethodToCallChain(classPtr->destructorPtr, cbPtr, doneFilters,
filterDecl, flags);
filterDecl);
} else {
Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods,
(char *) methodNameObj);
@@ -1428,7 +1383,7 @@ AddSimpleClassChainToCallContext(
flags |= DEFINITE_PROTECTED;
}
}
AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl, flags);
AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl);
}
}
+14 -33
View File
@@ -1301,39 +1301,6 @@ TclFreeObj(
ObjInitDeletionContext(context);
# ifdef TCL_THREADS
/*
* Check to make sure that the Tcl_Obj was allocated by the current
* thread. Don't do this check when shutting down since thread local
* storage can be finalized before the last Tcl_Obj is freed.
*/
if (!TclInExit()) {
Tcl_HashTable *tablePtr;
Tcl_HashEntry *hPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
tablePtr = tsdPtr->objThreadMap;
if (!tablePtr) {
Tcl_Panic("TclFreeObj: object table not initialized");
}
hPtr = Tcl_FindHashEntry(tablePtr, (char *) objPtr);
if (hPtr) {
/*
* As the Tcl_Obj is going to be deleted we remove the entry.
*/
ObjData *objData = Tcl_GetHashValue(hPtr);
if (objData != NULL) {
ckfree(objData);
}
Tcl_DeleteHashEntry(hPtr);
}
}
# endif
/*
* Check for a double free of the same value. This is slightly tricky
* because it is customary to free a Tcl_Obj when its refcount falls
@@ -3799,6 +3766,20 @@ Tcl_DbDecrRefCount(
Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread",
"decr ref count");
}
/*
* If the Tcl_Obj is going to be deleted, remove the entry.
*/
if ((objPtr->refCount - 1) <= 0) {
ObjData *objData = Tcl_GetHashValue(hPtr);
if (objData != NULL) {
ckfree(objData);
}
Tcl_DeleteHashEntry(hPtr);
}
}
# endif /* TCL_THREADS */
#endif /* TCL_MEM_DEBUG */
+67 -46
View File
@@ -618,47 +618,6 @@ TclIsSpaceProc(
return CHAR_TYPE(byte) & (TYPE_SPACE) || byte == '\n';
}
/*
*----------------------------------------------------------------------
*
* TclIsBareword--
*
* Report whether byte is one that can be part of a "bareword".
* This concept is named in expression parsing, where it determines
* what can be a legal function name, but is the same definition used
* in determining what variable names can be parsed as variable
* substitutions without the benefit of enclosing braces. The set of
* ASCII chars that are accepted are the numeric chars ('0'-'9'),
* the alphabetic chars ('a'-'z', 'A'-'Z') and underscore ('_').
*
* Results:
* Returns 1, if byte is in the accepted set of chars, 0 otherwise.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
TclIsBareword(
char byte)
{
if (byte < '0' || byte > 'z') {
return 0;
}
if (byte <= '9' || byte >= 'a') {
return 1;
}
if (byte == '_') {
return 1;
}
if (byte < 'A' || byte > 'Z') {
return 0;
}
return 1;
}
/*
*----------------------------------------------------------------------
*
@@ -1387,7 +1346,9 @@ Tcl_ParseVarName(
{
Tcl_Token *tokenPtr;
register const char *src;
int varIndex;
unsigned char c;
int varIndex, offset;
Tcl_UniChar ch;
unsigned array;
if ((numBytes == 0) || (start == NULL)) {
@@ -1470,12 +1431,22 @@ Tcl_ParseVarName(
tokenPtr->numComponents = 0;
while (numBytes) {
if (TclIsBareword(*src)) {
src += 1;
numBytes -= 1;
if (Tcl_UtfCharComplete(src, numBytes)) {
offset = Tcl_UtfToUniChar(src, &ch);
} else {
char utfBytes[TCL_UTF_MAX];
memcpy(utfBytes, src, (size_t) numBytes);
utfBytes[numBytes] = '\0';
offset = Tcl_UtfToUniChar(utfBytes, &ch);
}
c = UCHAR(ch);
if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */
src += offset;
numBytes -= offset;
continue;
}
if ((src[0] == ':') && (numBytes != 1) && (src[1] == ':')) {
if ((c == ':') && (numBytes != 1) && (src[1] == ':')) {
src += 2;
numBytes -= 2;
while (numBytes && (*src == ':')) {
@@ -2525,6 +2496,56 @@ TclObjCommandComplete(
return CommandComplete(script, length);
}
/*
*----------------------------------------------------------------------
*
* TclIsLocalScalar --
*
* Check to see if a given string is a legal scalar variable name with no
* namespace qualifiers or substitutions.
*
* Results:
* Returns 1 if the variable is a local scalar.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
TclIsLocalScalar(
const char *src,
int len)
{
const char *p;
const char *lastChar = src + (len - 1);
for (p=src ; p<=lastChar ; p++) {
if ((CHAR_TYPE(*p) != TYPE_NORMAL)
&& (CHAR_TYPE(*p) != TYPE_COMMAND_END)) {
/*
* TCL_COMMAND_END is returned for the last character of the
* string. By this point we know it isn't an array or namespace
* reference.
*/
return 0;
}
if (*p == '(') {
if (*lastChar == ')') { /* We have an array element */
return 0;
}
} else if (*p == ':') {
if ((p != lastChar) && *(p+1) == ':') { /* qualified name */
return 0;
}
}
}
return 1;
}
/*
* Local Variables:
* mode: c
+246 -14
View File
@@ -15,6 +15,7 @@
#include "tclInt.h"
#include "tclCompile.h"
#include "tclOOInt.h"
/*
* Variables that are part of the [apply] command implementation and which
@@ -40,6 +41,9 @@ static void InitResolvedLocals(Tcl_Interp *interp,
ByteCode *codePtr, Var *defPtr,
Namespace *nsPtr);
static void InitLocalCache(Proc *procPtr);
static int PushProcCallFrame(ClientData clientData,
register Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[], int isLambda);
static void ProcBodyDup(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
static void ProcBodyFree(Tcl_Obj *objPtr);
static int ProcWrongNumArgs(Tcl_Interp *interp, int skip);
@@ -88,10 +92,10 @@ static const Tcl_ObjType levelReferenceType = {
*
* Internally, ptr1 is a pointer to a Proc instance that is not bound to a
* command name, and ptr2 is a pointer to the namespace that the Proc instance
* will execute within. IF YOU CHANGE THIS, CHECK IN tclDisassemble.c TOO.
* will execute within.
*/
const Tcl_ObjType tclLambdaType = {
static const Tcl_ObjType lambdaType = {
"lambdaExpr", /* name */
FreeLambdaInternalRep, /* freeIntRepProc */
DupLambdaInternalRep, /* dupIntRepProc */
@@ -217,7 +221,7 @@ Tcl_ProcObjCmd(
*
* This code is nearly identical to the #280 code in SetLambdaFromAny, see
* this file. The differences are the different index of the body in the
* line array of the context, and the lambda code requires some special
* line array of the context, and the lamdba code requires some special
* processing. Find a way to factor the common elements into a single
* function.
*/
@@ -1567,7 +1571,7 @@ InitArgsAndLocals(
/*
*----------------------------------------------------------------------
*
* TclPushProcCallFrame --
* PushProcCallFrame --
*
* Compiles a proc body if necessary, then pushes a CallFrame suitable
* for executing it.
@@ -1582,8 +1586,8 @@ InitArgsAndLocals(
*----------------------------------------------------------------------
*/
int
TclPushProcCallFrame(
static int
PushProcCallFrame(
ClientData clientData, /* Record describing procedure to be
* interpreted. */
register Tcl_Interp *interp,/* Interpreter in which procedure was
@@ -1704,7 +1708,7 @@ TclNRInterpProc(
* procedure. */
Tcl_Obj *const objv[]) /* Argument value objects. */
{
int result = TclPushProcCallFrame(clientData, interp, objc, objv,
int result = PushProcCallFrame(clientData, interp, objc, objv,
/*isLambda*/ 0);
if (result != TCL_OK) {
@@ -2439,7 +2443,7 @@ DupLambdaInternalRep(
procPtr->refCount++;
Tcl_IncrRefCount(nsObjPtr);
copyPtr->typePtr = &tclLambdaType;
copyPtr->typePtr = &lambdaType;
}
static void
@@ -2476,7 +2480,7 @@ SetLambdaFromAny(
/*
* Convert objPtr to list type first; if it cannot be converted, or if its
* length is not 2, then it cannot be converted to tclLambdaType.
* length is not 2, then it cannot be converted to lambdaType.
*/
result = TclListObjGetElements(NULL, objPtr, &objc, &objv);
@@ -2622,14 +2626,14 @@ SetLambdaFromAny(
/*
* Free the list internalrep of objPtr - this will free argsPtr, but
* bodyPtr retains a reference from the Proc structure. Then finish the
* conversion to tclLambdaType.
* conversion to lambdaType.
*/
TclFreeIntRep(objPtr);
objPtr->internalRep.twoPtrValue.ptr1 = procPtr;
objPtr->internalRep.twoPtrValue.ptr2 = nsObjPtr;
objPtr->typePtr = &tclLambdaType;
objPtr->typePtr = &lambdaType;
return TCL_OK;
}
@@ -2680,12 +2684,12 @@ TclNRApplyObjCmd(
}
/*
* Set lambdaPtr, convert it to tclLambdaType in the current interp if
* Set lambdaPtr, convert it to lambdaType in the current interp if
* necessary.
*/
lambdaPtr = objv[1];
if (lambdaPtr->typePtr == &tclLambdaType) {
if (lambdaPtr->typePtr == &lambdaType) {
procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1;
}
@@ -2763,7 +2767,7 @@ TclNRApplyObjCmd(
}
extraPtr->isRootEnsemble = isRootEnsemble;
result = TclPushProcCallFrame(procPtr, interp, objc, objv, 1);
result = PushProcCallFrame(procPtr, interp, objc, objv, 1);
if (result == TCL_OK) {
TclNRAddCallback(interp, ApplyNR2, extraPtr, NULL, NULL, NULL);
result = TclNRInterpProcCore(interp, objv[1], 2, &MakeLambdaError);
@@ -2822,6 +2826,234 @@ MakeLambdaError(
(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}
/*
*----------------------------------------------------------------------
*
* Tcl_DisassembleObjCmd --
*
* Implementation of the "::tcl::unsupported::disassemble" command. This
* command is not documented, but will disassemble procedures, lambda
* terms and general scripts. Note that will compile terms if necessary
* in order to disassemble them.
*
*----------------------------------------------------------------------
*/
int
Tcl_DisassembleObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
static const char *const types[] = {
"lambda", "method", "objmethod", "proc", "script", NULL
};
enum Types {
DISAS_LAMBDA, DISAS_CLASS_METHOD, DISAS_OBJECT_METHOD, DISAS_PROC,
DISAS_SCRIPT
};
int idx, result;
Tcl_Obj *codeObjPtr = NULL;
Proc *procPtr = NULL;
Tcl_HashEntry *hPtr;
Object *oPtr;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "type ...");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], types, "type", 0, &idx)!=TCL_OK){
return TCL_ERROR;
}
switch ((enum Types) idx) {
case DISAS_LAMBDA: {
Command cmd;
Tcl_Obj *nsObjPtr;
Tcl_Namespace *nsPtr;
/*
* Compile (if uncompiled) and disassemble a lambda term.
*/
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "lambdaTerm");
return TCL_ERROR;
}
if (objv[2]->typePtr == &lambdaType) {
procPtr = objv[2]->internalRep.twoPtrValue.ptr1;
}
if (procPtr == NULL || procPtr->iPtr != (Interp *) interp) {
result = SetLambdaFromAny(interp, objv[2]);
if (result != TCL_OK) {
return result;
}
procPtr = objv[2]->internalRep.twoPtrValue.ptr1;
}
memset(&cmd, 0, sizeof(Command));
nsObjPtr = objv[2]->internalRep.twoPtrValue.ptr2;
result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
if (result != TCL_OK) {
return result;
}
cmd.nsPtr = (Namespace *) nsPtr;
procPtr->cmdPtr = &cmd;
result = PushProcCallFrame(procPtr, interp, objc, objv, 1);
if (result != TCL_OK) {
return result;
}
TclPopStackFrame(interp);
codeObjPtr = procPtr->bodyPtr;
break;
}
case DISAS_PROC:
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "procName");
return TCL_ERROR;
}
procPtr = TclFindProc((Interp *) interp, TclGetString(objv[2]));
if (procPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" isn't a procedure", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROC",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
}
/*
* Compile (if uncompiled) and disassemble a procedure.
*/
result = PushProcCallFrame(procPtr, interp, 2, objv+1, 1);
if (result != TCL_OK) {
return result;
}
TclPopStackFrame(interp);
codeObjPtr = procPtr->bodyPtr;
break;
case DISAS_SCRIPT:
/*
* Compile and disassemble a script.
*/
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "script");
return TCL_ERROR;
}
if ((objv[2]->typePtr != &tclByteCodeType)
&& (TclSetByteCodeFromAny(interp, objv[2], NULL, NULL) != TCL_OK)) {
return TCL_ERROR;
}
codeObjPtr = objv[2];
break;
case DISAS_CLASS_METHOD:
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "className methodName");
return TCL_ERROR;
}
/*
* Look up the body of a class method.
*/
oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
if (oPtr == NULL) {
return TCL_ERROR;
}
if (oPtr->classPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" is not a class", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
}
hPtr = Tcl_FindHashEntry(&oPtr->classPtr->classMethods,
(char *) objv[3]);
goto methodBody;
case DISAS_OBJECT_METHOD:
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "objectName methodName");
return TCL_ERROR;
}
/*
* Look up the body of an instance method.
*/
oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
if (oPtr == NULL) {
return TCL_ERROR;
}
if (oPtr->methodsPtr == NULL) {
goto unknownMethod;
}
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[3]);
/*
* Compile (if necessary) and disassemble a method body.
*/
methodBody:
if (hPtr == NULL) {
unknownMethod:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"unknown method \"%s\"", TclGetString(objv[3])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[3]), NULL);
return TCL_ERROR;
}
procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
if (procPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"body not available for this kind of method", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
"METHODTYPE", NULL);
return TCL_ERROR;
}
if (procPtr->bodyPtr->typePtr != &tclByteCodeType) {
Command cmd;
/*
* Yes, this is ugly, but we need to pass the namespace in to the
* compiler in two places.
*/
cmd.nsPtr = (Namespace *) oPtr->namespacePtr;
procPtr->cmdPtr = &cmd;
result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr,
(Namespace *) oPtr->namespacePtr, "body of method",
TclGetString(objv[3]));
procPtr->cmdPtr = NULL;
if (result != TCL_OK) {
return result;
}
}
codeObjPtr = procPtr->bodyPtr;
break;
default:
CLANG_ASSERT(0);
}
/*
* Do the actual disassembly.
*/
if (((ByteCode *) codeObjPtr->internalRep.twoPtrValue.ptr1)->flags
& TCL_BYTECODE_PRECOMPILED) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"may not disassemble prebuilt bytecode", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
"BYTECODE", NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, TclDisassembleByteCodeObj(codeObjPtr));
return TCL_OK;
}
/*
* Local Variables:
* mode: c
+1 -2
View File
@@ -946,8 +946,7 @@ CompileRegexp(
* Tcl_RegExpExecObj to optionally do a fast match (avoids RE engine).
*/
if (TclReToGlob(NULL, string, length, &stringBuf, &exact,
NULL) == TCL_OK) {
if (TclReToGlob(NULL, string, length, &stringBuf, &exact) == TCL_OK) {
regexpPtr->globObjPtr = TclDStringToObj(&stringBuf);
Tcl_IncrRefCount(regexpPtr->globObjPtr);
} else {
-1
View File
@@ -1412,7 +1412,6 @@ const TclStubs tclStubs = {
Tcl_FindSymbol, /* 628 */
Tcl_FSUnloadFile, /* 629 */
Tcl_ZlibStreamSetCompressionDictionary, /* 630 */
Tcl_MutexUnlockAndFinalize, /* 631 */
};
/* !END!: Do not edit above this line. */
+2 -45
View File
@@ -50,7 +50,6 @@ static void RememberSyncObject(void *objPtr,
#undef Tcl_MutexLock
#undef Tcl_MutexUnlock
#undef Tcl_MutexFinalize
#undef Tcl_MutexUnlockAndFinalize
#undef Tcl_ConditionNotify
#undef Tcl_ConditionWait
#undef Tcl_ConditionFinalize
@@ -282,43 +281,6 @@ Tcl_MutexFinalize(
TclpMasterUnlock();
}
/*
*----------------------------------------------------------------------
*
* Tcl_MutexUnlockAndFinalize --
*
* This procedure is invoked to unlock and then finalize a mutex.
* The mutex must have been locked by Tcl_MutexLock. It is also
* removed from the list of remembered objects. The mutex can no
* longer be used after calling this procedure.
*
* Results:
* None.
*
* Side effects:
* Remove the mutex from the list.
*
*----------------------------------------------------------------------
*/
void
Tcl_MutexUnlockAndFinalize(
Tcl_Mutex *mutexPtr)
{
Tcl_Mutex mutex;
TclpMasterLock();
TclpMutexLock();
#ifdef TCL_THREADS
mutex = *mutexPtr;
*mutexPtr = NULL; /* Force it to be created again. */
Tcl_MutexUnlock(&mutex);
TclpFinalizeMutex(&mutex);
#endif
ForgetSyncObject(mutexPtr, &mutexRecord);
TclpMutexUnlock();
TclpMasterUnlock();
}
/*
*----------------------------------------------------------------------
*
@@ -391,16 +353,11 @@ Tcl_ConditionFinalize(
*/
void
TclFinalizeThreadData(int quick)
TclFinalizeThreadData(void)
{
TclFinalizeThreadDataThread();
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
if (!quick) {
/*
* Quick exit principle makes it useless to terminate allocators
*/
TclFinalizeThreadAllocThread();
}
TclFinalizeThreadAllocThread();
#endif
}
+30 -108
View File
@@ -84,7 +84,6 @@ typedef union Block {
typedef struct Bucket {
Block *firstPtr; /* First block available */
Block *lastPtr; /* End of block list */
long numFree; /* Number of blocks available */
/* All fields below for accounting only */
@@ -108,7 +107,6 @@ typedef struct Cache {
Tcl_ThreadId owner; /* Which thread's cache is this? */
Tcl_Obj *firstObjPtr; /* List of free objects for thread */
int numObjects; /* Number of objects for thread */
Tcl_Obj *lastPtr; /* Last object in this cache */
int totalAssigned; /* Total space assigned to thread */
Bucket buckets[NBUCKETS]; /* The buckets for this thread */
} Cache;
@@ -137,7 +135,6 @@ static int GetBlocks(Cache *cachePtr, int bucket);
static Block * Ptr2Block(char *ptr);
static char * Block2Ptr(Block *blockPtr, int bucket, unsigned int reqSize);
static void MoveObjs(Cache *fromPtr, Cache *toPtr, int numMove);
static void PutObjs(Cache *fromPtr, int numMove);
/*
* Local variables defined in this file and initialized at startup.
@@ -220,11 +217,10 @@ GetCache(void)
cachePtr = TclpGetAllocCache();
if (cachePtr == NULL) {
cachePtr = TclpSysAlloc(sizeof(Cache), 0);
cachePtr = calloc(1, sizeof(Cache));
if (cachePtr == NULL) {
Tcl_Panic("alloc: could not allocate new cache");
}
memset(cachePtr, 0, sizeof(Cache));
Tcl_MutexLock(listLockPtr);
cachePtr->nextPtr = firstCachePtr;
firstCachePtr = cachePtr;
@@ -274,7 +270,9 @@ TclFreeAllocCache(
*/
if (cachePtr->numObjects > 0) {
PutObjs(cachePtr, cachePtr->numObjects);
Tcl_MutexLock(objLockPtr);
MoveObjs(cachePtr, sharedPtr, cachePtr->numObjects);
Tcl_MutexUnlock(objLockPtr);
}
/*
@@ -289,7 +287,7 @@ TclFreeAllocCache(
*nextPtrPtr = cachePtr->nextPtr;
cachePtr->nextPtr = NULL;
Tcl_MutexUnlock(listLockPtr);
TclpSysFree(cachePtr);
free(cachePtr);
}
/*
@@ -334,7 +332,7 @@ TclpAlloc(
/*
* Increment the requested size to include room for the Block structure.
* Call TclpSysAlloc() directly if the required amount is greater than the
* Call malloc() directly if the required amount is greater than the
* largest block, otherwise pop the smallest block large enough,
* allocating more blocks if necessary.
*/
@@ -346,7 +344,7 @@ TclpAlloc(
#endif
if (size > MAXALLOC) {
bucket = NBUCKETS;
blockPtr = TclpSysAlloc(size, 0);
blockPtr = malloc(size);
if (blockPtr != NULL) {
cachePtr->totalAssigned += reqSize;
}
@@ -409,16 +407,13 @@ TclpFree(
bucket = blockPtr->sourceBucket;
if (bucket == NBUCKETS) {
cachePtr->totalAssigned -= blockPtr->blockReqSize;
TclpSysFree(blockPtr);
free(blockPtr);
return;
}
cachePtr->buckets[bucket].totalAssigned -= blockPtr->blockReqSize;
blockPtr->nextBlock = cachePtr->buckets[bucket].firstPtr;
cachePtr->buckets[bucket].firstPtr = blockPtr;
if (cachePtr->buckets[bucket].numFree == 0) {
cachePtr->buckets[bucket].lastPtr = blockPtr;
}
cachePtr->buckets[bucket].numFree++;
cachePtr->buckets[bucket].numInserts++;
@@ -477,7 +472,7 @@ TclpRealloc(
/*
* If the block is not a system block and fits in place, simply return the
* existing pointer. Otherwise, if the block is a system block and the new
* size would also require a system block, call TclpSysRealloc() directly.
* size would also require a system block, call realloc() directly.
*/
blockPtr = Ptr2Block(ptr);
@@ -500,7 +495,7 @@ TclpRealloc(
} else if (size > MAXALLOC) {
cachePtr->totalAssigned -= blockPtr->blockReqSize;
cachePtr->totalAssigned += reqSize;
blockPtr = TclpSysRealloc(blockPtr, size);
blockPtr = realloc(blockPtr, size);
if (blockPtr == NULL) {
return NULL;
}
@@ -572,17 +567,15 @@ TclThreadAllocObj(void)
Tcl_Obj *newObjsPtr;
cachePtr->numObjects = numMove = NOBJALLOC;
newObjsPtr = TclpSysAlloc(sizeof(Tcl_Obj) * numMove, 0);
newObjsPtr = malloc(sizeof(Tcl_Obj) * numMove);
if (newObjsPtr == NULL) {
Tcl_Panic("alloc: could not allocate %d new objects", numMove);
}
cachePtr->lastPtr = newObjsPtr + numMove - 1;
objPtr = cachePtr->firstObjPtr; /* NULL */
while (--numMove >= 0) {
newObjsPtr[numMove].internalRep.twoPtrValue.ptr1 = objPtr;
objPtr = newObjsPtr + numMove;
objPtr = &newObjsPtr[numMove];
objPtr->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr;
cachePtr->firstObjPtr = objPtr;
}
cachePtr->firstObjPtr = newObjsPtr;
}
}
@@ -630,9 +623,6 @@ TclThreadFreeObj(
objPtr->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr;
cachePtr->firstObjPtr = objPtr;
if (cachePtr->numObjects == 0) {
cachePtr->lastPtr = objPtr;
}
cachePtr->numObjects++;
/*
@@ -641,7 +631,9 @@ TclThreadFreeObj(
*/
if (cachePtr->numObjects > NOBJHIGH) {
PutObjs(cachePtr, NOBJALLOC);
Tcl_MutexLock(objLockPtr);
MoveObjs(cachePtr, sharedPtr, NOBJALLOC);
Tcl_MutexUnlock(objLockPtr);
}
}
@@ -739,64 +731,10 @@ MoveObjs(
* just have to update the first and last.
*/
toPtr->lastPtr = objPtr;
objPtr->internalRep.twoPtrValue.ptr1 = toPtr->firstObjPtr; /* NULL */
objPtr->internalRep.twoPtrValue.ptr1 = toPtr->firstObjPtr;
toPtr->firstObjPtr = fromFirstObjPtr;
}
/*
*----------------------------------------------------------------------
*
* PutObjs --
*
* Move Tcl_Obj's from thread cache to shared cache.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static void
PutObjs(
Cache *fromPtr,
int numMove)
{
int keep = fromPtr->numObjects - numMove;
Tcl_Obj *firstPtr, *lastPtr = NULL;
fromPtr->numObjects = keep;
firstPtr = fromPtr->firstObjPtr;
if (keep == 0) {
fromPtr->firstObjPtr = NULL;
} else {
do {
lastPtr = firstPtr;
firstPtr = firstPtr->internalRep.twoPtrValue.ptr1;
} while (--keep > 0);
lastPtr->internalRep.twoPtrValue.ptr1 = NULL;
}
/*
* Move all objects as a block - they are already linked to each other, we
* just have to update the first and last.
*/
Tcl_MutexLock(objLockPtr);
fromPtr->lastPtr->internalRep.twoPtrValue.ptr1 = sharedPtr->firstObjPtr;
sharedPtr->firstObjPtr = firstPtr;
if (sharedPtr->numObjects == 0) {
sharedPtr->lastPtr = fromPtr->lastPtr;
}
sharedPtr->numObjects += numMove;
Tcl_MutexUnlock(objLockPtr);
fromPtr->lastPtr = lastPtr;
}
/*
*----------------------------------------------------------------------
*
@@ -909,25 +847,20 @@ PutBlocks(
int bucket,
int numMove)
{
register Block *lastPtr, *firstPtr;
register int n = numMove;
/*
* We have numFree. Want to shed numMove. So compute how many
* Blocks to keep.
* Before acquiring the lock, walk the block list to find the last block
* to be moved.
*/
int keep = cachePtr->buckets[bucket].numFree - numMove;
Block *lastPtr = NULL, *firstPtr;
cachePtr->buckets[bucket].numFree = keep;
firstPtr = cachePtr->buckets[bucket].firstPtr;
if (keep == 0) {
cachePtr->buckets[bucket].firstPtr = NULL;
} else {
do {
lastPtr = firstPtr;
firstPtr = firstPtr->nextBlock;
} while (--keep > 0);
lastPtr->nextBlock = NULL;
firstPtr = lastPtr = cachePtr->buckets[bucket].firstPtr;
while (--n > 0) {
lastPtr = lastPtr->nextBlock;
}
cachePtr->buckets[bucket].firstPtr = lastPtr->nextBlock;
cachePtr->buckets[bucket].numFree -= numMove;
/*
* Aquire the lock and place the list of blocks at the front of the shared
@@ -935,17 +868,10 @@ PutBlocks(
*/
LockBucket(cachePtr, bucket);
cachePtr->buckets[bucket].lastPtr->nextBlock
= sharedPtr->buckets[bucket].firstPtr;
lastPtr->nextBlock = sharedPtr->buckets[bucket].firstPtr;
sharedPtr->buckets[bucket].firstPtr = firstPtr;
if (sharedPtr->buckets[bucket].numFree == 0) {
sharedPtr->buckets[bucket].lastPtr
= cachePtr->buckets[bucket].lastPtr;
}
sharedPtr->buckets[bucket].numFree += numMove;
UnlockBucket(cachePtr, bucket);
cachePtr->buckets[bucket].lastPtr = lastPtr;
}
/*
@@ -992,8 +918,6 @@ GetBlocks(
if (n >= sharedPtr->buckets[bucket].numFree) {
cachePtr->buckets[bucket].firstPtr =
sharedPtr->buckets[bucket].firstPtr;
cachePtr->buckets[bucket].lastPtr =
sharedPtr->buckets[bucket].lastPtr;
cachePtr->buckets[bucket].numFree =
sharedPtr->buckets[bucket].numFree;
sharedPtr->buckets[bucket].firstPtr = NULL;
@@ -1007,7 +931,6 @@ GetBlocks(
blockPtr = blockPtr->nextBlock;
}
sharedPtr->buckets[bucket].firstPtr = blockPtr->nextBlock;
cachePtr->buckets[bucket].lastPtr = blockPtr;
blockPtr->nextBlock = NULL;
}
}
@@ -1041,7 +964,7 @@ GetBlocks(
if (blockPtr == NULL) {
size = MAXALLOC;
blockPtr = TclpSysAlloc(size, 0);
blockPtr = malloc(size);
if (blockPtr == NULL) {
return 0;
}
@@ -1059,7 +982,6 @@ GetBlocks(
((char *) blockPtr + bucketInfo[bucket].blockSize);
blockPtr = blockPtr->nextBlock;
}
cachePtr->buckets[bucket].lastPtr = blockPtr;
blockPtr->nextBlock = NULL;
}
return 1;
-3
View File
@@ -2511,9 +2511,6 @@ TclObjCallVarTraces(
if (!part1Ptr) {
part1Ptr = localName(iPtr->varFramePtr, index);
}
if (!part1Ptr) {
Tcl_Panic("Cannot trace a variable with no name");
}
part1 = TclGetString(part1Ptr);
part2 = part2Ptr? TclGetString(part2Ptr) : NULL;
+1 -8
View File
@@ -4249,8 +4249,7 @@ TclReToGlob(
const char *reStr,
int reStrLen,
Tcl_DString *dsPtr,
int *exactPtr,
int *quantifiersFoundPtr)
int *exactPtr)
{
int anchorLeft, anchorRight, lastIsStar, numStars;
char *dsStr, *dsStrStart;
@@ -4258,9 +4257,6 @@ TclReToGlob(
strEnd = reStr + reStrLen;
Tcl_DStringInit(dsPtr);
if (quantifiersFoundPtr != NULL) {
*quantifiersFoundPtr = 0;
}
/*
* "***=xxx" == "*xxx*", watch for glob-sensitive chars.
@@ -4373,9 +4369,6 @@ TclReToGlob(
}
break;
case '.':
if (quantifiersFoundPtr != NULL) {
*quantifiersFoundPtr = 1;
}
anchorLeft = 0; /* prevent exact match */
if (p+1 < strEnd) {
if (p[1] == '*') {
+6 -5
View File
@@ -4405,8 +4405,8 @@ ObjMakeUpvar(
|| !HasLocalVars(varFramePtr)
|| (strstr(TclGetString(myNamePtr), "::") != NULL))) {
Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
"bad variable name \"%s\": can't create namespace "
"variable that refers to procedure variable",
"bad variable name \"%s\": upvar won't create "
"namespace variable that refers to procedure variable",
TclGetString(myNamePtr)));
Tcl_SetErrorCode(interp, "TCL", "UPVAR", "INVERTED", NULL);
return TCL_ERROR;
@@ -4506,8 +4506,9 @@ TclPtrObjMakeUpvar(
*/
Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
"bad variable name \"%s\": can't create a scalar "
"variable that looks like an array element", myName));
"bad variable name \"%s\": upvar won't create a"
" scalar variable that looks like an array element",
myName));
Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT",
NULL);
return TCL_ERROR;
@@ -4746,7 +4747,7 @@ Tcl_GetVariableFullName(
} else if (iPtr->varFramePtr->procPtr) {
int index = varPtr - iPtr->varFramePtr->compiledLocals;
if (index >= 0 && index < iPtr->varFramePtr->numCompiledLocals) {
if (index < iPtr->varFramePtr->numCompiledLocals) {
namePtr = localName(iPtr->varFramePtr, index);
Tcl_AppendObjToObj(objPtr, namePtr);
}
+1 -1
View File
@@ -26,7 +26,7 @@
* interface, even if that is mostly true).
*/
#define TCL_ZLIB_VERSION "2.0.1"
#define TCL_ZLIB_VERSION "2.0"
/*
* Magic flags used with wbits fields to indicate that we're handling the gzip
+13 -34
View File
@@ -11,7 +11,7 @@
package require Tcl 8.6
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
package provide http 2.8.9
package provide http 2.8.8
namespace eval http {
# Allow resourcing to not clobber existing data
@@ -566,10 +566,6 @@ proc http::geturl {url args} {
# Proxy connections aren't shared among different hosts.
set state(socketinfo) $host:$port
# Save the accept types at this point to prevent a race condition. [Bug
# c11a51c482]
set state(accept-types) $http(-accept)
# See if we are supposed to use a previously opened channel.
if {$state(-keepalive)} {
variable socketmap
@@ -641,20 +637,8 @@ proc http::geturl {url args} {
return $token
}
# http::Connected --
#
# Callback used when the connection to the HTTP server is actually
# established.
#
# Arguments:
# token State token.
# proto What protocol (http, https, etc.) was used to connect.
# phost Are we using keep-alive? Non-empty if yes.
# srvurl Service-local URL that we're requesting
# Results:
# None.
proc http::Connected {token proto phost srvurl} {
proc http::Connected { token proto phost srvurl} {
variable http
variable urlTypes
@@ -707,12 +691,13 @@ proc http::Connected {token proto phost srvurl} {
if {[info exists state(-handler)]} {
set state(-protocol) 1.0
}
set accept_types_seen 0
if {[catch {
puts $sock "$how $srvurl HTTP/$state(-protocol)"
if {[dict exists $state(-headers) Host]} {
puts $sock "Accept: $http(-accept)"
array set hdrs $state(-headers)
if {[info exists hdrs(Host)]} {
# Allow Host spoofing. [Bug 928154]
puts $sock "Host: [dict get $state(-headers) Host]"
puts $sock "Host: $hdrs(Host)"
} elseif {$port == $defport} {
# Don't add port in this case, to handle broken servers. [Bug
# #504508]
@@ -720,6 +705,7 @@ proc http::Connected {token proto phost srvurl} {
} else {
puts $sock "Host: $host:$port"
}
unset hdrs
puts $sock "User-Agent: $http(-useragent)"
if {$state(-protocol) == 1.0 && $state(-keepalive)} {
puts $sock "Connection: keep-alive"
@@ -732,21 +718,18 @@ proc http::Connected {token proto phost srvurl} {
}
set accept_encoding_seen 0
set content_type_seen 0
dict for {key value} $state(-headers) {
set value [string map [list \n "" \r ""] $value]
set key [string map {" " -} [string trim $key]]
foreach {key value} $state(-headers) {
if {[string equal -nocase $key "host"]} {
continue
}
if {[string equal -nocase $key "accept-encoding"]} {
set accept_encoding_seen 1
}
if {[string equal -nocase $key "accept"]} {
set accept_types_seen 1
}
if {[string equal -nocase $key "content-type"]} {
set content_type_seen 1
}
set value [string map [list \n "" \r ""] $value]
set key [string trim $key]
if {[string equal -nocase $key "content-length"]} {
set contDone 1
set state(querylength) $value
@@ -755,13 +738,8 @@ proc http::Connected {token proto phost srvurl} {
puts $sock "$key: $value"
}
}
# Allow overriding the Accept header on a per-connection basis. Useful
# for working with REST services. [Bug c11a51c482]
if {!$accept_types_seen} {
puts $sock "Accept: $state(accept-types)"
}
if {!$accept_encoding_seen && ![info exists state(-handler)]} {
puts $sock "Accept-Encoding: gzip,deflate,compress"
puts $sock "Accept-Encoding: deflate,gzip,compress"
}
if {$isQueryChannel && $state(querylength) == 0} {
# Try to determine size of data in channel. If we cannot seek, the
@@ -817,6 +795,7 @@ proc http::Connected {token proto phost srvurl} {
Finish $token $err
}
}
}
# Data access functions:
@@ -1320,7 +1299,7 @@ proc http::Eof {token {force 0}} {
set state(body) [zlib $coding $state(body)]
}
} err]} {
Log "error doing decompression: $err"
Log "error doing $coding '$state(body)'"
return [Finish $token $err]
}
+1 -1
View File
@@ -1,2 +1,2 @@
if {![package vsatisfies [package provide Tcl] 8.6]} {return}
package ifneeded http 2.8.9 [list tclPkgSetup $dir http 2.8.9 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
package ifneeded http 2.8.8 [list tclPkgSetup $dir http 2.8.8 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
+1 -1
View File
@@ -16,7 +16,7 @@
if {[info commands package] == ""} {
error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]"
}
package require -exact Tcl 8.6.4
package require -exact Tcl 8.6.1
# Compute the auto path to use in this interpreter.
# The values on the path come from several locations:
+1 -1
View File
@@ -1,3 +1,3 @@
package ifneeded platform 1.0.13 [list source [file join $dir platform.tcl]]
package ifneeded platform 1.0.12 [list source [file join $dir platform.tcl]]
package ifneeded platform::shell 1.1.4 [list source [file join $dir shell.tcl]]
+20 -23
View File
@@ -313,25 +313,13 @@ proc ::platform::patterns {id} {
}
}
}
macosx-powerpc {
lappend res macosx-universal
}
macosx-x86_64 {
lappend res macosx-i386-x86_64
}
macosx-ix86 {
lappend res macosx-universal macosx-i386-x86_64
}
macosx*-* {
# 10.5+
if {[regexp {macosx([^-]*)-(.*)} $id -> v cpu]} {
switch -exact -- $cpu {
ix86 {
lappend alt i386-x86_64
lappend alt universal
}
x86_64 { lappend alt i386-x86_64 }
ix86 -
x86_64 { set alt i386-x86_64 }
default { set alt {} }
}
@@ -342,26 +330,35 @@ proc ::platform::patterns {id} {
set res {}
for {set j $minor} {$j >= 5} {incr j -1} {
lappend res macosx${major}.${j}-${cpu}
foreach a $alt {
lappend res macosx${major}.${j}-$a
lappend res macosx${major}.${j}-universal
if {$alt ne {}} {
lappend res macosx${major}.${j}-$alt
}
}
# Add unversioned patterns for 10.3/10.4 builds.
lappend res macosx-${cpu}
foreach a $alt {
lappend res macosx-$a
lappend res macosx-universal
if {$alt ne {}} {
lappend res macosx-$alt
}
} else {
# No version, just do unversioned patterns.
foreach a $alt {
lappend res macosx-$a
lappend res macosx-universal
if {$alt ne {}} {
lappend res macosx-$alt
}
}
} else {
# no v, no cpu ... nothing
lappend res macosx-universal
}
}
macosx-powerpc {
lappend res macosx-universal
}
macosx-x86_64 -
macosx-ix86 {
lappend res macosx-universal macosx-i386-x86_64
}
}
lappend res tcl ; # Pure tcl packages are always compatible.
return $res
@@ -371,7 +368,7 @@ proc ::platform::patterns {id} {
# ### ### ### ######### ######### #########
## Ready
package provide platform 1.0.13
package provide platform 1.0.12
# ### ### ### ######### ######### #########
## Demo application
+1 -1
View File
@@ -187,7 +187,7 @@ proc ::platform::shell::TEMP {} {
}
}
}
if {$channel ne ""} {
if {$channel != ""} {
return -code error "Failed to open a temporary file: $channel"
} else {
return -code error "Failed to find an unused temporary file name"
-32
View File
@@ -3,38 +3,6 @@
set TZData(:Africa/Accra) {
{-9223372036854775808 -52 0 LMT}
{-1640995148 0 0 GMT}
{-1556841600 1200 1 GHST}
{-1546388400 0 0 GMT}
{-1525305600 1200 1 GHST}
{-1514852400 0 0 GMT}
{-1493769600 1200 1 GHST}
{-1483316400 0 0 GMT}
{-1462233600 1200 1 GHST}
{-1451780400 0 0 GMT}
{-1430611200 1200 1 GHST}
{-1420158000 0 0 GMT}
{-1399075200 1200 1 GHST}
{-1388622000 0 0 GMT}
{-1367539200 1200 1 GHST}
{-1357086000 0 0 GMT}
{-1336003200 1200 1 GHST}
{-1325550000 0 0 GMT}
{-1304380800 1200 1 GHST}
{-1293927600 0 0 GMT}
{-1272844800 1200 1 GHST}
{-1262391600 0 0 GMT}
{-1241308800 1200 1 GHST}
{-1230855600 0 0 GMT}
{-1209772800 1200 1 GHST}
{-1199319600 0 0 GMT}
{-1178150400 1200 1 GHST}
{-1167697200 0 0 GMT}
{-1146614400 1200 1 GHST}
{-1136161200 0 0 GMT}
{-1115078400 1200 1 GHST}
{-1104625200 0 0 GMT}
{-1083542400 1200 1 GHST}
{-1073089200 0 0 GMT}
{-1051920000 1200 1 GHST}
{-1041466800 0 0 GMT}
{-1020384000 1200 1 GHST}
+5 -3
View File
@@ -1,5 +1,7 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Nairobi)]} {
LoadTimeZoneFile Africa/Nairobi
set TZData(:Africa/Addis_Ababa) {
{-9223372036854775808 9288 0 LMT}
{-3155682888 9320 0 ADMT}
{-1062210920 10800 0 EAT}
}
set TZData(:Africa/Addis_Ababa) $TZData(:Africa/Nairobi)
+6 -3
View File
@@ -1,5 +1,8 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Nairobi)]} {
LoadTimeZoneFile Africa/Nairobi
set TZData(:Africa/Asmara) {
{-9223372036854775808 9332 0 LMT}
{-3155682932 9332 0 AMT}
{-2524530932 9320 0 ADMT}
{-1062210920 10800 0 EAT}
}
set TZData(:Africa/Asmara) $TZData(:Africa/Nairobi)
+3 -3
View File
@@ -1,5 +1,5 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Nairobi)]} {
LoadTimeZoneFile Africa/Nairobi
if {![info exists TZData(Africa/Asmara)]} {
LoadTimeZoneFile Africa/Asmara
}
set TZData(:Africa/Asmera) $TZData(:Africa/Nairobi)
set TZData(:Africa/Asmera) $TZData(:Africa/Asmara)
+6 -3
View File
@@ -1,5 +1,8 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Abidjan)]} {
LoadTimeZoneFile Africa/Abidjan
set TZData(:Africa/Bamako) {
{-9223372036854775808 -1920 0 LMT}
{-1830382080 0 0 GMT}
{-1131235200 -3600 0 WAT}
{-300841200 0 0 GMT}
}
set TZData(:Africa/Bamako) $TZData(:Africa/Abidjan)
+4 -3
View File
@@ -1,5 +1,6 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Lagos)]} {
LoadTimeZoneFile Africa/Lagos
set TZData(:Africa/Bangui) {
{-9223372036854775808 4460 0 LMT}
{-1830388460 3600 0 WAT}
}
set TZData(:Africa/Bangui) $TZData(:Africa/Lagos)
+6 -3
View File
@@ -1,5 +1,8 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Abidjan)]} {
LoadTimeZoneFile Africa/Abidjan
set TZData(:Africa/Banjul) {
{-9223372036854775808 -3996 0 LMT}
{-1830380004 -3996 0 BMT}
{-1104533604 -3600 0 WAT}
{-189385200 0 0 GMT}
}
set TZData(:Africa/Banjul) $TZData(:Africa/Abidjan)
+1 -1
View File
@@ -2,6 +2,6 @@
set TZData(:Africa/Bissau) {
{-9223372036854775808 -3740 0 LMT}
{-1830380260 -3600 0 WAT}
{-1849388260 -3600 0 WAT}
{157770000 0 0 GMT}
}
+4 -3
View File
@@ -1,5 +1,6 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Maputo)]} {
LoadTimeZoneFile Africa/Maputo
set TZData(:Africa/Blantyre) {
{-9223372036854775808 8400 0 LMT}
{-2109291600 7200 0 CAT}
}
set TZData(:Africa/Blantyre) $TZData(:Africa/Maputo)
+4 -3
View File
@@ -1,5 +1,6 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Lagos)]} {
LoadTimeZoneFile Africa/Lagos
set TZData(:Africa/Brazzaville) {
{-9223372036854775808 3668 0 LMT}
{-1830387668 3600 0 WAT}
}
set TZData(:Africa/Brazzaville) $TZData(:Africa/Lagos)
+4 -3
View File
@@ -1,5 +1,6 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Maputo)]} {
LoadTimeZoneFile Africa/Maputo
set TZData(:Africa/Bujumbura) {
{-9223372036854775808 7048 0 LMT}
{-2524528648 7200 0 CAT}
}
set TZData(:Africa/Bujumbura) $TZData(:Africa/Maputo)
-4
View File
@@ -125,8 +125,4 @@ set TZData(:Africa/Cairo) {
{1281474000 7200 0 EET}
{1284069600 10800 1 EEST}
{1285880400 7200 0 EET}
{1400191200 10800 1 EEST}
{1403816400 7200 0 EET}
{1406844000 10800 1 EEST}
{1411678800 7200 0 EET}
}
+83 -148
View File
@@ -38,46 +38,46 @@ set TZData(:Africa/Casablanca) {
{1376100000 3600 1 WEST}
{1382839200 0 0 WET}
{1396144800 3600 1 WEST}
{1403920800 0 0 WET}
{1406944800 3600 1 WEST}
{1404007200 0 0 WET}
{1406599200 3600 1 WEST}
{1414288800 0 0 WET}
{1427594400 3600 1 WEST}
{1434160800 0 0 WET}
{1434592800 0 0 WET}
{1437184800 3600 1 WEST}
{1445738400 0 0 WET}
{1459044000 3600 1 WEST}
{1465005600 0 0 WET}
{1468029600 3600 1 WEST}
{1465264800 0 0 WET}
{1467856800 3600 1 WEST}
{1477792800 0 0 WET}
{1490493600 3600 1 WEST}
{1495245600 0 0 WET}
{1498874400 3600 1 WEST}
{1495850400 0 0 WET}
{1498442400 3600 1 WEST}
{1509242400 0 0 WET}
{1521943200 3600 1 WEST}
{1526090400 0 0 WET}
{1529114400 3600 1 WEST}
{1526436000 0 0 WET}
{1529028000 3600 1 WEST}
{1540692000 0 0 WET}
{1553997600 3600 1 WEST}
{1556935200 0 0 WET}
{1559959200 3600 1 WEST}
{1557108000 0 0 WET}
{1559700000 3600 1 WEST}
{1572141600 0 0 WET}
{1585447200 3600 1 WEST}
{1587175200 0 0 WET}
{1590804000 3600 1 WEST}
{1587693600 0 0 WET}
{1590285600 3600 1 WEST}
{1603591200 0 0 WET}
{1616896800 3600 1 WEST}
{1618020000 0 0 WET}
{1621044000 3600 1 WEST}
{1618279200 0 0 WET}
{1620871200 3600 1 WEST}
{1635645600 0 0 WET}
{1648346400 3600 1 WEST}
{1648864800 0 0 WET}
{1651888800 3600 1 WEST}
{1648951200 0 0 WET}
{1651543200 3600 1 WEST}
{1667095200 0 0 WET}
{1682128800 3600 1 WEST}
{1698544800 0 0 WET}
{1712973600 3600 1 WEST}
{1712714400 3600 1 WEST}
{1729994400 0 0 WET}
{1743818400 3600 1 WEST}
{1743386400 3600 1 WEST}
{1761444000 0 0 WET}
{1774749600 3600 1 WEST}
{1792893600 0 0 WET}
@@ -98,136 +98,71 @@ set TZData(:Africa/Casablanca) {
{2026951200 3600 1 WEST}
{2045700000 0 0 WET}
{2058400800 3600 1 WEST}
{2077063200 0 0 WET}
{2077153200 0 0 WET}
{2077149600 0 0 WET}
{2090455200 3600 1 WEST}
{2107908000 0 0 WET}
{2108602800 0 0 WET}
{2108167200 0 0 WET}
{2121904800 3600 1 WEST}
{2138752800 0 0 WET}
{2140052400 0 0 WET}
{2138839200 0 0 WET}
{2153354400 3600 1 WEST}
{2172103200 0 0 WET}
{2184804000 3600 1 WEST}
{2203552800 0 0 WET}
{2216253600 3600 1 WEST}
{2235002400 0 0 WET}
{2248308000 3600 1 WEST}
{2266452000 0 0 WET}
{2279757600 3600 1 WEST}
{2297901600 0 0 WET}
{2311207200 3600 1 WEST}
{2329351200 0 0 WET}
{2342656800 3600 1 WEST}
{2361405600 0 0 WET}
{2374106400 3600 1 WEST}
{2392855200 0 0 WET}
{2405556000 3600 1 WEST}
{2424304800 0 0 WET}
{2437610400 3600 1 WEST}
{2455754400 0 0 WET}
{2469060000 3600 1 WEST}
{2487204000 0 0 WET}
{2500509600 3600 1 WEST}
{2519258400 0 0 WET}
{2531959200 3600 1 WEST}
{2550708000 0 0 WET}
{2563408800 3600 1 WEST}
{2582157600 0 0 WET}
{2595463200 3600 1 WEST}
{2613607200 0 0 WET}
{2626912800 3600 1 WEST}
{2645056800 0 0 WET}
{2658362400 3600 1 WEST}
{2676506400 0 0 WET}
{2689812000 3600 1 WEST}
{2708560800 0 0 WET}
{2721261600 3600 1 WEST}
{2740010400 0 0 WET}
{2752711200 3600 1 WEST}
{2771460000 0 0 WET}
{2784765600 3600 1 WEST}
{2802909600 0 0 WET}
{2816215200 3600 1 WEST}
{2834359200 0 0 WET}
{2847664800 3600 1 WEST}
{2866413600 0 0 WET}
{2879114400 3600 1 WEST}
{2897863200 0 0 WET}
{2910564000 3600 1 WEST}
{2929312800 0 0 WET}
{2942013600 3600 1 WEST}
{2960762400 0 0 WET}
{2974068000 3600 1 WEST}
{2992212000 0 0 WET}
{3005517600 3600 1 WEST}
{3023661600 0 0 WET}
{3036967200 3600 1 WEST}
{3055716000 0 0 WET}
{3068416800 3600 1 WEST}
{3087165600 0 0 WET}
{3099866400 3600 1 WEST}
{3118615200 0 0 WET}
{3131920800 3600 1 WEST}
{3150064800 0 0 WET}
{3163370400 3600 1 WEST}
{3181514400 0 0 WET}
{3194820000 3600 1 WEST}
{3212964000 0 0 WET}
{3226269600 3600 1 WEST}
{3245018400 0 0 WET}
{3257719200 3600 1 WEST}
{3276468000 0 0 WET}
{3289168800 3600 1 WEST}
{3307917600 0 0 WET}
{3321223200 3600 1 WEST}
{3339367200 0 0 WET}
{3352672800 3600 1 WEST}
{3370816800 0 0 WET}
{3384122400 3600 1 WEST}
{3402871200 0 0 WET}
{3415572000 3600 1 WEST}
{3434320800 0 0 WET}
{3447021600 3600 1 WEST}
{3465770400 0 0 WET}
{3479076000 3600 1 WEST}
{3497220000 0 0 WET}
{3510525600 3600 1 WEST}
{3528669600 0 0 WET}
{3541975200 3600 1 WEST}
{3560119200 0 0 WET}
{3573424800 3600 1 WEST}
{3592173600 0 0 WET}
{3604874400 3600 1 WEST}
{3623623200 0 0 WET}
{3636324000 3600 1 WEST}
{3655072800 0 0 WET}
{3668378400 3600 1 WEST}
{3686522400 0 0 WET}
{3699828000 3600 1 WEST}
{3717972000 0 0 WET}
{3731277600 3600 1 WEST}
{3750026400 0 0 WET}
{3762727200 3600 1 WEST}
{3781476000 0 0 WET}
{3794176800 3600 1 WEST}
{3812925600 0 0 WET}
{3825626400 3600 1 WEST}
{3844375200 0 0 WET}
{3857680800 3600 1 WEST}
{3875824800 0 0 WET}
{3889130400 3600 1 WEST}
{3907274400 0 0 WET}
{3920580000 3600 1 WEST}
{3939328800 0 0 WET}
{3952029600 3600 1 WEST}
{3970778400 0 0 WET}
{3983479200 3600 1 WEST}
{4002228000 0 0 WET}
{4015533600 3600 1 WEST}
{4033677600 0 0 WET}
{4046983200 3600 1 WEST}
{4065127200 0 0 WET}
{4078432800 3600 1 WEST}
{4096576800 0 0 WET}
{2184800400 3600 1 WEST}
{2216250000 3600 1 WEST}
{2248304400 3600 1 WEST}
{2279754000 3600 1 WEST}
{2311203600 3600 1 WEST}
{2342653200 3600 1 WEST}
{2374102800 3600 1 WEST}
{2405552400 3600 1 WEST}
{2437606800 3600 1 WEST}
{2469056400 3600 1 WEST}
{2500506000 3600 1 WEST}
{2531955600 3600 1 WEST}
{2563405200 3600 1 WEST}
{2595459600 3600 1 WEST}
{2626909200 3600 1 WEST}
{2658358800 3600 1 WEST}
{2689808400 3600 1 WEST}
{2721258000 3600 1 WEST}
{2752707600 3600 1 WEST}
{2784762000 3600 1 WEST}
{2816211600 3600 1 WEST}
{2847661200 3600 1 WEST}
{2879110800 3600 1 WEST}
{2910560400 3600 1 WEST}
{2942010000 3600 1 WEST}
{2974064400 3600 1 WEST}
{3005514000 3600 1 WEST}
{3036963600 3600 1 WEST}
{3068413200 3600 1 WEST}
{3099862800 3600 1 WEST}
{3131917200 3600 1 WEST}
{3163366800 3600 1 WEST}
{3194816400 3600 1 WEST}
{3226266000 3600 1 WEST}
{3257715600 3600 1 WEST}
{3289165200 3600 1 WEST}
{3321219600 3600 1 WEST}
{3352669200 3600 1 WEST}
{3384118800 3600 1 WEST}
{3415568400 3600 1 WEST}
{3447018000 3600 1 WEST}
{3479072400 3600 1 WEST}
{3510522000 3600 1 WEST}
{3541971600 3600 1 WEST}
{3573421200 3600 1 WEST}
{3604870800 3600 1 WEST}
{3636320400 3600 1 WEST}
{3668374800 3600 1 WEST}
{3699824400 3600 1 WEST}
{3731274000 3600 1 WEST}
{3762723600 3600 1 WEST}
{3794173200 3600 1 WEST}
{3825622800 3600 1 WEST}
{3857677200 3600 1 WEST}
{3889126800 3600 1 WEST}
{3920576400 3600 1 WEST}
{3952026000 3600 1 WEST}
{3983475600 3600 1 WEST}
{4015530000 3600 1 WEST}
{4046979600 3600 1 WEST}
{4078429200 3600 1 WEST}
}
+6 -3
View File
@@ -1,5 +1,8 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Abidjan)]} {
LoadTimeZoneFile Africa/Abidjan
set TZData(:Africa/Conakry) {
{-9223372036854775808 -3292 0 LMT}
{-1830380708 0 0 GMT}
{-1131235200 -3600 0 WAT}
{-315615600 0 0 GMT}
}
set TZData(:Africa/Conakry) $TZData(:Africa/Abidjan)
+5 -3
View File
@@ -1,5 +1,7 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Abidjan)]} {
LoadTimeZoneFile Africa/Abidjan
set TZData(:Africa/Dakar) {
{-9223372036854775808 -4184 0 LMT}
{-1830379816 -3600 0 WAT}
{-902098800 0 0 GMT}
}
set TZData(:Africa/Dakar) $TZData(:Africa/Abidjan)
+6 -3
View File
@@ -1,5 +1,8 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Nairobi)]} {
LoadTimeZoneFile Africa/Nairobi
set TZData(:Africa/Dar_es_Salaam) {
{-9223372036854775808 9428 0 LMT}
{-1230777428 10800 0 EAT}
{-694321200 9900 0 BEAUT}
{-284006700 10800 0 EAT}
}
set TZData(:Africa/Dar_es_Salaam) $TZData(:Africa/Nairobi)
+4 -3
View File
@@ -1,5 +1,6 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Nairobi)]} {
LoadTimeZoneFile Africa/Nairobi
set TZData(:Africa/Djibouti) {
{-9223372036854775808 10356 0 LMT}
{-1846291956 10800 0 EAT}
}
set TZData(:Africa/Djibouti) $TZData(:Africa/Nairobi)
+4 -3
View File
@@ -1,5 +1,6 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Lagos)]} {
LoadTimeZoneFile Africa/Lagos
set TZData(:Africa/Douala) {
{-9223372036854775808 2328 0 LMT}
{-1830386328 3600 0 WAT}
}
set TZData(:Africa/Douala) $TZData(:Africa/Lagos)
-215
View File
@@ -4,219 +4,4 @@ set TZData(:Africa/El_Aaiun) {
{-9223372036854775808 -3168 0 LMT}
{-1136070432 -3600 0 WAT}
{198291600 0 0 WET}
{199756800 3600 1 WEST}
{207702000 0 0 WET}
{231292800 3600 1 WEST}
{244249200 0 0 WET}
{265507200 3600 1 WEST}
{271033200 0 0 WET}
{1212278400 3600 1 WEST}
{1220223600 0 0 WET}
{1243814400 3600 1 WEST}
{1250809200 0 0 WET}
{1272758400 3600 1 WEST}
{1281222000 0 0 WET}
{1301788800 3600 1 WEST}
{1312066800 0 0 WET}
{1335664800 3600 1 WEST}
{1342749600 0 0 WET}
{1345428000 3600 1 WEST}
{1348970400 0 0 WET}
{1367114400 3600 1 WEST}
{1373162400 0 0 WET}
{1376100000 3600 1 WEST}
{1382839200 0 0 WET}
{1396144800 3600 1 WEST}
{1403920800 0 0 WET}
{1406944800 3600 1 WEST}
{1414288800 0 0 WET}
{1427594400 3600 1 WEST}
{1434160800 0 0 WET}
{1437184800 3600 1 WEST}
{1445738400 0 0 WET}
{1459044000 3600 1 WEST}
{1465005600 0 0 WET}
{1468029600 3600 1 WEST}
{1477792800 0 0 WET}
{1490493600 3600 1 WEST}
{1495245600 0 0 WET}
{1498874400 3600 1 WEST}
{1509242400 0 0 WET}
{1521943200 3600 1 WEST}
{1526090400 0 0 WET}
{1529114400 3600 1 WEST}
{1540692000 0 0 WET}
{1553997600 3600 1 WEST}
{1556935200 0 0 WET}
{1559959200 3600 1 WEST}
{1572141600 0 0 WET}
{1585447200 3600 1 WEST}
{1587175200 0 0 WET}
{1590804000 3600 1 WEST}
{1603591200 0 0 WET}
{1616896800 3600 1 WEST}
{1618020000 0 0 WET}
{1621044000 3600 1 WEST}
{1635645600 0 0 WET}
{1648346400 3600 1 WEST}
{1648864800 0 0 WET}
{1651888800 3600 1 WEST}
{1667095200 0 0 WET}
{1682128800 3600 1 WEST}
{1698544800 0 0 WET}
{1712973600 3600 1 WEST}
{1729994400 0 0 WET}
{1743818400 3600 1 WEST}
{1761444000 0 0 WET}
{1774749600 3600 1 WEST}
{1792893600 0 0 WET}
{1806199200 3600 1 WEST}
{1824948000 0 0 WET}
{1837648800 3600 1 WEST}
{1856397600 0 0 WET}
{1869098400 3600 1 WEST}
{1887847200 0 0 WET}
{1901152800 3600 1 WEST}
{1919296800 0 0 WET}
{1932602400 3600 1 WEST}
{1950746400 0 0 WET}
{1964052000 3600 1 WEST}
{1982800800 0 0 WET}
{1995501600 3600 1 WEST}
{2014250400 0 0 WET}
{2026951200 3600 1 WEST}
{2045700000 0 0 WET}
{2058400800 3600 1 WEST}
{2077063200 0 0 WET}
{2077153200 0 0 WET}
{2090455200 3600 1 WEST}
{2107908000 0 0 WET}
{2108602800 0 0 WET}
{2121904800 3600 1 WEST}
{2138752800 0 0 WET}
{2140052400 0 0 WET}
{2153354400 3600 1 WEST}
{2172103200 0 0 WET}
{2184804000 3600 1 WEST}
{2203552800 0 0 WET}
{2216253600 3600 1 WEST}
{2235002400 0 0 WET}
{2248308000 3600 1 WEST}
{2266452000 0 0 WET}
{2279757600 3600 1 WEST}
{2297901600 0 0 WET}
{2311207200 3600 1 WEST}
{2329351200 0 0 WET}
{2342656800 3600 1 WEST}
{2361405600 0 0 WET}
{2374106400 3600 1 WEST}
{2392855200 0 0 WET}
{2405556000 3600 1 WEST}
{2424304800 0 0 WET}
{2437610400 3600 1 WEST}
{2455754400 0 0 WET}
{2469060000 3600 1 WEST}
{2487204000 0 0 WET}
{2500509600 3600 1 WEST}
{2519258400 0 0 WET}
{2531959200 3600 1 WEST}
{2550708000 0 0 WET}
{2563408800 3600 1 WEST}
{2582157600 0 0 WET}
{2595463200 3600 1 WEST}
{2613607200 0 0 WET}
{2626912800 3600 1 WEST}
{2645056800 0 0 WET}
{2658362400 3600 1 WEST}
{2676506400 0 0 WET}
{2689812000 3600 1 WEST}
{2708560800 0 0 WET}
{2721261600 3600 1 WEST}
{2740010400 0 0 WET}
{2752711200 3600 1 WEST}
{2771460000 0 0 WET}
{2784765600 3600 1 WEST}
{2802909600 0 0 WET}
{2816215200 3600 1 WEST}
{2834359200 0 0 WET}
{2847664800 3600 1 WEST}
{2866413600 0 0 WET}
{2879114400 3600 1 WEST}
{2897863200 0 0 WET}
{2910564000 3600 1 WEST}
{2929312800 0 0 WET}
{2942013600 3600 1 WEST}
{2960762400 0 0 WET}
{2974068000 3600 1 WEST}
{2992212000 0 0 WET}
{3005517600 3600 1 WEST}
{3023661600 0 0 WET}
{3036967200 3600 1 WEST}
{3055716000 0 0 WET}
{3068416800 3600 1 WEST}
{3087165600 0 0 WET}
{3099866400 3600 1 WEST}
{3118615200 0 0 WET}
{3131920800 3600 1 WEST}
{3150064800 0 0 WET}
{3163370400 3600 1 WEST}
{3181514400 0 0 WET}
{3194820000 3600 1 WEST}
{3212964000 0 0 WET}
{3226269600 3600 1 WEST}
{3245018400 0 0 WET}
{3257719200 3600 1 WEST}
{3276468000 0 0 WET}
{3289168800 3600 1 WEST}
{3307917600 0 0 WET}
{3321223200 3600 1 WEST}
{3339367200 0 0 WET}
{3352672800 3600 1 WEST}
{3370816800 0 0 WET}
{3384122400 3600 1 WEST}
{3402871200 0 0 WET}
{3415572000 3600 1 WEST}
{3434320800 0 0 WET}
{3447021600 3600 1 WEST}
{3465770400 0 0 WET}
{3479076000 3600 1 WEST}
{3497220000 0 0 WET}
{3510525600 3600 1 WEST}
{3528669600 0 0 WET}
{3541975200 3600 1 WEST}
{3560119200 0 0 WET}
{3573424800 3600 1 WEST}
{3592173600 0 0 WET}
{3604874400 3600 1 WEST}
{3623623200 0 0 WET}
{3636324000 3600 1 WEST}
{3655072800 0 0 WET}
{3668378400 3600 1 WEST}
{3686522400 0 0 WET}
{3699828000 3600 1 WEST}
{3717972000 0 0 WET}
{3731277600 3600 1 WEST}
{3750026400 0 0 WET}
{3762727200 3600 1 WEST}
{3781476000 0 0 WET}
{3794176800 3600 1 WEST}
{3812925600 0 0 WET}
{3825626400 3600 1 WEST}
{3844375200 0 0 WET}
{3857680800 3600 1 WEST}
{3875824800 0 0 WET}
{3889130400 3600 1 WEST}
{3907274400 0 0 WET}
{3920580000 3600 1 WEST}
{3939328800 0 0 WET}
{3952029600 3600 1 WEST}
{3970778400 0 0 WET}
{3983479200 3600 1 WEST}
{4002228000 0 0 WET}
{4015533600 3600 1 WEST}
{4033677600 0 0 WET}
{4046983200 3600 1 WEST}
{4065127200 0 0 WET}
{4078432800 3600 1 WEST}
{4096576800 0 0 WET}
}
+34 -3
View File
@@ -1,5 +1,36 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Abidjan)]} {
LoadTimeZoneFile Africa/Abidjan
set TZData(:Africa/Freetown) {
{-9223372036854775808 -3180 0 LMT}
{-2776979220 -3180 0 FMT}
{-1785712020 -3600 0 WAT}
{-1091487600 -1200 1 SLST}
{-1080949200 -3600 0 WAT}
{-1059865200 -1200 1 SLST}
{-1049326800 -3600 0 WAT}
{-1028329200 -1200 1 SLST}
{-1017790800 -3600 0 WAT}
{-996793200 -1200 1 SLST}
{-986254800 -3600 0 WAT}
{-965257200 -1200 1 SLST}
{-954718800 -3600 0 WAT}
{-933634800 -1200 1 SLST}
{-923096400 -3600 0 WAT}
{-902098800 -1200 1 SLST}
{-891560400 -3600 0 WAT}
{-870562800 -1200 1 SLST}
{-860024400 -3600 0 WAT}
{-410223600 0 0 WAT}
{-397180800 3600 1 SLST}
{-389235600 0 0 GMT}
{-365644800 3600 1 SLST}
{-357699600 0 0 GMT}
{-334108800 3600 1 SLST}
{-326163600 0 0 GMT}
{-302486400 3600 1 SLST}
{-294541200 0 0 GMT}
{-270950400 3600 1 SLST}
{-263005200 0 0 GMT}
{-239414400 3600 1 SLST}
{-231469200 0 0 GMT}
}
set TZData(:Africa/Freetown) $TZData(:Africa/Abidjan)
+7 -3
View File
@@ -1,5 +1,9 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Maputo)]} {
LoadTimeZoneFile Africa/Maputo
set TZData(:Africa/Gaborone) {
{-9223372036854775808 6220 0 LMT}
{-2682294220 5400 0 SAST}
{-2109288600 7200 0 CAT}
{-829526400 10800 1 CAST}
{-813805200 7200 0 CAT}
}
set TZData(:Africa/Gaborone) $TZData(:Africa/Maputo)
+4 -3
View File
@@ -1,5 +1,6 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Maputo)]} {
LoadTimeZoneFile Africa/Maputo
set TZData(:Africa/Harare) {
{-9223372036854775808 7452 0 LMT}
{-2109290652 7200 0 CAT}
}
set TZData(:Africa/Harare) $TZData(:Africa/Maputo)
+7 -3
View File
@@ -1,5 +1,9 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Nairobi)]} {
LoadTimeZoneFile Africa/Nairobi
set TZData(:Africa/Kampala) {
{-9223372036854775808 7780 0 LMT}
{-1309745380 10800 0 EAT}
{-1262314800 9000 0 BEAT}
{-694319400 9900 0 BEAUT}
{-410237100 10800 0 EAT}
}
set TZData(:Africa/Kampala) $TZData(:Africa/Nairobi)
+4 -3
View File
@@ -1,5 +1,6 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Maputo)]} {
LoadTimeZoneFile Africa/Maputo
set TZData(:Africa/Kigali) {
{-9223372036854775808 7216 0 LMT}
{-1091498416 7200 0 CAT}
}
set TZData(:Africa/Kigali) $TZData(:Africa/Maputo)
+4 -3
View File
@@ -1,5 +1,6 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Lagos)]} {
LoadTimeZoneFile Africa/Lagos
set TZData(:Africa/Kinshasa) {
{-9223372036854775808 3672 0 LMT}
{-2276643672 3600 0 WAT}
}
set TZData(:Africa/Kinshasa) $TZData(:Africa/Lagos)
+4 -3
View File
@@ -1,5 +1,6 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Lagos)]} {
LoadTimeZoneFile Africa/Lagos
set TZData(:Africa/Libreville) {
{-9223372036854775808 2268 0 LMT}
{-1830386268 3600 0 WAT}
}
set TZData(:Africa/Libreville) $TZData(:Africa/Lagos)
+4 -3
View File
@@ -1,5 +1,6 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Abidjan)]} {
LoadTimeZoneFile Africa/Abidjan
set TZData(:Africa/Lome) {
{-9223372036854775808 292 0 LMT}
{-2429827492 0 0 GMT}
}
set TZData(:Africa/Lome) $TZData(:Africa/Abidjan)
+5 -3
View File
@@ -1,5 +1,7 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Lagos)]} {
LoadTimeZoneFile Africa/Lagos
set TZData(:Africa/Luanda) {
{-9223372036854775808 3176 0 LMT}
{-2461452776 3124 0 AOT}
{-1849395124 3600 0 WAT}
}
set TZData(:Africa/Luanda) $TZData(:Africa/Lagos)
+4 -3
View File
@@ -1,5 +1,6 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Maputo)]} {
LoadTimeZoneFile Africa/Maputo
set TZData(:Africa/Lubumbashi) {
{-9223372036854775808 6592 0 LMT}
{-2276646592 7200 0 CAT}
}
set TZData(:Africa/Lubumbashi) $TZData(:Africa/Maputo)
+4 -3
View File
@@ -1,5 +1,6 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Maputo)]} {
LoadTimeZoneFile Africa/Maputo
set TZData(:Africa/Lusaka) {
{-9223372036854775808 6788 0 LMT}
{-2109289988 7200 0 CAT}
}
set TZData(:Africa/Lusaka) $TZData(:Africa/Maputo)
+5 -3
View File
@@ -1,5 +1,7 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Lagos)]} {
LoadTimeZoneFile Africa/Lagos
set TZData(:Africa/Malabo) {
{-9223372036854775808 2108 0 LMT}
{-1830386108 0 0 GMT}
{-190857600 3600 0 WAT}
}
set TZData(:Africa/Malabo) $TZData(:Africa/Lagos)
+6 -3
View File
@@ -1,5 +1,8 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Johannesburg)]} {
LoadTimeZoneFile Africa/Johannesburg
set TZData(:Africa/Maseru) {
{-9223372036854775808 6600 0 LMT}
{-2109289800 7200 0 SAST}
{-829526400 10800 1 SAST}
{-813805200 7200 0 SAST}
}
set TZData(:Africa/Maseru) $TZData(:Africa/Johannesburg)
+4 -3
View File
@@ -1,5 +1,6 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Johannesburg)]} {
LoadTimeZoneFile Africa/Johannesburg
set TZData(:Africa/Mbabane) {
{-9223372036854775808 7464 0 LMT}
{-2109290664 7200 0 SAST}
}
set TZData(:Africa/Mbabane) $TZData(:Africa/Johannesburg)
+6 -3
View File
@@ -1,5 +1,8 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Nairobi)]} {
LoadTimeZoneFile Africa/Nairobi
set TZData(:Africa/Mogadishu) {
{-9223372036854775808 10888 0 LMT}
{-2403572488 10800 0 EAT}
{-1230778800 9000 0 BEAT}
{-410236200 10800 0 EAT}
}
set TZData(:Africa/Mogadishu) $TZData(:Africa/Nairobi)
+6 -3
View File
@@ -1,5 +1,8 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Lagos)]} {
LoadTimeZoneFile Africa/Lagos
set TZData(:Africa/Niamey) {
{-9223372036854775808 508 0 LMT}
{-1830384508 -3600 0 WAT}
{-1131231600 0 0 GMT}
{-315619200 3600 0 WAT}
}
set TZData(:Africa/Niamey) $TZData(:Africa/Lagos)

Some files were not shown because too many files have changed in this diff Show More