Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | merge trunk |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | dgp-refactor |
Files: | files | file ages | folders |
SHA3-256: |
08d36921f05851c20d6639f6c0b165e1 |
User & Date: | dgp 2019-06-13 12:13:48.121 |
Context
2019-06-17
| ||
18:36 | merge trunk check-in: d40e234200 user: dgp tags: dgp-refactor | |
2019-06-13
| ||
12:13 | merge trunk check-in: 08d36921f0 user: dgp tags: dgp-refactor | |
2019-06-12
| ||
15:42 | Merge 8.7 check-in: c5ff3f41bd user: jan.nijtmans tags: trunk | |
2019-06-06
| ||
08:20 | Merge 8.7, and add some more usage of TCL_INDEX_NONE/TCL_AUTO_LENGTH check-in: 68a11af555 user: jan.nijtmans tags: trunk | |
2019-05-16
| ||
18:34 | merge trunk check-in: d807d42276 user: dgp tags: dgp-refactor | |
Changes
Name change from README to README.md.
|
| | > | | | > > > | < | | | | | | | | | | | < | < < < | < | < | < | | | < < | < | > < | | < | | | < | | < < | | | | | | | | < < | | < < | | | < | | < < | < < | | < | | < < | < < | | < < | < | | < < | | < < | | | > > | | < < < | | < < | | | < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 | # README: Tcl This is the **Tcl 9.0a0** source distribution. You can get any source release of Tcl from [our distribution site](https://sourceforge.net/projects/tcl/files/Tcl/). [](https://travis-ci.org/tcltk/tcl) ## Contents 1. [Introduction](#intro) 2. [Documentation](#doc) 3. [Compiling and installing Tcl](#build) 4. [Development tools](#devtools) 5. [Tcl newsgroup](#complangtcl) 6. [The Tcler's Wiki](#wiki) 7. [Mailing lists](#email) 8. [Support and Training](#support) 9. [Tracking Development](#watch) 10. [Thank You](#thanks) ## <a id="intro">1.</a> Introduction Tcl provides a powerful platform for creating integration applications that tie together diverse applications, protocols, devices, and frameworks. When paired with the Tk toolkit, Tcl provides the fastest and most powerful way to create GUI applications that run on PCs, Unix, and Mac OS X. Tcl can also be used for a variety of web-related tasks and for creating powerful command languages for applications. Tcl is maintained, enhanced, and distributed freely by the Tcl community. Source code development and tracking of bug reports and feature requests takes place at [core.tcl-lang.org](https://core.tcl-lang.org/). Tcl/Tk release and mailing list services are [hosted by SourceForge](https://sourceforge.net/projects/tcl/) with the Tcl Developer Xchange hosted at [www.tcl-lang.org](https://www.tcl-lang.org). Tcl is a freely available open source package. You can do virtually anything you like with it, such as modifying it, redistributing it, and selling it either in whole or in part. See the file `license.terms` for complete information. ## <a id="doc">2.</a> Documentation Extensive documentation is available at our website. The home page for this release, including new features, is [here](https://www.tcl.tk/software/tcltk/9.0.html). Detailed release notes can be found at the [file distributions page](https://sourceforge.net/projects/tcl/files/Tcl/) by clicking on the relevant version. Information about Tcl itself can be found at the [Developer Xchange](https://www.tcl-lang.org/about/). There have been many Tcl books on the market. Many are mentioned in [the Wiki](https://wiki.tcl-lang.org/_/ref?N=25206). The complete set of reference manual entries for Tcl 9.0 is [online, here](https://www.tcl-lang.org/man/tcl9.0/). ### <a id="doc.unix">2a.</a> Unix Documentation The `doc` subdirectory in this release contains a complete set of reference manual entries for Tcl. Files with extension "`.1`" are for programs (for example, `tclsh.1`); files with extension "`.3`" are for C library procedures; and files with extension "`.n`" describe Tcl commands. The file "`doc/Tcl.n`" gives a quick summary of the Tcl language syntax. To print any of the man pages on Unix, cd to the "doc" directory and invoke your favorite variant of troff using the normal -man macros, for example groff -man -Tpdf Tcl.n >output.pdf to print Tcl.n to PDF. If Tcl has been installed correctly and your "man" program supports it, you should be able to access the Tcl manual entries using the normal "man" mechanisms, such as man Tcl ### <a id="doc.win">2b.</a> Windows Documentation The "doc" subdirectory in this release contains a complete set of Windows help files for Tcl. Once you install this Tcl release, a shortcut to the Windows help Tcl documentation will appear in the "Start" menu: Start | Programs | Tcl | Tcl Help ## <a id="build">3.</a> Compiling and installing Tcl There are brief notes in the `unix/README`, `win/README`, and `macosx/README` about compiling on these different platforms. There is additional information about building Tcl from sources [online](https://www.tcl-lang.org/doc/howto/compile.html). ## <a id="devtools">4.</a> Development tools ActiveState produces a high quality set of commercial quality development tools that is available to accelerate your Tcl application development. Tcl Dev Kit builds on the earlier TclPro toolset and provides a debugger, static code checker, single-file wrapping utility, bytecode compiler and more. More information can be found at http://www.ActiveState.com/Tcl ## <a id="complangtcl">5.</a> Tcl newsgroup There is a USENET news group, "`comp.lang.tcl`", intended for the exchange of information about Tcl, Tk, and related applications. The newsgroup is a great place to ask general information questions. For bug reports, please see the "Support and bug fixes" section below. ## <a id="wiki">6.</a> Tcl'ers Wiki There is a [wiki-based open community site](https://wiki.tcl-lang.org/) covering all aspects of Tcl/Tk. It is dedicated to the Tcl programming language and its extensions. A wealth of useful information can be found there. It contains code snippets, references to papers, books, and FAQs, as well as pointers to development tools, extensions, and applications. You can also recommend additional URLs by editing the wiki yourself. ## <a id="email">7.</a> Mailing lists Several mailing lists are hosted at SourceForge to discuss development or use issues (like Macintosh and Windows topics). For more information and to subscribe, visit [here](https://sourceforge.net/projects/tcl/) and go to the Mailing Lists page. ## <a id="support">8.</a> Support and Training We are very interested in receiving bug reports, patches, and suggestions for improvements. We prefer that you send this information to us as tickets entered into [our issue tracker](https://core.tcl-lang.org/tcl/reportlist). We will log and follow-up on each bug, although we cannot promise a specific turn-around time. Enhancements may take longer and may not happen at all unless there is widespread support for them (we're trying to slow the rate at which Tcl/Tk turns into a kitchen sink). It's very difficult to make incompatible changes to Tcl/Tk at this point, due to the size of the installed base. The Tcl community is too large for us to provide much individual support for users. If you need help we suggest that you post questions to `comp.lang.tcl` or ask a question on [Stack Overflow](https://stackoverflow.com/questions/tagged/tcl). We read the newsgroup and will attempt to answer esoteric questions for which no one else is likely to know the answer. In addition, see the wiki for [links to other organizations](https://wiki.tcl-lang.org/training) that offer Tcl/Tk training. ## <a id="watch">9.</a> Tracking Development Tcl is developed in public. You can keep an eye on how Tcl is changing at [core.tcl-lang.org](https://core.tcl-lang.org/). ## <a id="thanks">10.</a> Thank You We'd like to express our thanks to the Tcl community for all the helpful suggestions, bug reports, and patches we have received. Tcl/Tk has improved vastly and will continue to do so with your help. |
Changes to doc/IntObj.3.
1 2 3 4 5 6 7 8 9 10 | '\" '\" Copyright (c) 1996-1997 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH Tcl_IntObj 3 8.5 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | '\" '\" Copyright (c) 1996-1997 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH Tcl_IntObj 3 8.5 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_GetIntFromObj, Tcl_GetIntForIndex, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl values as integers .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp Tcl_Obj * \fBTcl_NewIntObj\fR(\fIintValue\fR) .sp |
︙ | ︙ | |||
27 28 29 30 31 32 33 34 35 36 37 38 39 40 | \fBTcl_SetLongObj\fR(\fIobjPtr, longValue\fR) .sp \fBTcl_SetWideIntObj\fR(\fIobjPtr, wideValue\fR) .sp int \fBTcl_GetIntFromObj\fR(\fIinterp, objPtr, intPtr\fR) .sp int \fBTcl_GetLongFromObj\fR(\fIinterp, objPtr, longPtr\fR) .sp int \fBTcl_GetWideIntFromObj\fR(\fIinterp, objPtr, widePtr\fR) .sp .sp | > > > | 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 | \fBTcl_SetLongObj\fR(\fIobjPtr, longValue\fR) .sp \fBTcl_SetWideIntObj\fR(\fIobjPtr, wideValue\fR) .sp int \fBTcl_GetIntFromObj\fR(\fIinterp, objPtr, intPtr\fR) .sp int \fBTcl_GetIntForIndex\fR(\fIinterp, objPtr, endValue, intPtr\fR) .sp int \fBTcl_GetLongFromObj\fR(\fIinterp, objPtr, longPtr\fR) .sp int \fBTcl_GetWideIntFromObj\fR(\fIinterp, objPtr, widePtr\fR) .sp .sp |
︙ | ︙ | |||
51 52 53 54 55 56 57 58 59 60 61 62 63 64 | int \fBTcl_TakeBignumFromObj\fR(\fIinterp, objPtr, bigValue\fR) .sp int \fBTcl_InitBignumFromDouble\fR(\fIinterp, doubleValue, bigValue\fR) .SH ARGUMENTS .AS Tcl_WideInt doubleValue in/out .AP int intValue in Integer value used to initialize or set a Tcl value. .AP long longValue in Long integer value used to initialize or set a Tcl value. .AP Tcl_WideInt wideValue in Wide integer value used to initialize or set a Tcl value. .AP Tcl_Obj *objPtr in/out | > > | 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 | int \fBTcl_TakeBignumFromObj\fR(\fIinterp, objPtr, bigValue\fR) .sp int \fBTcl_InitBignumFromDouble\fR(\fIinterp, doubleValue, bigValue\fR) .SH ARGUMENTS .AS Tcl_WideInt doubleValue in/out .AP int endValue in \fBTcl_GetIntForIndex\fR will return this when the input value is "end". .AP int intValue in Integer value used to initialize or set a Tcl value. .AP long longValue in Long integer value used to initialize or set a Tcl value. .AP Tcl_WideInt wideValue in Wide integer value used to initialize or set a Tcl value. .AP Tcl_Obj *objPtr in/out |
︙ | ︙ | |||
110 111 112 113 114 115 116 117 118 119 120 121 122 123 | and \fBTcl_SetBignumObj\fR routines each set the value of an existing Tcl value pointed to by \fIobjPtr\fR to the integral value provided by the other argument. The \fIobjPtr\fR argument must point to an unshared Tcl value. Any attempt to set the value of a shared Tcl value violates Tcl's copy-on-write policy. Any existing string representation or internal representation in the unshared Tcl value will be freed as a consequence of setting the new value. .PP The \fBTcl_GetIntFromObj\fR, \fBTcl_GetLongFromObj\fR, \fBTcl_GetWideIntFromObj\fR, \fBTcl_GetBignumFromObj\fR, and \fBTcl_TakeBignumFromObj\fR routines attempt to retrieve an integral value of the appropriate type from the Tcl value \fIobjPtr\fR. If the attempt succeeds, then \fBTCL_OK\fR is returned, and the value is written to the storage provided by the caller. The attempt might | > > > > > > > > > > | 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 | and \fBTcl_SetBignumObj\fR routines each set the value of an existing Tcl value pointed to by \fIobjPtr\fR to the integral value provided by the other argument. The \fIobjPtr\fR argument must point to an unshared Tcl value. Any attempt to set the value of a shared Tcl value violates Tcl's copy-on-write policy. Any existing string representation or internal representation in the unshared Tcl value will be freed as a consequence of setting the new value. .PP The \fBTcl_GetIntForIndex\fR routine attempts to retrieve an index value from the Tcl value \fIobjPtr\fR. If the attempt succeeds, then \fBTCL_OK\fR is returned, and the value is written to the storage provided by the caller. The attempt might fail if \fIobjPtr\fR does not hold an index value. If the attempt fails, then \fBTCL_ERROR\fR is returned, and if \fIinterp\fR is non-NULL, an error message is left in \fIinterp\fR. The \fBTcl_ObjType\fR of \fIobjPtr\fR may be changed to make subsequent calls to the same routine more efficient. .PP The \fBTcl_GetIntFromObj\fR, \fBTcl_GetLongFromObj\fR, \fBTcl_GetWideIntFromObj\fR, \fBTcl_GetBignumFromObj\fR, and \fBTcl_TakeBignumFromObj\fR routines attempt to retrieve an integral value of the appropriate type from the Tcl value \fIobjPtr\fR. If the attempt succeeds, then \fBTCL_OK\fR is returned, and the value is written to the storage provided by the caller. The attempt might |
︙ | ︙ |
Changes to doc/LinkVar.3.
︙ | ︙ | |||
55 56 57 58 59 60 61 | In \fBTcl_LinkArray\fR, the additional linked types \fBTCL_LINK_CHARS\fR and \fBTCL_LINK_BYTES\fR may be used. .VE "TIP 312" .sp All the above for both functions may be optionally OR'ed with \fBTCL_LINK_READ_ONLY\fR to make the Tcl variable read-only. | | | 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 | In \fBTcl_LinkArray\fR, the additional linked types \fBTCL_LINK_CHARS\fR and \fBTCL_LINK_BYTES\fR may be used. .VE "TIP 312" .sp All the above for both functions may be optionally OR'ed with \fBTCL_LINK_READ_ONLY\fR to make the Tcl variable read-only. .AP size_t size in .VS "TIP 312" The number of elements in the C array. Must be greater than zero. .VE "TIP 312" .BE .SH DESCRIPTION .PP \fBTcl_LinkVar\fR uses variable traces to keep the Tcl variable |
︙ | ︙ |
Changes to doc/RegExp.3.
︙ | ︙ | |||
60 61 62 63 64 65 66 | by \fBTcl_GetRegExpFromObj\fR or \fBTcl_RegExpCompile\fR. .AP char *start in If \fItext\fR is just a portion of some other string, this argument identifies the beginning of the larger string. If it is not the same as \fItext\fR, then no .QW \fB^\fR matches will be allowed. | | | | | | 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 | by \fBTcl_GetRegExpFromObj\fR or \fBTcl_RegExpCompile\fR. .AP char *start in If \fItext\fR is just a portion of some other string, this argument identifies the beginning of the larger string. If it is not the same as \fItext\fR, then no .QW \fB^\fR matches will be allowed. .AP size_t index in Specifies which range is desired: 0 means the range of the entire match, 1 or greater means the range that matched a parenthesized sub-expression. .AP "const char" **startPtr out The address of the first character in the range is stored here, or NULL if there is no such range. .AP "const char" **endPtr out The address of the character just after the last one in the range is stored here, or NULL if there is no such range. .AP int cflags in OR-ed combination of the compilation flags \fBTCL_REG_ADVANCED\fR, \fBTCL_REG_EXTENDED\fR, \fBTCL_REG_BASIC\fR, \fBTCL_REG_EXPANDED\fR, \fBTCL_REG_QUOTE\fR, \fBTCL_REG_NOCASE\fR, \fBTCL_REG_NEWLINE\fR, \fBTCL_REG_NLSTOP\fR, \fBTCL_REG_NLANCH\fR, \fBTCL_REG_NOSUB\fR, and \fBTCL_REG_CANMATCH\fR. See below for more information. .AP size_t offset in The character offset into the text where matching should begin. The value of the offset has no impact on \fB^\fR matches. This behavior is controlled by \fIeflags\fR. .AP size_t nmatches in The number of matching subexpressions that should be remembered for later use. If this value is 0, then no subexpression match information will be computed. If the value is TCL_INDEX_NONE, then all of the matching subexpressions will be remembered. Any other value will be taken as the maximum number of subexpressions to remember. .AP int eflags in OR-ed combination of the execution flags \fBTCL_REG_NOTBOL\fR and \fBTCL_REG_NOTEOL\fR. See below for more information. .AP Tcl_RegExpInfo *infoPtr out |
︙ | ︙ | |||
333 334 335 336 337 338 339 | \fBTcl_RegExpGetInfo\fR retrieves information about the last match performed with a given regular expression \fIregexp\fR. The \fIinfoPtr\fR argument contains a pointer to a structure that is defined as follows: .PP .CS typedef struct Tcl_RegExpInfo { | | | | | | 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 | \fBTcl_RegExpGetInfo\fR retrieves information about the last match performed with a given regular expression \fIregexp\fR. The \fIinfoPtr\fR argument contains a pointer to a structure that is defined as follows: .PP .CS typedef struct Tcl_RegExpInfo { size_t \fInsubs\fR; Tcl_RegExpIndices *\fImatches\fR; size_t \fIextendStart\fR; } \fBTcl_RegExpInfo\fR; .CE .PP The \fInsubs\fR field contains a count of the number of parenthesized subexpressions within the regular expression. If the \fBTCL_REG_NOSUB\fR was used, then this value will be zero. The \fImatches\fR field points to an array of \fInsubs\fR+1 values that indicate the bounds of each subexpression matched. The first element in the array refers to the range matched by the entire regular expression, and subsequent elements refer to the parenthesized subexpressions in the order that they appear in the pattern. Each element is a structure that is defined as follows: .PP .CS typedef struct Tcl_RegExpIndices { size_t \fIstart\fR; size_t \fIend\fR; } \fBTcl_RegExpIndices\fR; .CE .PP The \fIstart\fR and \fIend\fR values are Unicode character indices relative to the offset location within \fIobjPtr\fR where matching began. The \fIstart\fR index identifies the first character of the matched subexpression. The \fIend\fR index identifies the first character |
︙ | ︙ |
Changes to doc/Utf.3.
︙ | ︙ | |||
240 241 242 243 244 245 246 | specified character (not byte) \fIindex\fR in the UTF-8 string \fIsrc\fR. The source string must contain at least \fIindex\fR characters. .PP \fBTcl_UtfAtIndex\fR returns a pointer to the specified character (not byte) \fIindex\fR in the UTF-8 string \fIsrc\fR. The source string must contain at least \fIindex\fR characters. This is equivalent to calling | | | 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 | specified character (not byte) \fIindex\fR in the UTF-8 string \fIsrc\fR. The source string must contain at least \fIindex\fR characters. .PP \fBTcl_UtfAtIndex\fR returns a pointer to the specified character (not byte) \fIindex\fR in the UTF-8 string \fIsrc\fR. The source string must contain at least \fIindex\fR characters. This is equivalent to calling \fBTcl_UtfNext\fR \fIindex\fR times. If \fIindex\fR is TCL_INDEX_NONE, the return pointer points to the first character in the source string. .PP \fBTcl_UtfBackslash\fR is a utility procedure used by several of the Tcl commands. It parses a backslash sequence and stores the properly formed UTF-8 character represented by the backslash sequence in the output buffer \fIdst\fR. At most \fBTCL_UTF_MAX\fR bytes are stored in the buffer. \fBTcl_UtfBackslash\fR modifies \fI*readPtr\fR to contain the number |
︙ | ︙ |
Changes to doc/coroutine.n.
︙ | ︙ | |||
10 11 12 13 14 15 16 | '\" Note: do not modify the .SH NAME line immediately below! .SH NAME coroutine, yield, yieldto \- Create and produce values from coroutines .SH SYNOPSIS .nf \fBcoroutine \fIname command\fR ?\fIarg...\fR? \fByield\fR ?\fIvalue\fR? | < > | > > > | 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | '\" Note: do not modify the .SH NAME line immediately below! .SH NAME coroutine, yield, yieldto \- Create and produce values from coroutines .SH SYNOPSIS .nf \fBcoroutine \fIname command\fR ?\fIarg...\fR? \fByield\fR ?\fIvalue\fR? \fByieldto\fR \fIcommand\fR ?\fIarg...\fR? \fIname\fR ?\fIvalue...\fR? .sp .VS "8.7, TIP383" \fBcoroinject \fIcoroName command\fR ?\fIarg...\fR? \fBcoroprobe \fIcoroName command\fR ?\fIarg...\fR? .VE "8.7, TIP383" .fi .BE .SH DESCRIPTION .PP The \fBcoroutine\fR command creates a new coroutine context (with associated command) named \fIname\fR and executes that context by calling \fIcommand\fR, passing in the other remaining arguments without further interpretation. Once |
︙ | ︙ | |||
35 36 37 38 39 40 41 | of the context can then be resumed by calling the context command, optionally passing in the \fIsingle\fR value to use as the result of the \fByield\fR call that caused the context to be suspended. If the coroutine context never yields and instead returns conventionally, the result of the \fBcoroutine\fR command will be the result of the evaluation of the context. .PP | < | | < > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 | of the context can then be resumed by calling the context command, optionally passing in the \fIsingle\fR value to use as the result of the \fByield\fR call that caused the context to be suspended. If the coroutine context never yields and instead returns conventionally, the result of the \fBcoroutine\fR command will be the result of the evaluation of the context. .PP The coroutine may also suspend its execution by use of the \fByieldto\fR command, which instead of returning, cedes execution to some command called \fIcommand\fR (resolved in the context of the coroutine) and to which \fIany number\fR of arguments may be passed. Since every coroutine has a context command, \fByieldto\fR can be used to transfer control directly from one coroutine to another (this is only advisable if the two coroutines are expecting this to happen) but \fIany\fR command may be the target. If a coroutine is suspended by this mechanism, the coroutine processing can be resumed by calling the context command optionally passing in an arbitrary number of arguments. The return value of the \fByieldto\fR call will be the list of arguments passed to the context command; it is up to the caller to decide what to do with those values. .PP The recommended way of writing a version of \fByield\fR that allows resumption with multiple arguments is by using \fByieldto\fR and the \fBreturn\fR command, like this: .PP .CS proc yieldMultiple {value} { tailcall \fByieldto\fR string cat $value } .CE .PP The coroutine can also be deleted by destroying the command \fIname\fR, and the name of the current coroutine can be retrieved by using \fBinfo coroutine\fR. If there are deletion traces on variables in the coroutine's implementation, they will fire at the point when the coroutine is explicitly deleted (or, naturally, if the command returns conventionally). .PP At the point when \fIcommand\fR is called, the current namespace will be the global namespace and there will be no stack frames above it (in the sense of \fBupvar\fR and \fBuplevel\fR). However, which command to call will be determined in the namespace that the \fBcoroutine\fR command was called from. .PP .VS "8.7, TIP383" A suspended coroutine (i.e., one that has \fByield\fRed or \fByieldto\fR-d) may have its state inspected (or modified) at that point by using \fBcoroprobe\fR to run a command at the point where the coroutine is at. The command takes the name of the coroutine to run the command in, \fIcoroName\fR, and the name of a command (any any arguments it requires) to immediately run at that point. The result of that command is the result of the \fBcoroprobe\fR command, and the gross state of the coroutine remains the same afterwards (i.e., the coroutine is still expecting the results of a \fByield\fR or \fByieldto\fR as before) though variables may have been changed. .PP Similarly, the \fBcoroinject\fR command may be used to place a command to be run inside a suspended coroutine (when it is resumed) to process arguments, with quite a bit of similarity to \fBcoroprobe\fR. However, with \fBcoroinject\fR there are several key differences: .VE "8.7, TIP383" .IP \(bu .VS "8.7, TIP383" The coroutine is not immediately resumed after the injection has been done. A consequence of this is that multiple injections may be done before the coroutine is resumed. There injected commands are performed in \fIreverse order of definition\fR (that is, they are internally stored on a stack). .VE "8.7, TIP383" .IP \(bu .VS "8.7, TIP383" An additional two arguments are appended to the list of arguments to be run (that is, the \fIcommand\fR and its \fIargs\fR are extended by two elements). The first is the name of the command that suspended the coroutine (\fByield\fR or \fByieldto\fR), and the second is the argument (or list of arguments, in the case of \fByieldto\fR) that is the current resumption value. .VE "8.7, TIP383" .IP \(bu .VS "8.7, TIP383" The result of the injected command is used as the result of the \fByield\fR or \fByieldto\fR that caused the coroutine to become suspended. Where there are multiple injected commands, the result of one becomes the resumption value processed by the next. .PP The injection is a one-off. It is not retained once it has been executed. It may \fByield\fR or \fByieldto\fR as part of its execution. .PP Note that running coroutines may be neither probed nor injected; the operations may only be applied to .VE "8.7, TIP383" .SH EXAMPLES .PP This example shows a coroutine that will produce an infinite sequence of even values, and a loop that consumes the first ten of them. .PP .CS proc allNumbers {} { |
︙ | ︙ | |||
134 135 136 137 138 139 140 | } }} allNumbers for {set i 1} {$i <= 20} {incr i} { puts "prime#$i = [\fIeratosthenes\fR]" } .CE .PP | < | > > > > > > > > > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > | 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 | } }} allNumbers for {set i 1} {$i <= 20} {incr i} { puts "prime#$i = [\fIeratosthenes\fR]" } .CE .PP This example shows how a value can be passed around a group of three coroutines that yield to each other: .PP .CS proc juggler {name target {value ""}} { if {$value eq ""} { set value [\fByield\fR [info coroutine]] } while {$value ne ""} { puts "$name : $value" set value [string range $value 0 end-1] lassign [\fByieldto\fR \fI$target\fR $value] value } } \fBcoroutine\fR j1 juggler Larry [ \fBcoroutine\fR j2 juggler Curly [ \fBcoroutine\fR j3 juggler Moe j1]] "Nyuck!Nyuck!Nyuck!" .CE .PP .VS "8.7, TIP383" This example shows a simple coroutine that collects non-empty values and returns a list of them when not given an argument. It also shows how we can look inside the coroutine to find out what it is doing, and how we can modify the input on a one-off basis. .PP .CS proc collectorImpl {} { set me [info coroutine] set accumulator {} for {set val [\fByield\fR $me]} {$val ne ""} {set val [\fByield\fR]} { lappend accumulator $val } return $accumulator } \fBcoroutine\fR collect collectorImpl \fIcollect\fR 123 \fIcollect\fR "abc def" \fIcollect\fR 456 puts [\fBcoroprobe \fIcollect\fR set accumulator] # ==> 123 {abc def} 456 \fIcollect\fR "pqr" \fBcoroinject \fIcollect\fR apply {{type value} { puts "Received '$value' at a $type in [info coroutine]" return [string toupper $value] }} \fIcollect\fR rst # ==> Received 'rst' at a yield in ::collect \fIcollect\fR xyz puts [\fIcollect\fR] # ==> 123 {abc def} 456 pqr RST xyz .CE .PP This example shows a simple coroutine that collects non-empty values and returns a list of them when not given an argument. It also shows how we can look inside the coroutine to find out what it is doing. .VE "8.7, TIP383" .SS "DETAILED SEMANTICS" .PP This example demonstrates that coroutines start from the global namespace, and that \fIcommand\fR resolution happens before the coroutine stack is created. .PP .CS proc report {where level} { |
︙ | ︙ |
Changes to doc/expr.n.
︙ | ︙ | |||
91 92 93 94 95 96 97 | \fBTcl\fR. .PP Below are some examples of simple expressions where the value of \fBa\fR is 3 and the value of \fBb\fR is 6. The command on the left side of each line produces the value on the right side. .PP .CS | | | 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 | \fBTcl\fR. .PP Below are some examples of simple expressions where the value of \fBa\fR is 3 and the value of \fBb\fR is 6. The command on the left side of each line produces the value on the right side. .PP .CS .ta 9c \fBexpr\fR 3.1 + $a \fI6.1\fR \fBexpr\fR 2 + "$a.$b" \fI5.6\fR \fBexpr\fR 4*[llength "6 2"] \fI8\fR \fBexpr\fR {{word one} < "word $a"} \fI0\fR .CE .SS OPERATORS .PP |
︙ | ︙ | |||
184 185 186 187 188 189 190 | \fB|\fR . Bit-wise OR. Valid for integer operands. .TP 20 \fB&&\fR . Logical AND. If both operands are true, the result is 1, or 0 otherwise. | | > > > > > | > > | 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 | \fB|\fR . Bit-wise OR. Valid for integer operands. .TP 20 \fB&&\fR . Logical AND. If both operands are true, the result is 1, or 0 otherwise. This operator evaluates lazily; it only evaluates its second operand if it must in order to determine its result. This operator evaluates lazily; it only evaluates its second operand if it must in order to determine its result. .TP 20 \fB||\fR . Logical OR. If both operands are false, the result is 0, or 1 otherwise. This operator evaluates lazily; it only evaluates its second operand if it must in order to determine its result. .TP 20 \fIx \fB?\fI y \fB:\fI z\fR . If-then-else, as in C. If \fIx\fR is false , the result is the value of \fIy\fR. Otherwise the result is the value of \fIz\fR. This operator evaluates lazily; it evaluates only one of \fIy\fR or \fIz\fR. .PP The exponentiation operator promotes types in the same way that the multiply and divide operators do, and the result is is the same as the result of \fBpow\fR. Exponentiation groups right-to-left within a precedence level. Other binary operators group left-to-right. For example, the value of .PP .PP .CS \fBexpr\fR {4*2 < 7} .CE .PP is 0, while the value of .PP |
︙ | ︙ | |||
331 332 333 334 335 336 337 | substitutions on, enclosing an expression in braces or otherwise quoting it so that it's a static value allows the Tcl compiler to generate bytecode for the expression, resulting in better speed and smaller storage requirements. This also avoids issues that can arise if Tcl is allowed to perform substitution on the value before \fBexpr\fR is called. .PP In the following example, the value of the expression is 11 because the Tcl parser first | | > > > | > > < | | > > > > > > > > > > > > > > > > > > > > > > | 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 | substitutions on, enclosing an expression in braces or otherwise quoting it so that it's a static value allows the Tcl compiler to generate bytecode for the expression, resulting in better speed and smaller storage requirements. This also avoids issues that can arise if Tcl is allowed to perform substitution on the value before \fBexpr\fR is called. .PP In the following example, the value of the expression is 11 because the Tcl parser first substitutes \fB$b\fR and \fBexpr\fR then substitutes \fB$a\fR as part of evaluating the expression .QW "$a + 2*4" . Enclosing the expression in braces would result in a syntax error as \fB$b\fR does not evaluate to a numeric value. .PP .CS set a 3 set b {$a + 2} \fBexpr\fR $b*4 .CE .PP When an expression is generated at runtime, like the one above is, the bytecode compiler must ensure that new code is generated each time the expression is evaluated. This is the most costly kind of expression from a performance perspective. In such cases, consider directly using the commands described in the \fBmathfunc\fR(n) or \fBmathop\fR(n) documentation instead of \fBexpr\fR. .PP Most expressions are not formed at runtime, but are literal strings or contain substitutions that don't introduce other substitutions. To allow the bytecode compiler to work with an expression as a string literal at compilation time, ensure that it contains no substitutions or that it is enclosed in braces or otherwise quoted to prevent Tcl from performing substitutions, allowing \fBexpr\fR to perform them instead. .PP If it is necessary to include a non-constant expression string within the wider context of an otherwise-constant expression, the most efficient technique is to put the varying part inside a recursive \fBexpr\fR, as this at least allows for the compilation of the outer part, though it does mean that the varying part must itself be evaluated as a separate expression. Thus, in this example the result is 20 and the outer expression benefits from fully cached bytecode compilation. .PP .CS set a 3 set b {$a + 2} \fBexpr\fR {[\fBexpr\fR $b] * 4} .CE .PP In general, you should enclose your expression in braces wherever possible, and where not possible, the argument to \fBexpr\fR should be an expression defined elsewhere as simply as possible. It is usually more efficient and safer to use other techniques (e.g., the commands in the \fBtcl::mathop\fR namespace) than it is to do complex expression generation. .SH EXAMPLES .PP A numeric comparison whose result is 1: .PP .CS \fBexpr\fR {"0x03" > "2"} .CE .PP A string comparison whose result is 1: .PP .CS \fBexpr\fR {"0y" > "0x12"} .CE .PP Define a procedure that computes an .QW interesting mathematical function: |
︙ | ︙ |
Changes to doc/file.n.
︙ | ︙ | |||
428 429 430 431 432 433 434 435 436 437 438 439 440 441 | \fBfile tail \fIname\fR . Returns all of the characters in the last filesystem component of \fIname\fR. Any trailing directory separator in \fIname\fR is ignored. If \fIname\fR contains no separators then returns \fIname\fR. So, \fBfile tail a/b\fR, \fBfile tail a/b/\fR and \fBfile tail b\fR all return \fBb\fR. .TP \fBfile tempfile\fR ?\fInameVar\fR? ?\fItemplate\fR? '\" TIP #210 .VS 8.6 Creates a temporary file and returns a read-write channel opened on that file. If the \fInameVar\fR is given, it specifies a variable that the name of the temporary file will be written into; if absent, Tcl will attempt to arrange | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 | \fBfile tail \fIname\fR . Returns all of the characters in the last filesystem component of \fIname\fR. Any trailing directory separator in \fIname\fR is ignored. If \fIname\fR contains no separators then returns \fIname\fR. So, \fBfile tail a/b\fR, \fBfile tail a/b/\fR and \fBfile tail b\fR all return \fBb\fR. .TP \fBfile tempdir\fR ?\fItemplate\fR? .VS "8.7, TIP 431" Creates a temporary directory (guaranteed to be newly created and writable by the current script) and returns its name. If \fItemplate\fR is given, it specifies one of or both of the existing directory (on a filesystem controlled by the operating system) to contain the temporary directory, and the base part of the directory name; it is considered to have the location of the directory if there is a directory separator in the name, and the base part is everything after the last directory separator (if non-empty). The default containing directory is determined by system-specific operations, and the default base name prefix is .QW \fBtcl\fR . .RS .PP The following output is typical and illustrative; the actual output will vary between platforms: .PP .CS % \fBfile tempdir\fR /var/tmp/tcl_u0kuy5 % \fBfile tempdir\fR /tmp/myapp /tmp/myapp_8o7r9L % \fBfile tempdir\fR /tmp/ /tmp/tcl_1mOJHD % \fBfile tempdir\fR myapp /var/tmp/myapp_0ihS0n .CE .RE .VE "8.7, TIP 431" .TP \fBfile tempfile\fR ?\fInameVar\fR? ?\fItemplate\fR? '\" TIP #210 .VS 8.6 Creates a temporary file and returns a read-write channel opened on that file. If the \fInameVar\fR is given, it specifies a variable that the name of the temporary file will be written into; if absent, Tcl will attempt to arrange |
︙ | ︙ |
Changes to doc/timerate.n.
︙ | ︙ | |||
37 38 39 40 41 42 43 | by the maximal number of iterations to evaluate the script. If \fImax-count\fR is specified, the evalution will stop either this count of iterations is reached or the time is exceeded. .sp It will then return a canonical tcl-list of the form: .PP .CS | | | 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 | by the maximal number of iterations to evaluate the script. If \fImax-count\fR is specified, the evalution will stop either this count of iterations is reached or the time is exceeded. .sp It will then return a canonical tcl-list of the form: .PP .CS \fB0.095977 \(mcs/# 52095836 # 10419167 #/sec 5000.000 net-ms\fR .CE .PP which indicates: .IP \(bu 3 the average amount of time required per iteration, in microseconds ([\fBlindex\fR $result 0]) .IP \(bu 3 the count how many times it was executed ([\fBlindex\fR $result 2]) |
︙ | ︙ |
Changes to generic/regcomp.c.
︙ | ︙ | |||
334 335 336 337 338 339 340 | v->cv = NULL; v->cv2 = NULL; v->lacons = NULL; v->nlacons = 0; v->spaceused = 0; re->re_magic = REMAGIC; re->re_info = 0; /* bits get set during parse */ | < | 334 335 336 337 338 339 340 341 342 343 344 345 346 347 | v->cv = NULL; v->cv2 = NULL; v->lacons = NULL; v->nlacons = 0; v->spaceused = 0; re->re_magic = REMAGIC; re->re_info = 0; /* bits get set during parse */ re->re_guts = NULL; re->re_fns = (void*)(&functions); /* * More complex setup, malloced things. */ |
︙ | ︙ | |||
2081 2082 2083 2084 2085 2086 2087 | g = (struct guts *) re->re_guts; if (g->magic != GUTSMAGIC) { fprintf(f, "bad guts magic number (0x%x not 0x%x)\n", g->magic, GUTSMAGIC); } fprintf(f, "\n\n\n========= DUMP ==========\n"); | | | | 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 | g = (struct guts *) re->re_guts; if (g->magic != GUTSMAGIC) { fprintf(f, "bad guts magic number (0x%x not 0x%x)\n", g->magic, GUTSMAGIC); } fprintf(f, "\n\n\n========= DUMP ==========\n"); fprintf(f, "nsub %" TCL_Z_MODIFIER "d, info 0%lo, ntree %d\n", re->re_nsub, re->re_info, g->ntree); dumpcolors(&g->cmap, f); if (!NULLCNFA(g->search)) { fprintf(f, "\nsearch:\n"); dumpcnfa(&g->search, f); } for (i = 1; i < g->nlacons; i++) { |
︙ | ︙ |
Changes to generic/regex.h.
︙ | ︙ | |||
113 114 115 116 117 118 119 | /* * other interface types */ /* the biggie, a compiled RE (or rather, a front end to same) */ typedef struct { int re_magic; /* magic number */ | < > < | | | 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 | /* * other interface types */ /* the biggie, a compiled RE (or rather, a front end to same) */ typedef struct { int re_magic; /* magic number */ long re_info; /* information about RE */ size_t re_nsub; /* number of subexpressions */ #define REG_UBACKREF 000001 #define REG_ULOOKAHEAD 000002 #define REG_UBOUNDS 000004 #define REG_UBRACES 000010 #define REG_UBSALNUM 000020 #define REG_UPBOTCH 000040 #define REG_UBBS 000100 #define REG_UNONPOSIX 000200 #define REG_UUNSPEC 000400 #define REG_UUNPORT 001000 #define REG_ULOCALE 002000 #define REG_UEMPTYMATCH 004000 #define REG_UIMPOSSIBLE 010000 #define REG_USHORTEST 020000 char *re_endp; /* backward compatibility kludge */ /* the rest is opaque pointers to hidden innards */ char *re_guts; /* `char *' is more portable than `void *' */ char *re_fns; } regex_t; /* result reporting (may acquire more fields later) */ typedef struct { size_t rm_so; /* start of substring */ size_t rm_eo; /* end of substring */ } regmatch_t; /* supplementary control and reporting */ typedef struct { regmatch_t rm_extend; /* see REG_EXPECT */ } rm_detail_t; |
︙ | ︙ |
Changes to generic/regexec.c.
︙ | ︙ | |||
183 184 185 186 187 188 189 | * Sanity checks. */ if (re == NULL || string == NULL || re->re_magic != REMAGIC) { FreeVars(v); return REG_INVARG; } | < < < < | 183 184 185 186 187 188 189 190 191 192 193 194 195 196 | * Sanity checks. */ if (re == NULL || string == NULL || re->re_magic != REMAGIC) { FreeVars(v); return REG_INVARG; } /* * Setup. */ v->re = re; v->g = (struct guts *)re->re_guts; |
︙ | ︙ | |||
885 886 887 888 889 890 891 | assert(t->op == 'b'); assert(n >= 0); assert((size_t)n < v->nmatch); MDEBUG(("cbackref n%d %d{%d-%d}\n", t->id, n, min, max)); /* get the backreferenced string */ | | | 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 | assert(t->op == 'b'); assert(n >= 0); assert((size_t)n < v->nmatch); MDEBUG(("cbackref n%d %d{%d-%d}\n", t->id, n, min, max)); /* get the backreferenced string */ if (v->pmatch[n].rm_so == TCL_INDEX_NONE) { return REG_NOMATCH; } brstring = v->start + v->pmatch[n].rm_so; brlen = v->pmatch[n].rm_eo - v->pmatch[n].rm_so; /* special cases for zero-length strings */ if (brlen == 0) { |
︙ | ︙ |
Changes to generic/tcl.decls.
︙ | ︙ | |||
2432 2433 2434 2435 2436 2437 2438 | declare 643 { int Tcl_IsShared(Tcl_Obj *objPtr) } # TIP#312 New Tcl_LinkArray() function declare 644 { int Tcl_LinkArray(Tcl_Interp *interp, const char *varName, void *addr, | | > > > > > | 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 | declare 643 { int Tcl_IsShared(Tcl_Obj *objPtr) } # TIP#312 New Tcl_LinkArray() function declare 644 { int Tcl_LinkArray(Tcl_Interp *interp, const char *varName, void *addr, int type, size_t size) } declare 645 { int Tcl_GetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, size_t endValue, size_t *indexPtr) } # ----- BASELINE -- FOR -- 8.7.0 ----- # ############################################################################## # Define the platform specific public Tcl interface. These functions are only |
︙ | ︙ |
Changes to generic/tcl.h.
︙ | ︙ | |||
455 456 457 458 459 460 461 | /* * Structures filled in by Tcl_RegExpInfo. Note that all offset values are * relative to the start of the match string, not the beginning of the entire * string. */ typedef struct Tcl_RegExpIndices { | | | | | < | 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 | /* * Structures filled in by Tcl_RegExpInfo. Note that all offset values are * relative to the start of the match string, not the beginning of the entire * string. */ typedef struct Tcl_RegExpIndices { size_t start; /* Character offset of first character in * match. */ size_t end; /* Character offset of first character after * the match. */ } Tcl_RegExpIndices; typedef struct Tcl_RegExpInfo { size_t nsubs; /* Number of subexpressions in the compiled * expression. */ Tcl_RegExpIndices *matches; /* Array of nsubs match offset pairs. */ size_t extendStart; /* The offset at which a subsequent match * might begin. */ } Tcl_RegExpInfo; /* * Picky compilers complain if this typdef doesn't appear before the struct's * reference in tclDecls.h. */ |
︙ | ︙ | |||
2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 | /* * Constants for special size_t-typed values, see TIP #494 */ #define TCL_IO_FAILURE ((size_t)-1) #define TCL_AUTO_LENGTH ((size_t)-1) /* *---------------------------------------------------------------------------- * Single public declaration for NRE. */ typedef int (Tcl_NRPostProc) (void *data[], Tcl_Interp *interp, | > | 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 | /* * Constants for special size_t-typed values, see TIP #494 */ #define TCL_IO_FAILURE ((size_t)-1) #define TCL_AUTO_LENGTH ((size_t)-1) #define TCL_INDEX_NONE ((size_t)-1) /* *---------------------------------------------------------------------------- * Single public declaration for NRE. */ typedef int (Tcl_NRPostProc) (void *data[], Tcl_Interp *interp, |
︙ | ︙ |
Changes to generic/tclAssembly.c.
︙ | ︙ | |||
511 512 513 514 515 516 517 518 519 520 521 522 523 524 | * The instructions must be in ascending order by numeric operation code. */ static const unsigned char NonThrowingByteCodes[] = { INST_PUSH1, INST_PUSH4, INST_POP, INST_DUP, /* 1-4 */ INST_JUMP1, INST_JUMP4, /* 34-35 */ INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE, /* 70-72 */ INST_LIST, /* 79 */ INST_OVER, /* 95 */ INST_PUSH_RETURN_OPTIONS, /* 108 */ INST_REVERSE, /* 126 */ INST_NOP, /* 132 */ INST_STR_MAP, /* 143 */ INST_STR_FIND, /* 144 */ | > | 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 | * The instructions must be in ascending order by numeric operation code. */ static const unsigned char NonThrowingByteCodes[] = { INST_PUSH1, INST_PUSH4, INST_POP, INST_DUP, /* 1-4 */ INST_JUMP1, INST_JUMP4, /* 34-35 */ INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE, /* 70-72 */ INST_STR_EQ, INST_STR_NEQ, INST_STR_CMP, INST_STR_LEN, /* 73-76 */ INST_LIST, /* 79 */ INST_OVER, /* 95 */ INST_PUSH_RETURN_OPTIONS, /* 108 */ INST_REVERSE, /* 126 */ INST_NOP, /* 132 */ INST_STR_MAP, /* 143 */ INST_STR_FIND, /* 144 */ |
︙ | ︙ |
Changes to generic/tclBasic.c.
︙ | ︙ | |||
151 152 153 154 155 156 157 | static Tcl_NRPostProc TEOV_Exception; static Tcl_NRPostProc TEOV_NotFoundCallback; static Tcl_NRPostProc TEOV_RestoreVarFrame; static Tcl_NRPostProc TEOV_RunLeaveTraces; static Tcl_NRPostProc EvalObjvCore; static Tcl_NRPostProc Dispatch; | | > > > > | 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 | static Tcl_NRPostProc TEOV_Exception; static Tcl_NRPostProc TEOV_NotFoundCallback; static Tcl_NRPostProc TEOV_RestoreVarFrame; static Tcl_NRPostProc TEOV_RunLeaveTraces; static Tcl_NRPostProc EvalObjvCore; static Tcl_NRPostProc Dispatch; static Tcl_ObjCmdProc NRInjectObjCmd; static Tcl_NRPostProc NRPostInvoke; static Tcl_ObjCmdProc CoroTypeObjCmd; static Tcl_ObjCmdProc TclNRCoroInjectObjCmd; static Tcl_ObjCmdProc TclNRCoroProbeObjCmd; static Tcl_NRPostProc InjectHandler; static Tcl_NRPostProc InjectHandlerPostCall; MODULE_SCOPE const TclStubs tclStubs; /* * Magical counts for the number of arguments accepted by a coroutine command * after particular kinds of [yield]. */ |
︙ | ︙ | |||
220 221 222 223 224 225 226 227 228 229 230 231 232 233 | {"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, CMD_IS_SAFE}, {"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, CMD_IS_SAFE}, {"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, CMD_IS_SAFE}, {"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE}, {"concat", Tcl_ConcatObjCmd, TclCompileConcatCmd, NULL, CMD_IS_SAFE}, {"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, CMD_IS_SAFE}, {"coroutine", NULL, NULL, TclNRCoroutineObjCmd, CMD_IS_SAFE}, {"error", Tcl_ErrorObjCmd, TclCompileErrorCmd, NULL, CMD_IS_SAFE}, {"eval", Tcl_EvalObjCmd, NULL, TclNREvalObjCmd, CMD_IS_SAFE}, {"expr", Tcl_ExprObjCmd, TclCompileExprCmd, TclNRExprObjCmd, CMD_IS_SAFE}, {"for", Tcl_ForObjCmd, TclCompileForCmd, TclNRForObjCmd, CMD_IS_SAFE}, {"foreach", Tcl_ForeachObjCmd, TclCompileForeachCmd, TclNRForeachCmd, CMD_IS_SAFE}, {"format", Tcl_FormatObjCmd, TclCompileFormatCmd, NULL, CMD_IS_SAFE}, | > > | 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 | {"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, CMD_IS_SAFE}, {"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, CMD_IS_SAFE}, {"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, CMD_IS_SAFE}, {"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE}, {"concat", Tcl_ConcatObjCmd, TclCompileConcatCmd, NULL, CMD_IS_SAFE}, {"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, CMD_IS_SAFE}, {"coroinject", NULL, NULL, TclNRCoroInjectObjCmd, CMD_IS_SAFE}, {"coroprobe", NULL, NULL, TclNRCoroProbeObjCmd, CMD_IS_SAFE}, {"coroutine", NULL, NULL, TclNRCoroutineObjCmd, CMD_IS_SAFE}, {"error", Tcl_ErrorObjCmd, TclCompileErrorCmd, NULL, CMD_IS_SAFE}, {"eval", Tcl_EvalObjCmd, NULL, TclNREvalObjCmd, CMD_IS_SAFE}, {"expr", Tcl_ExprObjCmd, TclCompileExprCmd, TclNRExprObjCmd, CMD_IS_SAFE}, {"for", Tcl_ForObjCmd, TclCompileForCmd, TclNRForObjCmd, CMD_IS_SAFE}, {"foreach", Tcl_ForeachObjCmd, TclCompileForeachCmd, TclNRForeachCmd, CMD_IS_SAFE}, {"format", Tcl_FormatObjCmd, TclCompileFormatCmd, NULL, CMD_IS_SAFE}, |
︙ | ︙ | |||
343 344 345 346 347 348 349 350 351 352 353 354 355 356 | {"file", "readable"}, {"file", "readlink"}, {"file", "rename"}, {"file", "rootname"}, {"file", "size"}, {"file", "stat"}, {"file", "tail"}, {"file", "tempfile"}, {"file", "type"}, {"file", "volumes"}, {"file", "writable"}, /* [info] has two unsafe commands */ {"info", "cmdtype"}, {"info", "nameofexecutable"}, | > | 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 | {"file", "readable"}, {"file", "readlink"}, {"file", "rename"}, {"file", "rootname"}, {"file", "size"}, {"file", "stat"}, {"file", "tail"}, {"file", "tempdir"}, {"file", "tempfile"}, {"file", "type"}, {"file", "volumes"}, {"file", "writable"}, /* [info] has two unsafe commands */ {"info", "cmdtype"}, {"info", "nameofexecutable"}, |
︙ | ︙ | |||
570 571 572 573 574 575 576 | } #if defined(_WIN32) && !defined(_WIN64) if (sizeof(time_t) != 4) { /*NOTREACHED*/ Tcl_Panic("<time.h> is not compatible with MSVC"); } | | | | 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 | } #if defined(_WIN32) && !defined(_WIN64) if (sizeof(time_t) != 4) { /*NOTREACHED*/ Tcl_Panic("<time.h> is not compatible with MSVC"); } if ((offsetof(Tcl_StatBuf,st_atime) != 32) || (offsetof(Tcl_StatBuf,st_ctime) != 40)) { /*NOTREACHED*/ Tcl_Panic("<sys/stat.h> is not compatible with MSVC"); } #endif if (cancelTableInitialized == 0) { Tcl_MutexLock(&cancelLock); |
︙ | ︙ | |||
937 938 939 940 941 942 943 | cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::tcl::unsupported::assemble", Tcl_AssembleObjCmd, TclNRAssembleObjCmd, NULL, NULL); cmdPtr->compileProc = &TclCompileAssembleCmd; /* Coroutine monkeybusiness */ Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL, | | | 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 | cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::tcl::unsupported::assemble", Tcl_AssembleObjCmd, TclNRAssembleObjCmd, NULL, NULL); cmdPtr->compileProc = &TclCompileAssembleCmd; /* Coroutine monkeybusiness */ Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL, NRInjectObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "::tcl::unsupported::corotype", CoroTypeObjCmd, NULL, NULL); /* Export unsupported commands */ nsPtr = Tcl_FindNamespace(interp, "::tcl::unsupported", NULL, 0); if (nsPtr) { Tcl_Export(interp, nsPtr, "*", 1); |
︙ | ︙ | |||
8505 8506 8507 8508 8509 8510 8511 | return TCL_ERROR; } } /* *---------------------------------------------------------------------- * | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | < | < < | < | < < | 8512 8513 8514 8515 8516 8517 8518 8519 8520 8521 8522 8523 8524 8525 8526 8527 8528 8529 8530 8531 8532 8533 8534 8535 8536 8537 8538 8539 8540 8541 8542 8543 8544 8545 8546 8547 8548 8549 8550 8551 8552 8553 8554 8555 8556 8557 8558 8559 8560 8561 8562 8563 8564 8565 8566 8567 8568 8569 8570 8571 8572 8573 8574 8575 8576 8577 8578 8579 8580 8581 8582 8583 8584 8585 8586 8587 8588 8589 8590 8591 8592 8593 8594 8595 8596 8597 8598 8599 8600 8601 8602 8603 8604 8605 8606 8607 8608 8609 8610 8611 8612 8613 8614 8615 8616 8617 8618 8619 8620 8621 8622 8623 8624 8625 8626 8627 8628 8629 8630 8631 8632 8633 8634 8635 8636 8637 8638 8639 8640 8641 8642 8643 8644 8645 8646 8647 8648 8649 8650 8651 8652 8653 8654 8655 8656 8657 8658 8659 8660 8661 8662 8663 8664 8665 8666 8667 8668 8669 8670 8671 8672 8673 8674 8675 8676 8677 8678 8679 8680 8681 8682 8683 8684 8685 8686 8687 8688 8689 8690 8691 8692 8693 8694 8695 8696 8697 8698 8699 8700 8701 8702 8703 8704 8705 8706 8707 8708 8709 8710 8711 8712 8713 8714 8715 8716 8717 8718 8719 8720 8721 8722 8723 8724 8725 8726 8727 8728 8729 8730 8731 8732 8733 8734 8735 8736 8737 8738 8739 8740 8741 8742 8743 8744 8745 8746 8747 8748 8749 8750 8751 8752 8753 8754 8755 8756 8757 8758 8759 8760 8761 8762 8763 8764 8765 8766 8767 8768 8769 8770 8771 8772 8773 8774 8775 8776 8777 8778 8779 8780 8781 8782 8783 8784 8785 8786 8787 8788 8789 8790 8791 8792 8793 8794 8795 8796 8797 8798 8799 8800 8801 8802 8803 8804 8805 8806 8807 8808 8809 8810 8811 8812 8813 8814 8815 8816 | return TCL_ERROR; } } /* *---------------------------------------------------------------------- * * TclNRCoroInjectObjCmd, TclNRCoroProbeObjCmd -- * * Implementation of [coroinject] and [coroprobe] commands. * *---------------------------------------------------------------------- */ static inline CoroutineData * GetCoroutineFromObj( Tcl_Interp *interp, Tcl_Obj *objPtr, const char *errMsg) { /* * How to get a coroutine from its handle. */ Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", TclGetString(objPtr), NULL); return NULL; } return cmdPtr->objClientData; } static int TclNRCoroInjectObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { CoroutineData *corPtr; ExecEnv *savedEEPtr = iPtr->execEnvPtr; /* * Usage more or less like tailcall: * coroinject coroName cmd ?arg1 arg2 ...? */ if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?"); return TCL_ERROR; } corPtr = GetCoroutineFromObj(interp, objv[1], "can only inject a command into a coroutine"); if (!corPtr) { return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can only inject a command into a suspended coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", NULL); return TCL_ERROR; } /* * Add the callback to the coro's execEnv, so that it is the first thing * to happen when the coro is resumed. */ iPtr->execEnvPtr = corPtr->eePtr; TclNRAddCallback(interp, InjectHandler, corPtr, Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), NULL); iPtr->execEnvPtr = savedEEPtr; return TCL_OK; } static int TclNRCoroProbeObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { CoroutineData *corPtr; ExecEnv *savedEEPtr = iPtr->execEnvPtr; int numLevels, unused; int *stackLevel = &unused; /* * Usage more or less like tailcall: * coroprobe coroName cmd ?arg1 arg2 ...? */ if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?"); return TCL_ERROR; } corPtr = GetCoroutineFromObj(interp, objv[1], "can only inject a probe command into a coroutine"); if (!corPtr) { return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can only inject a probe command into a suspended coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", NULL); return TCL_ERROR; } /* * Add the callback to the coro's execEnv, so that it is the first thing * to happen when the coro is resumed. */ iPtr->execEnvPtr = corPtr->eePtr; TclNRAddCallback(interp, InjectHandler, corPtr, Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), corPtr); iPtr->execEnvPtr = savedEEPtr; /* * Now we immediately transfer control to the coroutine to run our probe. * TRICKY STUFF copied from the [yield] implementation. * * Push the callback to restore the caller's context on yield back. */ TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, NULL, NULL, NULL); /* * Record the stackLevel at which the resume is happening, then swap * the interp's environment to make it suitable to run this coroutine. */ corPtr->stackLevel = stackLevel; numLevels = corPtr->auxNumLevels; corPtr->auxNumLevels = iPtr->numLevels; /* * Do the actual stack swap. */ SAVE_CONTEXT(corPtr->caller); corPtr->callerEEPtr = iPtr->execEnvPtr; RESTORE_CONTEXT(corPtr->running); iPtr->execEnvPtr = corPtr->eePtr; iPtr->numLevels += numLevels; return TCL_OK; } /* *---------------------------------------------------------------------- * * InjectHandler, InjectHandlerPostProc -- * * Part of the implementation of [coroinject] and [coroprobe]. These are * run inside the context of the coroutine being injected/probed into. * * InjectHandler runs a script (possibly adding arguments) in the context * of the coroutine. The script is specified as a one-shot list (with * reference count equal to 1) in data[1]. This function also arranges * for InjectHandlerPostProc to be the part that runs after the script * completes. * * InjectHandlerPostProc cleans up after InjectHandler (deleting the * list) and, for the [coroprobe] command *only*, yields back to the * caller context (i.e., where [coroprobe] was run). *s *---------------------------------------------------------------------- */ static int InjectHandler( ClientData data[], Tcl_Interp *interp, int result) { CoroutineData *corPtr = data[0]; Tcl_Obj *listPtr = data[1]; int nargs = PTR2INT(data[2]); ClientData isProbe = data[3]; int objc; Tcl_Obj **objv; if (!isProbe) { /* * If this is [coroinject], add the extra arguments now. */ if (nargs == COROUTINE_ARGUMENTS_SINGLE_OPTIONAL) { Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj("yield", -1)); } else if (nargs == COROUTINE_ARGUMENTS_ARBITRARY) { Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj("yieldto", -1)); } else { /* * I don't think this is reachable... */ Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewIntObj(nargs)); } Tcl_ListObjAppendElement(NULL, listPtr, Tcl_GetObjResult(interp)); } /* * Call the user's script; we're in the right place. */ Tcl_IncrRefCount(listPtr); TclMarkTailcall(interp); TclNRAddCallback(interp, InjectHandlerPostCall, corPtr, listPtr, INT2PTR(nargs), isProbe); TclListObjGetElements(NULL, listPtr, &objc, &objv); return TclNREvalObjv(interp, objc, objv, 0, NULL); } static int InjectHandlerPostCall( ClientData data[], Tcl_Interp *interp, int result) { CoroutineData *corPtr = data[0]; Tcl_Obj *listPtr = data[1]; int nargs = PTR2INT(data[2]); ClientData isProbe = data[3]; int numLevels; /* * Delete the command words for what we just executed. */ Tcl_DecrRefCount(listPtr); /* * If we were doing a probe, splice ourselves back out of the stack * cleanly here. General injection should instead just look after itself. * * Code from guts of [yield] implementation. */ if (isProbe) { if (result == TCL_ERROR) { Tcl_AddErrorInfo(interp, "\n (injected coroutine probe command)"); } corPtr->nargs = nargs; corPtr->stackLevel = NULL; numLevels = iPtr->numLevels; iPtr->numLevels = corPtr->auxNumLevels; corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; iPtr->execEnvPtr = corPtr->callerEEPtr; } return result; } /* *---------------------------------------------------------------------- * * NRInjectObjCmd -- * * Implementation of [::tcl::unsupported::inject] command. * *---------------------------------------------------------------------- */ static int NRInjectObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { CoroutineData *corPtr; ExecEnv *savedEEPtr = iPtr->execEnvPtr; /* * Usage more or less like tailcall: * inject coroName cmd ?arg1 arg2 ...? */ if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?"); return TCL_ERROR; } corPtr = GetCoroutineFromObj(interp, objv[1], "can only inject a command into a coroutine"); if (!corPtr) { return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can only inject a command into a suspended coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", NULL); return TCL_ERROR; } |
︙ | ︙ |
Changes to generic/tclBinary.c.
︙ | ︙ | |||
155 156 157 158 159 160 161 | { "hex", BinaryDecodeHex, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, { "uuencode", BinaryDecodeUu, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, { "base64", BinaryDecode64, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, { NULL, NULL, NULL, NULL, NULL, 0 } }; /* | | | | | | | | | | | | | | | | | | | | | | | | | | < | | | | | | < | | | | | | | | < | | | | | | | | | | | < | | | | | | | | | | | | < | | | | | | | | 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 | { "hex", BinaryDecodeHex, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, { "uuencode", BinaryDecodeUu, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, { "base64", BinaryDecode64, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, { NULL, NULL, NULL, NULL, NULL, 0 } }; /* * The following object types represent an array of bytes. The intent is to * allow arbitrary binary data to pass through Tcl as a Tcl value without loss * or damage. Such values are useful for things like encoded strings or Tk * images to name just two. * * It's strange to have two Tcl_ObjTypes in place for this task when one would * do, so a bit of detail and history how we got to this point and where we * might go from here. * * A bytearray is an ordered sequence of bytes. Each byte is an integer value * in the range [0-255]. To be a Tcl value type, we need a way to encode each * value in the value set as a Tcl string. The simplest encoding is to * represent each byte value as the same codepoint value. A bytearray of N * bytes is encoded into a Tcl string of N characters where the codepoint of * each character is the value of corresponding byte. This approach creates a * one-to-one map between all bytearray values and a subset of Tcl string * values. * * When converting a Tcl string value to the bytearray internal rep, the * question arises what to do with strings outside that subset? That is, * those Tcl strings containing at least one codepoint greater than 255? The * obviously correct answer is to raise an error! That string value does not * represent any valid bytearray value. Full Stop. The setFromAnyProc * signature has a completion code return value for just this reason, to * reject invalid inputs. * * Unfortunately this was not the path taken by the authors of the original * tclByteArrayType. They chose to accept all Tcl string values as acceptable * string encodings of the bytearray values that result from masking away the * high bits of any codepoint value at all. This meant that every bytearray * value had multiple accepted string representations. * * The implications of this choice are truly ugly. When a Tcl value has a * string representation, we are required to accept that as the true value. * Bytearray values that possess a string representation cannot be processed * as bytearrays because we cannot know which true value that bytearray * represents. The consequence is that we drag around an internal rep that we * cannot make any use of. This painful price is extracted at any point after * a string rep happens to be generated for the value. This happens even when * the troublesome codepoints outside the byte range never show up. This * happens rather routinely in normal Tcl operations unless we burden the * script writer with the cognitive burden of avoiding it. The price is also * paid by callers of the C interface. The routine * * unsigned char *Tcl_GetByteArrayFromObj(objPtr, lenPtr) * * has a guarantee to always return a non-NULL value, but that value points to * a byte sequence that cannot be used by the caller to process the Tcl value * absent some sideband testing that objPtr is "pure". Tcl offers no public * interface to perform this test, so callers either break encapsulation or * are unavoidably buggy. Tcl has defined a public interface that cannot be * used correctly. The Tcl source code itself suffers the same problem, and * has been buggy, but progressively less so as more and more portions of the * code have been retrofitted with the required "purity testing". The set of * values able to pass the purity test can be increased via the introduction * of a "canonical" flag marker, but the only way the broken interface itself * can be discarded is to start over and define the Tcl_ObjType properly. * Bytearrays should simply be usable as bytearrays without a kabuki dance of * testing. * * The Tcl_ObjType "properByteArrayType" is (nearly) a correct implementation * of bytearrays. Any Tcl value with the type properByteArrayType can have * its bytearray value fetched and used with confidence that acting on that * value is equivalent to acting on the true Tcl string value. This still * implies a side testing burden -- past mistakes will not let us avoid that * immediately, but it is at least a conventional test of type, and can be * implemented entirely by examining the objPtr fields, with no need to query * the intrep, as a canonical flag would require. * * Until Tcl_GetByteArrayFromObj() and Tcl_SetByteArrayLength() can be revised * to admit the possibility of returning NULL when the true value is not a * valid bytearray, we need a mechanism to retain compatibility with the * deployed callers of the broken interface. That's what the retained * "tclByteArrayType" provides. In those unusual circumstances where we * convert an invalid bytearray value to a bytearray type, it is to this * legacy type. Essentially any time this legacy type gets used, it's a * signal of a bug being ignored. A TIP should be drafted to remove this * connection to the broken past so that Tcl 9 will no longer have any trace * of it. Prescribing a migration path will be the key element of that work. * The internal changes now in place are the limit of what can be done short * of interface repair. They provide a great expansion of the histories over * which bytearray values can be useful in the meanwhile. */ static const Tcl_ObjType properByteArrayType = { "bytearray", FreeProperByteArrayInternalRep, DupProperByteArrayInternalRep, UpdateStringOfByteArray, |
︙ | ︙ | |||
278 279 280 281 282 283 284 | * minus 1 byte. */ unsigned char bytes[1]; /* The array of bytes. The actual size of this * field depends on the 'allocated' field * above. */ } ByteArray; #define BYTEARRAY_SIZE(len) \ | | | 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 | * minus 1 byte. */ unsigned char bytes[1]; /* The array of bytes. The actual size of this * field depends on the 'allocated' field * above. */ } ByteArray; #define BYTEARRAY_SIZE(len) \ (offsetof(ByteArray, bytes) + (len)) #define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1) #define SET_BYTEARRAY(irPtr, baPtr) \ (irPtr)->twoPtrValue.ptr1 = (baPtr) int TclIsPureByteArray( Tcl_Obj * objPtr) |
︙ | ︙ | |||
394 395 396 397 398 399 400 | * *---------------------------------------------------------------------- */ void Tcl_SetByteArrayObj( Tcl_Obj *objPtr, /* Object to initialize as a ByteArray. */ | | | | | 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 | * *---------------------------------------------------------------------- */ void Tcl_SetByteArrayObj( Tcl_Obj *objPtr, /* Object to initialize as a ByteArray. */ const unsigned char *bytes, /* The array of bytes to use as the new value. * May be NULL even if length > 0. */ size_t length) /* Length of the array of bytes, which must * be >= 0. */ { ByteArray *byteArrayPtr; Tcl_ObjIntRep ir; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj"); } |
︙ | ︙ | |||
706 707 708 709 710 711 712 713 714 715 716 717 718 719 | if ((src[i] == 0) || (src[i] > 127)) { size++; } } if (size == length) { char *dst = Tcl_InitStringRep(objPtr, (char *)src, size); TclOOM(dst, size); } else { char *dst = Tcl_InitStringRep(objPtr, NULL, size); TclOOM(dst, size); for (i = 0; i < length; i++) { dst += Tcl_UniCharToUtf(src[i], dst); } | > > | | 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 | if ((src[i] == 0) || (src[i] > 127)) { size++; } } if (size == length) { char *dst = Tcl_InitStringRep(objPtr, (char *)src, size); TclOOM(dst, size); } else { char *dst = Tcl_InitStringRep(objPtr, NULL, size); TclOOM(dst, size); for (i = 0; i < length; i++) { dst += Tcl_UniCharToUtf(src[i], dst); } (void) Tcl_InitStringRep(objPtr, NULL, size); } } /* *---------------------------------------------------------------------- * * TclAppendBytesToByteArray -- |
︙ | ︙ | |||
788 789 790 791 792 793 794 | */ if (needed > byteArrayPtr->allocated) { ByteArray *ptr = NULL; size_t attempt; if (needed <= INT_MAX/2) { | > | > > > | > > > | > > | 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 | */ if (needed > byteArrayPtr->allocated) { ByteArray *ptr = NULL; size_t attempt; if (needed <= INT_MAX/2) { /* * Try to allocate double the total space that is needed. */ attempt = 2 * needed; ptr = Tcl_AttemptRealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); } if (ptr == NULL) { /* * Try to allocate double the increment that is needed (plus). */ size_t limit = UINT_MAX - needed; size_t extra = len + TCL_MIN_GROWTH; size_t growth = (extra > limit) ? limit : extra; attempt = needed + growth; ptr = Tcl_AttemptRealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); } if (ptr == NULL) { /* * Last chance: Try to allocate exactly what is needed. */ attempt = needed; ptr = Tcl_Realloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); } byteArrayPtr = ptr; byteArrayPtr->allocated = attempt; SET_BYTEARRAY(irPtr, byteArrayPtr); } |
︙ | ︙ | |||
877 878 879 880 881 882 883 | int arg; /* Index of next argument to consume. */ int value = 0; /* Current integer value to be packed. * Initialized to avoid compiler warning. */ char cmd; /* Current format character. */ size_t count; /* Count associated with current format * character. */ int flags; /* Format field flags */ | | | 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 | int arg; /* Index of next argument to consume. */ int value = 0; /* Current integer value to be packed. * Initialized to avoid compiler warning. */ char cmd; /* Current format character. */ size_t count; /* Count associated with current format * character. */ int flags; /* Format field flags */ const char *format; /* Pointer to current position in format * string. */ Tcl_Obj *resultPtr = NULL; /* Object holding result buffer. */ unsigned char *buffer; /* Start of result buffer. */ unsigned char *cursor; /* Current position within result buffer. */ unsigned char *maxPos; /* Greatest position within result buffer that * cursor has visited.*/ const char *errorString; |
︙ | ︙ | |||
1064 1065 1066 1067 1068 1069 1070 | */ resultPtr = Tcl_NewObj(); buffer = Tcl_SetByteArrayLength(resultPtr, length); memset(buffer, 0, length); /* | | | | | 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 | */ resultPtr = Tcl_NewObj(); buffer = Tcl_SetByteArrayLength(resultPtr, length); memset(buffer, 0, length); /* * Pack the data into the result object. Note that we can skip the error * checking during this pass, since we have already parsed the string * once. */ arg = 2; format = TclGetString(objv[1]); cursor = buffer; maxPos = cursor; while (*format != 0) { |
︙ | ︙ | |||
1279 1280 1281 1282 1283 1284 1285 | TclListObjGetElements(interp, objv[arg], &listc, &listv); if (count == BINARY_ALL) { count = listc; } } arg++; for (i = 0; (size_t)i < count; i++) { | | | 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 | TclListObjGetElements(interp, objv[arg], &listc, &listv); if (count == BINARY_ALL) { count = listc; } } arg++; for (i = 0; (size_t)i < count; i++) { if (FormatNumber(interp, cmd, listv[i], &cursor) != TCL_OK) { Tcl_DecrRefCount(resultPtr); return TCL_ERROR; } } break; } case 'x': |
︙ | ︙ | |||
1383 1384 1385 1386 1387 1388 1389 | int arg; /* Index of next argument to consume. */ int value = 0; /* Current integer value to be packed. * Initialized to avoid compiler warning. */ char cmd; /* Current format character. */ size_t count; /* Count associated with current format * character. */ int flags; /* Format field flags */ | | | 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 | int arg; /* Index of next argument to consume. */ int value = 0; /* Current integer value to be packed. * Initialized to avoid compiler warning. */ char cmd; /* Current format character. */ size_t count; /* Count associated with current format * character. */ int flags; /* Format field flags */ const char *format; /* Pointer to current position in format * string. */ Tcl_Obj *resultPtr = NULL; /* Object holding result buffer. */ unsigned char *buffer; /* Start of result buffer. */ const char *errorString; const char *str; int offset, size; size_t length = 0; |
︙ | ︙ | |||
1443 1444 1445 1446 1447 1448 1449 | /* * Trim trailing nulls and spaces, if necessary. */ if (cmd == 'A') { while (size > 0) { | | | 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 | /* * Trim trailing nulls and spaces, if necessary. */ if (cmd == 'A') { while (size > 0) { if (src[size - 1] != '\0' && src[size - 1] != ' ') { break; } size--; } } /* |
︙ | ︙ | |||
2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 | * Single-precision floating point values. Tcl_GetDoubleFromObj * returns TCL_ERROR for NaN, but we can check by comparing the * object's type pointer. */ if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) { const Tcl_ObjIntRep *irPtr = TclFetchIntRep(src, &tclDoubleType); if (irPtr == NULL) { return TCL_ERROR; } dvalue = irPtr->doubleValue; } /* * Because some compilers will generate floating point exceptions on * an overflow cast (e.g. Borland), we restrict the values to the * valid range for float. */ | > | | 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 | * Single-precision floating point values. Tcl_GetDoubleFromObj * returns TCL_ERROR for NaN, but we can check by comparing the * object's type pointer. */ if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) { const Tcl_ObjIntRep *irPtr = TclFetchIntRep(src, &tclDoubleType); if (irPtr == NULL) { return TCL_ERROR; } dvalue = irPtr->doubleValue; } /* * Because some compilers will generate floating point exceptions on * an overflow cast (e.g. Borland), we restrict the values to the * valid range for float. */ if (fabs(dvalue) > (double) FLT_MAX) { fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX; } else { fvalue = (float) dvalue; } CopyNumber(&fvalue, *cursorPtr, sizeof(float), type); *cursorPtr += sizeof(float); return TCL_OK; |
︙ | ︙ | |||
2171 2172 2173 2174 2175 2176 2177 | static Tcl_Obj * ScanNumber( unsigned char *buffer, /* Buffer to scan number from. */ int type, /* Format character from "binary scan" */ int flags, /* Format field flags */ Tcl_HashTable **numberCachePtrPtr) | | | | | 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 | static Tcl_Obj * ScanNumber( unsigned char *buffer, /* Buffer to scan number from. */ int type, /* Format character from "binary scan" */ int flags, /* Format field flags */ Tcl_HashTable **numberCachePtrPtr) /* Place to look for cache of scanned value * objects, or NULL if too many different * numbers have been scanned. */ { long value; float fvalue; double dvalue; Tcl_WideUInt uwvalue; /* |
︙ | ︙ | |||
2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 | + (buffer[1] << 16) + (((long) buffer[0]) << 24)); } /* * Check to see if the value was sign extended properly on systems * where an int is more than 32-bits. * We avoid caching unsigned integers as we cannot distinguish between * 32bit signed and unsigned in the hash (short and char are ok). */ if (flags & BINARY_UNSIGNED) { return Tcl_NewWideIntObj((Tcl_WideInt)(unsigned long)value); } | > | | | | 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 | + (buffer[1] << 16) + (((long) buffer[0]) << 24)); } /* * Check to see if the value was sign extended properly on systems * where an int is more than 32-bits. * * We avoid caching unsigned integers as we cannot distinguish between * 32bit signed and unsigned in the hash (short and char are ok). */ if (flags & BINARY_UNSIGNED) { return Tcl_NewWideIntObj((Tcl_WideInt)(unsigned long)value); } if ((value & (((unsigned) 1) << 31)) && (value > 0)) { value -= (((unsigned) 1) << 31); value -= (((unsigned) 1) << 31); } returnNumericObject: if (*numberCachePtrPtr == NULL) { return Tcl_NewWideIntObj(value); } else { register Tcl_HashTable *tablePtr = *numberCachePtrPtr; |
︙ | ︙ | |||
2456 2457 2458 2459 2460 2461 2462 | return TCL_ERROR; } TclNewObj(resultObj); data = TclGetByteArrayFromObj(objv[1], &count); cursor = Tcl_SetByteArrayLength(resultObj, count * 2); for (offset = 0; offset < count; ++offset) { | | | | 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 | return TCL_ERROR; } TclNewObj(resultObj); data = TclGetByteArrayFromObj(objv[1], &count); cursor = Tcl_SetByteArrayLength(resultObj, count * 2); for (offset = 0; offset < count; ++offset) { *cursor++ = HexDigits[(data[offset] >> 4) & 0x0f]; *cursor++ = HexDigits[data[offset] & 0x0f]; } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
2498 2499 2500 2501 2502 2503 2504 | enum {OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); return TCL_ERROR; } | | | | | 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 | enum {OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); return TCL_ERROR; } for (i = 1; i < objc - 1; ++i) { if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { case OPT_STRICT: strict = 1; break; } } TclNewObj(resultObj); datastart = data = (unsigned char *) TclGetStringFromObj(objv[objc - 1], &count); dataend = data + count; size = (count + 1) / 2; begin = cursor = Tcl_SetByteArrayLength(resultObj, size); while (data < dataend) { value = 0; for (i = 0 ; i < 2 ; i++) { if (data >= dataend) { value <<= 4; break; } c = *data++; if (!isxdigit(UCHAR(c))) { |
︙ | ︙ | |||
2541 2542 2543 2544 2545 2546 2547 | c -= '0'; if (c > 9) { c += ('0' - 'A') + 10; } if (c > 16) { c += ('A' - 'a'); } | | | 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 | c -= '0'; if (c > 9) { c += ('0' - 'A') + 10; } if (c > 16) { c += ('A' - 'a'); } value |= c & 0xf; } if (i < 2) { cut++; } *cursor++ = UCHAR(value); value = 0; } |
︙ | ︙ | |||
2613 2614 2615 2616 2617 2618 2619 | Tcl_Obj *resultObj; unsigned char *data, *cursor, *limit; int maxlen = 0; const char *wrapchar = "\n"; size_t wrapcharlen = 1; int i, index, size, outindex = 0; size_t offset, count = 0; | | | | | | | | | | | | 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 | Tcl_Obj *resultObj; unsigned char *data, *cursor, *limit; int maxlen = 0; const char *wrapchar = "\n"; size_t wrapcharlen = 1; int i, index, size, outindex = 0; size_t offset, count = 0; enum { OPT_MAXLEN, OPT_WRAPCHAR }; static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL }; if (objc < 2 || objc % 2 != 0) { Tcl_WrongNumArgs(interp, 1, objv, "?-maxlen len? ?-wrapchar char? data"); return TCL_ERROR; } for (i = 1; i < objc - 1; i += 2) { if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { case OPT_MAXLEN: if (Tcl_GetIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) { return TCL_ERROR; } if (maxlen < 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "line length out of range", -1)); Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE", "LINE_LENGTH", NULL); return TCL_ERROR; } break; case OPT_WRAPCHAR: wrapchar = TclGetStringFromObj(objv[i + 1], &wrapcharlen); if (wrapcharlen == 0) { maxlen = 0; } break; } } resultObj = Tcl_NewObj(); data = TclGetByteArrayFromObj(objv[objc - 1], &count); if (count > 0) { size = (((count * 4) / 3) + 3) & ~3; /* ensure 4 byte chunks */ if (maxlen > 0 && size > maxlen) { int adjusted = size + (wrapcharlen * (size / maxlen)); if (size % maxlen == 0) { adjusted -= wrapcharlen; } size = adjusted; } cursor = Tcl_SetByteArrayLength(resultObj, size); limit = cursor + size; for (offset = 0; offset < count; offset += 3) { unsigned char d[3] = {0, 0, 0}; for (i = 0; i < 3 && offset + i < count; ++i) { d[i] = data[offset + i]; } OUTPUT(B64Digits[d[0] >> 2]); OUTPUT(B64Digits[((d[0] & 0x03) << 4) | (d[1] >> 4)]); if (offset + 1 < count) { OUTPUT(B64Digits[((d[1] & 0x0f) << 2) | (d[2] >> 6)]); } else { OUTPUT(B64Digits[64]); } if (offset+2 < count) { OUTPUT(B64Digits[d[2] & 0x3f]); } else { |
︙ | ︙ | |||
2723 2724 2725 2726 2727 2728 2729 | int lineLength = 61; const unsigned char SingleNewline[] = { (unsigned char) '\n' }; const unsigned char *wrapchar = SingleNewline; size_t j, offset, count = 0, wrapcharlen = sizeof(SingleNewline); enum { OPT_MAXLEN, OPT_WRAPCHAR }; static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL }; | | | | > | | | | | | | 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 | int lineLength = 61; const unsigned char SingleNewline[] = { (unsigned char) '\n' }; const unsigned char *wrapchar = SingleNewline; size_t j, offset, count = 0, wrapcharlen = sizeof(SingleNewline); enum { OPT_MAXLEN, OPT_WRAPCHAR }; static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL }; if (objc < 2 || objc % 2 != 0) { Tcl_WrongNumArgs(interp, 1, objv, "?-maxlen len? ?-wrapchar char? data"); return TCL_ERROR; } for (i = 1; i < objc - 1; i += 2) { if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { case OPT_MAXLEN: if (Tcl_GetIntFromObj(interp, objv[i + 1], &lineLength) != TCL_OK) { return TCL_ERROR; } if (lineLength < 3 || lineLength > 85) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "line length out of range", -1)); Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE", "LINE_LENGTH", NULL); return TCL_ERROR; } break; case OPT_WRAPCHAR: wrapchar = TclGetByteArrayFromObj(objv[i + 1], &wrapcharlen); break; } } /* * Allocate the buffer. This is a little bit too long, but is "good * enough". */ resultObj = Tcl_NewObj(); offset = 0; data = TclGetByteArrayFromObj(objv[objc - 1], &count); rawLength = (lineLength - 1) * 3 / 4; start = cursor = Tcl_SetByteArrayLength(resultObj, (lineLength + wrapcharlen) * ((count + (rawLength - 1)) / rawLength)); n = bits = 0; /* * Encode the data. Each output line first has the length of raw data * encoded by the output line described in it by one encoded byte, then * the encoded data follows (encoding each 6 bits as one character). * Encoded lines are always terminated by a newline. */ while (offset < count) { int lineLen = count - offset; if (lineLen > rawLength) { lineLen = rawLength; } *cursor++ = UueDigits[lineLen]; for (i = 0 ; i < lineLen ; i++) { n <<= 8; n |= data[offset++]; for (bits += 8; bits > 6 ; bits -= 6) { *cursor++ = UueDigits[(n >> (bits - 6)) & 0x3f]; } } if (bits > 0) { n <<= 8; *cursor++ = UueDigits[(n >> (bits + 2)) & 0x3f]; bits = 0; } for (j = 0 ; j < wrapcharlen ; ++j) { *cursor++ = wrapchar[j]; } } /* * Fix the length of the output bytearray. */ Tcl_SetByteArrayLength(resultObj, cursor - start); Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
2835 2836 2837 2838 2839 2840 2841 | { Tcl_Obj *resultObj = NULL; unsigned char *data, *datastart, *dataend; unsigned char *begin, *cursor; int i, index, size, strict = 0, lineLen; size_t count = 0; unsigned char c; | | | | | 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 | { Tcl_Obj *resultObj = NULL; unsigned char *data, *datastart, *dataend; unsigned char *begin, *cursor; int i, index, size, strict = 0, lineLen; size_t count = 0; unsigned char c; enum { OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); return TCL_ERROR; } for (i = 1; i < objc - 1; ++i) { if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { case OPT_STRICT: strict = 1; break; } } TclNewObj(resultObj); datastart = data = (unsigned char *) TclGetStringFromObj(objv[objc - 1], &count); dataend = data + count; size = ((count + 3) & ~3) * 3 / 4; begin = cursor = Tcl_SetByteArrayLength(resultObj, size); lineLen = -1; /* * The decoding loop. First, we get the length of line (strictly, the |
︙ | ︙ | |||
2888 2889 2890 2891 2892 2893 2894 | lineLen = (c - 32) & 0x3f; } /* * Now we read a four-character grouping. */ | | | 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 | lineLen = (c - 32) & 0x3f; } /* * Now we read a four-character grouping. */ for (i = 0 ; i < 4 ; i++) { if (data < dataend) { d[i] = c = *data++; if (c < 32 || c > 96) { if (strict) { if (!TclIsSpaceProc(c)) { goto badUu; } else if (c == '\n') { |
︙ | ︙ | |||
3007 3008 3009 3010 3011 3012 3013 | enum { OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); return TCL_ERROR; } | | | | 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 | enum { OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); return TCL_ERROR; } for (i = 1; i < objc - 1; ++i) { if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { case OPT_STRICT: strict = 1; break; } } TclNewObj(resultObj); datastart = data = (unsigned char *) TclGetStringFromObj(objv[objc - 1], &count); dataend = data + count; size = ((count + 3) & ~3) * 3 / 4; begin = cursor = Tcl_SetByteArrayLength(resultObj, size); while (data < dataend) { unsigned long value = 0; /* |
︙ | ︙ | |||
3049 3050 3051 3052 3053 3054 3055 | if (data < dataend) { c = *data++; } else if (i > 1) { c = '='; } else { if (strict && i <= 1) { | > | | > > | | | | > | > | | > > | 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 | if (data < dataend) { c = *data++; } else if (i > 1) { c = '='; } else { if (strict && i <= 1) { /* * Single resp. unfulfilled char (each 4th next single * char) is rather bad64 error case in strict mode. */ goto bad64; } cut += 3; break; } /* * Load the character into the block value. Handle ='s specially * because they're only valid as the last character or two of the * final block of input. Unless strict mode is enabled, skip any * input whitespace characters. */ if (cut) { if (c == '=' && i > 1) { value <<= 6; cut++; } else if (!strict && TclIsSpaceProc(c)) { i--; } else { goto bad64; } } else if (c >= 'A' && c <= 'Z') { value = (value << 6) | ((c - 'A') & 0x3f); } else if (c >= 'a' && c <= 'z') { value = (value << 6) | ((c - 'a' + 26) & 0x3f); } else if (c >= '0' && c <= '9') { value = (value << 6) | ((c - '0' + 52) & 0x3f); } else if (c == '+') { value = (value << 6) | 0x3e; } else if (c == '/') { value = (value << 6) | 0x3f; } else if (c == '=' && (!strict || i > 1)) { /* * "=" and "a=" is rather bad64 error case in strict mode. */ value <<= 6; if (i) { cut++; } } else if (strict || !TclIsSpaceProc(c)) { goto bad64; } else { i--; } } *cursor++ = UCHAR((value >> 16) & 0xff); |
︙ | ︙ | |||
3134 3135 3136 3137 3138 3139 3140 | /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ | < | 3150 3151 3152 3153 3154 3155 3156 | /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to generic/tclCkalloc.c.
︙ | ︙ | |||
35 36 37 38 39 40 41 | size_t refCount; /* Number of mem_headers referencing this * tag. */ char string[1]; /* Actual size of string will be as large as * needed for actual tag. This must be the * last field in the structure. */ } MemTag; | | | 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 | size_t refCount; /* Number of mem_headers referencing this * tag. */ char string[1]; /* Actual size of string will be as large as * needed for actual tag. This must be the * last field in the structure. */ } MemTag; #define TAG_SIZE(bytesInString) ((offsetof(MemTag, string) + 1) + bytesInString) static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers (set * by "memory tag" command). */ /* * One of the following structures is allocated just before each dynamically * allocated chunk of memory, both to record information about the chunk and |
︙ | ︙ |
Changes to generic/tclCmdAH.c.
︙ | ︙ | |||
952 953 954 955 956 957 958 959 960 961 962 963 964 965 | {"rootname", PathRootNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, {"separator", FilesystemSeparatorCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"size", FileAttrSizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, {"split", PathSplitCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"stat", FileAttrStatCmd, TclCompileBasic2ArgCmd, NULL, NULL, 1}, {"system", PathFilesystemCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"tail", PathTailCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, {"tempfile", TclFileTemporaryCmd, TclCompileBasic0To2ArgCmd, NULL, NULL, 1}, {"type", FileAttrTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, {"volumes", FilesystemVolumesCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1}, {"writable", FileAttrIsWritableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, {NULL, NULL, NULL, NULL, NULL, 0} }; return TclMakeEnsemble(interp, "file", initMap); | > | 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 | {"rootname", PathRootNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, {"separator", FilesystemSeparatorCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"size", FileAttrSizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, {"split", PathSplitCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"stat", FileAttrStatCmd, TclCompileBasic2ArgCmd, NULL, NULL, 1}, {"system", PathFilesystemCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"tail", PathTailCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, {"tempdir", TclFileTempDirCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1}, {"tempfile", TclFileTemporaryCmd, TclCompileBasic0To2ArgCmd, NULL, NULL, 1}, {"type", FileAttrTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, {"volumes", FilesystemVolumesCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1}, {"writable", FileAttrIsWritableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, {NULL, NULL, NULL, NULL, NULL, 0} }; return TclMakeEnsemble(interp, "file", initMap); |
︙ | ︙ |
Changes to generic/tclCmdMZ.c.
︙ | ︙ | |||
123 124 125 126 127 128 129 | int Tcl_RegexpObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | < | 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 | int Tcl_RegexpObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { size_t offset, stringLength, matchLength, cflags, eflags; int i, indices, match, about, all, doinline, numMatchesSaved; Tcl_RegExp regExpr; Tcl_Obj *objPtr, *startIndex = NULL, *resultPtr = NULL; Tcl_RegExpInfo info; static const char *const options[] = { "-all", "-about", "-indices", "-inline", "-expanded", "-line", "-linestop", "-lineanchor", "-nocase", "-start", "--", NULL |
︙ | ︙ | |||
305 306 307 308 309 310 311 | * considered the start of the line. If for example the pattern {^} is * passed and -start is positive, then the pattern will not match the * start of the string unless the previous character is a newline. */ if (offset == TCL_INDEX_START) { eflags = 0; | | | 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 | * considered the start of the line. If for example the pattern {^} is * passed and -start is positive, then the pattern will not match the * start of the string unless the previous character is a newline. */ if (offset == TCL_INDEX_START) { eflags = 0; } else if (offset + 1 > stringLength + 1) { eflags = TCL_REG_NOTBOL; } else if (Tcl_GetUniChar(objPtr, offset-1) == '\n') { eflags = 0; } else { eflags = TCL_REG_NOTBOL; } |
︙ | ︙ | |||
361 362 363 364 365 366 367 | resultPtr = Tcl_NewObj(); } } for (i = 0; i < objc; i++) { Tcl_Obj *newPtr; if (indices) { | | | | | | | | | | 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 | resultPtr = Tcl_NewObj(); } } for (i = 0; i < objc; i++) { Tcl_Obj *newPtr; if (indices) { size_t start, end; Tcl_Obj *objs[2]; /* * Only adjust the match area if there was a match for that * area. (Scriptics Bug 4391/SF Bug #219232) */ if (i <= (int)info.nsubs && info.matches[i].start != TCL_INDEX_NONE) { start = offset + info.matches[i].start; end = offset + info.matches[i].end; /* * Adjust index so it refers to the last character in the * match instead of the first character after the match. */ if (end + 1 >= offset + 1) { end--; } } else { start = TCL_INDEX_NONE; end = TCL_INDEX_NONE; } objs[0] = TclNewWideIntObjFromSize(start); objs[1] = TclNewWideIntObjFromSize(end); newPtr = Tcl_NewListObj(2, objs); } else { if (i <= (int)info.nsubs) { newPtr = Tcl_GetRange(objPtr, offset + info.matches[i].start, offset + info.matches[i].end - 1); } else { newPtr = Tcl_NewObj(); } } |
︙ | ︙ | |||
441 442 443 444 445 446 447 | * these cases we always want to bump the index up one. */ if (matchLength == 0) { offset++; } all++; | | | 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 | * these cases we always want to bump the index up one. */ if (matchLength == 0) { offset++; } all++; if (offset + 1 >= stringLength + 1) { break; } } /* * Set the interpreter's object result to an integer object with value 1 * if -all wasn't specified, otherwise it's all-1 (the number of times |
︙ | ︙ | |||
484 485 486 487 488 489 490 | int Tcl_RegsubObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | | | 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 | int Tcl_RegsubObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result, cflags, all, match, command, numParts; size_t idx, wlen, wsublen = 0, offset, numMatches; size_t start, end, subStart, subEnd; Tcl_RegExp regExpr; Tcl_RegExpInfo info; Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL; Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec = 0, *wend; static const char *const options[] = { "-all", "-command", "-expanded", "-line", |
︙ | ︙ | |||
509 510 511 512 513 514 515 | cflags = TCL_REG_ADVANCED; all = 0; offset = TCL_INDEX_START; command = 0; resultPtr = NULL; | | | 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 | cflags = TCL_REG_ADVANCED; all = 0; offset = TCL_INDEX_START; command = 0; resultPtr = NULL; for (idx = 1; idx < (size_t)objc; idx++) { const char *name; int index; name = TclGetString(objv[idx]); if (name[0] != '-') { break; } |
︙ | ︙ | |||
545 546 547 548 549 550 551 | cflags |= TCL_REG_NLSTOP; break; case REGSUB_LINEANCHOR: cflags |= TCL_REG_NLANCH; break; case REGSUB_START: { size_t temp; | | | | 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 | cflags |= TCL_REG_NLSTOP; break; case REGSUB_LINEANCHOR: cflags |= TCL_REG_NLANCH; break; case REGSUB_START: { size_t temp; if (++idx >= (size_t)objc) { goto endOfForLoop; } if (TclGetIntForIndexM(interp, objv[idx], TCL_INDEX_START, &temp) != TCL_OK) { goto optionError; } if (startIndex) { Tcl_DecrRefCount(startIndex); } startIndex = objv[idx]; Tcl_IncrRefCount(startIndex); break; } case REGSUB_LAST: idx++; goto endOfForLoop; } } endOfForLoop: if ((size_t)objc < idx + 3 || (size_t)objc > idx + 4) { Tcl_WrongNumArgs(interp, 1, objv, "?-option ...? exp string subSpec ?varName?"); optionError: if (startIndex) { Tcl_DecrRefCount(startIndex); } return TCL_ERROR; |
︙ | ︙ | |||
1265 1266 1267 1268 1269 1270 1271 | Tcl_ListObjAppendElement(NULL, listPtr, objPtr); stringPtr = p + 1; } TclNewStringObj(objPtr, stringPtr, end - stringPtr); Tcl_ListObjAppendElement(NULL, listPtr, objPtr); } else { const char *element, *p, *splitEnd; | | | 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 | Tcl_ListObjAppendElement(NULL, listPtr, objPtr); stringPtr = p + 1; } TclNewStringObj(objPtr, stringPtr, end - stringPtr); Tcl_ListObjAppendElement(NULL, listPtr, objPtr); } else { const char *element, *p, *splitEnd; size_t splitLen; Tcl_UniChar splitChar = 0; /* * Normal case: split on any of a given set of characters. Discard * instances of the split characters. */ |
︙ | ︙ | |||
1978 1979 1980 1981 1982 1983 1984 | static int StringMapCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | < | 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 | static int StringMapCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { size_t length1, length2, mapElemc, index; int nocase = 0, mapWithDict = 0, copySource = 0; Tcl_Obj **mapElemv, *sourceObj, *resultPtr; Tcl_UniChar *ustring1, *ustring2, *p, *end; int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, size_t); if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string"); |
︙ | ︙ | |||
2020 2021 2022 2023 2024 2025 2026 | Tcl_DictSearch search; /* * We know the type exactly, so all dict operations will succeed for * sure. This shortens this code quite a bit. */ | | | | | | > | > | 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 | Tcl_DictSearch search; /* * We know the type exactly, so all dict operations will succeed for * sure. This shortens this code quite a bit. */ Tcl_DictObjSize(interp, objv[objc-2], &i); if (i == 0) { /* * Empty charMap, just return whatever string was given. */ Tcl_SetObjResult(interp, objv[objc-1]); return TCL_OK; } mapElemc = 2 * i; mapWithDict = 1; /* * Copy the dictionary out into an array; that's the easiest way to * adapt this code... */ mapElemv = TclStackAlloc(interp, sizeof(Tcl_Obj *) * mapElemc); Tcl_DictObjFirst(interp, objv[objc-2], &search, mapElemv+0, mapElemv+1, &done); for (index=2 ; index<mapElemc ; index+=2) { Tcl_DictObjNext(&search, mapElemv+index, mapElemv+index+1, &done); } Tcl_DictObjDone(&search); } else { int i; if (TclListObjGetElements(interp, objv[objc-2], &i, &mapElemv) != TCL_OK) { return TCL_ERROR; } mapElemc = i; if (mapElemc == 0) { /* * empty charMap, just return whatever string was given. */ Tcl_SetObjResult(interp, objv[objc-1]); return TCL_OK; |
︙ | ︙ | |||
3480 3481 3482 3483 3484 3485 3486 | int TclNRSwitchObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | | 3480 3481 3482 3483 3484 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 | int TclNRSwitchObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int i, index, mode, foundmode, splitObjs, numMatchesSaved; int noCase; size_t patternLength, j; const char *pattern; Tcl_Obj *stringObj, *indexVarObj, *matchVarObj; Tcl_Obj *const *savedObjv = objv; Tcl_RegExp regExpr = NULL; Interp *iPtr = (Interp *) interp; int pc = 0; int bidx = 0; /* Index of body argument. */ |
︙ | ︙ | |||
3793 3794 3795 3796 3797 3798 3799 | TclNewObj(indicesObj); } for (j=0 ; j<=info.nsubs ; j++) { if (indexVarObj != NULL) { Tcl_Obj *rangeObjAry[2]; | | | | | 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 | TclNewObj(indicesObj); } for (j=0 ; j<=info.nsubs ; j++) { if (indexVarObj != NULL) { Tcl_Obj *rangeObjAry[2]; if (info.matches[j].end + 1 > 1) { rangeObjAry[0] = TclNewWideIntObjFromSize(info.matches[j].start); rangeObjAry[1] = TclNewWideIntObjFromSize(info.matches[j].end-1); } else { rangeObjAry[0] = rangeObjAry[1] = Tcl_NewWideIntObj(-1); } /* * Never fails; the object is always clean at this point. */ |
︙ | ︙ | |||
3912 3913 3914 3915 3916 3917 3918 | for (k=0; k < objc; k++) { ctxPtr->line[k] = -1; } } } for (j = i + 1; ; j += 2) { | | | 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 3922 3923 3924 3925 3926 | for (k=0; k < objc; k++) { ctxPtr->line[k] = -1; } } } for (j = i + 1; ; j += 2) { if (j >= (size_t)objc) { /* * This shouldn't happen since we've checked that the last body is * not a continuation... */ Tcl_Panic("fall-out when searching for body to match pattern"); } |
︙ | ︙ | |||
4195 4196 4197 4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 | "-direct", "-overhead", "-calibrate", "--", NULL }; enum options { TMRT_EV_DIRECT, TMRT_OVERHEAD, TMRT_CALIBRATE, TMRT_LAST }; NRE_callback *rootPtr; ByteCode *codePtr = NULL; for (i = 1; i < objc - 1; i++) { int index; if (Tcl_GetIndexFromObj(NULL, objv[i], options, "option", TCL_EXACT, &index) != TCL_OK) { break; | > | 4195 4196 4197 4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 | "-direct", "-overhead", "-calibrate", "--", NULL }; enum options { TMRT_EV_DIRECT, TMRT_OVERHEAD, TMRT_CALIBRATE, TMRT_LAST }; NRE_callback *rootPtr; ByteCode *codePtr = NULL; int codeOptimized = 0; for (i = 1; i < objc - 1; i++) { int index; if (Tcl_GetIndexFromObj(NULL, objv[i], options, "option", TCL_EXACT, &index) != TCL_OK) { break; |
︙ | ︙ | |||
4379 4380 4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 | if (!direct) { if (TclInterpReady(interp) != TCL_OK) { return TCL_ERROR; } codePtr = TclCompileObj(interp, objPtr, NULL, 0); TclPreserveByteCode(codePtr); } /* * Get start and stop time. */ #ifdef TCL_WIDE_CLICKS | > > > > > > > > > | 4380 4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 4393 4394 4395 4396 4397 4398 4399 4400 4401 4402 | if (!direct) { if (TclInterpReady(interp) != TCL_OK) { return TCL_ERROR; } codePtr = TclCompileObj(interp, objPtr, NULL, 0); TclPreserveByteCode(codePtr); /* * Replace last compiled done instruction with continue: it's a part of * iteration, this way evaluation will be more similar to a cycle (also * avoids extra overhead to set result to interp, etc.) */ if (codePtr->codeStart[codePtr->numCodeBytes-1] == INST_DONE) { codePtr->codeStart[codePtr->numCodeBytes-1] = INST_CONTINUE; codeOptimized = 1; } } /* * Get start and stop time. */ #ifdef TCL_WIDE_CLICKS |
︙ | ︙ | |||
4425 4426 4427 4428 4429 4430 4431 | if (!direct) { /* precompiled */ rootPtr = TOP_CB(interp); result = TclNRExecuteByteCode(interp, codePtr); result = TclNRRunCallbacks(interp, result, rootPtr); } else { /* eval */ result = TclEvalObjEx(interp, objPtr, 0, NULL, 0); } | < | | | | | > | < | | | | < | | > | > > > | 4435 4436 4437 4438 4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 4449 4450 4451 4452 4453 4454 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 4465 4466 4467 | if (!direct) { /* precompiled */ rootPtr = TOP_CB(interp); result = TclNRExecuteByteCode(interp, codePtr); result = TclNRRunCallbacks(interp, result, rootPtr); } else { /* eval */ result = TclEvalObjEx(interp, objPtr, 0, NULL, 0); } /* * Allow break and continue from measurement cycle (used for * conditional stop and flow control of iterations). */ switch (result) { case TCL_OK: break; case TCL_BREAK: /* * Force stop immediately. */ threshold = 1; maxcnt = 0; case TCL_CONTINUE: result = TCL_OK; break; default: goto done; } /* * Don't check time up to threshold. */ if (--threshold > 0) { |
︙ | ︙ | |||
4541 4542 4543 4544 4545 4546 4547 | threshold = maxcnt - count; } } } { Tcl_Obj *objarr[8], **objs = objarr; | | > | > > | | | 4553 4554 4555 4556 4557 4558 4559 4560 4561 4562 4563 4564 4565 4566 4567 4568 4569 4570 4571 4572 4573 4574 4575 4576 4577 4578 4579 4580 | threshold = maxcnt - count; } } } { Tcl_Obj *objarr[8], **objs = objarr; Tcl_WideUInt usec, val; int digits; /* * Absolute execution time in microseconds or in wide clicks. */ usec = (Tcl_WideUInt)(middle - start); #ifdef TCL_WIDE_CLICKS /* * convert execution time (in wide clicks) to microsecs. */ usec *= TclpWideClickInMicrosec(); #endif /* TCL_WIDE_CLICKS */ if (!count) { /* no iterations - avoid divide by zero */ objs[0] = objs[2] = objs[4] = Tcl_NewWideIntObj(0); goto retRes; } |
︙ | ︙ | |||
4575 4576 4577 4578 4579 4580 4581 | if (overhead > 0) { /* * Estimate the time of overhead (microsecs). */ Tcl_WideUInt curOverhead = overhead * count; | | | | | | | | | | | | | | | | > > > > > | 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 4627 4628 4629 4630 4631 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648 4649 4650 4651 4652 4653 4654 4655 4656 4657 4658 4659 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 4697 4698 4699 4700 | if (overhead > 0) { /* * Estimate the time of overhead (microsecs). */ Tcl_WideUInt curOverhead = overhead * count; if (usec > curOverhead) { usec -= curOverhead; } else { usec = 0; } } } else { /* * Calibration: obtaining new measurement overhead. */ if (measureOverhead > ((double) usec) / count) { measureOverhead = ((double) usec) / count; } objs[0] = Tcl_NewDoubleObj(measureOverhead); TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#-overhead"); /* mics */ objs += 2; } val = usec / count; /* microsecs per iteration */ if (val >= 1000000) { objs[0] = Tcl_NewWideIntObj(val); } else { if (val < 10) { digits = 6; } else if (val < 100) { digits = 4; } else if (val < 1000) { digits = 3; } else if (val < 10000) { digits = 2; } else { digits = 1; } objs[0] = Tcl_ObjPrintf("%.*f", digits, ((double) usec)/count); } objs[2] = Tcl_NewWideIntObj(count); /* iterations */ /* * Calculate speed as rate (count) per sec */ if (!usec) { usec++; /* Avoid divide by zero. */ } if (count < (WIDE_MAX / 1000000)) { val = (count * 1000000) / usec; if (val < 100000) { if (val < 100) { digits = 3; } else if (val < 1000) { digits = 2; } else { digits = 1; } objs[4] = Tcl_ObjPrintf("%.*f", digits, ((double) (count * 1000000)) / usec); } else { objs[4] = Tcl_NewWideIntObj(val); } } else { objs[4] = Tcl_NewWideIntObj((count / usec) * 1000000); } retRes: /* * Estimated net execution time (in millisecs). */ if (!calibrate) { if (usec >= 1) { objs[6] = Tcl_ObjPrintf("%.3f", (double)usec / 1000); } else { objs[6] = Tcl_NewWideIntObj(0); } TclNewLiteralStringObj(objs[7], "net-ms"); } /* * Construct the result as a list because many programs have always * parsed as such (extracting the first element, typically). */ TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#"); /* mics/# */ TclNewLiteralStringObj(objs[3], "#"); TclNewLiteralStringObj(objs[5], "#/sec"); Tcl_SetObjResult(interp, Tcl_NewListObj(8, objarr)); } done: if (codePtr != NULL) { if ( codeOptimized && codePtr->codeStart[codePtr->numCodeBytes-1] == INST_CONTINUE ) { codePtr->codeStart[codePtr->numCodeBytes-1] = INST_DONE; } TclReleaseByteCode(codePtr); } return result; } /* *---------------------------------------------------------------------- |
︙ | ︙ |
Changes to generic/tclCompile.c.
︙ | ︙ | |||
3058 3059 3060 3061 3062 3063 3064 | /* * Create a new variable if appropriate. */ if (create || (name == NULL)) { localVar = procPtr->numCompiledLocals; | | | 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 | /* * Create a new variable if appropriate. */ if (create || (name == NULL)) { localVar = procPtr->numCompiledLocals; localPtr = Tcl_Alloc(offsetof(CompiledLocal, name) + nameBytes + 1); if (procPtr->firstLocalPtr == NULL) { procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr; } else { procPtr->lastLocalPtr->nextPtr = localPtr; procPtr->lastLocalPtr = localPtr; } localPtr->nextPtr = NULL; |
︙ | ︙ |
Changes to generic/tclDecls.h.
︙ | ︙ | |||
1748 1749 1750 1751 1752 1753 1754 | /* 642 */ EXTERN void Tcl_DecrRefCount(Tcl_Obj *objPtr); /* 643 */ EXTERN int Tcl_IsShared(Tcl_Obj *objPtr); /* 644 */ EXTERN int Tcl_LinkArray(Tcl_Interp *interp, const char *varName, void *addr, int type, | | > > > > | 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 | /* 642 */ EXTERN void Tcl_DecrRefCount(Tcl_Obj *objPtr); /* 643 */ EXTERN int Tcl_IsShared(Tcl_Obj *objPtr); /* 644 */ EXTERN int Tcl_LinkArray(Tcl_Interp *interp, const char *varName, void *addr, int type, size_t size); /* 645 */ EXTERN int Tcl_GetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, size_t endValue, size_t *indexPtr); typedef struct { const struct TclPlatStubs *tclPlatStubs; const struct TclIntStubs *tclIntStubs; const struct TclIntPlatStubs *tclIntPlatStubs; } TclStubHooks; |
︙ | ︙ | |||
2428 2429 2430 2431 2432 2433 2434 | char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, size_t numBytes); /* 637 */ Tcl_ObjIntRep * (*tcl_FetchIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 638 */ void (*tcl_StoreIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjIntRep *irPtr); /* 639 */ int (*tcl_HasStringRep) (Tcl_Obj *objPtr); /* 640 */ void (*tcl_IncrRefCount) (Tcl_Obj *objPtr); /* 641 */ void (*tcl_DecrRefCount) (Tcl_Obj *objPtr); /* 642 */ int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */ | | > | 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 | char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, size_t numBytes); /* 637 */ Tcl_ObjIntRep * (*tcl_FetchIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 638 */ void (*tcl_StoreIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjIntRep *irPtr); /* 639 */ int (*tcl_HasStringRep) (Tcl_Obj *objPtr); /* 640 */ void (*tcl_IncrRefCount) (Tcl_Obj *objPtr); /* 641 */ void (*tcl_DecrRefCount) (Tcl_Obj *objPtr); /* 642 */ int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */ int (*tcl_LinkArray) (Tcl_Interp *interp, const char *varName, void *addr, int type, size_t size); /* 644 */ int (*tcl_GetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, size_t endValue, size_t *indexPtr); /* 645 */ } TclStubs; extern const TclStubs *tclStubsPtr; #ifdef __cplusplus } #endif |
︙ | ︙ | |||
3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 | (tclStubsPtr->tcl_IncrRefCount) /* 641 */ #define Tcl_DecrRefCount \ (tclStubsPtr->tcl_DecrRefCount) /* 642 */ #define Tcl_IsShared \ (tclStubsPtr->tcl_IsShared) /* 643 */ #define Tcl_LinkArray \ (tclStubsPtr->tcl_LinkArray) /* 644 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #if defined(USE_TCL_STUBS) # undef Tcl_CreateInterp | > > | 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 | (tclStubsPtr->tcl_IncrRefCount) /* 641 */ #define Tcl_DecrRefCount \ (tclStubsPtr->tcl_DecrRefCount) /* 642 */ #define Tcl_IsShared \ (tclStubsPtr->tcl_IsShared) /* 643 */ #define Tcl_LinkArray \ (tclStubsPtr->tcl_LinkArray) /* 644 */ #define Tcl_GetIntForIndex \ (tclStubsPtr->tcl_GetIntForIndex) /* 645 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #if defined(USE_TCL_STUBS) # undef Tcl_CreateInterp |
︙ | ︙ |
Changes to generic/tclEnv.c.
︙ | ︙ | |||
228 229 230 231 232 233 234 | * exist, enlarge the array if necessary to make room. If the name exists, * free its old entry. */ Tcl_MutexLock(&envMutex); index = TclpFindVariable(name, &length); | | | 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 | * exist, enlarge the array if necessary to make room. If the name exists, * free its old entry. */ Tcl_MutexLock(&envMutex); index = TclpFindVariable(name, &length); if (index == TCL_INDEX_NONE) { #ifndef USE_PUTENV /* * We need to handle the case where the environment may be changed * outside our control. ourEnvironSize is only valid if the current * environment is the one we allocated. [Bug 979640] */ |
︙ | ︙ | |||
312 313 314 315 316 317 318 | /* * Watch out for versions of putenv that copy the string (e.g. VC++). In * this case we need to free the string immediately. Otherwise update the * string in the cache. */ | | | 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 | /* * Watch out for versions of putenv that copy the string (e.g. VC++). In * this case we need to free the string immediately. Otherwise update the * string in the cache. */ if ((index != TCL_INDEX_NONE) && (environ[index] == p)) { ReplaceString(oldValue, p); #ifdef HAVE_PUTENV_THAT_COPIES } else { /* * This putenv() copies instead of taking ownership. */ |
︙ | ︙ |
Changes to generic/tclExecute.c.
︙ | ︙ | |||
93 94 95 96 97 98 99 | #endif /* * These are used by evalstats to monitor object usage in Tcl. */ #ifdef TCL_COMPILE_STATS | | | | | 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 | #endif /* * These are used by evalstats to monitor object usage in Tcl. */ #ifdef TCL_COMPILE_STATS size_t tclObjsAlloced = 0; size_t tclObjsFreed = 0; size_t tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 }; #endif /* TCL_COMPILE_STATS */ /* * NR_TEBC * Helpers for NR - non-recursive calls to TEBC * Minimal data required to fully reconstruct the execution state. */ |
︙ | ︙ | |||
149 150 151 152 153 154 155 | } while (0) /* * These variable-access macros have to coincide with those in tclVar.c */ #define VarHashGetValue(hPtr) \ | | | 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 | } while (0) /* * These variable-access macros have to coincide with those in tclVar.c */ #define VarHashGetValue(hPtr) \ ((Var *) ((char *)hPtr - offsetof(VarInHash, entry))) static inline Var * VarHashCreateVar( TclVarHashTable *tablePtr, Tcl_Obj *key, int *newPtr) { |
︙ | ︙ | |||
4922 4923 4924 4925 4926 4927 4928 | TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr), (match < 0 ? -1 : match > 0 ? 1 : 0))); JUMP_PEEPHOLE_F(match, 1, 2); case INST_STR_LEN: valuePtr = OBJ_AT_TOS; slength = Tcl_GetCharLength(valuePtr); | | | | 4922 4923 4924 4925 4926 4927 4928 4929 4930 4931 4932 4933 4934 4935 4936 4937 | TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr), (match < 0 ? -1 : match > 0 ? 1 : 0))); JUMP_PEEPHOLE_F(match, 1, 2); case INST_STR_LEN: valuePtr = OBJ_AT_TOS; slength = Tcl_GetCharLength(valuePtr); objResultPtr = TclNewWideIntObjFromSize(slength); TRACE(("\"%.20s\" => %" TCL_Z_MODIFIER "u\n", O2S(valuePtr), slength)); NEXT_INST_F(1, 1, 1); case INST_STR_UPPER: valuePtr = OBJ_AT_TOS; TRACE(("\"%.20s\" => ", O2S(valuePtr))); if (Tcl_IsShared(valuePtr)) { s1 = TclGetStringFromObj(valuePtr, &slength); |
︙ | ︙ | |||
6834 6835 6836 6837 6838 6839 6840 | } Tcl_IncrRefCount(dictPtr); if (TclListObjGetElements(interp, OBJ_AT_TOS, &length, &keyPtrPtr) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } | | | 6834 6835 6836 6837 6838 6839 6840 6841 6842 6843 6844 6845 6846 6847 6848 | } Tcl_IncrRefCount(dictPtr); if (TclListObjGetElements(interp, OBJ_AT_TOS, &length, &keyPtrPtr) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } if ((size_t)length != duiPtr->length) { Tcl_Panic("dictUpdateStart argument length mismatch"); } for (i=0 ; i<length ; i++) { if (Tcl_DictObjGet(interp, dictPtr, keyPtrPtr[i], &valuePtr) != TCL_OK) { TRACE_ERROR(interp); Tcl_DecrRefCount(dictPtr); |
︙ | ︙ | |||
7817 7818 7819 7820 7821 7822 7823 | Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); mp_init(&bigResult); if (opcode == INST_LSHIFT) { mp_mul_2d(&big1, shift, &bigResult); } else { | | | | | | 7817 7818 7819 7820 7821 7822 7823 7824 7825 7826 7827 7828 7829 7830 7831 7832 7833 7834 7835 7836 7837 7838 7839 7840 7841 7842 7843 7844 7845 7846 7847 7848 7849 7850 7851 7852 7853 7854 7855 7856 | Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); mp_init(&bigResult); if (opcode == INST_LSHIFT) { mp_mul_2d(&big1, shift, &bigResult); } else { mp_signed_rsh(&big1, shift, &bigResult); } mp_clear(&big1); BIG_RESULT(&bigResult); } case INST_BITOR: case INST_BITXOR: case INST_BITAND: if ((type1 != TCL_NUMBER_INT) || (type2 != TCL_NUMBER_INT)) { Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); mp_init(&bigResult); switch (opcode) { case INST_BITAND: mp_and(&big1, &big2, &bigResult); break; case INST_BITOR: mp_or(&big1, &big2, &bigResult); break; case INST_BITXOR: mp_xor(&big1, &big2, &bigResult); break; } mp_clear(&big1); mp_clear(&big2); BIG_RESULT(&bigResult); } |
︙ | ︙ | |||
8808 8809 8810 8811 8812 8813 8814 | size_t codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i; int bestDist = INT_MAX; /* Distance of pc to best cmd's start pc. */ int bestSrcOffset = -1; /* Initialized to avoid compiler warning. */ int bestSrcLength = -1; /* Initialized to avoid compiler warning. */ int bestCmdIdx = -1; /* The pc must point within the bytecode */ | | | 8808 8809 8810 8811 8812 8813 8814 8815 8816 8817 8818 8819 8820 8821 8822 | size_t codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i; int bestDist = INT_MAX; /* Distance of pc to best cmd's start pc. */ int bestSrcOffset = -1; /* Initialized to avoid compiler warning. */ int bestSrcLength = -1; /* Initialized to avoid compiler warning. */ int bestCmdIdx = -1; /* The pc must point within the bytecode */ assert (pcOffset < (size_t)codePtr->numCodeBytes); /* * Decode the code and source offset and length for each command. The * closest enclosing command is the last one whose code started before * pcOffset. */ |
︙ | ︙ | |||
8951 8952 8953 8954 8955 8956 8957 | * point or a catch range. */ ByteCode *codePtr) /* Points to the ByteCode in which to search * for the enclosing ExceptionRange. */ { ExceptionRange *rangeArrayPtr; int numRanges = codePtr->numExceptRanges; ExceptionRange *rangePtr; | | | | 8951 8952 8953 8954 8955 8956 8957 8958 8959 8960 8961 8962 8963 8964 8965 8966 | * point or a catch range. */ ByteCode *codePtr) /* Points to the ByteCode in which to search * for the enclosing ExceptionRange. */ { ExceptionRange *rangeArrayPtr; int numRanges = codePtr->numExceptRanges; ExceptionRange *rangePtr; size_t pcOffset = pc - codePtr->codeStart; size_t start; if (numRanges == 0) { return NULL; } /* * This exploits peculiarities of our compiler: nested ranges are always |
︙ | ︙ | |||
9125 9126 9127 9128 9129 9130 9131 | LiteralTable *globalTablePtr = &iPtr->literalTable; ByteCodeStats *statsPtr = &iPtr->stats; double totalCodeBytes, currentCodeBytes; double totalLiteralBytes, currentLiteralBytes; double objBytesIfUnshared, strBytesIfUnshared, sharingBytesSaved; double strBytesSharedMultX, strBytesSharedOnce; double numInstructions, currentHeaderBytes; | | | | < | 9125 9126 9127 9128 9129 9130 9131 9132 9133 9134 9135 9136 9137 9138 9139 9140 9141 | LiteralTable *globalTablePtr = &iPtr->literalTable; ByteCodeStats *statsPtr = &iPtr->stats; double totalCodeBytes, currentCodeBytes; double totalLiteralBytes, currentLiteralBytes; double objBytesIfUnshared, strBytesIfUnshared, sharingBytesSaved; double strBytesSharedMultX, strBytesSharedOnce; double numInstructions, currentHeaderBytes; size_t numCurrentByteCodes, numByteCodeLits; size_t refCountSum, literalMgmtBytes, sum, decadeHigh, length; size_t numSharedMultX, numSharedOnce, minSizeDecade, maxSizeDecade, i; char *litTableStats; LiteralEntry *entryPtr; Tcl_Obj *objPtr; #define Percent(a,b) ((a) * 100.0 / (b)) objPtr = Tcl_NewObj(); |
︙ | ︙ | |||
9173 9174 9175 9176 9177 9178 9179 | */ Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n"); Tcl_AppendPrintfToObj(objPtr, "Compilation and execution statistics for interpreter %p\n", iPtr); | | | | | | 9172 9173 9174 9175 9176 9177 9178 9179 9180 9181 9182 9183 9184 9185 9186 9187 9188 9189 9190 9191 9192 9193 9194 9195 9196 9197 9198 9199 9200 9201 9202 9203 9204 9205 9206 9207 9208 9209 9210 9211 9212 9213 9214 9215 9216 9217 9218 9219 9220 9221 | */ Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n"); Tcl_AppendPrintfToObj(objPtr, "Compilation and execution statistics for interpreter %p\n", iPtr); Tcl_AppendPrintfToObj(objPtr, "\nNumber ByteCodes executed\t%" TCL_Z_MODIFIER "u\n", statsPtr->numExecutions); Tcl_AppendPrintfToObj(objPtr, "Number ByteCodes compiled\t%" TCL_Z_MODIFIER "u\n", statsPtr->numCompilations); Tcl_AppendPrintfToObj(objPtr, " Mean executions/compile\t%.1f\n", statsPtr->numExecutions / (float)statsPtr->numCompilations); Tcl_AppendPrintfToObj(objPtr, "\nInstructions executed\t\t%.0f\n", numInstructions); Tcl_AppendPrintfToObj(objPtr, " Mean inst/compile\t\t%.0f\n", numInstructions / statsPtr->numCompilations); Tcl_AppendPrintfToObj(objPtr, " Mean inst/execution\t\t%.0f\n", numInstructions / statsPtr->numExecutions); Tcl_AppendPrintfToObj(objPtr, "\nTotal ByteCodes\t\t\t%" TCL_Z_MODIFIER "u\n", statsPtr->numCompilations); Tcl_AppendPrintfToObj(objPtr, " Source bytes\t\t\t%.6g\n", statsPtr->totalSrcBytes); Tcl_AppendPrintfToObj(objPtr, " Code bytes\t\t\t%.6g\n", totalCodeBytes); Tcl_AppendPrintfToObj(objPtr, " ByteCode bytes\t\t%.6g\n", statsPtr->totalByteCodeBytes); Tcl_AppendPrintfToObj(objPtr, " Literal bytes\t\t%.6g\n", totalLiteralBytes); Tcl_AppendPrintfToObj(objPtr, " table %" TCL_Z_MODIFIER "u + bkts %" TCL_Z_MODIFIER "u + entries %" TCL_Z_MODIFIER "u + objects %" TCL_Z_MODIFIER "u + strings %.6g\n", sizeof(LiteralTable), iPtr->literalTable.numBuckets * sizeof(LiteralEntry *), statsPtr->numLiteralsCreated * sizeof(LiteralEntry), statsPtr->numLiteralsCreated * sizeof(Tcl_Obj), statsPtr->totalLitStringBytes); Tcl_AppendPrintfToObj(objPtr, " Mean code/compile\t\t%.1f\n", totalCodeBytes / statsPtr->numCompilations); Tcl_AppendPrintfToObj(objPtr, " Mean code/source\t\t%.1f\n", totalCodeBytes / statsPtr->totalSrcBytes); Tcl_AppendPrintfToObj(objPtr, "\nCurrent (active) ByteCodes\t%" TCL_Z_MODIFIER "u\n", numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, " Source bytes\t\t\t%.6g\n", statsPtr->currentSrcBytes); Tcl_AppendPrintfToObj(objPtr, " Code bytes\t\t\t%.6g\n", currentCodeBytes); Tcl_AppendPrintfToObj(objPtr, " ByteCode bytes\t\t%.6g\n", statsPtr->currentByteCodeBytes); |
︙ | ︙ | |||
9239 9240 9241 9242 9243 9244 9245 | * * This gives the refcount of each obj as Tcl_IsShared was called for it. * Shared objects must be duplicated before they can be modified. */ numSharedMultX = 0; Tcl_AppendPrintfToObj(objPtr, "\nTcl_IsShared object check (all objects):\n"); | | | | | | 9238 9239 9240 9241 9242 9243 9244 9245 9246 9247 9248 9249 9250 9251 9252 9253 9254 9255 9256 9257 9258 9259 9260 9261 9262 | * * This gives the refcount of each obj as Tcl_IsShared was called for it. * Shared objects must be duplicated before they can be modified. */ numSharedMultX = 0; Tcl_AppendPrintfToObj(objPtr, "\nTcl_IsShared object check (all objects):\n"); Tcl_AppendPrintfToObj(objPtr, " Object had refcount <=1 (not shared)\t%" TCL_Z_MODIFIER "u\n", tclObjsShared[1]); for (i = 2; i < TCL_MAX_SHARED_OBJ_STATS; i++) { Tcl_AppendPrintfToObj(objPtr, " refcount ==%" TCL_Z_MODIFIER "u\t\t%" TCL_Z_MODIFIER "u\n", i, tclObjsShared[i]); numSharedMultX += tclObjsShared[i]; } Tcl_AppendPrintfToObj(objPtr, " refcount >=%" TCL_Z_MODIFIER "u\t\t%" TCL_Z_MODIFIER "u\n", i, tclObjsShared[0]); numSharedMultX += tclObjsShared[0]; Tcl_AppendPrintfToObj(objPtr, " Total shared objects\t\t\t%" TCL_Z_MODIFIER "u\n", numSharedMultX); /* * Literal table statistics. */ numByteCodeLits = 0; |
︙ | ︙ | |||
9286 9287 9288 9289 9290 9291 9292 | strBytesSharedOnce += (length+1); } } } sharingBytesSaved = (objBytesIfUnshared + strBytesIfUnshared) - currentLiteralBytes; | | | | | | | | 9285 9286 9287 9288 9289 9290 9291 9292 9293 9294 9295 9296 9297 9298 9299 9300 9301 9302 9303 9304 9305 9306 9307 9308 9309 9310 9311 9312 | strBytesSharedOnce += (length+1); } } } sharingBytesSaved = (objBytesIfUnshared + strBytesIfUnshared) - currentLiteralBytes; Tcl_AppendPrintfToObj(objPtr, "\nTotal objects (all interps)\t%" TCL_Z_MODIFIER "u\n", tclObjsAlloced); Tcl_AppendPrintfToObj(objPtr, "Current objects\t\t\t%" TCL_Z_MODIFIER "u\n", (tclObjsAlloced - tclObjsFreed)); Tcl_AppendPrintfToObj(objPtr, "Total literal objects\t\t%" TCL_Z_MODIFIER "u\n", statsPtr->numLiteralsCreated); Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal objects\t\t%" TCL_Z_MODIFIER "u (%0.1f%% of current objects)\n", globalTablePtr->numEntries, Percent(globalTablePtr->numEntries, tclObjsAlloced-tclObjsFreed)); Tcl_AppendPrintfToObj(objPtr, " ByteCode literals\t\t%" TCL_Z_MODIFIER "u (%0.1f%% of current literals)\n", numByteCodeLits, Percent(numByteCodeLits, globalTablePtr->numEntries)); Tcl_AppendPrintfToObj(objPtr, " Literals reused > 1x\t\t%" TCL_Z_MODIFIER "u\n", numSharedMultX); Tcl_AppendPrintfToObj(objPtr, " Mean reference count\t\t%.2f\n", ((double) refCountSum) / globalTablePtr->numEntries); Tcl_AppendPrintfToObj(objPtr, " Mean len, str reused >1x \t%.2f\n", (numSharedMultX ? strBytesSharedMultX/numSharedMultX : 0.0)); Tcl_AppendPrintfToObj(objPtr, " Mean len, str used 1x\t\t%.2f\n", (numSharedOnce ? strBytesSharedOnce/numSharedOnce : 0.0)); |
︙ | ︙ | |||
9324 9325 9326 9327 9328 9329 9330 | statsPtr->currentLitStringBytes); Tcl_AppendPrintfToObj(objPtr, " Bytes if no sharing\t\t%.6g = objects %.6g + strings %.6g\n", (objBytesIfUnshared + strBytesIfUnshared), objBytesIfUnshared, strBytesIfUnshared); Tcl_AppendPrintfToObj(objPtr, " String sharing savings \t%.6g = unshared %.6g - shared %.6g\n", (strBytesIfUnshared - statsPtr->currentLitStringBytes), strBytesIfUnshared, statsPtr->currentLitStringBytes); | | | 9323 9324 9325 9326 9327 9328 9329 9330 9331 9332 9333 9334 9335 9336 9337 | statsPtr->currentLitStringBytes); Tcl_AppendPrintfToObj(objPtr, " Bytes if no sharing\t\t%.6g = objects %.6g + strings %.6g\n", (objBytesIfUnshared + strBytesIfUnshared), objBytesIfUnshared, strBytesIfUnshared); Tcl_AppendPrintfToObj(objPtr, " String sharing savings \t%.6g = unshared %.6g - shared %.6g\n", (strBytesIfUnshared - statsPtr->currentLitStringBytes), strBytesIfUnshared, statsPtr->currentLitStringBytes); Tcl_AppendPrintfToObj(objPtr, " Literal mgmt overhead\t\t%" TCL_Z_MODIFIER "u (%0.1f%% of bytes with sharing)\n", literalMgmtBytes, Percent(literalMgmtBytes, currentLiteralBytes)); Tcl_AppendPrintfToObj(objPtr, " table %lu + buckets %lu + entries %lu\n", (unsigned long) sizeof(LiteralTable), (unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)), (unsigned long) (iPtr->literalTable.numEntries * sizeof(LiteralEntry))); |
︙ | ︙ | |||
9374 9375 9376 9377 9378 9379 9380 | /* * Detailed literal statistics. */ Tcl_AppendPrintfToObj(objPtr, "\nLiteral string sizes:\n"); Tcl_AppendPrintfToObj(objPtr, "\t Up to length\t\tPercentage\n"); maxSizeDecade = 0; | | > | | 9373 9374 9375 9376 9377 9378 9379 9380 9381 9382 9383 9384 9385 9386 9387 9388 9389 9390 9391 9392 9393 9394 9395 9396 9397 9398 | /* * Detailed literal statistics. */ Tcl_AppendPrintfToObj(objPtr, "\nLiteral string sizes:\n"); Tcl_AppendPrintfToObj(objPtr, "\t Up to length\t\tPercentage\n"); maxSizeDecade = 0; i = 32; while (i-- > 0) { if (statsPtr->literalCount[i] > 0) { maxSizeDecade = i; break; } } sum = 0; for (i = 0; i <= maxSizeDecade; i++) { decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->literalCount[i]; Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_Z_MODIFIER "u\t\t%8.0f%%\n", decadeHigh, Percent(sum, statsPtr->numLiteralsCreated)); } litTableStats = TclLiteralStats(globalTablePtr); Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal table statistics:\n%s\n", litTableStats); Tcl_Free(litTableStats); |
︙ | ︙ | |||
9416 9417 9418 9419 9420 9421 9422 | break; } } sum = 0; for (i = minSizeDecade; i <= maxSizeDecade; i++) { decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->srcCount[i]; | | | 9416 9417 9418 9419 9420 9421 9422 9423 9424 9425 9426 9427 9428 9429 9430 | break; } } sum = 0; for (i = minSizeDecade; i <= maxSizeDecade; i++) { decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->srcCount[i]; Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_Z_MODIFIER "u\t\t%8.0f%%\n", decadeHigh, Percent(sum, statsPtr->numCompilations)); } Tcl_AppendPrintfToObj(objPtr, "\nByteCode sizes:\n"); Tcl_AppendPrintfToObj(objPtr, "\t Up to size\t\tPercentage\n"); minSizeDecade = maxSizeDecade = 0; for (i = 0; i < 31; i++) { |
︙ | ︙ | |||
9439 9440 9441 9442 9443 9444 9445 | break; } } sum = 0; for (i = minSizeDecade; i <= maxSizeDecade; i++) { decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->byteCodeCount[i]; | | | 9439 9440 9441 9442 9443 9444 9445 9446 9447 9448 9449 9450 9451 9452 9453 | break; } } sum = 0; for (i = minSizeDecade; i <= maxSizeDecade; i++) { decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->byteCodeCount[i]; Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_Z_MODIFIER "u\t\t%8.0f%%\n", decadeHigh, Percent(sum, statsPtr->numCompilations)); } Tcl_AppendPrintfToObj(objPtr, "\nByteCode longevity (excludes Current ByteCodes):\n"); Tcl_AppendPrintfToObj(objPtr, "\t Up to ms\t\tPercentage\n"); minSizeDecade = maxSizeDecade = 0; for (i = 0; i < 31; i++) { |
︙ | ︙ | |||
9472 9473 9474 9475 9476 9477 9478 | /* * Instruction counts. */ Tcl_AppendPrintfToObj(objPtr, "\nInstruction counts:\n"); for (i = 0; i < LAST_INST_OPCODE; i++) { | | | 9472 9473 9474 9475 9476 9477 9478 9479 9480 9481 9482 9483 9484 9485 9486 | /* * Instruction counts. */ Tcl_AppendPrintfToObj(objPtr, "\nInstruction counts:\n"); for (i = 0; i < LAST_INST_OPCODE; i++) { Tcl_AppendPrintfToObj(objPtr, "%20s %8" TCL_Z_MODIFIER "u ", tclInstructionTable[i].name, statsPtr->instructionCount[i]); if (statsPtr->instructionCount[i]) { Tcl_AppendPrintfToObj(objPtr, "%6.1f%%\n", Percent(statsPtr->instructionCount[i], numInstructions)); } else { Tcl_AppendPrintfToObj(objPtr, "0\n"); } |
︙ | ︙ |
Changes to generic/tclFCmd.c.
︙ | ︙ | |||
1341 1342 1343 1344 1345 1346 1347 | Tcl_DecrRefCount(contents); return TCL_OK; } /* *--------------------------------------------------------------------------- * | | | 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 | Tcl_DecrRefCount(contents); return TCL_OK; } /* *--------------------------------------------------------------------------- * * TclFileTemporaryCmd -- * * This function implements the "tempfile" subcommand of the "file" * command. * * Results: * Returns a standard Tcl result. * |
︙ | ︙ | |||
1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 | Tcl_UnregisterChannel(interp, chan); return TCL_ERROR; } } Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1)); return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 | Tcl_UnregisterChannel(interp, chan); return TCL_ERROR; } } Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1)); return TCL_OK; } /* *--------------------------------------------------------------------------- * * TclFileTempDirCmd -- * * This function implements the "tempdir" subcommand of the "file" * command. * * Results: * Returns a standard Tcl result. * * Side effects: * Creates a temporary directory. * *--------------------------------------------------------------------------- */ int TclFileTempDirCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *dirNameObj; /* Object that will contain the directory * name. */ Tcl_Obj *baseDirObj = NULL, *nameBaseObj = NULL; /* Pieces of template. Each piece is NULL if * it is omitted. The platform temporary file * engine might ignore some pieces. */ if (objc < 1 || objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?template?"); return TCL_ERROR; } if (objc > 1) { int length; Tcl_Obj *templateObj = objv[1]; const char *string = TclGetStringFromObj(templateObj, &length); const int onWindows = (tclPlatform == TCL_PLATFORM_WINDOWS); /* * Treat an empty string as if it wasn't there. */ if (length == 0) { goto makeTemporary; } /* * The template only gives a directory if there is a directory * separator in it, and only gives a base name if there's at least one * character after the last directory separator. */ if (strchr(string, '/') == NULL && (!onWindows || strchr(string, '\\') == NULL)) { /* * No directory separator, so just assume we have a file name. * This is a bit wrong on Windows where we could have problems * with disk name prefixes... but those are much less common in * naked form so we just pass through and let the OS figure it out * instead. */ nameBaseObj = templateObj; Tcl_IncrRefCount(nameBaseObj); } else if (string[length-1] != '/' && (!onWindows || string[length-1] != '\\')) { /* * If the template has a non-terminal directory separator, split * into dirname and tail. */ baseDirObj = TclPathPart(interp, templateObj, TCL_PATH_DIRNAME); nameBaseObj = TclPathPart(interp, templateObj, TCL_PATH_TAIL); } else { /* * Otherwise, there must be a terminal directory separator, so * just the directory is given. */ baseDirObj = templateObj; Tcl_IncrRefCount(baseDirObj); } /* * Only allow creation of temporary directories in the native * filesystem since they are frequently used for integration with * external tools or system libraries. */ if (baseDirObj != NULL && Tcl_FSGetFileSystemForPath(baseDirObj) != &tclNativeFilesystem) { TclDecrRefCount(baseDirObj); baseDirObj = NULL; } } /* * Convert empty parts of the template into unspecified parts. */ if (baseDirObj && !TclGetString(baseDirObj)[0]) { TclDecrRefCount(baseDirObj); baseDirObj = NULL; } if (nameBaseObj && !TclGetString(nameBaseObj)[0]) { TclDecrRefCount(nameBaseObj); nameBaseObj = NULL; } /* * Create and open the temporary file. */ makeTemporary: dirNameObj = TclpCreateTemporaryDirectory(baseDirObj, nameBaseObj); /* * If we created pieces of template, get rid of them now. */ if (baseDirObj) { TclDecrRefCount(baseDirObj); } if (nameBaseObj) { TclDecrRefCount(nameBaseObj); } /* * Deal with results. */ if (dirNameObj == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't create temporary directory: %s", Tcl_PosixError(interp))); return TCL_ERROR; } Tcl_SetObjResult(interp, dirNameObj); return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to generic/tclHash.c.
︙ | ︙ | |||
280 281 282 283 284 285 286 | Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc; for (hPtr = tablePtr->buckets[index]; hPtr != NULL; hPtr = hPtr->nextPtr) { if (hash != hPtr->hash) { continue; } | > > | > | 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 | Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc; for (hPtr = tablePtr->buckets[index]; hPtr != NULL; hPtr = hPtr->nextPtr) { if (hash != hPtr->hash) { continue; } /* if keys pointers or values are equal */ if ((key == hPtr->key.oneWordValue) || compareKeysProc((void *) key, hPtr) ) { if (newPtr) { *newPtr = 0; } return hPtr; } } } else { |
︙ | ︙ | |||
775 776 777 778 779 780 781 | Tcl_HashEntry *hPtr; size_t size, allocsize; allocsize = size = strlen(string) + 1; if (size < sizeof(hPtr->key)) { allocsize = sizeof(hPtr->key); } | | | 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 | Tcl_HashEntry *hPtr; size_t size, allocsize; allocsize = size = strlen(string) + 1; if (size < sizeof(hPtr->key)) { allocsize = sizeof(hPtr->key); } hPtr = Tcl_Alloc(offsetof(Tcl_HashEntry, key) + allocsize); memcpy(hPtr->key.string, string, size); Tcl_SetHashValue(hPtr, NULL); return hPtr; } /* *---------------------------------------------------------------------- |
︙ | ︙ |
Changes to generic/tclIO.h.
︙ | ︙ | |||
46 47 48 49 50 51 52 | /* Next buffer in chain. */ char buf[1]; /* Placeholder for real buffer. The real * buffer occuppies this space + bufSize-1 * bytes. This must be the last field in the * structure. */ } ChannelBuffer; | | | 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 | /* Next buffer in chain. */ char buf[1]; /* Placeholder for real buffer. The real * buffer occuppies this space + bufSize-1 * bytes. This must be the last field in the * structure. */ } ChannelBuffer; #define CHANNELBUFFER_HEADER_SIZE offsetof(ChannelBuffer, buf) /* * How much extra space to allocate in buffer to hold bytes from previous * buffer (when converting to UTF-8) or to hold bytes that will go to next * buffer (when converting from UTF-8). */ |
︙ | ︙ |
Changes to generic/tclInt.decls.
︙ | ︙ | |||
148 149 150 151 152 153 154 | int TclGetFrame(Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr) } # Removed in 8.5: #declare 33 { # TclCmdProcType TclGetInterpProc(void) #} | > | | | < > | 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 | int TclGetFrame(Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr) } # Removed in 8.5: #declare 33 { # TclCmdProcType TclGetInterpProc(void) #} # Removed in 9.0: #declare 34 {deprecated {Use Tcl_GetIntForIndex}} { # int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, # int endValue, int *indexPtr) #} # Removed in 8.4b2: #declare 35 { # Tcl_Obj *TclGetIndexedScalar(Tcl_Interp *interp, int localIndex, # int flags) #} # Removed in 8.6a2: #declare 36 { |
︙ | ︙ | |||
610 611 612 613 614 615 616 | # Added for Tcl 8.2 declare 150 { int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re) } declare 151 { | | | | 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 | # Added for Tcl 8.2 declare 150 { int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re) } declare 151 { void TclRegExpRangeUniChar(Tcl_RegExp re, size_t index, size_t *startPtr, size_t *endPtr) } declare 152 { void TclSetLibraryPath(Tcl_Obj *pathPtr) } declare 153 { Tcl_Obj *TclGetLibraryPath(void) } |
︙ | ︙ | |||
1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 | int TclPtrUnsetVar(Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags) } declare 257 { void TclStaticPackage(Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc) } declare 258 { int TclMSB(size_t n) } ############################################################################## # Define the platform specific internal Tcl interface. These functions are # only available on the designated platform. | > > > > > > | 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 | int TclPtrUnsetVar(Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags) } declare 257 { void TclStaticPackage(Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc) } # TIP 431: temporary directory creation function declare 258 { Tcl_Obj *TclpCreateTemporaryDirectory(Tcl_Obj *dirObj, Tcl_Obj *basenameObj) } declare 259 { int TclMSB(size_t n) } ############################################################################## # Define the platform specific internal Tcl interface. These functions are # only available on the designated platform. |
︙ | ︙ |
Changes to generic/tclInt.h.
︙ | ︙ | |||
61 62 63 64 65 66 67 | #endif #ifdef NO_STRING_H #include "../compat/string.h" #else #include <string.h> #endif #if defined(STDC_HEADERS) || defined(__STDC__) || defined(__C99__FUNC__) \ | | | 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 | #endif #ifdef NO_STRING_H #include "../compat/string.h" #else #include <string.h> #endif #if defined(STDC_HEADERS) || defined(__STDC__) || defined(__C99__FUNC__) \ || defined(__cplusplus) || defined(_MSC_VER) || defined(__ICC) #include <stddef.h> #else typedef int ptrdiff_t; #endif /* * Ensure WORDS_BIGENDIAN is defined correctly: |
︙ | ︙ | |||
549 550 551 552 553 554 555 | void *clientData; /* Argument to pass to proc. */ int flags; /* What events the trace procedure is * interested in: OR-ed combination of * TCL_TRACE_RENAME, TCL_TRACE_DELETE. */ struct CommandTrace *nextPtr; /* Next in list of traces associated with a * particular command. */ | | | 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 | void *clientData; /* Argument to pass to proc. */ int flags; /* What events the trace procedure is * interested in: OR-ed combination of * TCL_TRACE_RENAME, TCL_TRACE_DELETE. */ struct CommandTrace *nextPtr; /* Next in list of traces associated with a * particular command. */ size_t refCount; /* Used to ensure this structure is not * deleted too early. Keeps track of how many * pieces of code have a pointer to this * structure. */ } CommandTrace; /* * When a command trace is active (i.e. its associated procedure is executing) |
︙ | ︙ | |||
1503 1504 1505 1506 1507 1508 1509 | * NULL if end of chain. */ Tcl_Obj *objPtr; /* Points to Tcl object that holds the * literal's bytes and length. */ size_t refCount; /* If in an interpreter's global literal * table, the number of ByteCode structures * that share the literal object; the literal * entry can be freed when refCount drops to | | | 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 | * NULL if end of chain. */ Tcl_Obj *objPtr; /* Points to Tcl object that holds the * literal's bytes and length. */ size_t refCount; /* If in an interpreter's global literal * table, the number of ByteCode structures * that share the literal object; the literal * entry can be freed when refCount drops to * 0. If in a local literal table, TCL_AUTO_LENGTH. */ Namespace *nsPtr; /* Namespace in which this literal is used. We * try to avoid sharing literal non-FQ command * names among different namespaces to reduce * shimmering. */ } LiteralEntry; typedef struct LiteralTable { |
︙ | ︙ | |||
2411 2412 2413 2414 2415 2416 2417 | #define TCL_EACH_KEEP_NONE 0 /* Discard iteration result like [foreach] */ #define TCL_EACH_COLLECT 1 /* Collect iteration result like [lmap] */ /* * Macros providing a faster path to booleans and integers: * Tcl_GetBooleanFromObj, Tcl_GetLongFromObj, Tcl_GetIntFromObj | | | 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 | #define TCL_EACH_KEEP_NONE 0 /* Discard iteration result like [foreach] */ #define TCL_EACH_COLLECT 1 /* Collect iteration result like [lmap] */ /* * Macros providing a faster path to booleans and integers: * Tcl_GetBooleanFromObj, Tcl_GetLongFromObj, Tcl_GetIntFromObj * and Tcl_GetIntForIndex. * * WARNING: these macros eval their args more than once. */ #define TclGetBooleanFromObj(interp, objPtr, boolPtr) \ (((objPtr)->typePtr == &tclIntType \ || (objPtr)->typePtr == &tclBooleanType) \ |
︙ | ︙ | |||
2447 2448 2449 2450 2451 2452 2453 | ? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \ : Tcl_GetIntFromObj((interp), (objPtr), (intPtr))) #define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \ (((objPtr)->typePtr == &tclIntType \ && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \ ? ((*(idxPtr) = ((objPtr)->internalRep.wideValue >= 0) \ ? (size_t)(objPtr)->internalRep.wideValue : TCL_INDEX_NONE), TCL_OK) \ | | | 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 | ? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \ : Tcl_GetIntFromObj((interp), (objPtr), (intPtr))) #define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \ (((objPtr)->typePtr == &tclIntType \ && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \ ? ((*(idxPtr) = ((objPtr)->internalRep.wideValue >= 0) \ ? (size_t)(objPtr)->internalRep.wideValue : TCL_INDEX_NONE), TCL_OK) \ : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr))) /* * Macro used to save a function call for common uses of * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is: * * MODULE_SCOPE int TclGetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, * Tcl_WideInt *wideIntPtr); |
︙ | ︙ | |||
2745 2746 2747 2748 2749 2750 2751 | * The head of the list of free Tcl objects, and the total number of Tcl * objects ever allocated and freed. */ MODULE_SCOPE Tcl_Obj * tclFreeObjList; #ifdef TCL_COMPILE_STATS | | | | | 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 | * The head of the list of free Tcl objects, and the total number of Tcl * objects ever allocated and freed. */ MODULE_SCOPE Tcl_Obj * tclFreeObjList; #ifdef TCL_COMPILE_STATS MODULE_SCOPE size_t tclObjsAlloced; MODULE_SCOPE size_t tclObjsFreed; #define TCL_MAX_SHARED_OBJ_STATS 5 MODULE_SCOPE size_t tclObjsShared[TCL_MAX_SHARED_OBJ_STATS]; #endif /* TCL_COMPILE_STATS */ /* * Pointer to a heap-allocated string of length zero that the Tcl core uses as * the value of an empty string representation for an object. This value is * shared by all new objects allocated by Tcl_NewObj. */ |
︙ | ︙ | |||
2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 | MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileDeleteCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileLinkCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileMakeDirsCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileReadLinkCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileRenameCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd; MODULE_SCOPE void TclCreateLateExitHandler(Tcl_ExitProc *proc, void *clientData); MODULE_SCOPE void TclDeleteLateExitHandler(Tcl_ExitProc *proc, void *clientData); MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr, Tcl_Obj *objPtr); | > | 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 | MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileDeleteCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileLinkCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileMakeDirsCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileReadLinkCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileRenameCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileTempDirCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd; MODULE_SCOPE void TclCreateLateExitHandler(Tcl_ExitProc *proc, void *clientData); MODULE_SCOPE void TclDeleteLateExitHandler(Tcl_ExitProc *proc, void *clientData); MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr, Tcl_Obj *objPtr); |
︙ | ︙ | |||
4053 4054 4055 4056 4057 4058 4059 | struct CompileEnv *envPtr); MODULE_SCOPE int TclDivOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileDivOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); | < < < < < < < < < < < < < < < < < < | 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 4080 4081 4082 | struct CompileEnv *envPtr); MODULE_SCOPE int TclDivOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileDivOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileLessOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileLeqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileGreaterOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileGeqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileEqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileStreqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileAssembleCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); |
︙ | ︙ | |||
4228 4229 4230 4231 4232 4233 4234 | MODULE_SCOPE int TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr, size_t before, size_t after, int *indexPtr); MODULE_SCOPE size_t TclIndexDecode(int encoded, size_t endValue); /* Constants used in index value encoding routines. */ #define TCL_INDEX_END ((size_t)-2) | < | 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 | MODULE_SCOPE int TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr, size_t before, size_t after, int *indexPtr); MODULE_SCOPE size_t TclIndexDecode(int encoded, size_t endValue); /* Constants used in index value encoding routines. */ #define TCL_INDEX_END ((size_t)-2) #define TCL_INDEX_START ((size_t)0) /* *---------------------------------------------------------------- * Macros used by the Tcl core to create and release Tcl objects. * TclNewObj(objPtr) creates a new object denoting an empty string. * TclDecrRefCount(objPtr) decrements the object's reference count, and frees |
︙ | ︙ | |||
4938 4939 4940 4941 4942 4943 4944 | # ifdef NO_ISNAN # define TclIsNaN(d) ((d) != (d)) # else # define TclIsNaN(d) (isnan(d)) # endif #endif | < < < < < | | < < | | 4920 4921 4922 4923 4924 4925 4926 4927 4928 4929 4930 4931 4932 4933 4934 4935 4936 | # ifdef NO_ISNAN # define TclIsNaN(d) ((d) != (d)) # else # define TclIsNaN(d) (isnan(d)) # endif #endif /* Workaround for platforms missing offsetof(), e.g. VC++ 6.0 */ #ifndef offsetof # define offsetof(type, field) ((size_t) ((char *) &((type *) 0)->field)) #endif /* *---------------------------------------------------------------- * Inline version of Tcl_GetCurrentNamespace and Tcl_GetGlobalNamespace. */ |
︙ | ︙ | |||
5072 5073 5074 5075 5076 5077 5078 | */ #if (!defined(TCL_WIDE_INT_IS_LONG) || (LONG_MAX > UINT_MAX)) && (SIZE_MAX <= UINT_MAX) # define TclWideIntFromSize(value) (((Tcl_WideInt)(((size_t)(value))+1))-1) # define TclNewWideIntObjFromSize(value) \ Tcl_NewWideIntObj(TclWideIntFromSize(value)) #else | | | 5047 5048 5049 5050 5051 5052 5053 5054 5055 5056 5057 5058 5059 5060 5061 | */ #if (!defined(TCL_WIDE_INT_IS_LONG) || (LONG_MAX > UINT_MAX)) && (SIZE_MAX <= UINT_MAX) # define TclWideIntFromSize(value) (((Tcl_WideInt)(((size_t)(value))+1))-1) # define TclNewWideIntObjFromSize(value) \ Tcl_NewWideIntObj(TclWideIntFromSize(value)) #else # define TclWideIntFromSize(value) ((Tcl_WideInt)(value)) # define TclNewWideIntObjFromSize Tcl_NewWideIntObj #endif /* * Support for Clang Static Analyzer <http://clang-analyzer.llvm.org> */ |
︙ | ︙ |
Changes to generic/tclIntDecls.h.
︙ | ︙ | |||
104 105 106 107 108 109 110 | /* Slot 30 is reserved */ /* 31 */ EXTERN const char * TclGetExtension(const char *name); /* 32 */ EXTERN int TclGetFrame(Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr); /* Slot 33 is reserved */ | | < < < | 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 | /* Slot 30 is reserved */ /* 31 */ EXTERN const char * TclGetExtension(const char *name); /* 32 */ EXTERN int TclGetFrame(Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr); /* Slot 33 is reserved */ /* Slot 34 is reserved */ /* Slot 35 is reserved */ /* Slot 36 is reserved */ /* 37 */ EXTERN int TclGetLoadedPackages(Tcl_Interp *interp, const char *targetName); /* 38 */ EXTERN int TclGetNamespaceForQualName(Tcl_Interp *interp, |
︙ | ︙ | |||
333 334 335 336 337 338 339 | EXTERN TclHandle TclHandlePreserve(TclHandle handle); /* 149 */ EXTERN void TclHandleRelease(TclHandle handle); /* 150 */ EXTERN int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re); /* 151 */ EXTERN void TclRegExpRangeUniChar(Tcl_RegExp re, size_t index, | | | 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 | EXTERN TclHandle TclHandlePreserve(TclHandle handle); /* 149 */ EXTERN void TclHandleRelease(TclHandle handle); /* 150 */ EXTERN int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re); /* 151 */ EXTERN void TclRegExpRangeUniChar(Tcl_RegExp re, size_t index, size_t *startPtr, size_t *endPtr); /* 152 */ EXTERN void TclSetLibraryPath(Tcl_Obj *pathPtr); /* 153 */ EXTERN Tcl_Obj * TclGetLibraryPath(void); /* Slot 154 is reserved */ /* Slot 155 is reserved */ /* 156 */ |
︙ | ︙ | |||
580 581 582 583 584 585 586 587 588 589 590 591 592 593 | Tcl_Obj *part2Ptr, const int flags); /* 257 */ EXTERN void TclStaticPackage(Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 258 */ EXTERN int TclMSB(size_t n); typedef struct TclIntStubs { int magic; void *hooks; void (*reserved0)(void); | > > > | 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 | Tcl_Obj *part2Ptr, const int flags); /* 257 */ EXTERN void TclStaticPackage(Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 258 */ EXTERN Tcl_Obj * TclpCreateTemporaryDirectory(Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 259 */ EXTERN int TclMSB(size_t n); typedef struct TclIntStubs { int magic; void *hooks; void (*reserved0)(void); |
︙ | ︙ | |||
620 621 622 623 624 625 626 | void (*reserved27)(void); Tcl_Channel (*tclpGetDefaultStdChannel) (int type); /* 28 */ void (*reserved29)(void); void (*reserved30)(void); const char * (*tclGetExtension) (const char *name); /* 31 */ int (*tclGetFrame) (Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr); /* 32 */ void (*reserved33)(void); | | | 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 | void (*reserved27)(void); Tcl_Channel (*tclpGetDefaultStdChannel) (int type); /* 28 */ void (*reserved29)(void); void (*reserved30)(void); const char * (*tclGetExtension) (const char *name); /* 31 */ int (*tclGetFrame) (Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr); /* 32 */ void (*reserved33)(void); void (*reserved34)(void); void (*reserved35)(void); void (*reserved36)(void); int (*tclGetLoadedPackages) (Tcl_Interp *interp, const char *targetName); /* 37 */ int (*tclGetNamespaceForQualName) (Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 38 */ TclObjCmdProcType (*tclGetObjInterpProc) (void); /* 39 */ int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 40 */ Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */ |
︙ | ︙ | |||
737 738 739 740 741 742 743 | void (*tclHideLiteral) (Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 144 */ const struct AuxDataType * (*tclGetAuxDataType) (const char *typeName); /* 145 */ TclHandle (*tclHandleCreate) (void *ptr); /* 146 */ void (*tclHandleFree) (TclHandle handle); /* 147 */ TclHandle (*tclHandlePreserve) (TclHandle handle); /* 148 */ void (*tclHandleRelease) (TclHandle handle); /* 149 */ int (*tclRegAbout) (Tcl_Interp *interp, Tcl_RegExp re); /* 150 */ | | | 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 | void (*tclHideLiteral) (Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 144 */ const struct AuxDataType * (*tclGetAuxDataType) (const char *typeName); /* 145 */ TclHandle (*tclHandleCreate) (void *ptr); /* 146 */ void (*tclHandleFree) (TclHandle handle); /* 147 */ TclHandle (*tclHandlePreserve) (TclHandle handle); /* 148 */ void (*tclHandleRelease) (TclHandle handle); /* 149 */ int (*tclRegAbout) (Tcl_Interp *interp, Tcl_RegExp re); /* 150 */ void (*tclRegExpRangeUniChar) (Tcl_RegExp re, size_t index, size_t *startPtr, size_t *endPtr); /* 151 */ void (*tclSetLibraryPath) (Tcl_Obj *pathPtr); /* 152 */ Tcl_Obj * (*tclGetLibraryPath) (void); /* 153 */ void (*reserved154)(void); void (*reserved155)(void); void (*tclRegError) (Tcl_Interp *interp, const char *msg, int status); /* 156 */ Var * (*tclVarTraceExists) (Tcl_Interp *interp, const char *varName); /* 157 */ void (*reserved158)(void); |
︙ | ︙ | |||
844 845 846 847 848 849 850 | int (*tclRegisterLiteral) (void *envPtr, const char *bytes, size_t length, int flags); /* 251 */ Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 252 */ Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, const int flags); /* 253 */ Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, const int flags); /* 254 */ int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */ int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 256 */ void (*tclStaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 257 */ | > | | 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 | int (*tclRegisterLiteral) (void *envPtr, const char *bytes, size_t length, int flags); /* 251 */ Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 252 */ Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, const int flags); /* 253 */ Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, const int flags); /* 254 */ int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */ int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 256 */ void (*tclStaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 257 */ Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */ int (*tclMSB) (size_t n); /* 259 */ } TclIntStubs; extern const TclIntStubs *tclIntStubsPtr; #ifdef __cplusplus } #endif |
︙ | ︙ | |||
910 911 912 913 914 915 916 | /* Slot 29 is reserved */ /* Slot 30 is reserved */ #define TclGetExtension \ (tclIntStubsPtr->tclGetExtension) /* 31 */ #define TclGetFrame \ (tclIntStubsPtr->tclGetFrame) /* 32 */ /* Slot 33 is reserved */ | | < | 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 | /* Slot 29 is reserved */ /* Slot 30 is reserved */ #define TclGetExtension \ (tclIntStubsPtr->tclGetExtension) /* 31 */ #define TclGetFrame \ (tclIntStubsPtr->tclGetFrame) /* 32 */ /* Slot 33 is reserved */ /* Slot 34 is reserved */ /* Slot 35 is reserved */ /* Slot 36 is reserved */ #define TclGetLoadedPackages \ (tclIntStubsPtr->tclGetLoadedPackages) /* 37 */ #define TclGetNamespaceForQualName \ (tclIntStubsPtr->tclGetNamespaceForQualName) /* 38 */ #define TclGetObjInterpProc \ |
︙ | ︙ | |||
1262 1263 1264 1265 1266 1267 1268 1269 | (tclIntStubsPtr->tclPtrIncrObjVar) /* 254 */ #define TclPtrObjMakeUpvar \ (tclIntStubsPtr->tclPtrObjMakeUpvar) /* 255 */ #define TclPtrUnsetVar \ (tclIntStubsPtr->tclPtrUnsetVar) /* 256 */ #define TclStaticPackage \ (tclIntStubsPtr->tclStaticPackage) /* 257 */ #define TclMSB \ | > > | | 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 | (tclIntStubsPtr->tclPtrIncrObjVar) /* 254 */ #define TclPtrObjMakeUpvar \ (tclIntStubsPtr->tclPtrObjMakeUpvar) /* 255 */ #define TclPtrUnsetVar \ (tclIntStubsPtr->tclPtrUnsetVar) /* 256 */ #define TclStaticPackage \ (tclIntStubsPtr->tclStaticPackage) /* 257 */ #define TclpCreateTemporaryDirectory \ (tclIntStubsPtr->tclpCreateTemporaryDirectory) /* 258 */ #define TclMSB \ (tclIntStubsPtr->tclMSB) /* 259 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #if defined(USE_TCL_STUBS) #undef Tcl_StaticPackage |
︙ | ︙ |
Changes to generic/tclLink.c.
︙ | ︙ | |||
29 30 31 32 33 34 35 | Tcl_Interp *interp; /* Interpreter containing Tcl variable. */ Namespace *nsPtr; /* Namespace containing Tcl variable */ Tcl_Obj *varName; /* Name of variable (must be global). This is * needed during trace callbacks, since the * actual variable may be aliased at that time * via upvar. */ void *addr; /* Location of C variable. */ | | | | 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 | Tcl_Interp *interp; /* Interpreter containing Tcl variable. */ Namespace *nsPtr; /* Namespace containing Tcl variable */ Tcl_Obj *varName; /* Name of variable (must be global). This is * needed during trace callbacks, since the * actual variable may be aliased at that time * via upvar. */ void *addr; /* Location of C variable. */ size_t bytes; /* Size of C variable array. This is 0 when * single variables, and >0 used for array * variables. */ size_t numElems; /* Number of elements in C variable array. * Zero for single variables. */ int type; /* Type of link (TCL_LINK_INT, etc.). */ union { char c; unsigned char uc; int i; unsigned int ui; |
︙ | ︙ | |||
241 242 243 244 245 246 247 | const char *varName, /* Name of a global variable in interp. */ void *addr, /* Address of a C variable to be linked to * varName. If NULL then the necessary space * will be allocated and returned as the * interpreter result. */ int type, /* Type of C variable: TCL_LINK_INT, etc. Also * may have TCL_LINK_READ_ONLY OR'ed in. */ | | | 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 | const char *varName, /* Name of a global variable in interp. */ void *addr, /* Address of a C variable to be linked to * varName. If NULL then the necessary space * will be allocated and returned as the * interpreter result. */ int type, /* Type of C variable: TCL_LINK_INT, etc. Also * may have TCL_LINK_READ_ONLY OR'ed in. */ size_t size) /* Size of C variable array, >1 if array */ { Tcl_Obj *objPtr; Link *linkPtr; Namespace *dummy; const char *name; int code; |
︙ | ︙ | |||
740 741 742 743 744 745 746 | Tcl_Interp *interp, /* Interpreter containing Tcl variable. */ const char *name1, /* First part of variable name. */ const char *name2, /* Second part of variable name. */ int flags) /* Miscellaneous additional information. */ { Link *linkPtr = clientData; int changed; | | | 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 | Tcl_Interp *interp, /* Interpreter containing Tcl variable. */ const char *name1, /* First part of variable name. */ const char *name2, /* Second part of variable name. */ int flags) /* Miscellaneous additional information. */ { Link *linkPtr = clientData; int changed; size_t valueLength = 0; const char *value; char **pp; Tcl_Obj *valueObj; int valueInt; Tcl_WideInt valueWide; Tcl_WideUInt valueUWide; double valueDouble; |
︙ | ︙ | |||
890 891 892 893 894 895 896 | pp = (char **) linkPtr->addr; *pp = Tcl_Realloc(*pp, ++valueLength); memcpy(*pp, value, valueLength); return NULL; case TCL_LINK_CHARS: | | | | 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 | pp = (char **) linkPtr->addr; *pp = Tcl_Realloc(*pp, ++valueLength); memcpy(*pp, value, valueLength); return NULL; case TCL_LINK_CHARS: value = (char *) TclGetStringFromObj(valueObj, &valueLength); valueLength++; /* include end of string char */ if (valueLength > linkPtr->bytes) { return (char *) "wrong size of char* value"; } if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, value, (size_t) valueLength); memcpy(linkPtr->addr, value, (size_t) valueLength); } else { linkPtr->lastValue.c = '\0'; LinkedVar(char) = linkPtr->lastValue.c; } return NULL; case TCL_LINK_BINARY: value = (char *) TclGetByteArrayFromObj(valueObj, &valueLength); if (valueLength != linkPtr->bytes) { return (char *) "wrong size of binary value"; } if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, value, (size_t) valueLength); memcpy(linkPtr->addr, value, (size_t) valueLength); } else { |
︙ | ︙ | |||
933 934 935 936 937 938 939 | /* * If we're working with an array of numbers, extract the Tcl list. */ if (linkPtr->flags & LINK_ALLOC_LAST) { if (Tcl_ListObjGetElements(NULL, (valueObj), &objc, &objv) == TCL_ERROR | | | 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 | /* * If we're working with an array of numbers, extract the Tcl list. */ if (linkPtr->flags & LINK_ALLOC_LAST) { if (Tcl_ListObjGetElements(NULL, (valueObj), &objc, &objv) == TCL_ERROR || (size_t)objc != linkPtr->numElems) { return (char *) "wrong dimension"; } } switch (linkPtr->type) { case TCL_LINK_INT: if (linkPtr->flags & LINK_ALLOC_LAST) { |
︙ | ︙ | |||
1273 1274 1275 1276 1277 1278 1279 | static Tcl_Obj * ObjValue( Link *linkPtr) /* Structure describing linked variable. */ { char *p; Tcl_Obj *resultObj, **objv; | | | 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 | static Tcl_Obj * ObjValue( Link *linkPtr) /* Structure describing linked variable. */ { char *p; Tcl_Obj *resultObj, **objv; size_t i; switch (linkPtr->type) { case TCL_LINK_INT: if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); objv = Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { |
︙ | ︙ |
Changes to generic/tclLiteral.c.
︙ | ︙ | |||
232 233 234 235 236 237 238 | } if ((flags & LITERAL_ON_HEAP)) { Tcl_Free((void *)bytes); } if (globalPtrPtr) { *globalPtrPtr = globalPtr; } else { | > | > | | | | 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 | } if ((flags & LITERAL_ON_HEAP)) { Tcl_Free((void *)bytes); } if (globalPtrPtr) { *globalPtrPtr = globalPtr; } else { if (globalPtr->refCount != TCL_AUTO_LENGTH) { globalPtr->refCount++; } #ifdef TCL_COMPILE_DEBUG if (globalPtr->refCount + 1 < 2) { Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %" TCL_Z_MODIFIER "u", "TclRegisterLiteral", (length>60? 60 : length), bytes, globalPtr->refCount); } #endif } return objPtr; } } } |
︙ | ︙ | |||
706 707 708 709 710 711 712 | if (entryPtr->objPtr == objPtr) { /* * If the literal is no longer being used by any ByteCode, delete * the entry then remove the reference corresponding to the global * literal table entry (decrement the ref count of the object). */ | | | 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 | if (entryPtr->objPtr == objPtr) { /* * If the literal is no longer being used by any ByteCode, delete * the entry then remove the reference corresponding to the global * literal table entry (decrement the ref count of the object). */ if ((entryPtr->refCount != TCL_AUTO_LENGTH) && (entryPtr->refCount-- <= 1)) { if (prevPtr == NULL) { globalTablePtr->buckets[index] = entryPtr->nextPtr; } else { prevPtr->nextPtr = entryPtr->nextPtr; } Tcl_Free(entryPtr); globalTablePtr->numEntries--; |
︙ | ︙ | |||
981 982 983 984 985 986 987 | */ result = Tcl_Alloc(NUM_COUNTERS*60 + 300); sprintf(result, "%" TCL_Z_MODIFIER "u entries in table, %" TCL_Z_MODIFIER "u buckets\n", tablePtr->numEntries, tablePtr->numBuckets); p = result + strlen(result); for (i=0 ; i<NUM_COUNTERS ; i++) { | | | | 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 | */ result = Tcl_Alloc(NUM_COUNTERS*60 + 300); sprintf(result, "%" TCL_Z_MODIFIER "u entries in table, %" TCL_Z_MODIFIER "u buckets\n", tablePtr->numEntries, tablePtr->numBuckets); p = result + strlen(result); for (i=0 ; i<NUM_COUNTERS ; i++) { sprintf(p, "number of buckets with %" TCL_Z_MODIFIER "u entries: %" TCL_Z_MODIFIER "u\n", i, count[i]); p += strlen(p); } sprintf(p, "number of buckets with %d or more entries: %" TCL_Z_MODIFIER "u\n", NUM_COUNTERS, overflow); p += strlen(p); sprintf(p, "average search distance for entry: %.1f", average); return result; } #endif /*TCL_COMPILE_STATS*/ |
︙ | ︙ | |||
1062 1063 1064 1065 1066 1067 1068 | for (i=0 ; i<globalTablePtr->numBuckets ; i++) { for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL; globalPtr=globalPtr->nextPtr) { count++; if (globalPtr->refCount + 1 < 2) { bytes = TclGetStringFromObj(globalPtr->objPtr, &length); | | | | 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 | for (i=0 ; i<globalTablePtr->numBuckets ; i++) { for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL; globalPtr=globalPtr->nextPtr) { count++; if (globalPtr->refCount + 1 < 2) { bytes = TclGetStringFromObj(globalPtr->objPtr, &length); Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %" TCL_Z_MODIFIER "u", "TclVerifyGlobalLiteralTable", (length>60? 60 : (int)length), bytes, globalPtr->refCount); } if (globalPtr->objPtr->bytes == NULL) { Tcl_Panic("%s: literal has NULL string rep", "TclVerifyGlobalLiteralTable"); } } } if (count != globalTablePtr->numEntries) { Tcl_Panic("%s: global literal table had %" TCL_Z_MODIFIER "u entries, should be %" TCL_Z_MODIFIER "u", "TclVerifyGlobalLiteralTable", count, globalTablePtr->numEntries); } } #endif /*TCL_COMPILE_DEBUG*/ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to generic/tclOOMethod.c.
︙ | ︙ | |||
117 118 119 120 121 122 123 | /* * Helper macros (derived from things private to tclVar.c) */ #define TclVarTable(contextNs) \ ((Tcl_HashTable *) (&((Namespace *) (contextNs))->varTable)) #define TclVarHashGetValue(hPtr) \ | | | 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 | /* * Helper macros (derived from things private to tclVar.c) */ #define TclVarTable(contextNs) \ ((Tcl_HashTable *) (&((Namespace *) (contextNs))->varTable)) #define TclVarHashGetValue(hPtr) \ ((Tcl_Var) ((char *)hPtr - offsetof(VarInHash, entry))) /* * ---------------------------------------------------------------------- * * Tcl_NewInstanceMethod -- * * Attach a method to an object instance. |
︙ | ︙ |
Changes to generic/tclProc.c.
︙ | ︙ | |||
630 631 632 633 634 635 636 | localPtr = localPtr->nextPtr; } else { /* * Allocate an entry in the runtime procedure frame's array of * local variables for the argument. */ | | | 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 | localPtr = localPtr->nextPtr; } else { /* * Allocate an entry in the runtime procedure frame's array of * local variables for the argument. */ localPtr = Tcl_Alloc(offsetof(CompiledLocal, name) + fieldValues[0]->length +1); if (procPtr->firstLocalPtr == NULL) { procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr; } else { procPtr->lastLocalPtr->nextPtr = localPtr; procPtr->lastLocalPtr = localPtr; } localPtr->nextPtr = NULL; |
︙ | ︙ |
Changes to generic/tclRegexp.c.
︙ | ︙ | |||
260 261 262 263 264 265 266 | * in (sub-)range here. */ { TclRegexp *regexpPtr = (TclRegexp *) re; const char *string; if (index > regexpPtr->re.re_nsub) { *startPtr = *endPtr = NULL; | | | 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 | * in (sub-)range here. */ { TclRegexp *regexpPtr = (TclRegexp *) re; const char *string; if (index > regexpPtr->re.re_nsub) { *startPtr = *endPtr = NULL; } else if (regexpPtr->matches[index].rm_so == TCL_INDEX_NONE) { *startPtr = *endPtr = NULL; } else { if (regexpPtr->objPtr) { string = TclGetString(regexpPtr->objPtr); } else { string = regexpPtr->string; } |
︙ | ︙ | |||
359 360 361 362 363 364 365 | void TclRegExpRangeUniChar( Tcl_RegExp re, /* Compiled regular expression that has been * passed to Tcl_RegExpExec. */ size_t index, /* 0 means give the range of the entire match, * > 0 means give the range of a matching | | | | | | | | | 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 | void TclRegExpRangeUniChar( Tcl_RegExp re, /* Compiled regular expression that has been * passed to Tcl_RegExpExec. */ size_t index, /* 0 means give the range of the entire match, * > 0 means give the range of a matching * subrange, TCL_INDEX_NONE means the range of the * rm_extend field. */ size_t *startPtr, /* Store address of first character in * (sub-)range here. */ size_t *endPtr) /* Store address of character just after last * in (sub-)range here. */ { TclRegexp *regexpPtr = (TclRegexp *) re; if ((regexpPtr->flags®_EXPECT) && (index == TCL_INDEX_NONE)) { *startPtr = regexpPtr->details.rm_extend.rm_so; *endPtr = regexpPtr->details.rm_extend.rm_eo; } else if (index + 1 > regexpPtr->re.re_nsub + 1) { *startPtr = TCL_INDEX_NONE; *endPtr = TCL_INDEX_NONE; } else { *startPtr = regexpPtr->matches[index].rm_so; *endPtr = regexpPtr->matches[index].rm_eo; } } /* |
︙ | ︙ | |||
673 674 675 676 677 678 679 | * Assume that there will never be more than INT_MAX subexpressions. This * is a pretty reasonable assumption; the RE engine doesn't scale _that_ * well and Tcl has other limits that constrain things as well... */ resultObj = Tcl_NewObj(); Tcl_ListObjAppendElement(NULL, resultObj, | | | 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 | * Assume that there will never be more than INT_MAX subexpressions. This * is a pretty reasonable assumption; the RE engine doesn't scale _that_ * well and Tcl has other limits that constrain things as well... */ resultObj = Tcl_NewObj(); Tcl_ListObjAppendElement(NULL, resultObj, TclNewWideIntObjFromSize(regexpPtr->re.re_nsub)); /* * Now append a list of all the bit-flags set for the RE. */ TclNewObj(infoObj); for (inf=infonames ; inf->bit != 0 ; inf++) { |
︙ | ︙ |
Changes to generic/tclStrToD.c.
︙ | ︙ | |||
4517 4518 4519 4520 4521 4522 4523 | if (lsb == -1-shift) { /* * Round to even */ mp_div_2d(a, -shift, &b, NULL); | | | 4517 4518 4519 4520 4521 4522 4523 4524 4525 4526 4527 4528 4529 4530 4531 | if (lsb == -1-shift) { /* * Round to even */ mp_div_2d(a, -shift, &b, NULL); if (mp_isodd(&b)) { if (b.sign == MP_ZPOS) { mp_add_d(&b, 1, &b); } else { mp_sub_d(&b, 1, &b); } } } else { |
︙ | ︙ |
Changes to generic/tclStringObj.c.
︙ | ︙ | |||
1400 1401 1402 1403 1404 1405 1406 | * "TCL STRING GROWTH ALGORITHM" comment at the top of this file for an * explanation of this growth algorithm. */ numChars = stringPtr->numChars + appendNumChars; if (numChars > stringPtr->maxChars) { | | | | | | 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 | * "TCL STRING GROWTH ALGORITHM" comment at the top of this file for an * explanation of this growth algorithm. */ numChars = stringPtr->numChars + appendNumChars; if (numChars > stringPtr->maxChars) { size_t index = TCL_INDEX_NONE; /* * Protect against case where unicode points into the existing * stringPtr->unicode array. Force it to follow any relocations due to * the reallocs below. */ if (unicode && unicode >= stringPtr->unicode && unicode <= stringPtr->unicode + stringPtr->maxChars) { index = unicode - stringPtr->unicode; } GrowUnicodeBuffer(objPtr, numChars); stringPtr = GET_STRING(objPtr); /* * Relocate unicode if needed; see above. */ if (index != TCL_INDEX_NONE) { unicode = stringPtr->unicode + index; } } /* * Copy the new string onto the end of the old string, then add the * trailing null. */ |
︙ | ︙ |
Changes to generic/tclStubInit.c.
︙ | ︙ | |||
230 231 232 233 234 235 236 | 0, /* 27 */ TclpGetDefaultStdChannel, /* 28 */ 0, /* 29 */ 0, /* 30 */ TclGetExtension, /* 31 */ TclGetFrame, /* 32 */ 0, /* 33 */ | | | 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 | 0, /* 27 */ TclpGetDefaultStdChannel, /* 28 */ 0, /* 29 */ 0, /* 30 */ TclGetExtension, /* 31 */ TclGetFrame, /* 32 */ 0, /* 33 */ 0, /* 34 */ 0, /* 35 */ 0, /* 36 */ TclGetLoadedPackages, /* 37 */ TclGetNamespaceForQualName, /* 38 */ TclGetObjInterpProc, /* 39 */ TclGetOpenMode, /* 40 */ TclGetOriginalCommand, /* 41 */ |
︙ | ︙ | |||
454 455 456 457 458 459 460 | TclRegisterLiteral, /* 251 */ TclPtrGetVar, /* 252 */ TclPtrSetVar, /* 253 */ TclPtrIncrObjVar, /* 254 */ TclPtrObjMakeUpvar, /* 255 */ TclPtrUnsetVar, /* 256 */ TclStaticPackage, /* 257 */ | > | | 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 | TclRegisterLiteral, /* 251 */ TclPtrGetVar, /* 252 */ TclPtrSetVar, /* 253 */ TclPtrIncrObjVar, /* 254 */ TclPtrObjMakeUpvar, /* 255 */ TclPtrUnsetVar, /* 256 */ TclStaticPackage, /* 257 */ TclpCreateTemporaryDirectory, /* 258 */ TclMSB, /* 259 */ }; static const TclIntPlatStubs tclIntPlatStubs = { TCL_STUB_MAGIC, 0, #if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ TclGetAndDetachPids, /* 0 */ |
︙ | ︙ | |||
650 651 652 653 654 655 656 | 0, /* 66 */ TclBN_mp_expt_d_ex, /* 67 */ TclBN_mp_set_long_long, /* 68 */ TclBN_mp_get_long_long, /* 69 */ TclBN_mp_set_long, /* 70 */ TclBN_mp_get_long, /* 71 */ TclBN_mp_get_int, /* 72 */ | | | | | | 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 | 0, /* 66 */ TclBN_mp_expt_d_ex, /* 67 */ TclBN_mp_set_long_long, /* 68 */ TclBN_mp_get_long_long, /* 69 */ TclBN_mp_set_long, /* 70 */ TclBN_mp_get_long, /* 71 */ TclBN_mp_get_int, /* 72 */ 0, /* 73 */ 0, /* 74 */ 0, /* 75 */ TclBN_mp_signed_rsh, /* 76 */ TclBN_mp_get_bit, /* 77 */ }; static const TclStubHooks tclStubHooks = { &tclPlatStubs, &tclIntStubs, &tclIntPlatStubs |
︙ | ︙ | |||
1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 | Tcl_FetchIntRep, /* 638 */ Tcl_StoreIntRep, /* 639 */ Tcl_HasStringRep, /* 640 */ Tcl_IncrRefCount, /* 641 */ Tcl_DecrRefCount, /* 642 */ Tcl_IsShared, /* 643 */ Tcl_LinkArray, /* 644 */ }; /* !END!: Do not edit above this line. */ | > | 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 | Tcl_FetchIntRep, /* 638 */ Tcl_StoreIntRep, /* 639 */ Tcl_HasStringRep, /* 640 */ Tcl_IncrRefCount, /* 641 */ Tcl_DecrRefCount, /* 642 */ Tcl_IsShared, /* 643 */ Tcl_LinkArray, /* 644 */ Tcl_GetIntForIndex, /* 645 */ }; /* !END!: Do not edit above this line. */ |
Changes to generic/tclTest.c.
︙ | ︙ | |||
344 345 346 347 348 349 350 | static int TestregexpObjCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestreturnObjCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static void TestregexpXflags(const char *string, | | | 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 | static int TestregexpObjCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestreturnObjCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static void TestregexpXflags(const char *string, size_t length, int *cflagsPtr, int *eflagsPtr); static int TestsaveresultCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static void TestsaveresultFree(void *blockPtr); static int TestsetassocdataCmd(void *dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestsetCmd(void *dummy, |
︙ | ︙ | |||
4052 4053 4054 4055 4056 4057 4058 | * value 0. */ Tcl_SetIntObj(Tcl_GetObjResult(interp), 0); if (objc > 2 && (cflags®_EXPECT) && indices) { const char *varName; const char *value; | | | | | | | | | | | | | 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090 4091 4092 4093 4094 4095 4096 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 4107 4108 4109 4110 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 4122 4123 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 4139 4140 4141 | * value 0. */ Tcl_SetIntObj(Tcl_GetObjResult(interp), 0); if (objc > 2 && (cflags®_EXPECT) && indices) { const char *varName; const char *value; size_t start, end; char resinfo[TCL_INTEGER_SPACE * 2]; varName = Tcl_GetString(objv[2]); TclRegExpRangeUniChar(regExpr, -1, &start, &end); sprintf(resinfo, "%" TCL_LL_MODIFIER "d %" TCL_LL_MODIFIER "d", TclWideIntFromSize(start), TclWideIntFromSize(end-1)); value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0); if (value == NULL) { Tcl_AppendResult(interp, "couldn't set variable \"", varName, "\"", NULL); return TCL_ERROR; } } else if (cflags & TCL_REG_CANMATCH) { const char *varName; const char *value; char resinfo[TCL_INTEGER_SPACE * 2]; Tcl_RegExpGetInfo(regExpr, &info); varName = Tcl_GetString(objv[2]); sprintf(resinfo, "%" TCL_LL_MODIFIER "d", TclWideIntFromSize(info.extendStart)); value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0); if (value == NULL) { Tcl_AppendResult(interp, "couldn't set variable \"", varName, "\"", NULL); return TCL_ERROR; } } return TCL_OK; } /* * If additional variable names have been specified, return * index information in those variables. */ objc -= 2; objv += 2; Tcl_RegExpGetInfo(regExpr, &info); for (i = 0; i < objc; i++) { size_t start, end; Tcl_Obj *newPtr, *varPtr, *valuePtr; varPtr = objv[i]; ii = ((cflags®_EXPECT) && i == objc-1) ? TCL_INDEX_NONE : (size_t)i; if (indices) { Tcl_Obj *objs[2]; if (ii == TCL_INDEX_NONE) { TclRegExpRangeUniChar(regExpr, ii, &start, &end); } else if (ii > info.nsubs) { start = TCL_INDEX_NONE; end = TCL_INDEX_NONE; } else { start = info.matches[ii].start; end = info.matches[ii].end; } /* * Adjust index so it refers to the last character in the match * instead of the first character after the match. */ if (end != TCL_INDEX_NONE) { end--; } objs[0] = TclNewWideIntObjFromSize(start); objs[1] = TclNewWideIntObjFromSize(end); newPtr = Tcl_NewListObj(2, objs); } else { if (ii == TCL_INDEX_NONE) { TclRegExpRangeUniChar(regExpr, ii, &start, &end); newPtr = Tcl_GetRange(objPtr, start, end); } else if (ii > info.nsubs) { newPtr = Tcl_NewObj(); } else { newPtr = Tcl_GetRange(objPtr, info.matches[ii].start, info.matches[ii].end - 1); } } valuePtr = Tcl_ObjSetVar2(interp, varPtr, NULL, newPtr, TCL_LEAVE_ERR_MSG); |
︙ | ︙ | |||
4168 4169 4170 4171 4172 4173 4174 | * *---------------------------------------------------------------------- */ static void TestregexpXflags( const char *string, /* The string of flags. */ | | > | | 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 | * *---------------------------------------------------------------------- */ static void TestregexpXflags( const char *string, /* The string of flags. */ size_t length, /* The length of the string in bytes. */ int *cflagsPtr, /* compile flags word */ int *eflagsPtr) /* exec flags word */ { size_t i; int cflags, eflags; cflags = *cflagsPtr; eflags = *eflagsPtr; for (i = 0; i < length; i++) { switch (string[i]) { case 'a': cflags |= REG_ADVF; |
︙ | ︙ | |||
4464 4465 4466 4467 4468 4469 4470 | } /* *---------------------------------------------------------------------- * * TestupvarCmd -- * | | | 4465 4466 4467 4468 4469 4470 4471 4472 4473 4474 4475 4476 4477 4478 4479 | } /* *---------------------------------------------------------------------- * * TestupvarCmd -- * * This procedure implements the "testupvar" command. It is used * to test Tcl_UpVar and Tcl_UpVar2. * * Results: * A standard Tcl result. * * Side effects: * Creates or modifies an "upvar" reference. |
︙ | ︙ | |||
7753 7754 7755 7756 7757 7758 7759 | if (resVarInfo->var) { HashVarFree(resVarInfo->var); } Tcl_Free(vInfoPtr); } #define TclVarHashGetValue(hPtr) \ | | | 7754 7755 7756 7757 7758 7759 7760 7761 7762 7763 7764 7765 7766 7767 7768 | if (resVarInfo->var) { HashVarFree(resVarInfo->var); } Tcl_Free(vInfoPtr); } #define TclVarHashGetValue(hPtr) \ ((Var *) ((char *)hPtr - offsetof(VarInHash, entry))) static Tcl_Var MyCompiledVarFetch( Tcl_Interp *interp, Tcl_ResolvedVarInfo *vinfoPtr) { MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *) vinfoPtr; |
︙ | ︙ |
Changes to generic/tclTestObj.c.
︙ | ︙ | |||
286 287 288 289 290 291 292 | return TCL_ERROR; } if (Tcl_GetBignumFromObj(interp, varPtr[varIndex], &bignumValue) != TCL_OK) { return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { | | | | 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 | return TCL_ERROR; } if (Tcl_GetBignumFromObj(interp, varPtr[varIndex], &bignumValue) != TCL_OK) { return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { Tcl_SetIntObj(varPtr[varIndex], !mp_isodd(&bignumValue)); } else { SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(!mp_isodd(&bignumValue))); } mp_clear(&bignumValue); break; case BIGNUM_RADIXSIZE: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "varIndex"); |
︙ | ︙ |
Changes to generic/tclThreadAlloc.c.
︙ | ︙ | |||
641 642 643 644 645 646 647 | if (cachePtr == sharedPtr) { Tcl_DStringAppendElement(dsPtr, "shared"); } else { sprintf(buf, "thread%p", cachePtr->owner); Tcl_DStringAppendElement(dsPtr, buf); } for (n = 0; n < NBUCKETS; ++n) { | | | 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 | if (cachePtr == sharedPtr) { Tcl_DStringAppendElement(dsPtr, "shared"); } else { sprintf(buf, "thread%p", cachePtr->owner); Tcl_DStringAppendElement(dsPtr, buf); } for (n = 0; n < NBUCKETS; ++n) { sprintf(buf, "%" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u", bucketInfo[n].blockSize, cachePtr->buckets[n].numFree, cachePtr->buckets[n].numRemoves, cachePtr->buckets[n].numInserts, cachePtr->buckets[n].totalAssigned, cachePtr->buckets[n].numLocks, cachePtr->buckets[n].numWaits); |
︙ | ︙ |
Changes to generic/tclTomMath.decls.
︙ | ︙ | |||
217 218 219 220 221 222 223 | unsigned long TclBN_mp_get_long(const mp_int *a) } declare 72 { unsigned long TclBN_mp_get_int(const mp_int *a) } # Added in libtommath 1.1.0 | > | | < > > | | < > > | | < > | | 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 | unsigned long TclBN_mp_get_long(const mp_int *a) } declare 72 { unsigned long TclBN_mp_get_int(const mp_int *a) } # Added in libtommath 1.1.0 # No longer in use: replaced by mp_and() #declare 73 { # int TclBN_mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c) #} # No longer in use: replaced by mp_or() #declare 74 { # int TclBN_mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c) #} # No longer in use: replaced by mp_xor() #declare 75 { # int TclBN_mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c) #} declare 76 { int TclBN_mp_signed_rsh(const mp_int *a, int b, mp_int *c) } declare 77 { int TclBN_mp_get_bit(const mp_int *a, int b) } # Local Variables: |
︙ | ︙ |
Changes to generic/tclTomMath.h.
︙ | ︙ | |||
199 200 201 202 203 204 205 | }; /* callback for mp_prime_random, should fill dst with random bytes and return how many read [upto len] */ typedef int ltm_prime_callback(unsigned char *dst, int len, void *dat); /* error code to char* string */ | > | > | | | | | | | | 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 | }; /* callback for mp_prime_random, should fill dst with random bytes and return how many read [upto len] */ typedef int ltm_prime_callback(unsigned char *dst, int len, void *dat); /* error code to char* string */ /* const char *mp_error_to_string(mp_err code); */ /* ---> init and deinit bignum functions <--- */ /* init a bignum */ /* mp_err mp_init(mp_int *a); */ /* free a bignum */ /* void mp_clear(mp_int *a); */ /* init a null terminated series of arguments */ /* mp_err mp_init_multi(mp_int *mp, ...); */ /* clear a null terminated series of arguments */ /* void mp_clear_multi(mp_int *mp, ...); */ /* exchange two ints */ /* void mp_exch(mp_int *a, mp_int *b); */ /* shrink ram required for a bignum */ /* mp_err mp_shrink(mp_int *a); */ /* grow an int to a given size */ /* mp_err mp_grow(mp_int *a, int size); */ /* init to a given number of digits */ /* mp_err mp_init_size(mp_int *a, int size); */ /* ---> Basic Manipulations <--- */ #define mp_iszero(a) (((a)->used == 0) ? MP_YES : MP_NO) #define mp_iseven(a) (((a)->used == 0 || (((a)->dp[0] & 1) == 0)) ? MP_YES : MP_NO) #define mp_isodd(a) (((a)->used > 0 && (((a)->dp[0] & 1) == 1)) ? MP_YES : MP_NO) #define mp_isneg(a) (((a)->sign != MP_ZPOS) ? MP_YES : MP_NO) /* set to zero */ /* void mp_zero(mp_int *a); */ |
︙ | ︙ | |||
406 407 408 409 410 411 412 | */ /* c = a AND b */ /* int mp_and(const mp_int *a, const mp_int *b, mp_int *c); */ | < < < < < < < < < < < < < < < | | 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 | */ /* c = a AND b */ /* int mp_and(const mp_int *a, const mp_int *b, mp_int *c); */ /* right shift (two complement) */ /* int mp_signed_rsh(const mp_int *a, int b, mp_int *c); */ /* ---> Basic arithmetic <--- */ /* b = ~a */ /* int mp_complement(const mp_int *a, mp_int *b); |
︙ | ︙ |
Changes to generic/tclTomMathDecls.h.
︙ | ︙ | |||
67 68 69 70 71 72 73 | #define mp_div_2 TclBN_mp_div_2 #define mp_div_2d TclBN_mp_div_2d #define mp_div_3 TclBN_mp_div_3 #define mp_div_d TclBN_mp_div_d #define mp_exch TclBN_mp_exch #define mp_expt_d TclBN_mp_expt_d #define mp_expt_d_ex TclBN_mp_expt_d_ex | < > > | 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 | #define mp_div_2 TclBN_mp_div_2 #define mp_div_2d TclBN_mp_div_2d #define mp_div_3 TclBN_mp_div_3 #define mp_div_d TclBN_mp_div_d #define mp_exch TclBN_mp_exch #define mp_expt_d TclBN_mp_expt_d #define mp_expt_d_ex TclBN_mp_expt_d_ex #define mp_get_int TclBN_mp_get_int #define mp_get_long TclBN_mp_get_long #define mp_get_long_long TclBN_mp_get_long_long #define mp_grow TclBN_mp_grow #define s_mp_get_bit TclBN_mp_get_bit #define mp_grow TclBN_mp_grow #define mp_init TclBN_mp_init #define mp_init_copy TclBN_mp_init_copy #define mp_init_multi TclBN_mp_init_multi #define mp_init_set TclBN_mp_init_set #define mp_init_set_int TclBN_mp_init_set_int #define mp_init_size TclBN_mp_init_size |
︙ | ︙ | |||
103 104 105 106 107 108 109 | #define mp_set_long TclBN_mp_set_long #define mp_set_long_long TclBN_mp_set_long_long #define mp_shrink TclBN_mp_shrink #define mp_sqr TclBN_mp_sqr #define mp_sqrt TclBN_mp_sqrt #define mp_sub TclBN_mp_sub #define mp_sub_d TclBN_mp_sub_d | < < | < | 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 | #define mp_set_long TclBN_mp_set_long #define mp_set_long_long TclBN_mp_set_long_long #define mp_shrink TclBN_mp_shrink #define mp_sqr TclBN_mp_sqr #define mp_sqrt TclBN_mp_sqrt #define mp_sub TclBN_mp_sub #define mp_sub_d TclBN_mp_sub_d #define mp_signed_rsh TclBN_mp_signed_rsh #define mp_to_unsigned_bin TclBN_mp_to_unsigned_bin #define mp_to_unsigned_bin_n TclBN_mp_to_unsigned_bin_n #define mp_toom_mul TclBN_mp_toom_mul #define s_mp_toom_mul TclBN_mp_toom_mul #define mp_toom_sqr TclBN_mp_toom_sqr #define s_mp_toom_sqr TclBN_mp_toom_sqr #define mp_toradix_n TclBN_mp_toradix_n |
︙ | ︙ | |||
320 321 322 323 324 325 326 | EXTERN Tcl_WideUInt TclBN_mp_get_long_long(const mp_int *a); /* 70 */ EXTERN int TclBN_mp_set_long(mp_int *a, unsigned long i); /* 71 */ EXTERN unsigned long TclBN_mp_get_long(const mp_int *a); /* 72 */ EXTERN unsigned long TclBN_mp_get_int(const mp_int *a); | | < | | < < | | < < | 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 | EXTERN Tcl_WideUInt TclBN_mp_get_long_long(const mp_int *a); /* 70 */ EXTERN int TclBN_mp_set_long(mp_int *a, unsigned long i); /* 71 */ EXTERN unsigned long TclBN_mp_get_long(const mp_int *a); /* 72 */ EXTERN unsigned long TclBN_mp_get_int(const mp_int *a); /* Slot 73 is reserved */ /* Slot 74 is reserved */ /* Slot 75 is reserved */ /* 76 */ EXTERN int TclBN_mp_signed_rsh(const mp_int *a, int b, mp_int *c); /* 77 */ EXTERN int TclBN_mp_get_bit(const mp_int *a, int b); typedef struct TclTomMathStubs { int magic; void *hooks; |
︙ | ︙ | |||
411 412 413 414 415 416 417 | void (*reserved66)(void); int (*tclBN_mp_expt_d_ex) (const mp_int *a, mp_digit b, mp_int *c, int fast); /* 67 */ int (*tclBN_mp_set_long_long) (mp_int *a, Tcl_WideUInt i); /* 68 */ Tcl_WideUInt (*tclBN_mp_get_long_long) (const mp_int *a); /* 69 */ int (*tclBN_mp_set_long) (mp_int *a, unsigned long i); /* 70 */ unsigned long (*tclBN_mp_get_long) (const mp_int *a); /* 71 */ unsigned long (*tclBN_mp_get_int) (const mp_int *a); /* 72 */ | | | | | | 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 | void (*reserved66)(void); int (*tclBN_mp_expt_d_ex) (const mp_int *a, mp_digit b, mp_int *c, int fast); /* 67 */ int (*tclBN_mp_set_long_long) (mp_int *a, Tcl_WideUInt i); /* 68 */ Tcl_WideUInt (*tclBN_mp_get_long_long) (const mp_int *a); /* 69 */ int (*tclBN_mp_set_long) (mp_int *a, unsigned long i); /* 70 */ unsigned long (*tclBN_mp_get_long) (const mp_int *a); /* 71 */ unsigned long (*tclBN_mp_get_int) (const mp_int *a); /* 72 */ void (*reserved73)(void); void (*reserved74)(void); void (*reserved75)(void); int (*tclBN_mp_signed_rsh) (const mp_int *a, int b, mp_int *c); /* 76 */ int (*tclBN_mp_get_bit) (const mp_int *a, int b); /* 77 */ } TclTomMathStubs; extern const TclTomMathStubs *tclTomMathStubsPtr; #ifdef __cplusplus } |
︙ | ︙ | |||
562 563 564 565 566 567 568 | (tclTomMathStubsPtr->tclBN_mp_get_long_long) /* 69 */ #define TclBN_mp_set_long \ (tclTomMathStubsPtr->tclBN_mp_set_long) /* 70 */ #define TclBN_mp_get_long \ (tclTomMathStubsPtr->tclBN_mp_get_long) /* 71 */ #define TclBN_mp_get_int \ (tclTomMathStubsPtr->tclBN_mp_get_int) /* 72 */ | | | | < | | < < | 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 | (tclTomMathStubsPtr->tclBN_mp_get_long_long) /* 69 */ #define TclBN_mp_set_long \ (tclTomMathStubsPtr->tclBN_mp_set_long) /* 70 */ #define TclBN_mp_get_long \ (tclTomMathStubsPtr->tclBN_mp_get_long) /* 71 */ #define TclBN_mp_get_int \ (tclTomMathStubsPtr->tclBN_mp_get_int) /* 72 */ /* Slot 73 is reserved */ /* Slot 74 is reserved */ /* Slot 75 is reserved */ #define TclBN_mp_signed_rsh \ (tclTomMathStubsPtr->tclBN_mp_signed_rsh) /* 76 */ #define TclBN_mp_get_bit \ (tclTomMathStubsPtr->tclBN_mp_get_bit) /* 77 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT #endif /* _TCLINTDECLS */ |
Changes to generic/tclTrace.c.
︙ | ︙ | |||
467 468 469 470 471 472 473 | break; } } command = TclGetStringFromObj(objv[5], &commandLength); length = commandLength; if ((enum traceOptions) optionIndex == TRACE_ADD) { TraceCommandInfo *tcmdPtr = Tcl_Alloc( | | | 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 | break; } } command = TclGetStringFromObj(objv[5], &commandLength); length = commandLength; if ((enum traceOptions) optionIndex == TRACE_ADD) { TraceCommandInfo *tcmdPtr = Tcl_Alloc( offsetof(TraceCommandInfo, command) + 1 + length); tcmdPtr->flags = flags; tcmdPtr->stepTrace = NULL; tcmdPtr->startLevel = 0; tcmdPtr->startCmd = NULL; tcmdPtr->length = length; tcmdPtr->refCount = 1; |
︙ | ︙ | |||
704 705 706 707 708 709 710 | } } command = TclGetStringFromObj(objv[5], &commandLength); length = commandLength; if ((enum traceOptions) optionIndex == TRACE_ADD) { TraceCommandInfo *tcmdPtr = Tcl_Alloc( | | | 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 | } } command = TclGetStringFromObj(objv[5], &commandLength); length = commandLength; if ((enum traceOptions) optionIndex == TRACE_ADD) { TraceCommandInfo *tcmdPtr = Tcl_Alloc( offsetof(TraceCommandInfo, command) + 1 + length); tcmdPtr->flags = flags; tcmdPtr->stepTrace = NULL; tcmdPtr->startLevel = 0; tcmdPtr->startCmd = NULL; tcmdPtr->length = length; tcmdPtr->refCount = 1; |
︙ | ︙ | |||
907 908 909 910 911 912 913 | break; } } command = TclGetStringFromObj(objv[5], &commandLength); length = commandLength; if ((enum traceOptions) optionIndex == TRACE_ADD) { CombinedTraceVarInfo *ctvarPtr = Tcl_Alloc( | | | 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 | break; } } command = TclGetStringFromObj(objv[5], &commandLength); length = commandLength; if ((enum traceOptions) optionIndex == TRACE_ADD) { CombinedTraceVarInfo *ctvarPtr = Tcl_Alloc( offsetof(CombinedTraceVarInfo, traceCmdInfo.command) + 1 + length); ctvarPtr->traceCmdInfo.flags = flags; #ifndef TCL_REMOVE_OBSOLETE_TRACES if (objv[0] == NULL) { ctvarPtr->traceCmdInfo.flags |= TCL_TRACE_OLD_STYLE; } |
︙ | ︙ |
Changes to generic/tclUtf.c.
︙ | ︙ | |||
1023 1024 1025 1026 1027 1028 1029 | register size_t index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; #if TCL_UTF_MAX <= 4 size_t len = 0; #endif | | | 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 | register size_t index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; #if TCL_UTF_MAX <= 4 size_t len = 0; #endif if (index != TCL_INDEX_NONE) { while (index--) { #if TCL_UTF_MAX <= 4 src += (len = TclUtfToUniChar(src, &ch)); #else src += TclUtfToUniChar(src, &ch); #endif } |
︙ | ︙ |
Changes to generic/tclUtil.c.
︙ | ︙ | |||
110 111 112 113 114 115 116 | int stringLength, const char *typeStr, const char *typeCode, const char **elementPtr, const char **nextPtr, size_t *sizePtr, int *literalPtr); /* * The following is the Tcl object type definition for an object that * represents a list index in the form, "end-offset". It is used as a | | | 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 | int stringLength, const char *typeStr, const char *typeCode, const char **elementPtr, const char **nextPtr, size_t *sizePtr, int *literalPtr); /* * The following is the Tcl object type definition for an object that * represents a list index in the form, "end-offset". It is used as a * performance optimization in Tcl_GetIntForIndex. The internal rep is * stored directly in the wideValue, so no memory management is required * for it. This is a caching intrep, keeping the result of a parse * around. This type is only created from a pre-existing string, so an * updateStringProc will never be called and need not exist. The type * is unregistered, so has no need of a setFromAnyProc either. */ |
︙ | ︙ | |||
2633 2634 2635 2636 2637 2638 2639 | * *---------------------------------------------------------------------- */ char * Tcl_DStringAppend( Tcl_DString *dsPtr, /* Structure describing dynamic string. */ | | | | | 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 | * *---------------------------------------------------------------------- */ char * Tcl_DStringAppend( Tcl_DString *dsPtr, /* Structure describing dynamic string. */ const char *bytes, /* String to append. If length is * TCL_AUTO_LENGTH then this must be null-terminated. */ size_t length) /* Number of bytes from "bytes" to append. If * TCL_AUTO_LENGTH, then append all of bytes, up to null * at end. */ { size_t newSize; if (length == TCL_AUTO_LENGTH) { length = strlen(bytes); } |
︙ | ︙ | |||
2660 2661 2662 2663 2664 2665 2666 | dsPtr->spaceAvl = newSize * 2; if (dsPtr->string == dsPtr->staticSpace) { char *newString = Tcl_Alloc(dsPtr->spaceAvl); memcpy(newString, dsPtr->string, dsPtr->length); dsPtr->string = newString; } else { | | | | | | 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 | dsPtr->spaceAvl = newSize * 2; if (dsPtr->string == dsPtr->staticSpace) { char *newString = Tcl_Alloc(dsPtr->spaceAvl); memcpy(newString, dsPtr->string, dsPtr->length); dsPtr->string = newString; } else { size_t index = TCL_INDEX_NONE; /* See [16896d49fd] */ if (bytes >= dsPtr->string && bytes <= dsPtr->string + dsPtr->length) { index = bytes - dsPtr->string; } dsPtr->string = Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl); if (index != TCL_INDEX_NONE) { bytes = dsPtr->string + index; } } } /* * Copy the new string into the buffer at the end of the old one. */ |
︙ | ︙ | |||
3558 3559 3560 3561 3562 3563 3564 | } return TCL_ERROR; } /* *---------------------------------------------------------------------- * | | | 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 | } return TCL_ERROR; } /* *---------------------------------------------------------------------- * * Tcl_GetIntForIndex -- * * Provides an integer corresponding to the list index held in a Tcl * object. The string value 'objPtr' is expected have the format * integer([+-]integer)? or end([+-]integer)?. * * Value * TCL_OK |
︙ | ︙ | |||
3585 3586 3587 3588 3589 3590 3591 | * The object referenced by 'objPtr' is converted, as needed, to an * integer, wide integer, or end-based-index object. * *---------------------------------------------------------------------- */ int | | | 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596 3597 3598 3599 | * The object referenced by 'objPtr' is converted, as needed, to an * integer, wide integer, or end-based-index object. * *---------------------------------------------------------------------- */ int Tcl_GetIntForIndex( Tcl_Interp *interp, /* Interpreter to use for error reporting. If * NULL, then no error message is left after * errors. */ Tcl_Obj *objPtr, /* Points to an object containing either "end" * or an integer. */ size_t endValue, /* The value to be stored at "indexPtr" if * "objPtr" holds "end". */ |
︙ | ︙ |
Changes to generic/tclVar.c.
︙ | ︙ | |||
41 42 43 44 45 46 47 | Tcl_Obj *key, int *newPtr); static inline Var * VarHashFirstVar(TclVarHashTable *tablePtr, Tcl_HashSearch *searchPtr); static inline Var * VarHashNextVar(Tcl_HashSearch *searchPtr); static inline void CleanupVar(Var *varPtr, Var *arrayPtr); #define VarHashGetValue(hPtr) \ | | | 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 | Tcl_Obj *key, int *newPtr); static inline Var * VarHashFirstVar(TclVarHashTable *tablePtr, Tcl_HashSearch *searchPtr); static inline Var * VarHashNextVar(Tcl_HashSearch *searchPtr); static inline void CleanupVar(Var *varPtr, Var *arrayPtr); #define VarHashGetValue(hPtr) \ ((Var *) ((char *)hPtr - offsetof(VarInHash, entry))) /* * NOTE: VarHashCreateVar increments the recount of its key argument. * All callers that will call Tcl_DecrRefCount on that argument must * call Tcl_IncrRefCount on it before passing it in. This requirement * can bubble up to callers of callers .... etc. */ |
︙ | ︙ |
Changes to libtommath/bn_mp_and.c.
1 2 | #include "tommath_private.h" #ifdef BN_MP_AND_C | | < < < < < < < < | < | | | | | > | | | > | > > > > > > | > | | < | > > > | > > > | < | | > > > > > | < < < > > | < < < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 | #include "tommath_private.h" #ifdef BN_MP_AND_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* two complement and */ mp_err mp_and(const mp_int *a, const mp_int *b, mp_int *c) { int used = MAX(a->used, b->used) + 1, i; mp_err err; mp_digit ac = 1, bc = 1, cc = 1; mp_sign csign = ((a->sign == MP_NEG) && (b->sign == MP_NEG)) ? MP_NEG : MP_ZPOS; if (c->alloc < used) { if ((err = mp_grow(c, used)) != MP_OKAY) { return err; } } for (i = 0; i < used; i++) { mp_digit x, y; /* convert to two complement if negative */ if (a->sign == MP_NEG) { ac += (i >= a->used) ? MP_MASK : (~a->dp[i] & MP_MASK); x = ac & MP_MASK; ac >>= MP_DIGIT_BIT; } else { x = (i >= a->used) ? 0uL : a->dp[i]; } /* convert to two complement if negative */ if (b->sign == MP_NEG) { bc += (i >= b->used) ? MP_MASK : (~b->dp[i] & MP_MASK); y = bc & MP_MASK; bc >>= MP_DIGIT_BIT; } else { y = (i >= b->used) ? 0uL : b->dp[i]; } c->dp[i] = x & y; /* convert to to sign-magnitude if negative */ if (csign == MP_NEG) { cc += ~c->dp[i] & MP_MASK; c->dp[i] = cc & MP_MASK; cc >>= MP_DIGIT_BIT; } } c->used = used; c->sign = csign; mp_clamp(c); return MP_OKAY; } #endif |
Changes to libtommath/bn_mp_cmp.c.
1 2 | #include "tommath_private.h" #ifdef BN_MP_CMP_C | | < < < < < < < < | < | < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | #include "tommath_private.h" #ifdef BN_MP_CMP_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* compare two ints (signed)*/ mp_ord mp_cmp(const mp_int *a, const mp_int *b) { /* compare based on sign */ if (a->sign != b->sign) { if (a->sign == MP_NEG) { return MP_LT; } else { return MP_GT; } } /* compare digits */ if (a->sign == MP_NEG) { /* if negative compare opposite direction */ return mp_cmp_mag(b, a); } else { return mp_cmp_mag(a, b); } } #endif |
Changes to libtommath/bn_mp_cmp_d.c.
1 2 | #include "tommath_private.h" #ifdef BN_MP_CMP_D_C | | < < < < < < < < | < | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | #include "tommath_private.h" #ifdef BN_MP_CMP_D_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* compare a digit */ mp_ord mp_cmp_d(const mp_int *a, mp_digit b) { /* compare based on sign */ if (a->sign == MP_NEG) { return MP_LT; } /* compare based on magnitude */ |
︙ | ︙ | |||
31 32 33 34 35 36 37 | } else if (a->dp[0] < b) { return MP_LT; } else { return MP_EQ; } } #endif | < < < < | 22 23 24 25 26 27 28 | } else if (a->dp[0] < b) { return MP_LT; } else { return MP_EQ; } } #endif |
Changes to libtommath/bn_mp_cmp_mag.c.
1 2 | #include "tommath_private.h" #ifdef BN_MP_CMP_MAG_C | | < < < < < < < < | < | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | #include "tommath_private.h" #ifdef BN_MP_CMP_MAG_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* compare maginitude of two ints (unsigned) */ mp_ord mp_cmp_mag(const mp_int *a, const mp_int *b) { int n; const mp_digit *tmpa, *tmpb; /* compare based on # of non-zero digits */ if (a->used > b->used) { return MP_GT; } if (a->used < b->used) { |
︙ | ︙ | |||
42 43 44 45 46 47 48 | if (*tmpa < *tmpb) { return MP_LT; } } return MP_EQ; } #endif | < < < < | 33 34 35 36 37 38 39 | if (*tmpa < *tmpb) { return MP_LT; } } return MP_EQ; } #endif |
Changes to libtommath/bn_mp_or.c.
1 2 | #include "tommath_private.h" #ifdef BN_MP_OR_C | | < < < < < < < < | < | | | | | > | | | > | > > > > > > | > | | < | > > > | > > > | > | > > > | > | > > > > | < < < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 | #include "tommath_private.h" #ifdef BN_MP_OR_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* two complement or */ mp_err mp_or(const mp_int *a, const mp_int *b, mp_int *c) { int used = MAX(a->used, b->used) + 1, i; mp_err err; mp_digit ac = 1, bc = 1, cc = 1; mp_sign csign = ((a->sign == MP_NEG) || (b->sign == MP_NEG)) ? MP_NEG : MP_ZPOS; if (c->alloc < used) { if ((err = mp_grow(c, used)) != MP_OKAY) { return err; } } for (i = 0; i < used; i++) { mp_digit x, y; /* convert to two complement if negative */ if (a->sign == MP_NEG) { ac += (i >= a->used) ? MP_MASK : (~a->dp[i] & MP_MASK); x = ac & MP_MASK; ac >>= MP_DIGIT_BIT; } else { x = (i >= a->used) ? 0uL : a->dp[i]; } /* convert to two complement if negative */ if (b->sign == MP_NEG) { bc += (i >= b->used) ? MP_MASK : (~b->dp[i] & MP_MASK); y = bc & MP_MASK; bc >>= MP_DIGIT_BIT; } else { y = (i >= b->used) ? 0uL : b->dp[i]; } c->dp[i] = x | y; /* convert to to sign-magnitude if negative */ if (csign == MP_NEG) { cc += ~c->dp[i] & MP_MASK; c->dp[i] = cc & MP_MASK; cc >>= MP_DIGIT_BIT; } } c->used = used; c->sign = csign; mp_clamp(c); return MP_OKAY; } #endif |
Name change from libtommath/bn_mp_tc_div_2d.c to libtommath/bn_mp_signed_rsh.c.
1 | #include "tommath_private.h" | | | < < < < < < < < | < | | | | < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | #include "tommath_private.h" #ifdef BN_MP_SIGNED_RSH_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* shift right by a certain bit count with sign extension */ mp_err mp_signed_rsh(const mp_int *a, int b, mp_int *c) { mp_err res; if (a->sign == MP_ZPOS) { return mp_div_2d(a, b, c, NULL); } res = mp_add_d(a, 1uL, c); if (res != MP_OKAY) { return res; } res = mp_div_2d(c, b, c, NULL); return (res == MP_OKAY) ? mp_sub_d(c, 1uL, c) : res; } #endif |
Deleted libtommath/bn_mp_tc_and.c.
|
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
Deleted libtommath/bn_mp_tc_or.c.
|
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
Deleted libtommath/bn_mp_tc_xor.c.
|
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
Changes to libtommath/bn_mp_xor.c.
1 2 | #include "tommath_private.h" #ifdef BN_MP_XOR_C | | < < < < < < < < | < | | | | | > | | | > | > > > > > > | > | | < | > > > | > > > | > | > > > | > | > > > > | < < < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 | #include "tommath_private.h" #ifdef BN_MP_XOR_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* two complement xor */ mp_err mp_xor(const mp_int *a, const mp_int *b, mp_int *c) { int used = MAX(a->used, b->used) + 1, i; mp_err err; mp_digit ac = 1, bc = 1, cc = 1; mp_sign csign = (a->sign != b->sign) ? MP_NEG : MP_ZPOS; if (c->alloc < used) { if ((err = mp_grow(c, used)) != MP_OKAY) { return err; } } for (i = 0; i < used; i++) { mp_digit x, y; /* convert to two complement if negative */ if (a->sign == MP_NEG) { ac += (i >= a->used) ? MP_MASK : (~a->dp[i] & MP_MASK); x = ac & MP_MASK; ac >>= MP_DIGIT_BIT; } else { x = (i >= a->used) ? 0uL : a->dp[i]; } /* convert to two complement if negative */ if (b->sign == MP_NEG) { bc += (i >= b->used) ? MP_MASK : (~b->dp[i] & MP_MASK); y = bc & MP_MASK; bc >>= MP_DIGIT_BIT; } else { y = (i >= b->used) ? 0uL : b->dp[i]; } c->dp[i] = x ^ y; /* convert to to sign-magnitude if negative */ if (csign == MP_NEG) { cc += ~c->dp[i] & MP_MASK; c->dp[i] = cc & MP_MASK; cc >>= MP_DIGIT_BIT; } } c->used = used; c->sign = csign; mp_clamp(c); return MP_OKAY; } #endif |
Name change from libtommath/bn_mp_get_bit.c to libtommath/bn_s_mp_get_bit.c.
1 | #include "tommath_private.h" | | | < < < < < < < < | < < | < | < | | < < | < < < | < < | < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | #include "tommath_private.h" #ifdef BN_S_MP_GET_BIT_C /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ /* Get bit at position b and return MP_YES if the bit is 1, MP_NO if it is 0 */ mp_bool s_mp_get_bit(const mp_int *a, int b) { mp_digit bit; int limb = (int)((unsigned)b / MP_DIGIT_BIT); if (limb >= a->used) { return MP_NO; } bit = (mp_digit)1 << ((unsigned)b % MP_DIGIT_BIT); return ((a->dp[limb] & bit) != 0u) ? MP_YES : MP_NO; } #endif |
Deleted libtommath/callgraph.txt.
more than 10,000 changes
Changes to libtommath/tommath.h.
|
| | < < < < < < < < | | | 1 2 3 4 5 6 7 8 9 10 | /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ #ifndef BN_H_ #define BN_H_ #include <stdio.h> #include <stdlib.h> #include <limits.h> |
︙ | ︙ | |||
155 156 157 158 159 160 161 | /* clear a null terminated series of arguments */ void mp_clear_multi(mp_int *mp, ...); /* exchange two ints */ void mp_exch(mp_int *a, mp_int *b); /* shrink ram required for a bignum */ | | | | | | | 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 | /* clear a null terminated series of arguments */ void mp_clear_multi(mp_int *mp, ...); /* exchange two ints */ void mp_exch(mp_int *a, mp_int *b); /* shrink ram required for a bignum */ mp_err mp_shrink(mp_int *a); /* grow an int to a given size */ mp_err mp_grow(mp_int *a, int size); /* init to a given number of digits */ mp_err mp_init_size(mp_int *a, int size); /* ---> Basic Manipulations <--- */ #define mp_iszero(a) (((a)->used == 0) ? MP_YES : MP_NO) #define mp_iseven(a) (((a)->used == 0 || (((a)->dp[0] & 1) == 0)) ? MP_YES : MP_NO) #define mp_isodd(a) (((a)->used > 0 && (((a)->dp[0] & 1) == 1)) ? MP_YES : MP_NO) #define mp_isneg(a) (((a)->sign != MP_ZPOS) ? MP_YES : MP_NO) /* set to zero */ void mp_zero(mp_int *a); /* set to a digit */ void mp_set(mp_int *a, mp_digit b); |
︙ | ︙ | |||
290 291 292 293 294 295 296 | /* c = a OR b (two complement) */ int mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c); /* c = a AND b (two complement) */ int mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c); /* right shift (two complement) */ | | | 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 | /* c = a OR b (two complement) */ int mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c); /* c = a AND b (two complement) */ int mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c); /* right shift (two complement) */ int mp_signed_rsh(const mp_int *a, int b, mp_int *c); /* ---> Basic arithmetic <--- */ /* b = ~a */ int mp_complement(const mp_int *a, mp_int *b); /* b = -a */ |
︙ | ︙ |
Changes to libtommath/tommath_class.h.
︙ | ︙ | |||
55 56 57 58 59 60 61 | # define BN_MP_EXPT_D_EX_C # define BN_MP_EXPTMOD_C # define BN_MP_EXPTMOD_FAST_C # define BN_MP_EXTEUCLID_C # define BN_MP_FREAD_C # define BN_MP_FWRITE_C # define BN_MP_GCD_C | | | 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 | # define BN_MP_EXPT_D_EX_C # define BN_MP_EXPTMOD_C # define BN_MP_EXPTMOD_FAST_C # define BN_MP_EXTEUCLID_C # define BN_MP_FREAD_C # define BN_MP_FWRITE_C # define BN_MP_GCD_C # define BN_S_MP_GET_BIT_C # define BN_MP_GET_DOUBLE_C # define BN_MP_GET_INT_C # define BN_MP_GET_LONG_C # define BN_MP_GET_LONG_LONG_C # define BN_MP_GROW_C # define BN_MP_IMPORT_C # define BN_MP_INIT_C |
︙ | ︙ | |||
131 132 133 134 135 136 137 | # define BN_MP_SQRMOD_C # define BN_MP_SQRT_C # define BN_MP_SQRTMOD_PRIME_C # define BN_MP_SUB_C # define BN_MP_SUB_D_C # define BN_MP_SUBMOD_C # define BN_MP_TC_AND_C | | | 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 | # define BN_MP_SQRMOD_C # define BN_MP_SQRT_C # define BN_MP_SQRTMOD_PRIME_C # define BN_MP_SUB_C # define BN_MP_SUB_D_C # define BN_MP_SUBMOD_C # define BN_MP_TC_AND_C # define BN_MP_SIGNED_RSH_C # define BN_MP_TC_OR_C # define BN_MP_TC_XOR_C # define BN_MP_TO_SIGNED_BIN_C # define BN_MP_TO_SIGNED_BIN_N_C # define BN_MP_TO_UNSIGNED_BIN_C # define BN_MP_TO_UNSIGNED_BIN_N_C # define BN_MP_TOOM_MUL_C |
︙ | ︙ | |||
438 439 440 441 442 443 444 | # define BN_MP_CMP_MAG_C # define BN_MP_EXCH_C # define BN_S_MP_SUB_C # define BN_MP_MUL_2D_C # define BN_MP_CLEAR_C #endif | | | 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 | # define BN_MP_CMP_MAG_C # define BN_MP_EXCH_C # define BN_S_MP_SUB_C # define BN_MP_MUL_2D_C # define BN_MP_CLEAR_C #endif #if defined(BN_S_MP_GET_BIT_C) # define BN_MP_ISZERO_C #endif #if defined(BN_MP_GET_DOUBLE_C) # define BN_MP_ISNEG_C #endif |
︙ | ︙ | |||
711 712 713 714 715 716 717 | # define BN_MP_COUNT_BITS_C # define BN_MP_MUL_2_C # define BN_MP_MUL_D_C # define BN_MP_ADD_C # define BN_MP_MUL_C # define BN_MP_SUB_C # define BN_MP_MOD_C | | | 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 | # define BN_MP_COUNT_BITS_C # define BN_MP_MUL_2_C # define BN_MP_MUL_D_C # define BN_MP_ADD_C # define BN_MP_MUL_C # define BN_MP_SUB_C # define BN_MP_MOD_C # define BN_S_MP_GET_BIT_C # define BN_MP_EXCH_C # define BN_MP_ISZERO_C # define BN_MP_CMP_C # define BN_MP_CLEAR_MULTI_C #endif #if defined(BN_MP_PRIME_IS_DIVISIBLE_C) |
︙ | ︙ | |||
798 799 800 801 802 803 804 | # define BN_MP_DIV_2D_C # define BN_MP_SET_C # define BN_MP_MUL_2_C # define BN_MP_COUNT_BITS_C # define BN_MP_MOD_C # define BN_MP_SQR_C # define BN_MP_SUB_C | | | 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 | # define BN_MP_DIV_2D_C # define BN_MP_SET_C # define BN_MP_MUL_2_C # define BN_MP_COUNT_BITS_C # define BN_MP_MOD_C # define BN_MP_SQR_C # define BN_MP_SUB_C # define BN_S_MP_GET_BIT_C # define BN_MP_ADD_C # define BN_MP_ISODD_C # define BN_MP_DIV_2_C # define BN_MP_SUB_D_C # define BN_MP_ISZERO_C # define BN_MP_CLEAR_MULTI_C #endif |
︙ | ︙ | |||
1030 1031 1032 1033 1034 1035 1036 | # define BN_MP_INIT_C # define BN_MP_ADD_C # define BN_MP_CLEAR_C # define BN_MP_AND_C # define BN_MP_SUB_C #endif | | | 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 | # define BN_MP_INIT_C # define BN_MP_ADD_C # define BN_MP_CLEAR_C # define BN_MP_AND_C # define BN_MP_SUB_C #endif #if defined(BN_MP_SIGNED_RSH_C) # define BN_MP_ISNEG_C # define BN_MP_DIV_2D_C # define BN_MP_ADD_D_C # define BN_MP_SUB_D_C #endif #if defined(BN_MP_TC_OR_C) |
︙ | ︙ |
Changes to tests-perf/test-performance.tcl.
︙ | ︙ | |||
47 48 49 50 51 52 53 | if {!$tcnt} { puts "" return } set mintm 0x7fffffff set maxtm 0 | | | | | | | | 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 | if {!$tcnt} { puts "" return } set mintm 0x7fffffff set maxtm 0 set nettm 0 set wtm 0 set wcnt 0 set i 0 foreach tm $_(itm) { if {[llength $tm] > 6} { set nettm [expr {$nettm + [lindex $tm 6]}] } set wtm [expr {$wtm + [lindex $tm 0]}] set wcnt [expr {$wcnt + [lindex $tm 2]}] set tm [lindex $tm 0] if {$tm > $maxtm} {set maxtm $tm; set maxi $i} if {$tm < $mintm} {set mintm $tm; set mini $i} incr i } puts [string repeat ** 40] set s [format "%d cases in %.2f sec." $tcnt [expr {([clock milliseconds] - $_(starttime)) / 1000.0}]] if {$nettm > 0} { append s [format " (%.2f net-sec.)" [expr {$nettm / 1000.0}]] } puts "Total $s:" lset _(m) 0 [format %.6f $wtm] lset _(m) 2 $wcnt lset _(m) 4 [format %.3f [expr {$wcnt / (($nettm ? $nettm : ($tcnt * [lindex $_(reptime) 0])) / 1000.0)}]] if {[llength $_(m)] > 6} { lset _(m) 6 [format %.3f $nettm] } puts $_(m) puts "Average:" lset _(m) 0 [format %.6f [expr {[lindex $_(m) 0] / $tcnt}]] lset _(m) 2 [expr {[lindex $_(m) 2] / $tcnt}] if {[llength $_(m)] > 6} { lset _(m) 6 [format %.3f [expr {[lindex $_(m) 6] / $tcnt}]] |
︙ | ︙ |
Changes to tests/cmdAH.test.
︙ | ︙ | |||
229 230 231 232 233 234 235 | } -result iso8859-1 test cmdAH-5.1 {Tcl_FileObjCmd} -returnCodes error -body { file } -result {wrong # args: should be "file subcommand ?arg ...?"} test cmdAH-5.2 {Tcl_FileObjCmd} -returnCodes error -body { file x | | | 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 | } -result iso8859-1 test cmdAH-5.1 {Tcl_FileObjCmd} -returnCodes error -body { file } -result {wrong # args: should be "file subcommand ?arg ...?"} test cmdAH-5.2 {Tcl_FileObjCmd} -returnCodes error -body { file x } -result {unknown or ambiguous subcommand "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempdir, tempfile, type, volumes, or writable} test cmdAH-5.3 {Tcl_FileObjCmd} -returnCodes error -body { file exists } -result {wrong # args: should be "file exists name"} test cmdAH-5.4 {Tcl_FileObjCmd} { file exists "" } 0 |
︙ | ︙ | |||
1520 1521 1522 1523 1524 1525 1526 | } set res } -result "characterSpecial" # Error conditions test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { file gorp x | | | 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 | } set res } -result "characterSpecial" # Error conditions test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { file gorp x } -result {unknown or ambiguous subcommand "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempdir, tempfile, type, volumes, or writable} test cmdAH-30.2 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { file ex x } -match glob -result {unknown or ambiguous subcommand "ex": must be *} test cmdAH-30.3 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { file is x } -match glob -result {unknown or ambiguous subcommand "is": must be *} test cmdAH-30.4 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { |
︙ | ︙ | |||
1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 | set template [file join $dirfile foo] close [file tempfile name $template.bar] expr {[string match $template*.bar $name] ? "ok" : "$template.bar produced $name"} } -constraints {unix nonPortable} -cleanup { catch {file delete $name} } -result ok # This shouldn't work, but just in case a test above failed... catch {close $newFileId} interp delete safeInterp interp delete simpleInterp | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 | set template [file join $dirfile foo] close [file tempfile name $template.bar] expr {[string match $template*.bar $name] ? "ok" : "$template.bar produced $name"} } -constraints {unix nonPortable} -cleanup { catch {file delete $name} } -result ok test cmdAH-33.1 {file tempdir} -body { file tempdir a b } -returnCodes error -result {wrong # args: should be "file tempdir ?template?"} test cmdAH-33.2 {file tempdir} -body { set d [file tempdir] list [file tail $d] [file exists $d] [file type $d] \ [glob -nocomplain -directory $d *] } -match glob -result {tcl_* 1 directory {}} -cleanup { catch {file delete $d} } test cmdAH-33.3 {file tempdir} -body { set d [file tempdir gorp] list [file tail $d] [file exists $d] [file type $d] \ [glob -nocomplain -directory $d *] } -match glob -result {gorp_* 1 directory {}} -cleanup { catch {file delete $d} } test cmdAH-33.4 {file tempdir} -setup { set base [file join [temporaryDirectory] gorp] file mkdir $base } -body { set pre [glob -nocomplain -directory $base *] set d [file normalize [file tempdir $base/]] list [string map [list $base GORP:] $d] [file exists $d] [file type $d] \ $pre [glob -nocomplain -directory $d *] } -match glob -result {GORP:/tcl_* 1 directory {} {}} -cleanup { catch {file delete -force $base} } test cmdAH-33.5 {file tempdir} -setup { set base [file join [temporaryDirectory] gorp] file mkdir $base } -body { set pre [glob -nocomplain -directory $base *] set d [file normalize [file tempdir $base/gorp]] list [string map [list $base GORP:] $d] [file exists $d] [file type $d] \ $pre [glob -nocomplain -directory $d *] } -match glob -result {GORP:/gorp_* 1 directory {} {}} -cleanup { catch {file delete -force $base} } test cmdAH-33.6 {file tempdir: missing parent dir} -setup { set base [file join [temporaryDirectory] gorp] file mkdir $base } -returnCodes error -body { file tempdir $base/quux/ } -cleanup { catch {file delete -force $base} } -result {can't create temporary directory: no such file or directory} test cmdAH-33.7 {file tempdir: missing parent dir} -setup { set base [file join [temporaryDirectory] gorp] file mkdir $base } -returnCodes error -body { file tempdir $base/quux/foobar } -cleanup { catch {file delete -force $base} } -result {can't create temporary directory: no such file or directory} # This shouldn't work, but just in case a test above failed... catch {close $newFileId} interp delete safeInterp interp delete simpleInterp |
︙ | ︙ |
Changes to tests/cmdMZ.test.
︙ | ︙ | |||
365 366 367 368 369 370 371 | test cmdMZ-6.3 {Tcl_TimeRateObjCmd: basic format of command} { list [catch {timerate -overhead b {} a b} msg] $msg } {1 {expected floating-point number but got "b"}} test cmdMZ-6.4 {Tcl_TimeRateObjCmd: compile of script happens even with negative iteration counts} { list [catch {timerate "foreach a {c d e} \{" -12456} msg] $msg } {1 {missing close-brace}} test cmdMZ-6.5a {Tcl_TimeRateObjCmd: result format and one iteration} { | | | | 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 | test cmdMZ-6.3 {Tcl_TimeRateObjCmd: basic format of command} { list [catch {timerate -overhead b {} a b} msg] $msg } {1 {expected floating-point number but got "b"}} test cmdMZ-6.4 {Tcl_TimeRateObjCmd: compile of script happens even with negative iteration counts} { list [catch {timerate "foreach a {c d e} \{" -12456} msg] $msg } {1 {missing close-brace}} test cmdMZ-6.5a {Tcl_TimeRateObjCmd: result format and one iteration} { regexp {^\d+(?:\.\d+)? \ws/# 1 # \d+(?:\.\d+)? #/sec \d+(?:\.\d+)? net-ms$} [timerate {} 0] } 1 test cmdMZ-6.5b {Tcl_TimeRateObjCmd: result format without iterations} { regexp {^0 \ws/# 0 # 0 #/sec 0 net-ms$} [timerate {} 0 0] } 1 test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measument} { set m1 [timerate {_nrt_sleep 0} 20] set m2 [timerate {_nrt_sleep 0.2} 20] list \ [expr {[lindex $m1 0] < [lindex $m2 0]}] \ [expr {[lindex $m1 0] < 100}] \ |
︙ | ︙ | |||
398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 | test cmdMZ-6.8 {Tcl_TimeRateObjCmd: allow (conditional) break from timerate} { set m1 [timerate {break}] list \ [expr {[lindex $m1 0] < 1000}] \ [expr {[lindex $m1 2] == 1}] \ [expr {[lindex $m1 4] > 1000}] \ [expr {[lindex $m1 6] < 10}] } {1 1 1 1} test cmdMZ-6.9 {Tcl_TimeRateObjCmd: max count of iterations} { set m1 [timerate {} 1000 5]; # max-count wins set m2 [timerate {_nrt_sleep 20} 1 5]; # max-time wins list [lindex $m1 2] [lindex $m2 2] } {5 1} test cmdMZ-6.10 {Tcl_TimeRateObjCmd: huge overhead cause 0us result} { set m1 [timerate -overhead 1e6 {_nrt_sleep 10} 100 1] list \ [expr {[lindex $m1 0] == 0.0}] \ [expr {[lindex $m1 2] == 1}] \ [expr {[lindex $m1 4] == 1000000}] \ [expr {[lindex $m1 6] <= 0.001}] } {1 1 1 1} test cmdMZ-try-1.0 { fix for issue 45b9faf103f2 [try] interaction with local variable names produces segmentation violation | > > > > > > > > > > > > > > | 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 | test cmdMZ-6.8 {Tcl_TimeRateObjCmd: allow (conditional) break from timerate} { set m1 [timerate {break}] list \ [expr {[lindex $m1 0] < 1000}] \ [expr {[lindex $m1 2] == 1}] \ [expr {[lindex $m1 4] > 1000}] \ [expr {[lindex $m1 6] < 10}] } {1 1 1 1} test cmdMZ-6.8.1 {Tcl_TimeRateObjCmd: allow (conditional) continue in timerate} { set m1 [timerate {continue; return -code error "unexpected"} 1000 10] list \ [expr {[lindex $m1 0] < 1000}] \ [expr {[lindex $m1 2] == 10}] \ [expr {[lindex $m1 4] > 1000}] \ [expr {[lindex $m1 6] < 100}] } {1 1 1 1} test cmdMZ-6.9 {Tcl_TimeRateObjCmd: max count of iterations} { set m1 [timerate {} 1000 5]; # max-count wins set m2 [timerate {_nrt_sleep 20} 1 5]; # max-time wins list [lindex $m1 2] [lindex $m2 2] } {5 1} test cmdMZ-6.10 {Tcl_TimeRateObjCmd: huge overhead cause 0us result} { set m1 [timerate -overhead 1e6 {_nrt_sleep 10} 100 1] list \ [expr {[lindex $m1 0] == 0.0}] \ [expr {[lindex $m1 2] == 1}] \ [expr {[lindex $m1 4] == 1000000}] \ [expr {[lindex $m1 6] <= 0.001}] } {1 1 1 1} test cmdMZ-6.11 {Tcl_TimeRateObjCmd: done/continue optimization rollback} { set m1 {set m2 ok} if 1 $m1 timerate $m1 1000 10 if 1 $m1; # if rollback is missing throws an error: invoked "continue" outside of a loop } ok test cmdMZ-try-1.0 { fix for issue 45b9faf103f2 [try] interaction with local variable names produces segmentation violation |
︙ | ︙ |
Changes to tests/coroutine.test.
︙ | ︙ | |||
789 790 791 792 793 794 795 | slave eval demo set result [slave eval {set ::result}] interp delete slave set result } -result {inject-executed} | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 | slave eval demo set result [slave eval {set ::result}] interp delete slave set result } -result {inject-executed} test coroutine-9.1 {coroprobe with yield} -body { coroutine demo apply {{} { foreach i {1 2} yield }} list [coroprobe demo set i] [demo] [coroprobe demo set i] [demo] } -cleanup { catch {rename demo {}} } -result {1 {} 2 {}} test coroutine-9.2 {coroprobe with yieldto} -body { coroutine demo apply {{} { lmap i {1 2} {yieldto string cat} }} list [coroprobe demo set i] [demo a b] [coroprobe demo set i] [demo c d] } -cleanup { catch {rename demo {}} } -result {1 {} 2 {{a b} {c d}}} test coroutine-9.3 {coroprobe errors} -setup { catch {rename demo {}} } -body { coroprobe demo set i } -returnCodes error -result {can only inject a probe command into a coroutine} test coroutine-9.4 {coroprobe errors} -body { proc demo {} { foreach i {1 2} yield } coroprobe demo set i } -returnCodes error -cleanup { catch {rename demo {}} } -result {can only inject a probe command into a coroutine} test coroutine-9.5 {coroprobe errors} -body { coroutine demo apply {{} { foreach i {1 2} yield }} coroprobe } -returnCodes error -cleanup { catch {rename demo {}} } -result {wrong # args: should be "coroprobe coroName cmd ?arg1 arg2 ...?"} test coroutine-9.6 {coroprobe errors} -body { coroutine demo apply {{} { foreach i {1 2} yield }} coroprobe demo } -returnCodes error -cleanup { catch {rename demo {}} } -result {wrong # args: should be "coroprobe coroName cmd ?arg1 arg2 ...?"} test coroutine-9.7 {coroprobe errors in probe command} -body { coroutine demo apply {{} { foreach i {1 2} yield }} coroprobe demo set } -returnCodes error -cleanup { catch {rename demo {}} } -result {wrong # args: should be "set varName ?newValue?"} test coroutine-9.8 {coroprobe errors in probe command} -body { coroutine demo apply {{} { foreach i {1 2} yield }} list [catch {coroprobe demo set}] [demo] [coroprobe demo set i] } -cleanup { catch {rename demo {}} } -result {1 {} 2} test coroutine-9.9 {coroprobe: advanced features} -setup { set i [interp create] } -body { $i eval { coroutine demo apply {{} { set f [info level],[info frame] foreach i {1 2} yield }} coroprobe demo apply {{} { upvar 1 f f list [info coroutine] [info level] [info frame] $f }} } } -cleanup { interp delete $i } -result {::demo 2 3 1,2} test coroutine-10.1 {coroinject with yield} -setup { set result {} } -body { coroutine demo apply {{} { lmap i {1 2} yield }} coroinject demo apply {{op val} {lappend ::result $op $val}} list $result [demo x] [demo y] $result } -cleanup { catch {rename demo {}} } -result {{} {} {{yield x} y} {yield x}} test coroutine-10.2 {coroinject stacking} -setup { set result {} } -body { coroutine demo apply {{} { lmap i {1 2} yield }} coroinject demo apply {{op val} {lappend ::result $op $val A;return $val}} coroinject demo apply {{op val} {lappend ::result $op $val B;return $val}} list $result [demo x] [demo y] $result } -cleanup { catch {rename demo {}} } -result {{} {} {x y} {yield x B yield x A}} test coroutine-10.3 {coroinject with yieldto} -setup { set result {} } -body { coroutine demo apply {{} { lmap i {1 2} {yieldto string cat} }} coroinject demo apply {{op val} {lappend ::result $op $val;return $val}} list $result [demo x mp] [demo y le] $result } -cleanup { catch {rename demo {}} } -result {{} {} {{x mp} {y le}} {yieldto {x mp}}} test coroutine-10.4 {coroinject errors} -setup { catch {rename demo {}} } -body { coroinject demo set i } -returnCodes error -result {can only inject a command into a coroutine} test coroutine-10.5 {coroinject errors} -body { proc demo {} { foreach i {1 2} yield } coroinject demo set i } -returnCodes error -cleanup { catch {rename demo {}} } -result {can only inject a command into a coroutine} test coroutine-10.6 {coroinject errors} -body { coroutine demo apply {{} { foreach i {1 2} yield }} coroinject } -returnCodes error -cleanup { catch {rename demo {}} } -result {wrong # args: should be "coroinject coroName cmd ?arg1 arg2 ...?"} test coroutine-10.7 {coroinject errors} -body { coroutine demo apply {{} { foreach i {1 2} yield }} coroinject demo } -returnCodes error -cleanup { catch {rename demo {}} } -result {wrong # args: should be "coroinject coroName cmd ?arg1 arg2 ...?"} test coroutine-10.8 {coroinject errors in injected command} -body { coroutine demo apply {{} { foreach i {1 2} yield }} coroinject demo apply {args {error "ERR: $args"}} list [catch demo msg] $msg [catch demo msg] $msg } -cleanup { catch {rename demo {}} } -result {1 {ERR: yield {}} 1 {invalid command name "demo"}} test coroutine-10.9 {coroinject: advanced features} -setup { set i [interp create] } -body { $i eval { coroutine demo apply {{} { set l [info level] set f [info frame] lmap i {1 2} yield }} coroinject demo apply {{arg op val} { global result upvar 1 f f l l lappend result [info coroutine] $arg $op $val lappend result [info level] $l [info frame] $f lappend result [yield $arg] return [string toupper $val] }} grill list [demo ABC] [demo pqr] [demo def] $result } } -cleanup { interp delete $i } -result {grill {} {ABC def} {::demo grill yield ABC 2 1 3 2 pqr}} test coroutine-11.1 {coro type} { coroutine demo eval { yield yield "PHASE 1" yieldto string cat "PHASE 2" ::tcl::unsupported::corotype [info coroutine] } list [demo] [::tcl::unsupported::corotype demo] \ [demo] [::tcl::unsupported::corotype demo] [demo] } {{PHASE 1} yield {PHASE 2} yieldto active} test coroutine-11.2 {coro type} -setup { catch {rename nosuchcommand ""} } -returnCodes error -body { ::tcl::unsupported::corotype nosuchcommand } -result {can only get coroutine type of a coroutine} test coroutine-11.3 {coro type} -returnCodes error -body { proc notacoroutine {} {} ::tcl::unsupported::corotype notacoroutine } -returnCodes error -cleanup { rename notacoroutine {} } -result {can only get coroutine type of a coroutine} test coroutine-12.1 {coroutine general introspection} -setup { set i [interp create] } -body { $i eval { # Make the introspection code namespace path tcl::unsupported proc probe {type var} { upvar 1 $var v |
︙ | ︙ |
Changes to tests/interp.test.
︙ | ︙ | |||
16 17 18 19 20 21 22 | } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testinterpdelete [llength [info commands testinterpdelete]] | | | 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testinterpdelete [llength [info commands testinterpdelete]] set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:encoding:system tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempdir tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable tcl:info:cmdtype tcl:info:nameofexecutable tcl:process:autopurge tcl:process:list tcl:process:purge tcl:process:status tcl:zipfs:lmkimg tcl:zipfs:lmkzip tcl:zipfs:mkimg tcl:zipfs:mkkey tcl:zipfs:mkzip tcl:zipfs:mount tcl:zipfs:mount_data tcl:zipfs:unmount unload} foreach i [interp slaves] { interp delete $i } # Part 0: Check out options for interp command test interp-1.1 {options for interp command} -returnCodes error -body { |
︙ | ︙ |
Changes to tools/genStubs.tcl.
︙ | ︙ | |||
519 520 521 522 523 524 525 | set pad 28 } append line $next set sep ", " } append line ", ...)" if {[lindex $args end] eq "{const char *} format"} { | | | 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 | set pad 28 } append line $next set sep ", " } append line ", ...)" if {[lindex $args end] eq "{const char *} format"} { append line " TCL_FORMAT_PRINTF(" [expr {[llength $args] - 1}] ", " [llength $args] ")" } } default { set sep "(" foreach arg $args { append line $sep set next {} |
︙ | ︙ | |||
627 628 629 630 631 632 633 | append text " " } append text [lindex $arg 1] [lindex $arg 2] set sep ", " } append text ", ...)" if {[lindex $args end] eq "{const char *} format"} { | | | 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 | append text " " } append text [lindex $arg 1] [lindex $arg 2] set sep ", " } append text ", ...)" if {[lindex $args end] eq "{const char *} format"} { append text " TCL_FORMAT_PRINTF(" [expr {[llength $args] - 1}] ", " [llength $args] ")" } } default { set sep "(" foreach arg $args { append text $sep [lindex $arg 0] if {[string index $text end] ne "*"} { |
︙ | ︙ |
Changes to tools/man2help2.tcl.
︙ | ︙ | |||
823 824 825 826 827 828 829 | } elseif {$length == 1} { set indent 5 } if {$text == {\(bu}} { set text "\u00b7" } | | | 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 | } elseif {$length == 1} { set indent 5 } if {$text == {\(bu}} { set text "\u00b7" } set tab [expr {$indent * 0.1}]i newPara $tab -$tab set state(sb) 80 setTabs $tab formattedText $text tab } |
︙ | ︙ |
Changes to tools/man2html2.tcl.
︙ | ︙ | |||
110 111 112 113 114 115 116 | # string - Text to output in the paragraph. proc text string { global file textState inDT charCnt inTable set pos [string first "\t" $string] if {$pos >= 0} { | | | | 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 | # string - Text to output in the paragraph. proc text string { global file textState inDT charCnt inTable set pos [string first "\t" $string] if {$pos >= 0} { text [string range $string 0 [expr {$pos-1}]] tab text [string range $string [expr {$pos+1}] end] return } if {$inTable} { if {$inTable == 1} { puts -nonewline $file <TR> set inTable 2 } |
︙ | ︙ | |||
467 468 469 470 471 472 473 | # puts "formattedText: $text" while {$text ne ""} { set index [string first \\ $text] if {$index < 0} { text $text return } | | | | | | | | | | 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 | # puts "formattedText: $text" while {$text ne ""} { set index [string first \\ $text] if {$index < 0} { text $text return } text [string range $text 0 [expr {$index-1}]] set c [string index $text [expr {$index+1}]] switch -- $c { f { font [string index $text [expr {$index+2}]] set text [string range $text [expr {$index+3}] end] } e { text \\ set text [string range $text [expr {$index+2}] end] } - { dash set text [string range $text [expr {$index+2}] end] } | { set text [string range $text [expr {$index+2}] end] } default { puts stderr "Unknown sequence: \\$c" set text [string range $text [expr {$index+2}] end] } } } } ############################################################################## # dash -- |
︙ | ︙ | |||
523 524 525 526 527 528 529 | # Arguments: # None. proc tab {} { global inPRE charCnt tabString file # ? charCnt if {$inPRE == 1} { | | | 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 | # Arguments: # None. proc tab {} { global inPRE charCnt tabString file # ? charCnt if {$inPRE == 1} { set pos [expr {$charCnt % [string length $tabString]}] set spaces [string first "1" [string range $tabString $pos end] ] text [format "%*s" [incr spaces] " "] } else { # puts "tab: found tab outside of <PRE> block" } } |
︙ | ︙ |
Changes to tools/regexpTestLib.tcl.
︙ | ︙ | |||
13 14 15 16 17 18 19 | set fileId [open $inFileName r] set i 0 while {[gets $fileId line] >= 0} { set len [string length $line] | | | | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | set fileId [open $inFileName r] set i 0 while {[gets $fileId line] >= 0} { set len [string length $line] if {($len > 0) && ([string index $line [expr {$len - 1}]] == "\\")} { if {[info exists lineArray(c$i)] == 0} { set lineArray(c$i) 1 } else { incr lineArray(c$i) } set line [string range $line 0 [expr {$len - 2}]] append lineArray($i) $line continue } if {[info exists lineArray(c$i)] == 0} { set lineArray(c$i) 1 } else { incr lineArray(c$i) |
︙ | ︙ | |||
200 201 202 203 204 205 206 | } set str [lindex $currentLine 2] } set flags [removeFlags $flags] # find the test result | | | 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 | } set str [lindex $currentLine 2] } set flags [removeFlags $flags] # find the test result set numVars [expr {$len - 3}] set vars {} set vals {} set result 0 set v 0 if {[regsub {\*} "$flags" "" newFlags] == 1} { # an error is expected |
︙ | ︙ |
Changes to tools/str2c.
︙ | ︙ | |||
35 36 37 38 39 40 41 | } else { puts "/* * Multi parts read only string generated by str2c */ static const char * const data\[\]= {" set n 1 for {set i 0} {$i<$lg} {incr i $MAX} { | | | 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 | } else { puts "/* * Multi parts read only string generated by str2c */ static const char * const data\[\]= {" set n 1 for {set i 0} {$i<$lg} {incr i $MAX} { set part [string range $r $i [expr {$i+$MAX-1}]] set len [string length $part]; puts "\t/* Start of part $n ($len characters) */" puts "\t\"[translate $part]\"," puts "\t/* End of part $n */\n" incr n } puts "\tNULL\t/* End of data marker */\n};" |
︙ | ︙ |
Changes to tools/tcltk-man2html-utils.tcl.
︙ | ︙ | |||
1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 | # set manual(toc-$manual(wing-file)-$manual(name)) \ [concat <DL> $manual(section-toc) </DL>] } if {!$verbose} { puts stderr "" } # # make the wing table of contents for the section # set width 0 foreach name $manual(wing-toc) { if {[string length $name] > $width} { | > > > > | 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 | # set manual(toc-$manual(wing-file)-$manual(name)) \ [concat <DL> $manual(section-toc) </DL>] } if {!$verbose} { puts stderr "" } if {![llength $manual(wing-toc)]} { fatal "not table of contents." } # # make the wing table of contents for the section # set width 0 foreach name $manual(wing-toc) { if {[string length $name] > $width} { |
︙ | ︙ |
Changes to tools/tcltk-man2html.tcl.
︙ | ︙ | |||
27 28 29 30 31 32 33 34 35 36 37 38 39 | ## ## Source the utility functions that provide most of the ## implementation of the transformation from nroff to html. ## source [file join [file dirname [info script]] tcltk-man2html-utils.tcl] proc findversion {top name useversion} { set upper [string toupper $name] foreach top1 [list $top $top/..] sub {{} generic} { foreach dirname [ glob -nocomplain -tails -type d -directory $top1 *] { | > > > > > > > > > > > > > > > > > > > > > > > | < | < < < < | < < | | | | | | | | < < | 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 | ## ## Source the utility functions that provide most of the ## implementation of the transformation from nroff to html. ## source [file join [file dirname [info script]] tcltk-man2html-utils.tcl] proc getversion {tclh {name {}}} { if {[file exists $tclh]} { set chan [open $tclh] set data [read $chan] close $chan if {$name eq ""} { set name [string toupper [file root [file tail $tclh]]] } # backslash isn't required in front of quote, but it keeps syntax # highlighting straight in some editors if {[regexp -lineanchor \ [string map [list @name@ $name] \ {^#define\s+@name@_VERSION\s+\"([^.])+\.([^.\"]+)}] \ $data -> major minor]} { return [list $major $minor] } } } proc findversion {top name useversion} { # Default search version is a glob pattern, switch it for string match: if {$useversion eq {{,[8-9].[0-9]{,[.ab][0-9]{,[0-9]}}}}} { set useversion {[8-9].[0-9]} } # Search: set upper [string toupper $name] foreach top1 [list $top $top/..] sub {{} generic} { foreach dirname [ glob -nocomplain -tails -type d -directory $top1 *] { set tclh [join [list $top1 $dirname {*}$sub ${name}.h] /] set v [getversion $tclh $upper] if {[llength $v]} { lassign $v major minor # to do # use glob matching instead of string matching or add # brace handling to [string matcch] if {$useversion eq {} || [string match $useversion $major.$minor]} { set top [file dirname [file dirname $tclh]] set prefix [file dirname $top] return [list $prefix [file tail $top] $major $minor] } } } } } proc parse_command_line {} { global argv Version # These variables determine where the man pages come from and where # the converted pages go to. |
︙ | ︙ | |||
146 147 148 149 150 151 152 153 154 | } } if {!$build_tcl && !$build_tk} { set build_tcl 1; set build_tk 1 } if {$build_tcl} { | > > > | > > > > > > | > | > > > > > > > > | > > | > > > | 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 | } } if {!$build_tcl && !$build_tk} { set build_tcl 1; set build_tk 1 } set major "" set minor "" if {$build_tcl} { # Find Tcl (firstly using glob pattern / backwards compatible way) set tcldir [lindex [lsort [glob -nocomplain -tails -type d \ -directory $tcltkdir tcl$useversion]] end] if {$tcldir ne {}} { # obtain version from generic header if we can: lassign [getversion [file join $tcltkdir $tcldir generic tcl.h]] major minor } else { lassign [findversion $tcltkdir tcl $useversion] tcltkdir tcldir major minor } if {$tcldir eq {} && $opt_build_tcl} { puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir" exit 1 } puts "using Tcl source directory $tcltkdir $tcldir" } if {$build_tk} { # Find Tk (firstly using glob pattern / backwards compatible way) set tkdir [lindex [lsort [glob -nocomplain -tails -type d \ -directory $tcltkdir tk$useversion]] end] if {$tkdir ne {}} { if {$major eq ""} { # obtain version from generic header if we can: lassign [getversion [file join $tcltkdir $tcldir generic tk.h]] major minor } } else { lassign [findversion $tcltkdir tk $useversion] tcltkdir tkdir major minor } if {$tkdir eq {} && $opt_build_tk} { puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir" exit 1 } puts "using Tk source directory $tkdir" } puts "verbose messages are [expr {$verbose ? {on} : {off}}]" # the title for the man pages overall global overall_title set overall_title "" if {$build_tcl} { if {$major ne ""} { append overall_title "Tcl $major.$minor" } else { append overall_title "Tcl [capitalize $tcldir]" } } if {$build_tcl && $build_tk} { append overall_title "/" } if {$build_tk} { append overall_title "[capitalize $tkdir]" } |
︙ | ︙ |
Changes to unix/Makefile.in.
︙ | ︙ | |||
322 323 324 325 326 327 328 | TOMMATH_OBJS = bn_reverse.o bn_fast_s_mp_mul_digs.o \ bn_fast_s_mp_sqr.o bn_mp_add.o bn_mp_and.o \ bn_mp_add_d.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o \ bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \ bn_mp_cnt_lsb.o bn_mp_copy.o \ bn_mp_count_bits.o bn_mp_div.o bn_mp_div_d.o bn_mp_div_2.o \ bn_mp_div_2d.o bn_mp_div_3.o bn_mp_exch.o \ | | | | 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 | TOMMATH_OBJS = bn_reverse.o bn_fast_s_mp_mul_digs.o \ bn_fast_s_mp_sqr.o bn_mp_add.o bn_mp_and.o \ bn_mp_add_d.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o \ bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \ bn_mp_cnt_lsb.o bn_mp_copy.o \ bn_mp_count_bits.o bn_mp_div.o bn_mp_div_d.o bn_mp_div_2.o \ bn_mp_div_2d.o bn_mp_div_3.o bn_mp_exch.o \ bn_mp_expt_d.o bn_mp_expt_d_ex.o bn_s_mp_get_bit.o bn_mp_get_int.o \ bn_mp_get_long.o bn_mp_get_long_long.o bn_mp_grow.o bn_mp_init.o \ bn_mp_init_copy.o bn_mp_init_multi.o bn_mp_init_set.o \ bn_mp_init_set_int.o bn_mp_init_size.o bn_mp_karatsuba_mul.o \ bn_mp_karatsuba_sqr.o \ bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mul.o bn_mp_mul_2.o \ bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_neg.o bn_mp_or.o \ bn_mp_radix_size.o bn_mp_radix_smap.o \ bn_mp_read_radix.o bn_mp_rshd.o bn_mp_set.o bn_mp_set_int.o \ bn_mp_set_long.o bn_mp_set_long_long.o bn_mp_shrink.o \ bn_mp_sqr.o bn_mp_sqrt.o bn_mp_sub.o bn_mp_sub_d.o \ bn_mp_signed_rsh.o \ bn_mp_to_unsigned_bin.o bn_mp_to_unsigned_bin_n.o \ bn_mp_toom_mul.o bn_mp_toom_sqr.o bn_mp_toradix_n.o \ bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \ bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o STUB_LIB_OBJS = tclStubLib.o \ tclTomMathStubLib.o \ |
︙ | ︙ | |||
546 547 548 549 550 551 552 | $(TOMMATH_DIR)/bn_mp_set_long.c \ $(TOMMATH_DIR)/bn_mp_set_long_long.c \ $(TOMMATH_DIR)/bn_mp_shrink.c \ $(TOMMATH_DIR)/bn_mp_sqr.c \ $(TOMMATH_DIR)/bn_mp_sqrt.c \ $(TOMMATH_DIR)/bn_mp_sub.c \ $(TOMMATH_DIR)/bn_mp_sub_d.c \ | | < < < | 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 | $(TOMMATH_DIR)/bn_mp_set_long.c \ $(TOMMATH_DIR)/bn_mp_set_long_long.c \ $(TOMMATH_DIR)/bn_mp_shrink.c \ $(TOMMATH_DIR)/bn_mp_sqr.c \ $(TOMMATH_DIR)/bn_mp_sqrt.c \ $(TOMMATH_DIR)/bn_mp_sub.c \ $(TOMMATH_DIR)/bn_mp_sub_d.c \ $(TOMMATH_DIR)/bn_mp_signed_rsh.c \ $(TOMMATH_DIR)/bn_mp_to_unsigned_bin.c \ $(TOMMATH_DIR)/bn_mp_to_unsigned_bin_n.c \ $(TOMMATH_DIR)/bn_mp_toom_mul.c \ $(TOMMATH_DIR)/bn_mp_toom_sqr.c \ $(TOMMATH_DIR)/bn_mp_toradix_n.c \ $(TOMMATH_DIR)/bn_mp_unsigned_bin_size.c \ $(TOMMATH_DIR)/bn_mp_xor.c \ |
︙ | ︙ | |||
1536 1537 1538 1539 1540 1541 1542 | bn_mp_expt_d.o: $(TOMMATH_DIR)/bn_mp_expt_d.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_expt_d.c bn_mp_expt_d_ex.o: $(TOMMATH_DIR)/bn_mp_expt_d_ex.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_expt_d_ex.c | | | | 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 | bn_mp_expt_d.o: $(TOMMATH_DIR)/bn_mp_expt_d.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_expt_d.c bn_mp_expt_d_ex.o: $(TOMMATH_DIR)/bn_mp_expt_d_ex.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_expt_d_ex.c bn_s_mp_get_bit.o: $(TOMMATH_DIR)/bn_s_mp_get_bit.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_get_bit.c bn_mp_get_int.o: $(TOMMATH_DIR)/bn_mp_get_int.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_get_int.c bn_mp_get_long.o: $(TOMMATH_DIR)/bn_mp_get_long.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_get_long.c |
︙ | ︙ | |||
1641 1642 1643 1644 1645 1646 1647 | bn_mp_sub.o: $(TOMMATH_DIR)/bn_mp_sub.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_sub.c bn_mp_sub_d.o: $(TOMMATH_DIR)/bn_mp_sub_d.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_sub_d.c | < < < < < < | | < < < | 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 | bn_mp_sub.o: $(TOMMATH_DIR)/bn_mp_sub.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_sub.c bn_mp_sub_d.o: $(TOMMATH_DIR)/bn_mp_sub_d.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_sub_d.c bn_mp_signed_rsh.o: $(TOMMATH_DIR)/bn_mp_signed_rsh.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_signed_rsh.c bn_mp_to_unsigned_bin.o: $(TOMMATH_DIR)/bn_mp_to_unsigned_bin.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_to_unsigned_bin.c bn_mp_to_unsigned_bin_n.o: $(TOMMATH_DIR)/bn_mp_to_unsigned_bin_n.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_to_unsigned_bin_n.c |
︙ | ︙ | |||
2188 2189 2190 2191 2192 2193 2194 | $(UNIX_DIR)/tcl.pc.in $(DISTDIR)/unix $(DIST_INSTALL_SCRIPT) $(UNIX_DIR)/configure $(UNIX_DIR)/ldAix $(DISTDIR)/unix $(INSTALL_DATA_DIR) $(DISTDIR)/generic $(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.[cdh] $(DISTDIR)/generic $(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.decls $(DISTDIR)/generic $(DIST_INSTALL_DATA) $(GENERIC_DIR)/README $(DISTDIR)/generic $(DIST_INSTALL_DATA) $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic | | | 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 | $(UNIX_DIR)/tcl.pc.in $(DISTDIR)/unix $(DIST_INSTALL_SCRIPT) $(UNIX_DIR)/configure $(UNIX_DIR)/ldAix $(DISTDIR)/unix $(INSTALL_DATA_DIR) $(DISTDIR)/generic $(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.[cdh] $(DISTDIR)/generic $(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.decls $(DISTDIR)/generic $(DIST_INSTALL_DATA) $(GENERIC_DIR)/README $(DISTDIR)/generic $(DIST_INSTALL_DATA) $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic $(DIST_INSTALL_DATA) $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README.md \ $(TOP_DIR)/ChangeLog.[12]??? $(TOP_DIR)/license.terms \ $(DISTDIR) $(INSTALL_DATA_DIR) $(DISTDIR)/library $(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \ $(TOP_DIR)/library/tclIndex $(DISTDIR)/library @for i in $(BUILTIN_PACKAGE_LIST) ; do \ $(INSTALL_DATA_DIR) $(DISTDIR)/library/$$i;\ |
︙ | ︙ |
Changes to unix/tclUnixFCmd.c.
︙ | ︙ | |||
2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 | * Assume that the default location ("/tmp" if not overridden) is always * an existing writable directory; we've no recovery mechanism if it * isn't. */ return TCL_TEMPORARY_FILE_DIRECTORY; } #if defined(__CYGWIN__) static void StatError( Tcl_Interp *interp, /* The interp that has the error */ Tcl_Obj *fileName) /* The name of the file which caused the | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 | * Assume that the default location ("/tmp" if not overridden) is always * an existing writable directory; we've no recovery mechanism if it * isn't. */ return TCL_TEMPORARY_FILE_DIRECTORY; } /* *---------------------------------------------------------------------- * * TclpCreateTemporaryDirectory -- * * Creates a temporary directory, possibly based on the supplied bits and * pieces of template supplied in the arguments. * * Results: * An object (refcount 0) containing the name of the newly-created * directory, or NULL on failure. * * Side effects: * Accesses the native filesystem. Makes a directory. * *---------------------------------------------------------------------- */ Tcl_Obj * TclpCreateTemporaryDirectory( Tcl_Obj *dirObj, Tcl_Obj *basenameObj) { Tcl_DString template, tmp; const char *string; #define DEFAULT_TEMP_DIR_PREFIX "tcl" /* * Build the template in writable memory from the user-supplied pieces and * some defaults. */ if (dirObj) { string = TclGetString(dirObj); Tcl_UtfToExternalDString(NULL, string, dirObj->length, &template); } else { Tcl_DStringInit(&template); Tcl_DStringAppend(&template, DefaultTempDir(), -1); /* INTL: native */ } if (Tcl_DStringValue(&template)[Tcl_DStringLength(&template) - 1] != '/') { TclDStringAppendLiteral(&template, "/"); } if (basenameObj) { string = TclGetString(basenameObj); if (basenameObj->length) { Tcl_UtfToExternalDString(NULL, string, basenameObj->length, &tmp); TclDStringAppendDString(&template, &tmp); Tcl_DStringFree(&tmp); } else { TclDStringAppendLiteral(&template, DEFAULT_TEMP_DIR_PREFIX); } } else { TclDStringAppendLiteral(&template, DEFAULT_TEMP_DIR_PREFIX); } TclDStringAppendLiteral(&template, "_XXXXXX"); /* * Make the temporary directory. */ if (mkdtemp(Tcl_DStringValue(&template)) == NULL) { Tcl_DStringFree(&template); return NULL; } /* * The template has been updated. Tell the caller what it was. */ Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&template), Tcl_DStringLength(&template), &tmp); Tcl_DStringFree(&template); return TclDStringToObj(&tmp); } #if defined(__CYGWIN__) static void StatError( Tcl_Interp *interp, /* The interp that has the error */ Tcl_Obj *fileName) /* The name of the file which caused the |
︙ | ︙ |
Changes to win/Makefile.in.
︙ | ︙ | |||
382 383 384 385 386 387 388 | bn_mp_div_d.${OBJEXT} \ bn_mp_div_2.${OBJEXT} \ bn_mp_div_2d.${OBJEXT} \ bn_mp_div_3.${OBJEXT} \ bn_mp_exch.${OBJEXT} \ bn_mp_expt_d.${OBJEXT} \ bn_mp_expt_d_ex.${OBJEXT} \ | | | 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 | bn_mp_div_d.${OBJEXT} \ bn_mp_div_2.${OBJEXT} \ bn_mp_div_2d.${OBJEXT} \ bn_mp_div_3.${OBJEXT} \ bn_mp_exch.${OBJEXT} \ bn_mp_expt_d.${OBJEXT} \ bn_mp_expt_d_ex.${OBJEXT} \ bn_s_mp_get_bit.${OBJEXT} \ bn_mp_get_int.${OBJEXT} \ bn_mp_get_long.${OBJEXT} \ bn_mp_get_long_long.${OBJEXT} \ bn_mp_grow.${OBJEXT} \ bn_mp_init.${OBJEXT} \ bn_mp_init_copy.${OBJEXT} \ bn_mp_init_multi.${OBJEXT} \ |
︙ | ︙ | |||
417 418 419 420 421 422 423 | bn_mp_set_long.${OBJEXT} \ bn_mp_set_long_long.${OBJEXT} \ bn_mp_shrink.${OBJEXT} \ bn_mp_sqr.${OBJEXT} \ bn_mp_sqrt.${OBJEXT} \ bn_mp_sub.${OBJEXT} \ bn_mp_sub_d.${OBJEXT} \ | < < | < | 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 | bn_mp_set_long.${OBJEXT} \ bn_mp_set_long_long.${OBJEXT} \ bn_mp_shrink.${OBJEXT} \ bn_mp_sqr.${OBJEXT} \ bn_mp_sqrt.${OBJEXT} \ bn_mp_sub.${OBJEXT} \ bn_mp_sub_d.${OBJEXT} \ bn_mp_signed_rsh.${OBJEXT} \ bn_mp_to_unsigned_bin.${OBJEXT} \ bn_mp_to_unsigned_bin_n.${OBJEXT} \ bn_mp_toom_mul.${OBJEXT} \ bn_mp_toom_sqr.${OBJEXT} \ bn_mp_toradix_n.${OBJEXT} \ bn_mp_unsigned_bin_size.${OBJEXT} \ bn_mp_xor.${OBJEXT} \ |
︙ | ︙ |
Changes to win/makefile.vc.
︙ | ︙ | |||
274 275 276 277 278 279 280 | $(TMP_DIR)\bn_mp_div_d.obj \ $(TMP_DIR)\bn_mp_div_2.obj \ $(TMP_DIR)\bn_mp_div_2d.obj \ $(TMP_DIR)\bn_mp_div_3.obj \ $(TMP_DIR)\bn_mp_exch.obj \ $(TMP_DIR)\bn_mp_expt_d.obj \ $(TMP_DIR)\bn_mp_expt_d_ex.obj \ | | | 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 | $(TMP_DIR)\bn_mp_div_d.obj \ $(TMP_DIR)\bn_mp_div_2.obj \ $(TMP_DIR)\bn_mp_div_2d.obj \ $(TMP_DIR)\bn_mp_div_3.obj \ $(TMP_DIR)\bn_mp_exch.obj \ $(TMP_DIR)\bn_mp_expt_d.obj \ $(TMP_DIR)\bn_mp_expt_d_ex.obj \ $(TMP_DIR)\bn_s_mp_get_bit.obj \ $(TMP_DIR)\bn_mp_get_int.obj \ $(TMP_DIR)\bn_mp_get_long.obj \ $(TMP_DIR)\bn_mp_get_long_long.obj \ $(TMP_DIR)\bn_mp_grow.obj \ $(TMP_DIR)\bn_mp_init.obj \ $(TMP_DIR)\bn_mp_init_copy.obj \ $(TMP_DIR)\bn_mp_init_multi.obj \ |
︙ | ︙ | |||
309 310 311 312 313 314 315 | $(TMP_DIR)\bn_mp_set_long.obj \ $(TMP_DIR)\bn_mp_set_long_long.obj \ $(TMP_DIR)\bn_mp_shrink.obj \ $(TMP_DIR)\bn_mp_sqr.obj \ $(TMP_DIR)\bn_mp_sqrt.obj \ $(TMP_DIR)\bn_mp_sub.obj \ $(TMP_DIR)\bn_mp_sub_d.obj \ | < < | < | 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 | $(TMP_DIR)\bn_mp_set_long.obj \ $(TMP_DIR)\bn_mp_set_long_long.obj \ $(TMP_DIR)\bn_mp_shrink.obj \ $(TMP_DIR)\bn_mp_sqr.obj \ $(TMP_DIR)\bn_mp_sqrt.obj \ $(TMP_DIR)\bn_mp_sub.obj \ $(TMP_DIR)\bn_mp_sub_d.obj \ $(TMP_DIR)\bn_mp_signed_rsh.obj \ $(TMP_DIR)\bn_mp_to_unsigned_bin.obj \ $(TMP_DIR)\bn_mp_to_unsigned_bin_n.obj \ $(TMP_DIR)\bn_mp_toom_mul.obj \ $(TMP_DIR)\bn_mp_toom_sqr.obj \ $(TMP_DIR)\bn_mp_toradix_n.obj \ $(TMP_DIR)\bn_mp_unsigned_bin_size.obj \ $(TMP_DIR)\bn_mp_xor.obj \ |
︙ | ︙ |
Changes to win/tclWinFCmd.c.
︙ | ︙ | |||
1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 | Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr); } } Tcl_IncrRefCount(resultPtr); return resultPtr; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 | Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr); } } Tcl_IncrRefCount(resultPtr); return resultPtr; } /* *---------------------------------------------------------------------- * * TclpCreateTemporaryDirectory -- * * Creates a temporary directory, possibly based on the supplied bits and * pieces of template supplied in the arguments. * * Results: * An object (refcount 0) containing the name of the newly-created * directory, or NULL on failure. * * Side effects: * Accesses the native filesystem. Makes a directory. * *---------------------------------------------------------------------- */ Tcl_Obj * TclpCreateTemporaryDirectory( Tcl_Obj *dirObj, Tcl_Obj *basenameObj) { Tcl_DString base, name; /* Contains WCHARs */ int baseLen; DWORD error; WCHAR tempBuf[MAX_PATH + 1]; DWORD len = GetTempPathW(MAX_PATH, tempBuf); /* * Build the path in writable memory from the user-supplied pieces and * some defaults. First, the parent temporary directory. */ if (dirObj) { Tcl_GetString(dirObj); if (dirObj->length < 1) { goto useSystemTemp; } Tcl_WinUtfToTChar(Tcl_GetString(dirObj), -1, &base); if (dirObj->bytes[dirObj->length - 1] != '\\') { TclUtfToWCharDString("\\", -1, &base); } } else { useSystemTemp: Tcl_DStringInit(&base); Tcl_DStringAppend(&base, (char *) tempBuf, len * sizeof(WCHAR)); } /* * Next, the base of the directory name. */ #define DEFAULT_TEMP_DIR_PREFIX "tcl" #define SUFFIX_LENGTH 8 if (basenameObj) { Tcl_WinUtfToTChar(Tcl_GetString(basenameObj), -1, &name); TclDStringAppendDString(&base, &name); Tcl_DStringFree(&name); } else { TclUtfToWCharDString(DEFAULT_TEMP_DIR_PREFIX, -1, &base); } TclUtfToWCharDString("_", -1, &base); /* * Now we keep on trying random suffixes until we get one that works * (i.e., that doesn't trigger the ERROR_ALREADY_EXISTS error). Note that * SUFFIX_LENGTH is longer than on Unix because we expect to be not on a * case-sensitive filesystem. */ baseLen = Tcl_DStringLength(&base); do { char tempbuf[SUFFIX_LENGTH + 1]; int i; static const char randChars[] = "QWERTYUIOPASDFGHJKLZXCVBNM1234567890"; static const int numRandChars = sizeof(randChars) - 1; /* * Put a random suffix on the end. */ error = ERROR_SUCCESS; tempbuf[SUFFIX_LENGTH] = '\0'; for (i = 0 ; i < SUFFIX_LENGTH; i++) { tempbuf[i] = randChars[(int) (rand() % numRandChars)]; } Tcl_DStringSetLength(&base, baseLen); TclUtfToWCharDString(tempbuf, -1, &base); } while (!CreateDirectoryW((LPCWSTR) Tcl_DStringValue(&base), NULL) && (error = GetLastError()) == ERROR_ALREADY_EXISTS); /* * Check for other errors. The big ones are ERROR_PATH_NOT_FOUND and * ERROR_ACCESS_DENIED. */ if (error != ERROR_SUCCESS) { TclWinConvertError(error); Tcl_DStringFree(&base); return NULL; } /* * We actually made the directory, so we're done! Report what we made back * as a (clean) Tcl_Obj. */ Tcl_WinTCharToUtf((LPCWSTR) Tcl_DStringValue(&base), -1, &name); Tcl_DStringFree(&base); return TclDStringToObj(&name); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: |
︙ | ︙ |