Compare commits

..
Author SHA1 Message Date
dgp ee6540e9cb Correct some faulty assumptions in the zlib transformation input driver.
BRANCHED - some other EOF matters need checking before this is trunk ready.
2014-03-21 19:07:02 +00:00
dgp 97ef11cb6e Added comments raising questions about possible updates to channel
drivers on Windows.
2014-03-21 17:11:32 +00:00
jan.nijtmans cb2a1e4c13 Fix [2f7cbd01c3]: tcl8.6.1 fails to build on FreeBSD 10.0 2014-03-20 10:10:04 +00:00
jan.nijtmans a62fd8466e Fix [2f7cbd01c3]: tcl8.6.1 fails to build on FreeBSD 10.0 2014-03-20 10:06:25 +00:00
jan.nijtmans c7a7120587 Proposed fix for [2f7cbd01c3]. 2014-03-20 09:22:29 +00:00
jan.nijtmans bef17eed6a Merge core-8-5-branch (New tests covering INPUT_NEED_NL flag handling. One exposes a bug.) 2014-03-09 21:58:12 +00:00
jan.nijtmans 6bcc85f28e Mark io-35.18b test as knownBug 2014-03-09 21:55:51 +00:00
dgp 4a58d3c00a New tests covering INPUT_NEED_NL flag handling. One exposes a bug. 2014-02-26 17:47:46 +00:00
jan.nijtmans 4840e7dbb4 Simplify macro handling in tclOO*Decls.h, just as already done in "novem" [0c37ab8944], itcl*Decls.h and tdbc*Decls.h.
This doesn't change the way symbols are exported. This simplifications were already present in the Tcl 8.6.2 headers, but those were buggy when tclOO was linked in statically without using stubs.
2014-02-26 13:16:18 +00:00
dkf 282de06cab [8d5f5b8034] Flush internal representations in [string tolower] of unshared obj 2014-02-25 15:49:52 +00:00
oehhar 8f14151916 Do not reopen a win serial channel for serial detection. There are issues with some Bluetooth virtual com. Fix bug [2413550], patch by Rolf Schroedter 2014-02-25 08:02:17 +00:00
oehhar ada7d66e9f Do not reopen a win serial channel for serial detection. There are issues with some Bluetooth virtual com. Fix bug [2413550], patch by Rolf Schroedter 2014-02-24 17:25:08 +00:00
dkf 1a8dc819d6 [3597178]: Improve documentation of what's going on with encodings 2014-02-23 13:07:36 +00:00
dgp 6e09fe5ab9 [1230597] Update test comment. 2014-02-19 14:12:37 +00:00
dgp fa1ab4f740 [1230597] Update test comment. 2014-02-19 14:10:55 +00:00
dkf c91f173c8b [9bf7e67b37]: minor documentation blooper 2014-02-16 08:18:29 +00:00
jan.nijtmans 47f1107ebc typo 2014-02-12 12:15:15 +00:00
jan.nijtmans 78bbf020ea typo 2014-02-12 12:13:32 +00:00
jan.nijtmans f0882154a8 Fix execute permission bit (should not be set) for *Decls.h files 2014-02-11 10:58:30 +00:00
oehhar 89583a6623 Changed position of flag evaluation as proposed by Phil Hoffman 2014-02-11 08:53:33 +00:00
jan.nijtmans 0258413bde Eliminate all usage of WIN32 and __WIN32__ macros: Some compilers (e.g. Clang/LLVM) don't define it, and _WIN32 is much more portable anyway.
See: [http://nadeausoftware.com/articles/2012/01/c_c_tip_how_use_compiler_predefined_macros_detect_operating_system#WindowsCygwinnonPOSIXandMinGW]
2014-02-10 11:59:22 +00:00
dgp b6ae0212a1 [a4494e28ed] Use flag bit instead of NULL pointer to suppress
teardown list of imported commands when the original command
              gets re-created. This prevents the panic otherwise possible when
              the invalid state represented by the NULL pointer is encountered
              during a command delete trace.
2014-02-06 22:48:34 +00:00
dgp 5ff110b484 Change the flag value to avoid merge conflict with trunk. 2014-02-06 22:41:14 +00:00
dgp 438b687249 [a4494e28ed] Use flag bit instead of NULL pointer to suppress teardown list of
imported commands when the original command gets re-created.  This prevents the
panic otherwise possible when the invalid state represented by the NULL pointer
is encountered during a command delete trace.
2014-02-06 22:38:17 +00:00
jan.nijtmans 8c3bcfe950 check for existance of __BORLANDC__ before using its value 2014-02-06 21:45:29 +00:00
jan.nijtmans cacb796441 Check for existance of __BORLANDC__ before using its value 2014-02-06 21:44:43 +00:00
jan.nijtmans 40094302e0 Satisfy required position of __stdcall from VC++ 2014-02-04 21:52:46 +00:00
jan.nijtmans c7569e1c35 Satisfy required position of __stdcall from VC++ 2014-02-04 21:51:32 +00:00
jan.nijtmans ae659fdb12 Add missing __stdcall (which crashes on win32), and clean-up indenting 2014-02-04 21:33:13 +00:00
jan.nijtmans fc5e6debde remove duplicate declaration 2014-02-04 21:29:44 +00:00
jan.nijtmans 876dd3ac96 Add missing __stdcall (which crashes on win32), and clean-up indenting 2014-02-04 21:21:53 +00:00
dgp 8c665116c9 Simplify the core output operations of channels. Reduce duplicative and dead code. 2014-02-04 16:24:14 +00:00
dgp 1eb2dfe0fc Simplify the core output operations of channels. Reduce duplicative and
dead code.
2014-02-04 15:17:12 +00:00
dgp f53e4a7a0e Be sure to finalize the identity encoding. 2014-02-04 14:30:55 +00:00
dkf 5be047220d make the printing of source much less inclined to be fazed by non-ASCII chars 2014-02-04 09:02:23 +00:00
dkf 510244810f [971cb4f1db]: Make debugging traces less inclined to serious visual corruption 2014-02-04 08:15:52 +00:00
dgp 9f92115d2d merge 8.5 2014-02-03 22:58:36 +00:00
jan.nijtmans ad8e3dcb0a Fix [651e828a52]: Wrong Windows version reported for Windows 8.1 2014-02-03 15:19:26 +00:00
jan.nijtmans f77ffeb9b2 Fix [651e828a52]: Wrong Windows version reported for Windows 8.1 2014-02-03 14:43:52 +00:00
dkf c574af192d add compilation of [string is] 2014-02-02 16:01:21 +00:00
dkf fd4bc0f106 compilation of [string is] 2014-02-02 14:43:48 +00:00
dkf cca7f018e0 improve the disassembly 2014-02-02 14:42:12 +00:00
dgp e12cc95f12 Simplify macro typecasting. 2014-01-31 22:07:10 +00:00
dgp beb8c62dff The "channel" Tcl_ObjType is caching only. It never needs an UpdateString routine.
It's also static to the tclIO.c file.
2014-01-31 20:42:21 +00:00
dgp 684c2c9051 Do not call updateStringProc directly. We have TclGetString() for that. 2014-01-31 20:02:58 +00:00
jan.nijtmans 767efbf478 Fix [4b3b7a3082]: tcl8.5.15/generic/tclExecute.c:7713: array index before sanity check ? 2014-01-31 09:19:11 +00:00
jan.nijtmans b4b95b976a Fix [4b3b7a3082]: tcl8.5.15/generic/tclExecute.c:7713: array index before sanity check ? 2014-01-31 09:13:13 +00:00
dgp 2c59046c95 Refactor to eliminate the DoWriteChars() layer. 2014-01-30 20:10:21 +00:00
dgp f11f5780e0 Eliminate DoWrite(). It duplicates WriteBytes(). 2014-01-30 19:30:34 +00:00
dgp c00d7aa9b9 Trial: Implement DoWrite() as WriteBytes(). 2014-01-30 19:13:28 +00:00
dgp 050c8a639f Simplification and cleanup enabled by last commit. 2014-01-30 18:45:11 +00:00
dgp 248247d828 Refactor WriteChars() and WriteBytes() into simple wrappers of a common
routine Write().
2014-01-30 18:31:39 +00:00
oehhar 42f972d403 merge 8.5 2014-01-30 15:02:40 +00:00
dgp a92cc7b340 Eliminate the use of a staging buffer in WriteChars(). 2014-01-30 14:51:44 +00:00
jan.nijtmans b6ac569a5d Fix [22c10c8e79]: core-8-5: msvc6 build: "Side by Side" error 2014-01-30 14:50:22 +00:00
jan.nijtmans 2c00f457ae Fix [22c10c8e79]: core-8-5: msvc6 build: "Side by Side" error 2014-01-30 14:44:56 +00:00
dgp 4a8456e406 Eliminate the use of a staging buffer in WriteChars(). 2014-01-30 14:31:17 +00:00
oehhar 63d77c0046 win/tclWinChan.c Tcl_InitNotifier: Bug [2413550] Avoid reopening of serial channels which causes issues with Bluetooth virtual com. Patch by Rolf Schroedter. 2014-01-30 11:02:51 +00:00
andreask cc6eaf6308 Squashed C99 syntax breaking the native AIX cc. 2014-01-29 23:18:58 +00:00
dkf 6597355ad8 Compile [string is] with character classes in a non-awful way. Needs more work to make resulting bytecode disassemble nicely. 2014-01-29 13:59:32 +00:00
dgp c53002fe3b The outputStage field is now unused, so never allocate it. 2014-01-28 20:23:26 +00:00
dgp 2c2a7d737a tidy things up 2014-01-28 20:19:39 +00:00
dgp d250eba26d Working code with no staging buffer use. 2014-01-28 18:51:59 +00:00
dgp 2585021472 WIP 2014-01-28 11:04:57 +00:00
dgp 518e457db3 merge 8.5 2014-01-27 17:58:10 +00:00
jan.nijtmans 4e83fe1049 sync tcl.m4 with Tk version 2014-01-25 21:41:48 +00:00
jan.nijtmans 5d9939831c sync tcl.m4 with Tk version 2014-01-25 21:41:12 +00:00
dkf f4549b8fc4 merge principal development branch 2014-01-25 09:02:30 +00:00
dgp c25181bd7d In WriteChars(), eliminate the copy step through a staging buffer when it
is not required for channel translation.
2014-01-24 21:52:59 +00:00
dgp 2ceb7a6077 In WriteChars(), eliminate the copy step through a staging buffer when
it is not required for channel translation.
2014-01-24 21:45:39 +00:00
dgp e3bde55a0f Eliminate the copy to a staging buffer when that serves no functional purpose. 2014-01-24 17:38:59 +00:00
dkf 834d5da992 improved tidy-up from branch 2014-01-22 19:33:03 +00:00
jan.nijtmans 2be298f89d remove unused variable 2014-01-22 13:48:16 +00:00
dkf c9ae8d64d3 minor tidying up 2014-01-22 09:14:57 +00:00
dkf 477af49f88 add compilation for [nextto] and [yieldto]; fix [a90d9331bc] 2014-01-22 09:11:07 +00:00
dkf 7716fd3e46 [a90d9331bc]: must not crash when yieldto called in vanishing namespace 2014-01-22 09:07:45 +00:00
dgp 8fc4750efc merge mark 2014-01-21 18:17:14 +00:00
dgp 78b4196767 Silence compiler warnings. 2014-01-21 18:16:37 +00:00
dgp 1e9a5591d9 [2992970] Restore safety of Tcl_AppendObjToObj(x, x) for bytearrays. 2014-01-21 17:25:41 +00:00
dkf 128e4211ae implementation of [yieldto] in bytecode 2014-01-21 15:07:59 +00:00
dkf 88b2f7f06e added compilation for [nextto] 2014-01-19 18:39:24 +00:00
dgp a994cc42f5 [2992970] Restore the safety of Tcl_AppendObjToObj(x, x) for bytearrays.
Also moves overflow checking to TclAppendBytesToByteArray() and adds
the ability to call TABTBA() with bytes==NULL, for appending unspecified
bytes.  That is, the string grows, but the new bytes are of undetermined
value.  Like Tcl_NewByteArrayObj(NULL, length) this option is useful
for manipulating buffers.  The TABTBA growth algorithm is also enhanced
a bit, copying over a fuller implementation from GrowStringBuffer()
in tclStringObj.c
2014-01-15 19:04:52 +00:00
dkf 12945e9a16 extend [string is] to booleans 2014-01-13 08:06:43 +00:00
dkf 2803a8a055 a different approach 2014-01-10 15:58:41 +00:00
dkf 29ae06c2d3 use compact form 2014-01-09 10:49:04 +00:00
jan.nijtmans 48459b2357 Make DEFAULT_TRIM_SET a MODULE_SCOPE string constant, so its value can be shared in tclCmdMZ.o and TclCompCmdsSZ.o
and it no longer pollutes the tclStringTrim.h header file.
2014-01-08 11:04:44 +00:00
dkf 8f95efa4cf merge main working branch 2014-01-07 14:25:22 +00:00
dkf c8e62b1cfa Add compilations for the following commands:
* concat
 * linsert
 * namespace origin
 * next
 * string replace
 * string tolower
 * string totitle
 * string toupper
 * string trim
 * string trimleft
 * string trimright
2014-01-07 14:19:04 +00:00
dkf cbc312324e make function static once more; not needed outside of source file 2014-01-07 14:13:37 +00:00
dkf 03ecb591a6 reduce the overhead of NR-enabled TclOO [next] 2014-01-07 13:59:30 +00:00
dkf 6bb7b1e15d factor out a common stanza 2014-01-05 17:31:38 +00:00
dkf a2e12b4377 merge main working branch 2014-01-05 17:00:15 +00:00
dkf 6d9846f8c9 merge trunk 2014-01-05 16:57:05 +00:00
mig 666deab1ea fix arraySet compiler to set -errorcode instead of -errorCode in return options 2014-01-05 15:01:52 +00:00
mig bb9e19e6eb skip the switch(result) on returning TCL_OK from a proc 2014-01-05 14:10:42 +00:00
mig ea8a9ba071 reducing TEBCdata: pc and cleanup now passed in the NREcallback 2014-01-05 12:01:04 +00:00
dkf 430c9bc178 redevelop code to have more in common with the interpreted [string is] and to remove non-working types 2014-01-02 15:30:53 +00:00
jan.nijtmans e7e7bafe96 merge-mark 2014-01-02 10:11:42 +00:00
dkf 9c349ce2e2 more fixes to instruction tracing; ensure all places that need DECACHE_STACK_INFO have it 2014-01-02 10:01:35 +00:00
dkf e7f9c9c822 merge main working branch 2014-01-02 09:38:03 +00:00
dkf 83fcae9bbe implement TclOO's [next] in bytecode 2014-01-02 09:17:07 +00:00
dkf d5961a83e0 merge main working branch; made opcode work by getting callback ordering right 2014-01-02 09:15:18 +00:00
dkf 9c6b83d5b1 merge trunk 2014-01-02 08:51:04 +00:00
dkf 8a115927af ... and more silly errors 2014-01-02 08:50:08 +00:00
dkf 68cab10668 merge trunk 2014-01-02 08:35:48 +00:00
dkf c28c2d5b9a oops... 2014-01-02 08:35:01 +00:00
dkf 78f85049ff merge main working branch 2014-01-02 08:32:36 +00:00
dkf a30f092ea3 merge trunk 2014-01-02 03:27:16 +00:00
dkf 4f13f826e4 more fixes to instruction tracing; ensure all places that need DECACHE_STACK_INFO have it. jan.nijtmans: Branch moved aside an hidden, so future bisects are not affected by this branch mistakes. 2014-01-02 03:10:43 +00:00
dkf 1c54736c0d factor out a common peephole stanza 2014-01-01 16:19:14 +00:00
dkf f9dd75e79c another jump peephole, this time with string comparisons 2013-12-31 23:34:57 +00:00
dkf d423ce0c06 more cleaning up of error-case instruction tracing 2013-12-31 17:28:16 +00:00
dkf 76b954ec41 merge trunk 2013-12-31 16:28:15 +00:00
dkf c45f1130d1 more peephole optimizations in TEBC, and better instruction execution traces 2013-12-31 16:26:55 +00:00
mig 0891bbbcbb clarify the resume sequence in TEBCresume; make checkInterp a local variable, remove it from the saved struct 2013-12-31 12:14:50 +00:00
dkf 05feb2c73f merge trunk 2013-12-31 10:49:07 +00:00
dkf 0e49a49b8f remove ill-advised change to assembler
What made sense for the compiler does not for the assembler, as that can (and does) build code blocks entirely out of order.
2013-12-31 10:47:19 +00:00
dgp 57dc79f34e merge trunk 2013-12-30 16:36:12 +00:00
dkf 413a0c2501 put the other definition of a trim set in the header file too 2013-12-30 11:56:54 +00:00
dkf 76007824cc Factor out the definition of the default string trim set; define it once only. 2013-12-30 11:40:44 +00:00
dkf db5995b2b8 merge main working branch 2013-12-30 10:24:20 +00:00
dkf 9083b5bf61 merge main working branch 2013-12-30 08:50:28 +00:00
dkf 4ad593f2bf implement [namespace origin] in bytecode 2013-12-30 08:37:49 +00:00
dkf cdacc33cbb allow generation by assembler 2013-12-30 08:16:21 +00:00
dkf f7157671ce corrected comment 2013-12-30 08:12:52 +00:00
dkf b004b21242 Improved general case of [string replace] implementation. 2013-12-29 18:49:20 +00:00
dgp ffb2a3d9b4 merge trunk 2013-10-23 15:34:01 +00:00
dkf 0eb33efc7a merge main dev branch 2013-01-03 14:08:49 +00:00
dkf 53baa9e5c4 merge main dev branch 2013-01-03 14:07:24 +00:00
dkf af735a0ba9 merge main dev branch 2012-12-19 11:43:40 +00:00
dkf a7b60b26f1 merge main dev branch 2012-12-19 11:42:46 +00:00
dkf d6bd07fecc merge dkf-compile-misc-info 2012-11-20 12:14:18 +00:00
dkf f497ce9a95 merge dkf-compile-misc-info 2012-11-20 12:13:43 +00:00
dkf 414163addc merge main dev branch 2012-11-05 21:56:13 +00:00
dkf 71fd534215 merge main dev branch 2012-11-05 21:55:40 +00:00
dkf b8bcc352ea merge main dev branch 2012-11-05 15:33:44 +00:00
dkf f04eef80d7 merge main dev branch 2012-11-05 15:28:01 +00:00
dkf 2de2d8678f reorder to preserve main BC development branch sequence better 2012-11-02 20:39:10 +00:00
dkf d5e04d6200 merge dkf-compile-misc-info 2012-11-02 20:25:57 +00:00
dkf 6d14b815b2 Work on compilation of [string is].
Hit some problem edge cases with differences in strictness of edge cases that
will force a rethink ([string is boolean] is significantly more strict than
Tcl_GetBooleanFromObj).
2012-11-02 16:50:06 +00:00
dkf ed18777278 Working towards a BCCed [next].
This version <i>almost</i> works, except for a problem with restoring the
context namespace upon return (which produces very strange results!)
2012-11-01 20:40:55 +00:00
222 changed files with 2579 additions and 1720 deletions
Regular → Executable
View File
Regular → Executable
View File
Executable → Regular
View File
Executable → Regular
View File
+27 -7
View File
@@ -14,10 +14,21 @@ encoding \- Manipulate encodings
.BE
.SH INTRODUCTION
.PP
Strings in Tcl are encoded using 16-bit Unicode characters. Different
operating system interfaces or applications may generate strings in
other encodings such as Shift-JIS. The \fBencoding\fR command helps
to bridge the gap between Unicode and these other formats.
Strings in Tcl are logically a sequence of 16-bit Unicode characters.
These strings are represented in memory as a sequence of bytes that
may be in one of several encodings: modified UTF\-8 (which uses 1 to 3
bytes per character), 16-bit
.QW Unicode
(which uses 2 bytes per character, with an endianness that is
dependent on the host architecture), and binary (which uses a single
byte per character but only handles a restricted range of characters).
Tcl does not guarantee to always use the same encoding for the same
string.
.PP
Different operating system interfaces or applications may generate
strings in other encodings such as Shift\-JIS. The \fBencoding\fR
command helps to bridge the gap between Unicode and these other
formats.
.SH DESCRIPTION
.PP
Performs one of several encoding related operations, depending on
@@ -37,8 +48,9 @@ system encoding is used.
Convert \fIstring\fR from Unicode to the specified \fIencoding\fR.
The result is a sequence of bytes that represents the converted
string. Each byte is stored in the lower 8-bits of a Unicode
character. If \fIencoding\fR is not specified, the current
system encoding is used.
character (indeed, the resulting string is a binary string as far as
Tcl is concerned, at least initially). If \fIencoding\fR is not
specified, the current system encoding is used.
.TP
\fBencoding dirs\fR ?\fIdirectoryList\fR?
.
@@ -56,6 +68,11 @@ searchable directory, that element is ignored.
.
Returns a list containing the names of all of the encodings that are
currently available.
The encodings
.QW utf-8
and
.QW iso8859-1
are guaranteed to be present in the list.
.TP
\fBencoding system\fR ?\fIencoding\fR?
.
@@ -73,7 +90,7 @@ However, because the \fBsource\fR command always reads files using the
current system encoding, Tcl will only source such files correctly
when the encoding used to write the file is the same. This tends not
to be true in an internationalized setting. For example, if such a
file was sourced in North America (where the ISO8859-1 is normally
file was sourced in North America (where the ISO8859\-1 is normally
used), each byte in the file would be treated as a separate character
that maps to the 00 page in Unicode. The resulting Tcl strings will
not contain the expected Japanese characters. Instead, they will
@@ -93,3 +110,6 @@ which is the Hiragana letter HA.
Tcl_GetEncoding(3)
.SH KEYWORDS
encoding, unicode
.\" Local Variables:
.\" mode: nroff
.\" End:
Executable → Regular
View File
+24 -4
View File
@@ -343,10 +343,13 @@ misleading.
\fBstring bytelength \fIstring\fR
.
Returns a decimal string giving the number of bytes used to represent
\fIstring\fR in memory. Because UTF\-8 uses one to three bytes to
represent Unicode characters, the byte length will not be the same as
the character length in general. The cases where a script cares about
the byte length are rare.
\fIstring\fR in memory when encoded as Tcl's internal modified UTF\-8;
Tcl may use other encodings for \fIstring\fR as well, and does not
guarantee to only use a single encoding for a particular \fIstring\fR.
Because UTF\-8 uses a variable number of bytes to represent Unicode
characters, the byte length will not be the same as the character
length in general. The cases where a script cares about the byte
length are rare.
.RS
.PP
In almost all cases, you should use the
@@ -354,10 +357,27 @@ In almost all cases, you should use the
Tcl byte array value). Refer to the \fBTcl_NumUtfChars\fR manual
entry for more details on the UTF\-8 representation.
.PP
Formally, the \fBstring bytelength\fR operation returns the content of
the \fIlength\fR field of the \fBTcl_Obj\fR structure, after calling
\fBTcl_GetString\fR to ensure that the \fIbytes\fR field is populated.
This is highly unlikely to be useful to Tcl scripts, as Tcl's internal
encoding is not strict UTF\-8, but rather a modified CESU\-8 with a
denormalized NUL (identical to that used in a number of places by
Java's serialization mechanism) to enable basic processing with
non-Unicode-aware C functions. As this representation should only
ever be used by Tcl's implementation, the number of bytes used to
store the representation is of very low value (except to C extension
code, which has direct access for the purpose of memory management,
etc.)
.PP
\fICompatibility note:\fR it is likely that this subcommand will be
withdrawn in a future version of Tcl. It is better to use the
\fBencoding convertto\fR command to convert a string to a known
encoding and then apply \fBstring length\fR to that.
.PP
.CS
\fBstring length\fR [encoding convertto utf-8 $theString]
.CE
.RE
.TP
\fBstring wordend \fIstring charIndex\fR
+1 -1
View File
@@ -10,7 +10,7 @@
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
argc, argv, argv0, auto_path, env, errorCode, errorInfo, tcl_interactive, tcl_library, tcl_nonwordchars, tcl_patchLevel, tcl_pkgPath, tcl_platform, tcl_precision, tcl_rcFileName, tcl_traceCompile, tcl_traceEval, tcl_wordchars, tcl_version \- Variables used by Tcl
argc, argv, argv0, auto_path, env, errorCode, errorInfo, tcl_interactive, tcl_library, tcl_nonwordchars, tcl_patchLevel, tcl_pkgPath, tcl_platform, tcl_precision, tcl_rcFileName, tcl_traceCompile, tcl_traceExec, tcl_wordchars, tcl_version \- Variables used by Tcl
.BE
.SH DESCRIPTION
.PP
+16 -19
View File
@@ -67,15 +67,12 @@ extern "C" {
* We use this method because there is no autoconf equivalent.
*/
#ifndef __WIN32__
# if defined(_WIN32) || defined(WIN32) || defined(__MINGW32__) || defined(__BORLANDC__) || (defined(__WATCOMC__) && defined(__WINDOWS_386__))
#ifdef _WIN32
# ifndef __WIN32__
# define __WIN32__
# ifndef WIN32
# define WIN32
# endif
# ifndef _WIN32
# define _WIN32
# endif
# endif
# ifndef WIN32
# define WIN32
# endif
#endif
@@ -83,11 +80,11 @@ extern "C" {
* STRICT: See MSDN Article Q83456
*/
#ifdef __WIN32__
#ifdef _WIN32
# ifndef STRICT
# define STRICT
# endif
#endif /* __WIN32__ */
#endif /* _WIN32 */
/*
* Utility macros: STRINGIFY takes an argument and wraps it in "" (double
@@ -191,7 +188,7 @@ extern "C" {
* MSVCRT.
*/
#if (defined(__WIN32__) && (defined(_MSC_VER) || (__BORLANDC__ >= 0x0550) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec))))
#if (defined(_WIN32) && (defined(_MSC_VER) || (defined(__BORLANDC__) && (__BORLANDC__ >= 0x0550)) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec))))
# define HAVE_DECLSPEC 1
# ifdef STATIC_BUILD
# define DLLIMPORT
@@ -315,14 +312,14 @@ extern "C" {
* VOID. This block is skipped under Cygwin and Mingw.
*/
#if defined(__WIN32__) && !defined(HAVE_WINNT_IGNORE_VOID)
#if defined(_WIN32) && !defined(HAVE_WINNT_IGNORE_VOID)
#ifndef VOID
#define VOID void
typedef char CHAR;
typedef short SHORT;
typedef long LONG;
#endif
#endif /* __WIN32__ && !HAVE_WINNT_IGNORE_VOID */
#endif /* _WIN32 && !HAVE_WINNT_IGNORE_VOID */
/*
* Macro to use instead of "void" for arguments that must have type "void *"
@@ -390,7 +387,7 @@ typedef long LONG;
*/
#if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG)
# if defined(__WIN32__)
# if defined(_WIN32)
# define TCL_WIDE_INT_TYPE __int64
# ifdef __BORLANDC__
# define TCL_LL_MODIFIER "L"
@@ -400,7 +397,7 @@ typedef long LONG;
# elif defined(__GNUC__)
# define TCL_WIDE_INT_TYPE long long
# define TCL_LL_MODIFIER "ll"
# else /* ! __WIN32__ && ! __GNUC__ */
# else /* ! _WIN32 && ! __GNUC__ */
/*
* Don't know what platform it is and configure hasn't discovered what is
* going on for us. Try to guess...
@@ -415,7 +412,7 @@ typedef long LONG;
# define TCL_WIDE_INT_TYPE long long
# endif
# endif /* NO_LIMITS_H */
# endif /* __WIN32__ */
# endif /* _WIN32 */
#endif /* !TCL_WIDE_INT_TYPE & !TCL_WIDE_INT_IS_LONG */
#ifdef TCL_WIDE_INT_IS_LONG
# undef TCL_WIDE_INT_TYPE
@@ -447,7 +444,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
# define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val)))
#endif /* TCL_WIDE_INT_IS_LONG */
#if defined(__WIN32__)
#if defined(_WIN32)
# ifdef __BORLANDC__
typedef struct stati64 Tcl_StatBuf;
# elif defined(_WIN64)
@@ -562,7 +559,7 @@ typedef struct Tcl_ZLibStream_ *Tcl_ZlibStream;
* will be called as the main fuction of the new thread created by that call.
*/
#if defined __WIN32__
#if defined _WIN32
typedef unsigned (__stdcall Tcl_ThreadCreateProc) (ClientData clientData);
#else
typedef void (Tcl_ThreadCreateProc) (ClientData clientData);
@@ -574,7 +571,7 @@ typedef void (Tcl_ThreadCreateProc) (ClientData clientData);
* in generic/tclThreadTest.c for it's usage.
*/
#if defined __WIN32__
#if defined _WIN32
# define Tcl_ThreadCreateType unsigned __stdcall
# define TCL_THREAD_CREATE_RETURN return 0
#else
+13 -7
View File
@@ -26,6 +26,7 @@
*- jumpTable testing
*- syntax (?)
*- returnCodeBranch
*- tclooNext, tclooNextClass
*/
#include "tclInt.h"
@@ -49,7 +50,7 @@ typedef enum BasicBlockCatchState {
BBCS_UNKNOWN = 0, /* Catch context has not yet been identified */
BBCS_NONE, /* Block is outside of any catch */
BBCS_INCATCH, /* Block is within a catch context */
BBCS_CAUGHT, /* Block is within a catch context and
BBCS_CAUGHT /* Block is within a catch context and
* may be executed after an exception fires */
} BasicBlockCatchState;
@@ -120,7 +121,7 @@ enum BasicBlockFlags {
* marking it as the start of a 'catch'
* sequence. The 'jumpTarget' is the exception
* exit from the catch block. */
BB_ENDCATCH = (1 << 5), /* Block ends with an 'endCatch' instruction,
BB_ENDCATCH = (1 << 5) /* Block ends with an 'endCatch' instruction,
* unwinding the catch from the exception
* stack. */
};
@@ -183,7 +184,7 @@ typedef enum TalInstType {
* produces N */
ASSEM_SINT1, /* One 1-byte signed-integer operand
* (INCR_STK_IMM) */
ASSEM_SINT4_LVT4, /* Signed 4-byte integer operand followed by
ASSEM_SINT4_LVT4 /* Signed 4-byte integer operand followed by
* LVT entry. Fixed arity */
} TalInstType;
@@ -437,6 +438,8 @@ static const TalInstDesc TalInstructionTable[] = {
{"nop", ASSEM_1BYTE, INST_NOP, 0, 0},
{"not", ASSEM_1BYTE, INST_LNOT, 1, 1},
{"nsupvar", ASSEM_LVT4, INST_NSUPVAR, 2, 1},
{"numericType", ASSEM_1BYTE, INST_NUM_TYPE, 1, 1},
{"originCmd", ASSEM_1BYTE, INST_ORIGIN_COMMAND, 1, 1},
{"over", ASSEM_OVER, INST_OVER, INT_MIN,-1-1},
{"pop", ASSEM_1BYTE, INST_POP, 1, 0},
{"pushReturnCode", ASSEM_1BYTE, INST_PUSH_RETURN_CODE, 0, 1},
@@ -453,9 +456,9 @@ static const TalInstDesc TalInstructionTable[] = {
| INST_STORE_ARRAY4), 2, 1},
{"storeArrayStk", ASSEM_1BYTE, INST_STORE_ARRAY_STK, 3, 1},
{"storeStk", ASSEM_1BYTE, INST_STORE_STK, 2, 1},
{"strLower", ASSEM_1BYTE, INST_STR_LOWER, 1, 1},
{"strTitle", ASSEM_1BYTE, INST_STR_TITLE, 1, 1},
{"strUpper", ASSEM_1BYTE, INST_STR_UPPER, 1, 1},
{"strcaseLower", ASSEM_1BYTE, INST_STR_LOWER, 1, 1},
{"strcaseTitle", ASSEM_1BYTE, INST_STR_TITLE, 1, 1},
{"strcaseUpper", ASSEM_1BYTE, INST_STR_UPPER, 1, 1},
{"strcmp", ASSEM_1BYTE, INST_STR_CMP, 2, 1},
{"strcat", ASSEM_CONCAT1, INST_STR_CONCAT1, INT_MIN,1},
{"streq", ASSEM_1BYTE, INST_STR_EQ, 2, 1},
@@ -466,6 +469,7 @@ static const TalInstDesc TalInstructionTable[] = {
{"strmatch", ASSEM_BOOL, INST_STR_MATCH, 2, 1},
{"strneq", ASSEM_1BYTE, INST_STR_NEQ, 2, 1},
{"strrange", ASSEM_1BYTE, INST_STR_RANGE, 3, 1},
{"strreplace", ASSEM_1BYTE, INST_STR_REPLACE, 4, 1},
{"strrfind", ASSEM_1BYTE, INST_STR_FIND_LAST, 2, 1},
{"strtrim", ASSEM_1BYTE, INST_STR_TRIM, 2, 1},
{"strtrimLeft", ASSEM_1BYTE, INST_STR_TRIM_LEFT, 2, 1},
@@ -475,6 +479,7 @@ static const TalInstDesc TalInstructionTable[] = {
{"tclooIsObject", ASSEM_1BYTE, INST_TCLOO_IS_OBJECT, 1, 1},
{"tclooNamespace", ASSEM_1BYTE, INST_TCLOO_NS, 1, 1},
{"tclooSelf", ASSEM_1BYTE, INST_TCLOO_SELF, 0, 1},
{"tryCvtToBoolean", ASSEM_1BYTE, INST_TRY_CVT_TO_BOOLEAN,1, 2},
{"tryCvtToNumeric", ASSEM_1BYTE, INST_TRY_CVT_TO_NUMERIC,1, 1},
{"uminus", ASSEM_1BYTE, INST_UMINUS, 1, 1},
{"unset", ASSEM_BOOL_LVT4,INST_UNSET_SCALAR, 0, 0},
@@ -514,7 +519,8 @@ static const unsigned char NonThrowingByteCodes[] = {
INST_RESOLVE_COMMAND, /* 154 */
INST_STR_TRIM, INST_STR_TRIM_LEFT, INST_STR_TRIM_RIGHT, /* 166-168 */
INST_CONCAT_STK, /* 169 */
INST_STR_UPPER, INST_STR_LOWER, INST_STR_TITLE /* 170-172 */
INST_STR_UPPER, INST_STR_LOWER, INST_STR_TITLE, /* 170-172 */
INST_NUM_TYPE /* 180 */
};
/*
+38 -24
View File
@@ -259,7 +259,7 @@ static const CmdInfo builtInCmds[] = {
{"variable", Tcl_VariableObjCmd, TclCompileVariableCmd, NULL, CMD_IS_SAFE},
{"while", Tcl_WhileObjCmd, TclCompileWhileCmd, TclNRWhileObjCmd, CMD_IS_SAFE},
{"yield", NULL, TclCompileYieldCmd, TclNRYieldObjCmd, CMD_IS_SAFE},
{"yieldto", NULL, NULL, TclNRYieldToObjCmd, CMD_IS_SAFE},
{"yieldto", NULL, TclCompileYieldToCmd, TclNRYieldToObjCmd, CMD_IS_SAFE},
/*
* Commands in the OS-interface. Note that many of these are unsafe.
@@ -2085,10 +2085,19 @@ Tcl_CreateCommand(
*/
cmdPtr = Tcl_GetHashValue(hPtr);
oldRefPtr = cmdPtr->importRefPtr;
cmdPtr->importRefPtr = NULL;
cmdPtr->refCount++;
if (cmdPtr->importRefPtr) {
cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
}
Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
oldRefPtr = cmdPtr->importRefPtr;
cmdPtr->importRefPtr = NULL;
}
TclCleanupCommandMacro(cmdPtr);
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
if (!isNew) {
/*
@@ -2272,10 +2281,19 @@ Tcl_CreateObjCommand(
* intact.
*/
oldRefPtr = cmdPtr->importRefPtr;
cmdPtr->importRefPtr = NULL;
cmdPtr->refCount++;
if (cmdPtr->importRefPtr) {
cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
}
Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
oldRefPtr = cmdPtr->importRefPtr;
cmdPtr->importRefPtr = NULL;
}
TclCleanupCommandMacro(cmdPtr);
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
if (!isNew) {
/*
@@ -3117,12 +3135,13 @@ Tcl_DeleteCommandFromToken(
* commands were created that refer back to this command. Delete these
* imported commands now.
*/
for (refPtr = cmdPtr->importRefPtr; refPtr != NULL;
refPtr = nextRefPtr) {
nextRefPtr = refPtr->nextPtr;
importCmd = (Tcl_Command) refPtr->importedCmdPtr;
Tcl_DeleteCommandFromToken(interp, importCmd);
if (!(cmdPtr->flags & CMD_REDEF_IN_PROGRESS)) {
for (refPtr = cmdPtr->importRefPtr; refPtr != NULL;
refPtr = nextRefPtr) {
nextRefPtr = refPtr->nextPtr;
importCmd = (Tcl_Command) refPtr->importedCmdPtr;
Tcl_DeleteCommandFromToken(interp, importCmd);
}
}
/*
@@ -8416,8 +8435,7 @@ TclNRYieldToObjCmd(
{
CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
Tcl_Obj *listPtr, *nsObjPtr;
Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
Tcl_Namespace *ns1Ptr;
Tcl_Namespace *nsPtr = TclGetCurrentNamespace(interp);
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
@@ -8431,11 +8449,13 @@ TclNRYieldToObjCmd(
return TCL_ERROR;
}
/*
* Add the tailcall in the caller env, then just yield.
*
* This is essentially code from TclNRTailcallObjCmd
*/
if (((Namespace *) nsPtr)->flags & NS_DYING) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"yieldto called in deleted namespace", -1));
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
NULL);
return TCL_ERROR;
}
/*
* Add the tailcall in the caller env, then just yield.
@@ -8444,15 +8464,9 @@ TclNRYieldToObjCmd(
*/
listPtr = Tcl_NewListObj(objc, objv);
nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
|| (nsPtr != ns1Ptr)) {
Tcl_Panic("yieldto failed to find the proper namespace");
}
TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
/*
* Add the callback in the caller's env, then instruct TEBC to yield.
*/
+33 -41
View File
@@ -610,9 +610,7 @@ UpdateStringOfByteArray(
*
* This function appends an array of bytes to a byte array object. Note
* that the object *must* be unshared, and the array of bytes *must not*
* refer to the object being appended to. Also the caller must have
* already checked that the final length of the bytearray after the
* append operations is complete will not overflow the int range.
* refer to the object being appended to.
*
* Results:
* None.
@@ -631,6 +629,7 @@ TclAppendBytesToByteArray(
int len)
{
ByteArray *byteArrayPtr;
int needed;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
@@ -639,64 +638,57 @@ TclAppendBytesToByteArray(
Tcl_Panic("%s must be called with definite number of bytes to append",
"TclAppendBytesToByteArray");
}
if (len == 0) {
/* Append zero bytes is a no-op. */
return;
}
if (objPtr->typePtr != &tclByteArrayType) {
SetByteArrayFromAny(NULL, objPtr);
}
byteArrayPtr = GET_BYTEARRAY(objPtr);
if (len > INT_MAX - byteArrayPtr->used) {
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
needed = byteArrayPtr->used + len;
/*
* If we need to, resize the allocated space in the byte array.
*/
if (byteArrayPtr->used + len > byteArrayPtr->allocated) {
unsigned int attempt, used = byteArrayPtr->used;
ByteArray *tmpByteArrayPtr = NULL;
if (needed > byteArrayPtr->allocated) {
ByteArray *ptr = NULL;
int attempt;
attempt = byteArrayPtr->allocated;
if (attempt < 1) {
/*
* No allocated bytes, so must be none used too. We use this
* method to calculate how many bytes to allocate because we can
* end up with a zero-length buffer otherwise, when doubling can
* cause trouble. [Bug 3067036]
*/
attempt = len + 1;
} else {
do {
attempt *= 2;
} while (attempt < used+len);
if (needed <= INT_MAX/2) {
/* Try to allocate double the total space that is needed. */
attempt = 2 * needed;
ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
}
if (ptr == NULL) {
/* Try to allocate double the increment that is needed (plus). */
unsigned int limit = INT_MAX - needed;
unsigned int extra = len + TCL_MIN_GROWTH;
int growth = (int) ((extra > limit) ? limit : extra);
if (BYTEARRAY_SIZE(attempt) > BYTEARRAY_SIZE(used)) {
tmpByteArrayPtr = attemptckrealloc(byteArrayPtr,
BYTEARRAY_SIZE(attempt));
attempt = needed + growth;
ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
}
if (tmpByteArrayPtr == NULL) {
attempt = used + len;
if (BYTEARRAY_SIZE(attempt) < BYTEARRAY_SIZE(used)) {
Tcl_Panic("attempt to allocate a bigger buffer than we can handle");
}
tmpByteArrayPtr = ckrealloc(byteArrayPtr,
BYTEARRAY_SIZE(attempt));
if (ptr == NULL) {
/* Last chance: Try to allocate exactly what is needed. */
attempt = needed;
ptr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
}
byteArrayPtr = tmpByteArrayPtr;
byteArrayPtr = ptr;
byteArrayPtr->allocated = attempt;
byteArrayPtr->used = used;
SET_BYTEARRAY(objPtr, byteArrayPtr);
}
/*
* Do the append if there's any point.
*/
if (len > 0) {
if (bytes) {
memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len);
byteArrayPtr->used += len;
TclInvalidateStringRep(objPtr);
}
byteArrayPtr->used += len;
TclInvalidateStringRep(objPtr);
}
/*
+1 -1
View File
@@ -19,7 +19,7 @@
* Windows has mktime. The configurators do not check.
*/
#ifdef __WIN32__
#ifdef _WIN32
#define HAVE_MKTIME 1
#endif
+1 -1
View File
@@ -1590,7 +1590,7 @@ FileAttrIsOwnedCmd(
* test for equivalence to the current user.
*/
#if defined(__WIN32__) || defined(__CYGWIN__)
#if defined(_WIN32) || defined(__CYGWIN__)
value = 1;
#else
value = (geteuid() == buf.st_uid);
+34 -34
View File
@@ -18,6 +18,7 @@
#include "tclInt.h"
#include "tclRegexp.h"
#include "tclStringTrim.h"
static inline Tcl_Obj * During(Tcl_Interp *interp, int resultCode,
Tcl_Obj *oldOptions, Tcl_Obj *errorInfo);
@@ -35,36 +36,35 @@ static int UniCharIsHexDigit(int character);
/*
* Default set of characters to trim in [string trim] and friends. This is a
* UTF-8 literal string containing all Unicode space characters [TIP #413]
*
* Synch with tclCompCmdsSZ.c
*/
#define DEFAULT_TRIM_SET \
"\x09\x0a\x0b\x0c\x0d " /* ASCII */\
"\xc0\x80" /* nul (U+0000) */\
"\xc2\x85" /* next line (U+0085) */\
"\xc2\xa0" /* non-breaking space (U+00a0) */\
"\xe1\x9a\x80" /* ogham space mark (U+1680) */ \
"\xe1\xa0\x8e" /* mongolian vowel separator (U+180e) */\
"\xe2\x80\x80" /* en quad (U+2000) */\
"\xe2\x80\x81" /* em quad (U+2001) */\
"\xe2\x80\x82" /* en space (U+2002) */\
"\xe2\x80\x83" /* em space (U+2003) */\
"\xe2\x80\x84" /* three-per-em space (U+2004) */\
"\xe2\x80\x85" /* four-per-em space (U+2005) */\
"\xe2\x80\x86" /* six-per-em space (U+2006) */\
"\xe2\x80\x87" /* figure space (U+2007) */\
"\xe2\x80\x88" /* punctuation space (U+2008) */\
"\xe2\x80\x89" /* thin space (U+2009) */\
"\xe2\x80\x8a" /* hair space (U+200a) */\
"\xe2\x80\x8b" /* zero width space (U+200b) */\
"\xe2\x80\xa8" /* line separator (U+2028) */\
"\xe2\x80\xa9" /* paragraph separator (U+2029) */\
"\xe2\x80\xaf" /* narrow no-break space (U+202f) */\
"\xe2\x81\x9f" /* medium mathematical space (U+205f) */\
"\xe2\x81\xa0" /* word joiner (U+2060) */\
"\xe3\x80\x80" /* ideographic space (U+3000) */\
const char tclDefaultTrimSet[] =
"\x09\x0a\x0b\x0c\x0d " /* ASCII */
"\xc0\x80" /* nul (U+0000) */
"\xc2\x85" /* next line (U+0085) */
"\xc2\xa0" /* non-breaking space (U+00a0) */
"\xe1\x9a\x80" /* ogham space mark (U+1680) */
"\xe1\xa0\x8e" /* mongolian vowel separator (U+180e) */
"\xe2\x80\x80" /* en quad (U+2000) */
"\xe2\x80\x81" /* em quad (U+2001) */
"\xe2\x80\x82" /* en space (U+2002) */
"\xe2\x80\x83" /* em space (U+2003) */
"\xe2\x80\x84" /* three-per-em space (U+2004) */
"\xe2\x80\x85" /* four-per-em space (U+2005) */
"\xe2\x80\x86" /* six-per-em space (U+2006) */
"\xe2\x80\x87" /* figure space (U+2007) */
"\xe2\x80\x88" /* punctuation space (U+2008) */
"\xe2\x80\x89" /* thin space (U+2009) */
"\xe2\x80\x8a" /* hair space (U+200a) */
"\xe2\x80\x8b" /* zero width space (U+200b) */
"\xe2\x80\xa8" /* line separator (U+2028) */
"\xe2\x80\xa9" /* paragraph separator (U+2029) */
"\xe2\x80\xaf" /* narrow no-break space (U+202f) */
"\xe2\x81\x9f" /* medium mathematical space (U+205f) */
"\xe2\x81\xa0" /* word joiner (U+2060) */
"\xe3\x80\x80" /* ideographic space (U+3000) */
"\xef\xbb\xbf" /* zero width no-break space (U+feff) */
;
/*
*----------------------------------------------------------------------
@@ -3191,8 +3191,8 @@ StringTrimCmd(
if (objc == 3) {
string2 = TclGetStringFromObj(objv[2], &length2);
} else if (objc == 2) {
string2 = DEFAULT_TRIM_SET;
length2 = strlen(DEFAULT_TRIM_SET);
string2 = tclDefaultTrimSet;
length2 = strlen(tclDefaultTrimSet);
} else {
Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
return TCL_ERROR;
@@ -3239,8 +3239,8 @@ StringTrimLCmd(
if (objc == 3) {
string2 = TclGetStringFromObj(objv[2], &length2);
} else if (objc == 2) {
string2 = DEFAULT_TRIM_SET;
length2 = strlen(DEFAULT_TRIM_SET);
string2 = tclDefaultTrimSet;
length2 = strlen(tclDefaultTrimSet);
} else {
Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
return TCL_ERROR;
@@ -3285,8 +3285,8 @@ StringTrimRCmd(
if (objc == 3) {
string2 = TclGetStringFromObj(objv[2], &length2);
} else if (objc == 2) {
string2 = DEFAULT_TRIM_SET;
length2 = strlen(DEFAULT_TRIM_SET);
string2 = tclDefaultTrimSet;
length2 = strlen(tclDefaultTrimSet);
} else {
Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
return TCL_ERROR;
@@ -3332,7 +3332,7 @@ TclInitStringCmd(
{"equal", StringEqualCmd, TclCompileStringEqualCmd, NULL, NULL, 0},
{"first", StringFirstCmd, TclCompileStringFirstCmd, NULL, NULL, 0},
{"index", StringIndexCmd, TclCompileStringIndexCmd, NULL, NULL, 0},
{"is", StringIsCmd, NULL, NULL, NULL, 0},
{"is", StringIsCmd, TclCompileStringIsCmd, NULL, NULL, 0},
{"last", StringLastCmd, TclCompileStringLastCmd, NULL, NULL, 0},
{"length", StringLenCmd, TclCompileStringLenCmd, NULL, NULL, 0},
{"map", StringMapCmd, TclCompileStringMapCmd, NULL, NULL, 0},
+2 -9
View File
@@ -65,13 +65,6 @@ const AuxDataType tclDictUpdateInfoType = {
FreeDictUpdateInfo, /* freeProc */
PrintDictUpdateInfo /* printProc */
};
/*
* The definition of what whitespace is stripped when [concat]enating. Must be
* kept in synch with tclUtil.c
*/
#define CONCAT_WS " \f\v\r\t\n"
/*
*----------------------------------------------------------------------
@@ -285,7 +278,7 @@ TclCompileArraySetCmd(
if (isDataValid && !isDataEven) {
PushStringLiteral(envPtr, "list must have an even number of elements");
PushStringLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}");
PushStringLiteral(envPtr, "-errorcode {TCL ARGUMENT FORMAT}");
TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR, envPtr);
TclEmitInt4( 0, envPtr);
goto done;
@@ -380,7 +373,7 @@ TclCompileArraySetCmd(
offsetFwd = CurrentOffset(envPtr);
TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr);
PushStringLiteral(envPtr, "list must have an even number of elements");
PushStringLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}");
PushStringLiteral(envPtr, "-errorcode {TCL ARGUMENT FORMAT}");
TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR, envPtr);
TclEmitInt4( 0, envPtr);
TclAdjustStackDepth(-1, envPtr);
+82
View File
@@ -1955,6 +1955,28 @@ TclCompileNamespaceCodeCmd(
return TCL_OK;
}
int
TclCompileNamespaceOriginCmd(
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. */
{
Tcl_Token *tokenPtr;
DefineLineInformation; /* TIP #280 */
if (parsePtr->numWords != 2) {
return TCL_ERROR;
}
tokenPtr = TokenAfter(parsePtr->tokenPtr);
CompileWord(envPtr, tokenPtr, interp, 1);
TclEmitOpcode( INST_ORIGIN_COMMAND, envPtr);
return TCL_OK;
}
int
TclCompileNamespaceQualifiersCmd(
Tcl_Interp *interp, /* Used for error reporting. */
@@ -3017,6 +3039,66 @@ IndexTailVarIfKnown(
return localIndex;
}
/*
* ----------------------------------------------------------------------
*
* TclCompileObjectNextCmd, TclCompileObjectSelfCmd --
*
* Compilations of the TclOO utility commands [next] and [self].
*
* ----------------------------------------------------------------------
*/
int
TclCompileObjectNextCmd(
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. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr = parsePtr->tokenPtr;
int i;
if (parsePtr->numWords > 255) {
return TCL_ERROR;
}
for (i=0 ; i<parsePtr->numWords ; i++) {
CompileWord(envPtr, tokenPtr, interp, i);
tokenPtr = TokenAfter(tokenPtr);
}
TclEmitInstInt1( INST_TCLOO_NEXT, i, envPtr);
return TCL_OK;
}
int
TclCompileObjectNextToCmd(
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. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr = parsePtr->tokenPtr;
int i;
if (parsePtr->numWords < 2 || parsePtr->numWords > 255) {
return TCL_ERROR;
}
for (i=0 ; i<parsePtr->numWords ; i++) {
CompileWord(envPtr, tokenPtr, interp, i);
tokenPtr = TokenAfter(tokenPtr);
}
TclEmitInstInt1( INST_TCLOO_NEXT_CLASS, i, envPtr);
return TCL_OK;
}
int
TclCompileObjectSelfCmd(
Tcl_Interp *interp, /* Used for error reporting. */
+364 -36
View File
@@ -17,6 +17,7 @@
#include "tclInt.h"
#include "tclCompile.h"
#include "tclStringTrim.h"
/*
* Prototypes for procedures defined later in this file:
@@ -423,6 +424,284 @@ TclCompileStringIndexCmd(
return TCL_OK;
}
int
TclCompileStringIsCmd(
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. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
static const char *const isClasses[] = {
"alnum", "alpha", "ascii", "control",
"boolean", "digit", "double", "entier",
"false", "graph", "integer", "list",
"lower", "print", "punct", "space",
"true", "upper", "wideinteger", "wordchar",
"xdigit", NULL
};
enum isClasses {
STR_IS_ALNUM, STR_IS_ALPHA, STR_IS_ASCII, STR_IS_CONTROL,
STR_IS_BOOL, STR_IS_DIGIT, STR_IS_DOUBLE, STR_IS_ENTIER,
STR_IS_FALSE, STR_IS_GRAPH, STR_IS_INT, STR_IS_LIST,
STR_IS_LOWER, STR_IS_PRINT, STR_IS_PUNCT, STR_IS_SPACE,
STR_IS_TRUE, STR_IS_UPPER, STR_IS_WIDE, STR_IS_WORD,
STR_IS_XDIGIT
};
int t, range, allowEmpty = 0, end;
InstStringClassType strClassType;
Tcl_Obj *isClass;
if (parsePtr->numWords < 3 || parsePtr->numWords > 6) {
return TCL_ERROR;
}
isClass = Tcl_NewObj();
if (!TclWordKnownAtCompileTime(tokenPtr, isClass)) {
Tcl_DecrRefCount(isClass);
return TCL_ERROR;
} else if (Tcl_GetIndexFromObj(interp, isClass, isClasses, "class", 0,
&t) != TCL_OK) {
Tcl_DecrRefCount(isClass);
TclCompileSyntaxError(interp, envPtr);
return TCL_OK;
}
Tcl_DecrRefCount(isClass);
#define GotLiteral(tokenPtr, word) \
((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD && \
(tokenPtr)[1].size > 1 && \
(tokenPtr)[1].start[0] == word[0] && \
strncmp((tokenPtr)[1].start, (word), (tokenPtr)[1].size) == 0)
/*
* Cannot handle the -failindex option at all, and that's the only legal
* way to have more than 4 arguments.
*/
if (parsePtr->numWords != 3 && parsePtr->numWords != 4) {
return TCL_ERROR;
}
tokenPtr = TokenAfter(tokenPtr);
if (parsePtr->numWords == 3) {
allowEmpty = 1;
} else {
if (!GotLiteral(tokenPtr, "-strict")) {
return TCL_ERROR;
}
tokenPtr = TokenAfter(tokenPtr);
}
#undef GotLiteral
/*
* Compile the code. There are several main classes of check here.
* 1. Character classes
* 2. Booleans
* 3. Integers
* 4. Floats
* 5. Lists
*/
CompileWord(envPtr, tokenPtr, interp, parsePtr->numWords-1);
switch ((enum isClasses) t) {
case STR_IS_ALNUM:
strClassType = STR_CLASS_ALNUM;
goto compileStrClass;
case STR_IS_ALPHA:
strClassType = STR_CLASS_ALPHA;
goto compileStrClass;
case STR_IS_ASCII:
strClassType = STR_CLASS_ASCII;
goto compileStrClass;
case STR_IS_CONTROL:
strClassType = STR_CLASS_CONTROL;
goto compileStrClass;
case STR_IS_DIGIT:
strClassType = STR_CLASS_DIGIT;
goto compileStrClass;
case STR_IS_GRAPH:
strClassType = STR_CLASS_GRAPH;
goto compileStrClass;
case STR_IS_LOWER:
strClassType = STR_CLASS_LOWER;
goto compileStrClass;
case STR_IS_PRINT:
strClassType = STR_CLASS_PRINT;
goto compileStrClass;
case STR_IS_PUNCT:
strClassType = STR_CLASS_PUNCT;
goto compileStrClass;
case STR_IS_SPACE:
strClassType = STR_CLASS_SPACE;
goto compileStrClass;
case STR_IS_UPPER:
strClassType = STR_CLASS_UPPER;
goto compileStrClass;
case STR_IS_WORD:
strClassType = STR_CLASS_WORD;
goto compileStrClass;
case STR_IS_XDIGIT:
strClassType = STR_CLASS_XDIGIT;
compileStrClass:
if (allowEmpty) {
OP1( STR_CLASS, strClassType);
} else {
int over, over2;
OP( DUP);
OP1( STR_CLASS, strClassType);
JUMP1( JUMP_TRUE, over);
OP( POP);
PUSH( "0");
JUMP1( JUMP, over2);
FIXJUMP1(over);
PUSH( "");
OP( STR_NEQ);
FIXJUMP1(over2);
}
return TCL_OK;
case STR_IS_BOOL:
case STR_IS_FALSE:
case STR_IS_TRUE:
OP( TRY_CVT_TO_BOOLEAN);
switch (t) {
int over, over2;
case STR_IS_BOOL:
if (allowEmpty) {
JUMP1( JUMP_TRUE, over);
PUSH( "");
OP( STR_EQ);
JUMP1( JUMP, over2);
FIXJUMP1(over);
OP( POP);
PUSH( "1");
FIXJUMP1(over2);
} else {
OP4( REVERSE, 2);
OP( POP);
}
return TCL_OK;
case STR_IS_TRUE:
JUMP1( JUMP_TRUE, over);
if (allowEmpty) {
PUSH( "");
OP( STR_EQ);
} else {
OP( POP);
PUSH( "0");
}
FIXJUMP1( over);
OP( LNOT);
OP( LNOT);
return TCL_OK;
case STR_IS_FALSE:
JUMP1( JUMP_TRUE, over);
if (allowEmpty) {
PUSH( "");
OP( STR_NEQ);
} else {
OP( POP);
PUSH( "1");
}
FIXJUMP1( over);
OP( LNOT);
return TCL_OK;
}
case STR_IS_DOUBLE: {
int satisfied, isEmpty;
if (allowEmpty) {
OP( DUP);
PUSH( "");
OP( STR_EQ);
JUMP1( JUMP_TRUE, isEmpty);
OP( NUM_TYPE);
JUMP1( JUMP_TRUE, satisfied);
PUSH( "0");
JUMP1( JUMP, end);
FIXJUMP1( isEmpty);
OP( POP);
FIXJUMP1( satisfied);
} else {
OP( NUM_TYPE);
JUMP1( JUMP_TRUE, satisfied);
PUSH( "0");
JUMP1( JUMP, end);
TclAdjustStackDepth(-1, envPtr);
FIXJUMP1( satisfied);
}
PUSH( "1");
FIXJUMP1( end);
return TCL_OK;
}
case STR_IS_INT:
case STR_IS_WIDE:
case STR_IS_ENTIER:
if (allowEmpty) {
int testNumType;
OP( DUP);
OP( NUM_TYPE);
OP( DUP);
JUMP1( JUMP_TRUE, testNumType);
OP( POP);
PUSH( "");
OP( STR_EQ);
JUMP1( JUMP, end);
TclAdjustStackDepth(1, envPtr);
FIXJUMP1( testNumType);
OP4( REVERSE, 2);
OP( POP);
} else {
OP( NUM_TYPE);
OP( DUP);
JUMP1( JUMP_FALSE, end);
}
switch (t) {
case STR_IS_INT:
PUSH( "1");
OP( EQ);
break;
case STR_IS_WIDE:
PUSH( "2");
OP( LE);
break;
case STR_IS_ENTIER:
PUSH( "3");
OP( LE);
break;
}
FIXJUMP1( end);
return TCL_OK;
case STR_IS_LIST:
range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
OP4( BEGIN_CATCH4, range);
ExceptionRangeStarts(envPtr, range);
OP( DUP);
OP( LIST_LENGTH);
OP( POP);
ExceptionRangeEnds(envPtr, range);
ExceptionRangeTarget(envPtr, range, catchOffset);
OP( POP);
OP( PUSH_RETURN_CODE);
OP( END_CATCH);
OP( LNOT);
return TCL_OK;
}
return TclCompileBasicMin0ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}
int
TclCompileStringMatchCmd(
Tcl_Interp *interp, /* Used for error reporting. */
@@ -700,8 +979,8 @@ TclCompileStringReplaceCmd(
/*
* We handle these replacements specially: first character (where
* idx1=idx2=0) and suffixes (where idx1=idx2=INDEX_END). Anything else
* and the semantics get rather screwy.
* idx1=idx2=0) and last character (where idx1=idx2=INDEX_END). Anything
* else and the semantics get rather screwy.
*/
if (idx1 == 0 && idx2 == 0) {
@@ -787,37 +1066,6 @@ TclCompileStringReplaceCmd(
}
}
/*
* Synch with tclCmdMZ.c
*/
#define DEFAULT_TRIM_SET \
"\x09\x0a\x0b\x0c\x0d " /* ASCII */\
"\xc0\x80" /* nul (U+0000) */\
"\xc2\x85" /* next line (U+0085) */\
"\xc2\xa0" /* non-breaking space (U+00a0) */\
"\xe1\x9a\x80" /* ogham space mark (U+1680) */ \
"\xe1\xa0\x8e" /* mongolian vowel separator (U+180e) */\
"\xe2\x80\x80" /* en quad (U+2000) */\
"\xe2\x80\x81" /* em quad (U+2001) */\
"\xe2\x80\x82" /* en space (U+2002) */\
"\xe2\x80\x83" /* em space (U+2003) */\
"\xe2\x80\x84" /* three-per-em space (U+2004) */\
"\xe2\x80\x85" /* four-per-em space (U+2005) */\
"\xe2\x80\x86" /* six-per-em space (U+2006) */\
"\xe2\x80\x87" /* figure space (U+2007) */\
"\xe2\x80\x88" /* punctuation space (U+2008) */\
"\xe2\x80\x89" /* thin space (U+2009) */\
"\xe2\x80\x8a" /* hair space (U+200a) */\
"\xe2\x80\x8b" /* zero width space (U+200b) */\
"\xe2\x80\xa8" /* line separator (U+2028) */\
"\xe2\x80\xa9" /* paragraph separator (U+2029) */\
"\xe2\x80\xaf" /* narrow no-break space (U+202f) */\
"\xe2\x81\x9f" /* medium mathematical space (U+205f) */\
"\xe2\x81\xa0" /* word joiner (U+2060) */\
"\xe3\x80\x80" /* ideographic space (U+3000) */\
"\xef\xbb\xbf" /* zero width no-break space (U+feff) */
int
TclCompileStringTrimLCmd(
Tcl_Interp *interp, /* Used for error reporting. */
@@ -840,7 +1088,7 @@ TclCompileStringTrimLCmd(
tokenPtr = TokenAfter(tokenPtr);
CompileWord(envPtr, tokenPtr, interp, 2);
} else {
PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET));
PushLiteral(envPtr, tclDefaultTrimSet, strlen(tclDefaultTrimSet));
}
OP( STR_TRIM_LEFT);
return TCL_OK;
@@ -868,7 +1116,7 @@ TclCompileStringTrimRCmd(
tokenPtr = TokenAfter(tokenPtr);
CompileWord(envPtr, tokenPtr, interp, 2);
} else {
PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET));
PushLiteral(envPtr, tclDefaultTrimSet, strlen(tclDefaultTrimSet));
}
OP( STR_TRIM_RIGHT);
return TCL_OK;
@@ -896,7 +1144,7 @@ TclCompileStringTrimCmd(
tokenPtr = TokenAfter(tokenPtr);
CompileWord(envPtr, tokenPtr, interp, 2);
} else {
PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET));
PushLiteral(envPtr, tclDefaultTrimSet, strlen(tclDefaultTrimSet));
}
OP( STR_TRIM);
return TCL_OK;
@@ -968,6 +1216,41 @@ TclCompileStringToTitleCmd(
return TCL_OK;
}
/*
* Support definitions for the [string is] compilation.
*/
static int
UniCharIsAscii(
int character)
{
return (character >= 0) && (character < 0x80);
}
static int
UniCharIsHexDigit(
int character)
{
return (character >= 0) && (character < 0x80) && isxdigit(character);
}
StringClassDesc const tclStringClassTable[] = {
{"alnum", Tcl_UniCharIsAlnum},
{"alpha", Tcl_UniCharIsAlpha},
{"ascii", UniCharIsAscii},
{"control", Tcl_UniCharIsControl},
{"digit", Tcl_UniCharIsDigit},
{"graph", Tcl_UniCharIsGraph},
{"lower", Tcl_UniCharIsLower},
{"print", Tcl_UniCharIsPrint},
{"punct", Tcl_UniCharIsPunct},
{"space", Tcl_UniCharIsSpace},
{"upper", Tcl_UniCharIsUpper},
{"word", Tcl_UniCharIsWordChar},
{"xdigit", UniCharIsHexDigit},
{NULL, NULL}
};
/*
*----------------------------------------------------------------------
*
@@ -3474,6 +3757,51 @@ TclCompileYieldCmd(
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclCompileYieldToCmd --
*
* Procedure called to compile the "yieldto" command.
*
* Results:
* Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
* evaluation to runtime.
*
* Side effects:
* Instructions are added to envPtr to execute the "yieldto" command at
* runtime.
*
*----------------------------------------------------------------------
*/
int
TclCompileYieldToCmd(
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. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
int i;
if (parsePtr->numWords < 2) {
return TCL_ERROR;
}
OP( NS_CURRENT);
for (i = 1 ; i < parsePtr->numWords ; i++) {
CompileWord(envPtr, tokenPtr, interp, i);
tokenPtr = TokenAfter(tokenPtr);
}
OP4( LIST, i);
OP( YIELD_TO_INVOKE);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
+70 -8
View File
@@ -493,6 +493,7 @@ InstructionDesc const tclInstructionTable[] = {
* qualified version, or produces the empty string if no such command
* exists. Never generates errors.
* Stack: ... cmdName => ... fullCmdName */
{"tclooSelf", 1, +1, 0, {OPERAND_NONE}},
/* Push the identity of the current TclOO object (i.e., the name of
* its current public access command) on the stack. */
@@ -594,23 +595,61 @@ InstructionDesc const tclInstructionTable[] = {
* is number of values to concatenate.
* Operation: push concat(stk1 stk2 ... stktop) */
{"strUpper", 1, 0, 0, {OPERAND_NONE}},
{"strcaseUpper", 1, 0, 0, {OPERAND_NONE}},
/* [string toupper] core: converts whole string to upper case using
* the default (extended "C" locale) rules.
* Stack: ... string => ... newString */
{"strLower", 1, 0, 0, {OPERAND_NONE}},
{"strcaseLower", 1, 0, 0, {OPERAND_NONE}},
/* [string tolower] core: converts whole string to upper case using
* the default (extended "C" locale) rules.
* Stack: ... string => ... newString */
{"strTitle", 1, 0, 0, {OPERAND_NONE}},
{"strcaseTitle", 1, 0, 0, {OPERAND_NONE}},
/* [string totitle] core: converts whole string to upper case using
* the default (extended "C" locale) rules.
* Stack: ... string => ... newString */
{"strReplace", 1, -3, 0, {OPERAND_NONE}},
{"strreplace", 1, -3, 0, {OPERAND_NONE}},
/* [string replace] core: replaces a non-empty range of one string
* with the contents of another.
* Stack: ... string fromIdx toIdx replacement => ... newString */
{"originCmd", 1, 0, 0, {OPERAND_NONE}},
/* Reports which command was the origin (via namespace import chain)
* of the command named on the top of the stack.
* Stack: ... cmdName => ... fullOriginalCmdName */
{"tclooNext", 2, INT_MIN, 1, {OPERAND_UINT1}},
/* Call the next item on the TclOO call chain, passing opnd arguments
* (min 1, max 255, *includes* "next"). The result of the invoked
* method implementation will be pushed on the stack in place of the
* arguments (similar to invokeStk).
* Stack: ... "next" arg2 arg3 -- argN => ... result */
{"tclooNextClass", 2, INT_MIN, 1, {OPERAND_UINT1}},
/* Call the following item on the TclOO call chain defined by class
* className, passing opnd arguments (min 2, max 255, *includes*
* "nextto" and the class name). The result of the invoked method
* implementation will be pushed on the stack in place of the
* arguments (similar to invokeStk).
* Stack: ... "nextto" className arg3 arg4 -- argN => ... result */
{"yieldToInvoke", 1, 0, 0, {OPERAND_NONE}},
/* Makes the current coroutine yield the value at the top of the
* stack, invoking the given command/args with resolution in the given
* namespace (all packed into a list), and places the list of values
* that are the response back on top of the stack when it resumes.
* Stack: ... [list ns cmd arg1 ... argN] => ... resumeList */
{"numericType", 1, 0, 0, {OPERAND_NONE}},
/* Pushes the numeric type code of the word at the top of the stack.
* Stack: ... value => ... typeCode */
{"tryCvtToBoolean", 1, +1, 0, {OPERAND_NONE}},
/* Try converting stktop to boolean if possible. No errors.
* Stack: ... value => ... value isStrictBool */
{"strclass", 2, 0, 1, {OPERAND_SCLS1}},
/* See if all the characters of the given string are a member of the
* specified (by opnd) character class. Note that an empty string will
* satisfy the class check (standard definition of "all").
* Stack: ... stringValue => ... boolean */
{NULL, 0, 0, 0, {OPERAND_NONE}}
};
@@ -5058,6 +5097,11 @@ FormatInstruction(
}
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;
@@ -5274,7 +5318,7 @@ PrintSourceToObj(
int maxChars) /* Maximum number of chars to print. */
{
register const char *p;
register int i = 0;
register int i = 0, len;
if (stringPtr == NULL) {
Tcl_AppendToObj(appendObj, "\"\"", -1);
@@ -5283,32 +5327,50 @@ PrintSourceToObj(
Tcl_AppendToObj(appendObj, "\"", -1);
p = stringPtr;
for (; (*p != '\0') && (i < maxChars); p++, i++) {
switch (*p) {
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:
Tcl_AppendPrintfToObj(appendObj, "%c", *p);
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
+50 -2
View File
@@ -751,6 +751,8 @@ typedef struct ByteCode {
#define INST_INFO_LEVEL_NUM 152
#define INST_INFO_LEVEL_ARGS 153
#define INST_RESOLVE_COMMAND 154
/* For compilation relating to TclOO */
#define INST_TCLOO_SELF 155
#define INST_TCLOO_CLASS 156
#define INST_TCLOO_NS 157
@@ -786,8 +788,19 @@ typedef struct ByteCode {
#define INST_STR_TITLE 176
#define INST_STR_REPLACE 177
#define INST_ORIGIN_COMMAND 178
#define INST_TCLOO_NEXT 179
#define INST_TCLOO_NEXT_CLASS 180
#define INST_YIELD_TO_INVOKE 181
#define INST_NUM_TYPE 182
#define INST_TRY_CVT_TO_BOOLEAN 183
#define INST_STR_CLASS 184
/* The last opcode */
#define LAST_INST_OPCODE 177
#define LAST_INST_OPCODE 184
/*
* Table describing the Tcl bytecode instructions: their name (for displaying
@@ -812,8 +825,9 @@ typedef enum InstOperandType {
* variable table. */
OPERAND_LVT4, /* Four byte unsigned index into the local
* variable table. */
OPERAND_AUX4 /* Four byte unsigned index into the aux data
OPERAND_AUX4, /* Four byte unsigned index into the aux data
* table. */
OPERAND_SCLS1 /* Index into tclStringClassTable. */
} InstOperandType;
typedef struct InstructionDesc {
@@ -831,6 +845,40 @@ typedef struct InstructionDesc {
MODULE_SCOPE InstructionDesc const tclInstructionTable[];
/*
* Constants used by INST_STRING_CLASS to indicate character classes. These
* correspond closely by name with what [string is] can support, but there is
* no requirement to keep the values the same.
*/
typedef enum InstStringClassType {
STR_CLASS_ALNUM, /* Unicode alphabet or digit characters. */
STR_CLASS_ALPHA, /* Unicode alphabet characters. */
STR_CLASS_ASCII, /* Characters in range U+000000..U+00007F. */
STR_CLASS_CONTROL, /* Unicode control characters. */
STR_CLASS_DIGIT, /* Unicode digit characters. */
STR_CLASS_GRAPH, /* Unicode printing characters, excluding
* space. */
STR_CLASS_LOWER, /* Unicode lower-case alphabet characters. */
STR_CLASS_PRINT, /* Unicode printing characters, including
* spaces. */
STR_CLASS_PUNCT, /* Unicode punctuation characters. */
STR_CLASS_SPACE, /* Unicode space characters. */
STR_CLASS_UPPER, /* Unicode upper-case alphabet characters. */
STR_CLASS_WORD, /* Unicode word (alphabetic, digit, connector
* punctuation) characters. */
STR_CLASS_XDIGIT /* Characters that can be used as digits in
* hexadecimal numbers ([0-9A-Fa-f]). */
} InstStringClassType;
typedef struct StringClassDesc {
const char *name; /* Name of the class. */
int (*comparator)(int); /* Function to test if a single unicode
* character is a member of the class. */
} StringClassDesc;
MODULE_SCOPE StringClassDesc const tclStringClassTable[];
/*
* Compilation of some Tcl constructs such as if commands and the logical or
* (||) and logical and (&&) operators in expressions requires the generation
+12 -12
View File
@@ -63,7 +63,7 @@ EXTERN void Tcl_DbCkfree(char *ptr, const char *file, int line);
/* 8 */
EXTERN char * Tcl_DbCkrealloc(char *ptr, unsigned int size,
const char *file, int line);
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 9 */
EXTERN void Tcl_CreateFileHandler(int fd, int mask,
Tcl_FileProc *proc, ClientData clientData);
@@ -73,7 +73,7 @@ EXTERN void Tcl_CreateFileHandler(int fd, int mask,
EXTERN void Tcl_CreateFileHandler(int fd, int mask,
Tcl_FileProc *proc, ClientData clientData);
#endif /* MACOSX */
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 10 */
EXTERN void Tcl_DeleteFileHandler(int fd);
#endif /* UNIX */
@@ -511,7 +511,7 @@ EXTERN Tcl_Interp * Tcl_GetMaster(Tcl_Interp *interp);
EXTERN const char * Tcl_GetNameOfExecutable(void);
/* 166 */
EXTERN Tcl_Obj * Tcl_GetObjResult(Tcl_Interp *interp);
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 167 */
EXTERN int Tcl_GetOpenFile(Tcl_Interp *interp,
const char *chanID, int forWriting,
@@ -1835,19 +1835,19 @@ typedef struct TclStubs {
char * (*tcl_DbCkalloc) (unsigned int size, const char *file, int line); /* 6 */
void (*tcl_DbCkfree) (char *ptr, const char *file, int line); /* 7 */
char * (*tcl_DbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 8 */
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */
#endif /* UNIX */
#if defined(__WIN32__) /* WIN */
#if defined(_WIN32) /* WIN */
void (*reserved9)(void);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */
#endif /* MACOSX */
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
void (*tcl_DeleteFileHandler) (int fd); /* 10 */
#endif /* UNIX */
#if defined(__WIN32__) /* WIN */
#if defined(_WIN32) /* WIN */
void (*reserved10)(void);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
@@ -2009,10 +2009,10 @@ typedef struct TclStubs {
Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */
const char * (*tcl_GetNameOfExecutable) (void); /* 165 */
Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */
#endif /* UNIX */
#if defined(__WIN32__) /* WIN */
#if defined(_WIN32) /* WIN */
void (*reserved167)(void);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
@@ -2513,7 +2513,7 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_DbCkfree) /* 7 */
#define Tcl_DbCkrealloc \
(tclStubsPtr->tcl_DbCkrealloc) /* 8 */
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
#define Tcl_CreateFileHandler \
(tclStubsPtr->tcl_CreateFileHandler) /* 9 */
#endif /* UNIX */
@@ -2521,7 +2521,7 @@ extern const TclStubs *tclStubsPtr;
#define Tcl_CreateFileHandler \
(tclStubsPtr->tcl_CreateFileHandler) /* 9 */
#endif /* MACOSX */
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
#define Tcl_DeleteFileHandler \
(tclStubsPtr->tcl_DeleteFileHandler) /* 10 */
#endif /* UNIX */
@@ -2841,7 +2841,7 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_GetNameOfExecutable) /* 165 */
#define Tcl_GetObjResult \
(tclStubsPtr->tcl_GetObjResult) /* 166 */
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
#define Tcl_GetOpenFile \
(tclStubsPtr->tcl_GetOpenFile) /* 167 */
#endif /* UNIX */
+3 -1
View File
@@ -182,6 +182,7 @@ TCL_DECLARE_MUTEX(encodingMutex)
static Tcl_Encoding defaultEncoding;
static Tcl_Encoding systemEncoding;
Tcl_Encoding tclIdentityEncoding;
/*
* The following variable is used in the sparse matrix code for a
@@ -567,7 +568,7 @@ TclInitEncodingSubsystem(void)
type.freeProc = NULL;
type.nullSize = 1;
type.clientData = NULL;
Tcl_CreateEncoding(&type);
tclIdentityEncoding = Tcl_CreateEncoding(&type);
type.encodingName = "utf-8";
type.toUtfProc = UtfExtToUtfIntProc;
@@ -651,6 +652,7 @@ TclFinalizeEncodingSubsystem(void)
Tcl_MutexLock(&encodingMutex);
encodingsInitialized = 0;
FreeEncoding(systemEncoding);
FreeEncoding(tclIdentityEncoding);
hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
while (hPtr != NULL) {
+2 -2
View File
@@ -444,7 +444,7 @@ TclUnsetEnv(
* that no = should be included, and Windows requires it.
*/
#if defined(__WIN32__) || defined(__CYGWIN__)
#if defined(_WIN32) || defined(__CYGWIN__)
string = ckalloc(length + 2);
memcpy(string, name, (size_t) length);
string[length] = '=';
@@ -453,7 +453,7 @@ TclUnsetEnv(
string = ckalloc(length + 1);
memcpy(string, name, (size_t) length);
string[length] = '\0';
#endif /* WIN32 */
#endif /* _WIN32 */
Tcl_UtfToExternalDString(NULL, string, -1, &envString);
string = ckrealloc(string, Tcl_DStringLength(&envString) + 1);
+919 -462
View File
File diff suppressed because it is too large Load Diff
+1 -1
View File
@@ -517,7 +517,7 @@ CopyRenameOneFile(
* 16 bits and we get collisions. See bug #2015723.
*/
#if !defined(WIN32) && !defined(__CYGWIN__)
#if !defined(_WIN32) && !defined(__CYGWIN__)
if ((sourceStatBuf.st_ino != 0) && (targetStatBuf.st_ino != 0)) {
if ((sourceStatBuf.st_ino == targetStatBuf.st_ino) &&
(sourceStatBuf.st_dev == targetStatBuf.st_dev)) {
+174 -769
View File
File diff suppressed because it is too large Load Diff
+4 -4
View File
@@ -19,7 +19,7 @@
*/
#include "tclInt.h"
#ifdef __WIN32__
#ifdef _WIN32
# include "tclWinInt.h"
#endif
#include "tclFileSystem.h"
@@ -792,7 +792,7 @@ TclFinalizeFilesystem(void)
* filesystem is likely to fail.
*/
#ifdef __WIN32__
#ifdef _WIN32
TclWinEncodingsCleanup();
#endif
}
@@ -819,7 +819,7 @@ TclResetFilesystem(void)
filesystemList = &nativeFilesystemRecord;
theFilesystemEpoch++;
#ifdef __WIN32__
#ifdef _WIN32
/*
* Cleans up the win32 API filesystem proc lookup table. This must happen
* very late in finalization so that deleting of copied dlls can occur.
@@ -3255,7 +3255,7 @@ Tcl_LoadFile(
return TCL_ERROR;
}
#ifndef __WIN32__
#ifndef _WIN32
/*
* Do we need to set appropriate permissions on the file? This may be
* required on some systems. On Unix we could loop over the file
+18
View File
@@ -1686,6 +1686,7 @@ typedef struct Command {
#define CMD_TRACE_ACTIVE 0x2
#define CMD_HAS_EXEC_TRACES 0x4
#define CMD_COMPILES_EXPANDED 0x8
#define CMD_REDEF_IN_PROGRESS 0x10
/*
*----------------------------------------------------------------
@@ -2639,6 +2640,8 @@ MODULE_SCOPE char *tclMemDumpFileName;
MODULE_SCOPE TclPlatformType tclPlatform;
MODULE_SCOPE Tcl_NotifierProcs tclNotifierHooks;
MODULE_SCOPE Tcl_Encoding tclIdentityEncoding;
/*
* TIP #233 (Virtualized Time)
* Data for the time hooks, if any.
@@ -3571,6 +3574,9 @@ MODULE_SCOPE int TclCompileNamespaceCodeCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileNamespaceCurrentCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileNamespaceOriginCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileNamespaceQualifiersCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -3586,6 +3592,12 @@ MODULE_SCOPE int TclCompileNamespaceWhichCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileNoOp(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileObjectNextCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileObjectNextToCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileObjectSelfCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -3613,6 +3625,9 @@ MODULE_SCOPE int TclCompileStringFirstCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileStringIndexCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileStringIsCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileStringLastCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
@@ -3679,6 +3694,9 @@ MODULE_SCOPE int TclCompileWhileCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileYieldCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileYieldToCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileBasic0ArgCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+8 -8
View File
@@ -13,7 +13,7 @@
#ifndef _TCLINTPLATDECLS
#define _TCLINTPLATDECLS
#ifdef __WIN32__
#ifdef _WIN32
# define Tcl_DirEntry void
# define DIR void
#endif
@@ -45,7 +45,7 @@ extern "C" {
* Exported function declarations:
*/
#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
/* 0 */
EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
Tcl_Channel chan);
@@ -104,7 +104,7 @@ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
Tcl_Obj *resultingNameObj);
#endif /* UNIX */
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* 0 */
EXTERN void TclWinConvertError(DWORD errCode);
/* 1 */
@@ -258,7 +258,7 @@ typedef struct TclIntPlatStubs {
int magic;
void *hooks;
#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
int (*tclpCloseFile) (TclFile file); /* 1 */
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
@@ -291,7 +291,7 @@ typedef struct TclIntPlatStubs {
int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* UNIX */
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
void (*tclWinConvertError) (DWORD errCode); /* 0 */
void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */
struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */
@@ -371,7 +371,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
* Inline function declarations:
*/
#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
#define TclGetAndDetachPids \
(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
#define TclpCloseFile \
@@ -420,7 +420,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
#define TclUnixOpenTemporaryFile \
(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#endif /* UNIX */
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
#define TclWinConvertError \
(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
#define TclWinConvertWSAError \
@@ -550,7 +550,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
#undef TclpInetNtoa
#define TclpInetNtoa inet_ntoa
#if defined(__WIN32__) || defined(__CYGWIN__)
#if defined(_WIN32) || defined(__CYGWIN__)
# undef TclWinNToHS
# define TclWinNToHS ntohs
#else
+2 -2
View File
@@ -830,7 +830,7 @@ Tcl_UnloadObjCmd(
* Unload the shared library from the application memory...
*/
#if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__)
#if defined(TCL_UNLOAD_DLLS) || defined(_WIN32)
/*
* Some Unix dlls are poorly behaved - registering things like atexit
* calls that can't be unregistered. If you unload such dlls, you get
@@ -1151,7 +1151,7 @@ TclFinalizeLoad(void)
pkgPtr = firstPackagePtr;
firstPackagePtr = pkgPtr->nextPtr;
#if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__)
#if defined(TCL_UNLOAD_DLLS) || defined(_WIN32)
/*
* Some Unix dlls are poorly behaved - registering things like atexit
* calls that can't be unregistered. If you unload such dlls, you get
+1 -1
View File
@@ -47,7 +47,7 @@
* we have to translate that to strcmp here.
*/
#ifndef __WIN32__
#ifndef _WIN32
# define TCHAR char
# define TEXT(arg) arg
# define _tcscmp strcmp
+1 -1
View File
@@ -171,7 +171,7 @@ static const EnsembleImplMap defaultNamespaceMap[] = {
{"forget", NamespaceForgetCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
{"import", NamespaceImportCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
{"inscope", NamespaceInscopeCmd, NULL, NRNamespaceInscopeCmd, NULL, 0},
{"origin", NamespaceOriginCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"origin", NamespaceOriginCmd, TclCompileNamespaceOriginCmd, NULL, NULL, 0},
{"parent", NamespaceParentCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
{"path", NamespacePathCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
{"qualifiers", NamespaceQualifiersCmd, TclCompileNamespaceQualifiersCmd, NULL, NULL, 0},
+6 -4
View File
@@ -437,10 +437,12 @@ InitFoundation(
* ensemble.
*/
Tcl_CreateObjCommand(interp, "::oo::Helpers::next", TclOONextObjCmd, NULL,
NULL);
Tcl_CreateObjCommand(interp, "::oo::Helpers::nextto", TclOONextToObjCmd,
NULL, NULL);
cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::oo::Helpers::next",
NULL, TclOONextObjCmd, NULL, NULL);
cmdPtr->compileProc = TclCompileObjectNextCmd;
cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::oo::Helpers::nextto",
NULL, TclOONextToObjCmd, NULL, NULL);
cmdPtr->compileProc = TclCompileObjectNextToCmd;
cmdPtr = (Command *) Tcl_CreateObjCommand(interp, "::oo::Helpers::self",
TclOOSelfObjCmd, NULL, NULL);
cmdPtr->compileProc = TclCompileObjectSelfCmd;
+1
View File
@@ -18,6 +18,7 @@ library tclOO
interface tclOO
hooks tclOOInt
scspec TCLAPI
declare 0 {
Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp,
+25 -18
View File
@@ -17,16 +17,11 @@
#include "tclOOInt.h"
static inline Tcl_Object *AddConstructionFinalizer(Tcl_Interp *interp);
static int AfterNRDestructor(ClientData data[],
Tcl_Interp *interp, int result);
static int DecrRefsPostClassConstructor(ClientData data[],
Tcl_Interp *interp, int result);
static int FinalizeConstruction(ClientData data[],
Tcl_Interp *interp, int result);
static int FinalizeEval(ClientData data[],
Tcl_Interp *interp, int result);
static int RestoreFrame(ClientData data[],
Tcl_Interp *interp, int result);
static Tcl_NRPostProc AfterNRDestructor;
static Tcl_NRPostProc DecrRefsPostClassConstructor;
static Tcl_NRPostProc FinalizeConstruction;
static Tcl_NRPostProc FinalizeEval;
static Tcl_NRPostProc NextRestoreFrame;
/*
* ----------------------------------------------------------------------
@@ -808,7 +803,7 @@ TclOONextObjCmd(
* that this is like [uplevel 1] and not [eval].
*/
TclNRAddCallback(interp, RestoreFrame, framePtr, NULL, NULL, NULL);
TclNRAddCallback(interp, NextRestoreFrame, framePtr, NULL,NULL,NULL);
iPtr->varFramePtr = framePtr->callerVarPtr;
return TclNRObjectContextInvokeNext(interp, context, objc, objv, 1);
}
@@ -826,6 +821,7 @@ TclOONextToObjCmd(
CallContext *contextPtr;
int i;
Tcl_Object object;
const char *methodType;
/*
* Start with sanity checks on the calling context to make sure that we
@@ -877,8 +873,8 @@ TclOONextToObjCmd(
* context. Note that this is like [uplevel 1] and not [eval].
*/
TclNRAddCallback(interp, RestoreFrame, framePtr, contextPtr,
INT2PTR(contextPtr->index), NULL);
TclNRAddCallback(interp, NextRestoreFrame, framePtr,
contextPtr, INT2PTR(contextPtr->index), NULL);
contextPtr->index = i-1;
iPtr->varFramePtr = framePtr->callerVarPtr;
return TclNRObjectContextInvokeNext(interp,
@@ -891,24 +887,35 @@ TclOONextToObjCmd(
* is on the chain but unreachable, or not on the chain at all.
*/
if (contextPtr->callPtr->flags & CONSTRUCTOR) {
methodType = "constructor";
} else if (contextPtr->callPtr->flags & DESTRUCTOR) {
methodType = "destructor";
} else {
methodType = "method";
}
for (i=contextPtr->index ; i>=0 ; i--) {
struct MInvoke *miPtr = contextPtr->callPtr->chain + i;
if (!miPtr->isFilter && miPtr->mPtr->declaringClassPtr == classPtr) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"method implementation by \"%s\" not reachable from here",
TclGetString(objv[1])));
"%s implementation by \"%s\" not reachable from here",
methodType, TclGetString(objv[1])));
Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_REACHABLE",
NULL);
return TCL_ERROR;
}
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"method has no non-filter implementation by \"%s\"",
TclGetString(objv[1])));
"%s has no non-filter implementation by \"%s\"",
methodType, TclGetString(objv[1])));
Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", NULL);
return TCL_ERROR;
}
static int
RestoreFrame(
NextRestoreFrame(
ClientData data[],
Tcl_Interp *interp,
int result)
+38 -40
View File
@@ -5,19 +5,19 @@
#ifndef _TCLOODECLS
#define _TCLOODECLS
#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
# define TCL_STORAGE_CLASS DLLEXPORT
#else
# ifdef USE_TCL_STUBS
# undef USE_TCLOO_STUBS
# define USE_TCLOO_STUBS
# define TCL_STORAGE_CLASS
#ifndef TCLAPI
# ifdef BUILD_tcl
# define TCLAPI extern DLLEXPORT
# else
# define TCL_STORAGE_CLASS DLLIMPORT
# define TCLAPI extern DLLIMPORT
# endif
#endif
#ifdef USE_TCL_STUBS
# undef USE_TCLOO_STUBS
# define USE_TCLOO_STUBS
#endif
/* !BEGIN!: Do not edit below this line. */
#ifdef __cplusplus
@@ -29,92 +29,92 @@ extern "C" {
*/
/* 0 */
EXTERN Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp,
TCLAPI Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp,
Tcl_Object sourceObject,
const char *targetName,
const char *targetNamespaceName);
/* 1 */
EXTERN Tcl_Object Tcl_GetClassAsObject(Tcl_Class clazz);
TCLAPI Tcl_Object Tcl_GetClassAsObject(Tcl_Class clazz);
/* 2 */
EXTERN Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object);
TCLAPI Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object);
/* 3 */
EXTERN Tcl_Command Tcl_GetObjectCommand(Tcl_Object object);
TCLAPI Tcl_Command Tcl_GetObjectCommand(Tcl_Object object);
/* 4 */
EXTERN Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp,
TCLAPI Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr);
/* 5 */
EXTERN Tcl_Namespace * Tcl_GetObjectNamespace(Tcl_Object object);
TCLAPI Tcl_Namespace * Tcl_GetObjectNamespace(Tcl_Object object);
/* 6 */
EXTERN Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method);
TCLAPI Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method);
/* 7 */
EXTERN Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method);
TCLAPI Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method);
/* 8 */
EXTERN int Tcl_MethodIsPublic(Tcl_Method method);
TCLAPI int Tcl_MethodIsPublic(Tcl_Method method);
/* 9 */
EXTERN int Tcl_MethodIsType(Tcl_Method method,
TCLAPI int Tcl_MethodIsType(Tcl_Method method,
const Tcl_MethodType *typePtr,
ClientData *clientDataPtr);
/* 10 */
EXTERN Tcl_Obj * Tcl_MethodName(Tcl_Method method);
TCLAPI Tcl_Obj * Tcl_MethodName(Tcl_Method method);
/* 11 */
EXTERN Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp,
TCLAPI Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp,
Tcl_Object object, Tcl_Obj *nameObj,
int isPublic, const Tcl_MethodType *typePtr,
ClientData clientData);
/* 12 */
EXTERN Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
TCLAPI Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
Tcl_Obj *nameObj, int isPublic,
const Tcl_MethodType *typePtr,
ClientData clientData);
/* 13 */
EXTERN Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp,
TCLAPI Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp,
Tcl_Class cls, const char *nameStr,
const char *nsNameStr, int objc,
Tcl_Obj *const *objv, int skip);
/* 14 */
EXTERN int Tcl_ObjectDeleted(Tcl_Object object);
TCLAPI int Tcl_ObjectDeleted(Tcl_Object object);
/* 15 */
EXTERN int Tcl_ObjectContextIsFiltering(
TCLAPI int Tcl_ObjectContextIsFiltering(
Tcl_ObjectContext context);
/* 16 */
EXTERN Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context);
TCLAPI Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context);
/* 17 */
EXTERN Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context);
TCLAPI Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context);
/* 18 */
EXTERN int Tcl_ObjectContextSkippedArgs(
TCLAPI int Tcl_ObjectContextSkippedArgs(
Tcl_ObjectContext context);
/* 19 */
EXTERN ClientData Tcl_ClassGetMetadata(Tcl_Class clazz,
TCLAPI ClientData Tcl_ClassGetMetadata(Tcl_Class clazz,
const Tcl_ObjectMetadataType *typePtr);
/* 20 */
EXTERN void Tcl_ClassSetMetadata(Tcl_Class clazz,
TCLAPI void Tcl_ClassSetMetadata(Tcl_Class clazz,
const Tcl_ObjectMetadataType *typePtr,
ClientData metadata);
/* 21 */
EXTERN ClientData Tcl_ObjectGetMetadata(Tcl_Object object,
TCLAPI ClientData Tcl_ObjectGetMetadata(Tcl_Object object,
const Tcl_ObjectMetadataType *typePtr);
/* 22 */
EXTERN void Tcl_ObjectSetMetadata(Tcl_Object object,
TCLAPI void Tcl_ObjectSetMetadata(Tcl_Object object,
const Tcl_ObjectMetadataType *typePtr,
ClientData metadata);
/* 23 */
EXTERN int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
TCLAPI int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
Tcl_ObjectContext context, int objc,
Tcl_Obj *const *objv, int skip);
/* 24 */
EXTERN Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
TCLAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
Tcl_Object object);
/* 25 */
EXTERN void Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
TCLAPI void Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
Tcl_ObjectMapMethodNameProc *mapMethodNameProc);
/* 26 */
EXTERN void Tcl_ClassSetConstructor(Tcl_Interp *interp,
TCLAPI void Tcl_ClassSetConstructor(Tcl_Interp *interp,
Tcl_Class clazz, Tcl_Method method);
/* 27 */
EXTERN void Tcl_ClassSetDestructor(Tcl_Interp *interp,
TCLAPI void Tcl_ClassSetDestructor(Tcl_Interp *interp,
Tcl_Class clazz, Tcl_Method method);
/* 28 */
EXTERN Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp,
TCLAPI Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp,
Tcl_Object object);
typedef struct {
@@ -231,6 +231,4 @@ extern const TclOOStubs *tclOOStubsPtr;
/* !END!: Do not edit above this line. */
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
#endif /* _TCLOODECLS */
+16 -29
View File
@@ -5,17 +5,6 @@
#ifndef _TCLOOINTDECLS
#define _TCLOOINTDECLS
#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
# define TCL_STORAGE_CLASS DLLEXPORT
#else
# ifdef USE_TCL_STUBS
# define TCL_STORAGE_CLASS
# else
# define TCL_STORAGE_CLASS DLLIMPORT
# endif
#endif
/* !BEGIN!: Do not edit below this line. */
#ifdef __cplusplus
@@ -27,46 +16,46 @@ extern "C" {
*/
/* 0 */
EXTERN Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp);
TCLAPI Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp);
/* 1 */
EXTERN Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp,
TCLAPI Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp,
Object *oPtr, int flags, Tcl_Obj *nameObj,
Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
const Tcl_MethodType *typePtr,
ClientData clientData, Proc **procPtrPtr);
/* 2 */
EXTERN Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp,
TCLAPI Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp,
Class *clsPtr, int flags, Tcl_Obj *nameObj,
const char *namePtr, Tcl_Obj *argsObj,
Tcl_Obj *bodyObj,
const Tcl_MethodType *typePtr,
ClientData clientData, Proc **procPtrPtr);
/* 3 */
EXTERN Method * TclOONewProcInstanceMethod(Tcl_Interp *interp,
TCLAPI Method * TclOONewProcInstanceMethod(Tcl_Interp *interp,
Object *oPtr, int flags, Tcl_Obj *nameObj,
Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
ProcedureMethod **pmPtrPtr);
/* 4 */
EXTERN Method * TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
TCLAPI Method * TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
int flags, Tcl_Obj *nameObj,
Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
ProcedureMethod **pmPtrPtr);
/* 5 */
EXTERN int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp,
TCLAPI int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp,
int objc, Tcl_Obj *const *objv,
int publicOnly, Class *startCls);
/* 6 */
EXTERN int TclOOIsReachable(Class *targetPtr, Class *startPtr);
TCLAPI int TclOOIsReachable(Class *targetPtr, Class *startPtr);
/* 7 */
EXTERN Method * TclOONewForwardMethod(Tcl_Interp *interp,
TCLAPI Method * TclOONewForwardMethod(Tcl_Interp *interp,
Class *clsPtr, int isPublic,
Tcl_Obj *nameObj, Tcl_Obj *prefixObj);
/* 8 */
EXTERN Method * TclOONewForwardInstanceMethod(Tcl_Interp *interp,
TCLAPI Method * TclOONewForwardInstanceMethod(Tcl_Interp *interp,
Object *oPtr, int isPublic, Tcl_Obj *nameObj,
Tcl_Obj *prefixObj);
/* 9 */
EXTERN Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
TCLAPI Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
Tcl_Object oPtr,
TclOO_PreCallProc *preCallPtr,
TclOO_PostCallProc *postCallPtr,
@@ -75,7 +64,7 @@ EXTERN Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
int flags, void **internalTokenPtr);
/* 10 */
EXTERN Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp,
TCLAPI Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp,
Tcl_Class clsPtr,
TclOO_PreCallProc *preCallPtr,
TclOO_PostCallProc *postCallPtr,
@@ -84,22 +73,22 @@ EXTERN Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp,
Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
int flags, void **internalTokenPtr);
/* 11 */
EXTERN int TclOOInvokeObject(Tcl_Interp *interp,
TCLAPI int TclOOInvokeObject(Tcl_Interp *interp,
Tcl_Object object, Tcl_Class startCls,
int publicPrivate, int objc,
Tcl_Obj *const *objv);
/* 12 */
EXTERN void TclOOObjectSetFilters(Object *oPtr, int numFilters,
TCLAPI void TclOOObjectSetFilters(Object *oPtr, int numFilters,
Tcl_Obj *const *filters);
/* 13 */
EXTERN void TclOOClassSetFilters(Tcl_Interp *interp,
TCLAPI void TclOOClassSetFilters(Tcl_Interp *interp,
Class *classPtr, int numFilters,
Tcl_Obj *const *filters);
/* 14 */
EXTERN void TclOOObjectSetMixins(Object *oPtr, int numMixins,
TCLAPI void TclOOObjectSetMixins(Object *oPtr, int numMixins,
Class *const *mixins);
/* 15 */
EXTERN void TclOOClassSetMixins(Tcl_Interp *interp,
TCLAPI void TclOOClassSetMixins(Tcl_Interp *interp,
Class *classPtr, int numMixins,
Class *const *mixins);
@@ -174,6 +163,4 @@ extern const TclOOIntStubs *tclOOIntStubsPtr;
/* !END!: Do not edit above this line. */
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
#endif /* _TCLOOINTDECLS */
+3 -3
View File
@@ -512,7 +512,7 @@ TclFSGetPathType(
if (PATHFLAGS(pathPtr) == 0) {
/* The path is not absolute... */
#ifdef __WIN32__
#ifdef _WIN32
/* ... on Windows we must make another call to determine whether
* it's relative or volumerelative [Bug 2571597]. */
return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr,
@@ -1956,7 +1956,7 @@ Tcl_FSGetNormalizedPath(
/*
* We have a refCount on the cwd.
*/
#ifdef __WIN32__
#ifdef _WIN32
} else if (type == TCL_PATH_VOLUME_RELATIVE) {
/*
* Only Windows has volume-relative paths.
@@ -1969,7 +1969,7 @@ Tcl_FSGetNormalizedPath(
return NULL;
}
pureNormalized = 0;
#endif /* __WIN32__ */
#endif /* _WIN32 */
}
}
+3 -3
View File
@@ -50,7 +50,7 @@ extern "C" {
* Exported function declarations:
*/
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* 0 */
EXTERN TCHAR * Tcl_WinUtfToTChar(const char *str, int len,
Tcl_DString *dsPtr);
@@ -75,7 +75,7 @@ typedef struct TclPlatStubs {
int magic;
void *hooks;
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
TCHAR * (*tcl_WinUtfToTChar) (const char *str, int len, Tcl_DString *dsPtr); /* 0 */
char * (*tcl_WinTCharToUtf) (const TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */
#endif /* WIN */
@@ -97,7 +97,7 @@ extern const TclPlatStubs *tclPlatStubsPtr;
* Inline function declarations:
*/
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
#define Tcl_WinUtfToTChar \
(tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */
#define Tcl_WinTCharToUtf \
+32 -40
View File
@@ -1855,9 +1855,39 @@ InterpProcNR2(
}
/*
* Process the result code.
* Free the stack-allocated compiled locals and CallFrame. It is important
* to pop the call frame without freeing it first: the compiledLocals
* cannot be freed before the frame is popped, as the local variables must
* be deleted. But the compiledLocals must be freed first, as they were
* allocated later on the stack.
*/
if (result != TCL_OK) {
goto process;
}
done:
if (TCL_DTRACE_PROC_RESULT_ENABLED()) {
int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
Tcl_Obj *r = Tcl_GetObjResult(interp);
TCL_DTRACE_PROC_RESULT(l < iPtr->varFramePtr->objc ?
TclGetString(iPtr->varFramePtr->objv[l]) : NULL, result,
TclGetString(r), r);
}
freePtr = iPtr->framePtr;
Tcl_PopCallFrame(interp); /* Pop but do not free. */
TclStackFree(interp, freePtr->compiledLocals);
/* Free compiledLocals. */
TclStackFree(interp, freePtr); /* Free CallFrame. */
return result;
/*
* Process any non-TCL_OK result code.
*/
process:
switch (result) {
case TCL_RETURN:
/*
@@ -1892,46 +1922,8 @@ InterpProcNR2(
*/
errorProc(interp, procNameObj);
default:
/*
* Process other results (OK and non-standard) by doing nothing
* special, skipping directly to the code afterwards that cleans up
* associated memory.
*
* Non-standard results are processed by passing them through quickly.
* This means they all work as exceptions, unwinding the stack quickly
* and neatly. Who knows how well they are handled by third-party code
* though...
*/
(void) 0; /* do nothing */
}
if (TCL_DTRACE_PROC_RESULT_ENABLED()) {
int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
Tcl_Obj *r = Tcl_GetObjResult(interp);
TCL_DTRACE_PROC_RESULT(l < iPtr->varFramePtr->objc ?
TclGetString(iPtr->varFramePtr->objv[l]) : NULL, result,
TclGetString(r), r);
}
/*
* Free the stack-allocated compiled locals and CallFrame. It is important
* to pop the call frame without freeing it first: the compiledLocals
* cannot be freed before the frame is popped, as the local variables must
* be deleted. But the compiledLocals must be freed first, as they were
* allocated later on the stack.
*/
freePtr = iPtr->framePtr;
Tcl_PopCallFrame(interp); /* Pop but do not free. */
TclStackFree(interp, freePtr->compiledLocals);
/* Free compiledLocals. */
TclStackFree(interp, freePtr); /* Free CallFrame. */
return result;
goto done;
}
/*
Executable → Regular
View File
+31 -11
View File
@@ -1281,23 +1281,43 @@ Tcl_AppendObjToObj(
if ((TclIsPureByteArray(objPtr) || objPtr->bytes == tclEmptyStringRep)
&& TclIsPureByteArray(appendObjPtr)) {
unsigned char *bytesSrc;
int lengthSrc, lengthTotal;
/*
* We do not assume that objPtr and appendObjPtr must be distinct!
* This makes this code a bit more complex than it otherwise would be,
* but in turn makes it much safer.
* You might expect the code here to be
*
* bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length);
* TclAppendBytesToByteArray(objPtr, bytes, length);
*
* and essentially all of the time that would be fine. However,
* it would run into trouble in the case where objPtr and
* appendObjPtr point to the same thing. That may never be a
* good idea. It seems to violate Copy On Write, and we don't
* have any tests for the situation, since making any Tcl commands
* that call Tcl_AppendObjToObj() do that appears impossible
* (They honor Copy On Write!). For the sake of extensions that
* go off into that realm, though, here's a more complex approach
* that can handle all the cases.
*/
/* Get lengths */
int lengthSrc;
(void) Tcl_GetByteArrayFromObj(objPtr, &length);
(void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc);
lengthTotal = length + lengthSrc;
if (((length > lengthSrc) ? length : lengthSrc) > lengthTotal) {
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
bytesSrc = Tcl_GetByteArrayFromObj(appendObjPtr, NULL);
TclAppendBytesToByteArray(objPtr, bytesSrc, lengthSrc);
/* Grow buffer enough for the append */
TclAppendBytesToByteArray(objPtr, NULL, lengthSrc);
/* Reset objPtr back to the original value */
Tcl_SetByteArrayLength(objPtr, length);
/*
* Now do the append knowing that buffer growth cannot cause
* any trouble.
*/
TclAppendBytesToByteArray(objPtr,
Tcl_GetByteArrayFromObj(appendObjPtr, NULL), lengthSrc);
return;
}
+43
View File
@@ -0,0 +1,43 @@
/*
* tclStringTrim.h --
*
* This file contains the definition of what characters are to be trimmed
* from a string by [string trim] by default. It's only needed by Tcl's
* implementation; it does not form a public or private API at all.
*
* Copyright (c) 1987-1993 The Regents of the University of California.
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
* Copyright (c) 1998-2000 Scriptics Corporation.
* Copyright (c) 2002 ActiveState Corporation.
* Copyright (c) 2003-2013 Donal K. Fellows.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#ifndef TCL_STRING_TRIM_H
#define TCL_STRING_TRIM_H
/*
* Default set of characters to trim in [string trim] and friends. This is a
* UTF-8 literal string containing all Unicode space characters. [TIP #413]
*/
MODULE_SCOPE const char tclDefaultTrimSet[];
/*
* The whitespace trimming set used when [concat]enating. This is a subset of
* the above, and deliberately so.
*/
#define CONCAT_TRIM_SET " \f\v\r\t\n"
#endif /* TCL_STRING_TRIM_H */
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
+10 -10
View File
@@ -90,7 +90,7 @@ static unsigned short TclWinNToHS(unsigned short ns) {
}
#endif
#ifdef __WIN32__
#ifdef _WIN32
# define TclUnixWaitForFile 0
# define TclUnixCopyFile 0
# define TclUnixOpenTemporaryFile 0
@@ -557,7 +557,7 @@ static const TclIntStubs tclIntStubs = {
static const TclIntPlatStubs tclIntPlatStubs = {
TCL_STUB_MAGIC,
0,
#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
TclGetAndDetachPids, /* 0 */
TclpCloseFile, /* 1 */
TclpCreateCommandChannel, /* 2 */
@@ -590,7 +590,7 @@ static const TclIntPlatStubs tclIntPlatStubs = {
TclWinCPUID, /* 29 */
TclUnixOpenTemporaryFile, /* 30 */
#endif /* UNIX */
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
TclWinConvertError, /* 0 */
TclWinConvertWSAError, /* 1 */
TclWinGetServByName, /* 2 */
@@ -661,7 +661,7 @@ static const TclIntPlatStubs tclIntPlatStubs = {
static const TclPlatStubs tclPlatStubs = {
TCL_STUB_MAGIC,
0,
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
Tcl_WinUtfToTChar, /* 0 */
Tcl_WinTCharToUtf, /* 1 */
#endif /* WIN */
@@ -758,19 +758,19 @@ const TclStubs tclStubs = {
Tcl_DbCkalloc, /* 6 */
Tcl_DbCkfree, /* 7 */
Tcl_DbCkrealloc, /* 8 */
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
Tcl_CreateFileHandler, /* 9 */
#endif /* UNIX */
#if defined(__WIN32__) /* WIN */
#if defined(_WIN32) /* WIN */
0, /* 9 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
Tcl_CreateFileHandler, /* 9 */
#endif /* MACOSX */
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
Tcl_DeleteFileHandler, /* 10 */
#endif /* UNIX */
#if defined(__WIN32__) /* WIN */
#if defined(_WIN32) /* WIN */
0, /* 10 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
@@ -932,10 +932,10 @@ const TclStubs tclStubs = {
Tcl_GetMaster, /* 164 */
Tcl_GetNameOfExecutable, /* 165 */
Tcl_GetObjResult, /* 166 */
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
Tcl_GetOpenFile, /* 167 */
#endif /* UNIX */
#if defined(__WIN32__) /* WIN */
#if defined(_WIN32) /* WIN */
0, /* 167 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
+58
View File
@@ -0,0 +1,58 @@
/*
* tclStubLibTbl.c --
*
* Stub object that will be statically linked into extensions that want
* to access Tcl.
*
* Copyright (c) 1998-1999 by Scriptics Corporation.
* Copyright (c) 1998 Paul Duffin.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclInt.h"
/*
*----------------------------------------------------------------------
*
* TclInitStubTable --
*
* Initialize the stub table, using the structure pointed at
* by the "version" argument.
*
* Results:
* Outputs the value of the "version" argument.
*
* Side effects:
* Sets the stub table pointers.
*
*----------------------------------------------------------------------
*/
MODULE_SCOPE const char *
TclInitStubTable(
const char *version) /* points to the version field of a
TclStubInfoType structure variable. */
{
tclStubsPtr = ((const TclStubInfoType *) version)->stubs;
if (tclStubsPtr->hooks) {
tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs;
tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs;
} else {
tclPlatStubsPtr = NULL;
tclIntStubsPtr = NULL;
tclIntPlatStubsPtr = NULL;
}
return version;
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
+3 -3
View File
@@ -414,7 +414,7 @@ static int TestNRELevels(ClientData clientData,
static int TestInterpResolverCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
#if defined(HAVE_CPUID) || defined(__WIN32__)
#if defined(HAVE_CPUID) || defined(_WIN32)
static int TestcpuidCmd(ClientData dummy,
Tcl_Interp* interp, int objc,
Tcl_Obj *const objv[]);
@@ -681,7 +681,7 @@ Tcltest_Init(
NULL, NULL);
Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd,
NULL, NULL);
#if defined(HAVE_CPUID) || defined(__WIN32__)
#if defined(HAVE_CPUID) || defined(_WIN32)
Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd,
(ClientData) 0, NULL);
#endif
@@ -6648,7 +6648,7 @@ TestNumUtfCharsCmd(
return TCL_OK;
}
#if defined(HAVE_CPUID) || defined(__WIN32__)
#if defined(HAVE_CPUID) || defined(_WIN32)
/*
*----------------------------------------------------------------------
*
+2 -2
View File
@@ -14,7 +14,7 @@
#include "tclInt.h"
#ifdef WIN32
#ifdef _WIN32
/*
* The information about each joinable thread is remembered in a structure as
@@ -305,7 +305,7 @@ TclSignalExitThread(
Tcl_MutexUnlock(&threadPtr->threadMutex);
}
#endif /* WIN32 */
#endif /* _WIN32 */
/*
* Local Variables:
+10 -6
View File
@@ -14,6 +14,7 @@
#include "tclInt.h"
#include "tclParse.h"
#include "tclStringTrim.h"
#include <math.h>
/*
@@ -1768,8 +1769,7 @@ TclTrimLeft(
*/
/* The whitespace characters trimmed during [concat] operations */
#define CONCAT_WS " \f\v\r\t\n"
#define CONCAT_WS_SIZE (int) (sizeof(CONCAT_WS "") - 1)
#define CONCAT_WS_SIZE (int) (sizeof(CONCAT_TRIM_SET "") - 1)
char *
Tcl_Concat(
@@ -1825,7 +1825,8 @@ Tcl_Concat(
* Trim away the leading whitespace.
*/
trim = TclTrimLeft(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
trim = TclTrimLeft(element, elemLength, CONCAT_TRIM_SET,
CONCAT_WS_SIZE);
element += trim;
elemLength -= trim;
@@ -1834,7 +1835,8 @@ Tcl_Concat(
* a final backslash character.
*/
trim = TclTrimRight(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
trim = TclTrimRight(element, elemLength, CONCAT_TRIM_SET,
CONCAT_WS_SIZE);
trim -= trim && (element[elemLength - trim - 1] == '\\');
elemLength -= trim;
@@ -1959,7 +1961,8 @@ Tcl_ConcatObj(
* Trim away the leading whitespace.
*/
trim = TclTrimLeft(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
trim = TclTrimLeft(element, elemLength, CONCAT_TRIM_SET,
CONCAT_WS_SIZE);
element += trim;
elemLength -= trim;
@@ -1968,7 +1971,8 @@ Tcl_ConcatObj(
* a final backslash character.
*/
trim = TclTrimRight(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
trim = TclTrimRight(element, elemLength, CONCAT_TRIM_SET,
CONCAT_WS_SIZE);
trim -= trim && (element[elemLength - trim - 1] == '\\');
elemLength -= trim;
+8 -38
View File
@@ -3012,52 +3012,22 @@ ZlibTransformInput(
return -1;
} else if (readBytes == 0) {
/*
* Check wether we hit on EOF in 'parent' or not. If not,
* differentiate between blocking and non-blocking modes. In
* non-blocking mode we ran temporarily out of data. Signal this
* to the caller via EWOULDBLOCK and error return (-1). In the
* other cases we simply return what we got and let the caller
* wait for more. On the other hand, if we got an EOF we have to
* convert and flush all waiting partial data.
*/
if (!Tcl_Eof(cd->parent)) {
/*
* The state of the seek system is unchanged!
*/
if ((gotBytes == 0) && (cd->flags & ASYNC)) {
*errorCodePtr = EWOULDBLOCK;
return -1;
}
return gotBytes;
}
/*
* (Semi-)Eof in parent.
*
* Now this is a bit different. The partial data waiting is
* converted and returned.
* The 'parent' is at EOF. It will not deliver us any more
* bytes. Make one last decompression attempt where we flush
* the streams.
*/
if (ResultGenerate(cd, 0, Z_SYNC_FLUSH, errorCodePtr) != TCL_OK) {
return -1;
}
if (Tcl_DStringLength(&cd->decompressed) == 0) {
/*
* The drain delivered nothing. Time to deliver what we've
* got.
*/
return gotBytes;
}
/*
* Reset eof, force caller to drain result buffer.
* Note that in the case where gotBytes == 0 (nothing in
* the decompressed buffer to begin with) and the flush
* also produce no new output, we are returning 0, which
* signals the EOF to our caller.
*/
((Channel *) cd->parent)->state->flags &= ~CHANNEL_EOF;
return gotBytes + ResultCopy(cd, buf, toRead);
} else /* readBytes > 0 */ {
/*
* Transform the read chunk, which was not empty. Anything we get
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File
Executable → Regular
View File

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